From 5bfd1c15c4d4478a49626a66be0455d736a3c215 Mon Sep 17 00:00:00 2001
From: Kevin Lyda <kevin@ie.suberic.net>
Date: Sun, 31 Jan 2016 00:05:51 +0000
Subject: [PATCH] Unpack and add lzh file contents.
---
.../vax90b1/gce90b/bulletin_beta/allmacs.mar | 299 +++
.../gce90b/bulletin_beta/bull20_ann.txt | Bin 11236 -> 10866 bytes
.../gce90b/bulletin_beta/bullcoms1.hlp | 789 +++++++
.../gce90b/bulletin_beta/bullcoms2.hlp | 801 +++++++
.../vax90b1/gce90b/bulletin_beta/bullet1.com | 1251 ++++++++++
.../vax90b1/gce90b/bulletin_beta/bullet2.com | 1142 ++++++++++
.../vax90b1/gce90b/bulletin_beta/bulletin.for | 1648 ++++++++++++++
.../gce90b/bulletin_beta/bulletin0.for | 1645 +++++++++++++
.../gce90b/bulletin_beta/bulletin1.for | 1786 +++++++++++++++
.../gce90b/bulletin_beta/bulletin10.for | 1980 ++++++++++++++++
.../gce90b/bulletin_beta/bulletin2.for | 1773 +++++++++++++++
.../gce90b/bulletin_beta/bulletin3.for | 1757 ++++++++++++++
.../gce90b/bulletin_beta/bulletin4.for | 1803 +++++++++++++++
.../gce90b/bulletin_beta/bulletin5.for | 2017 ++++++++++++++++
.../gce90b/bulletin_beta/bulletin6.for | 1693 ++++++++++++++
.../gce90b/bulletin_beta/bulletin7.for | 2026 +++++++++++++++++
.../gce90b/bulletin_beta/bulletin8.for | 1907 ++++++++++++++++
.../gce90b/bulletin_beta/bulletin9.for | 1977 ++++++++++++++++
.../bulletin_beta/bulletin_beta_ann.txt | Bin 4046 -> 3935 bytes
decus/vax90b1/gce90b/bulletin_beta/pmdf.com | 1019 +++++++++
20 files changed, 27313 insertions(+)
create mode 100644 decus/vax90b1/gce90b/bulletin_beta/allmacs.mar
mode change 100755 => 100644 decus/vax90b1/gce90b/bulletin_beta/bull20_ann.txt
create mode 100644 decus/vax90b1/gce90b/bulletin_beta/bullcoms1.hlp
create mode 100644 decus/vax90b1/gce90b/bulletin_beta/bullcoms2.hlp
create mode 100644 decus/vax90b1/gce90b/bulletin_beta/bullet1.com
create mode 100644 decus/vax90b1/gce90b/bulletin_beta/bullet2.com
create mode 100644 decus/vax90b1/gce90b/bulletin_beta/bulletin.for
create mode 100644 decus/vax90b1/gce90b/bulletin_beta/bulletin0.for
create mode 100644 decus/vax90b1/gce90b/bulletin_beta/bulletin1.for
create mode 100644 decus/vax90b1/gce90b/bulletin_beta/bulletin10.for
create mode 100644 decus/vax90b1/gce90b/bulletin_beta/bulletin2.for
create mode 100644 decus/vax90b1/gce90b/bulletin_beta/bulletin3.for
create mode 100644 decus/vax90b1/gce90b/bulletin_beta/bulletin4.for
create mode 100644 decus/vax90b1/gce90b/bulletin_beta/bulletin5.for
create mode 100644 decus/vax90b1/gce90b/bulletin_beta/bulletin6.for
create mode 100644 decus/vax90b1/gce90b/bulletin_beta/bulletin7.for
create mode 100644 decus/vax90b1/gce90b/bulletin_beta/bulletin8.for
create mode 100644 decus/vax90b1/gce90b/bulletin_beta/bulletin9.for
mode change 100755 => 100644 decus/vax90b1/gce90b/bulletin_beta/bulletin_beta_ann.txt
create mode 100644 decus/vax90b1/gce90b/bulletin_beta/pmdf.com
diff --git a/decus/vax90b1/gce90b/bulletin_beta/allmacs.mar b/decus/vax90b1/gce90b/bulletin_beta/allmacs.mar
new file mode 100644
index 0000000..a74474d
--- /dev/null
+++ b/decus/vax90b1/gce90b/bulletin_beta/allmacs.mar
@@ -0,0 +1,299 @@
+;
+; 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<R2,R3,R4,R5,R6,R7>
+ 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<R2,R3>
+ 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<R2,R3,R4,R5,R6,R7,R8>
+ 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,<IDENT,TIME>
+
+ .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, <IHI$T_IMGID+1>(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<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
+ 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/gce90b/bulletin_beta/bull20_ann.txt b/decus/vax90b1/gce90b/bulletin_beta/bull20_ann.txt
old mode 100755
new mode 100644
index 9db790eafced7d41f9acff57434c4df41f54c7f1..0eb31385a326567811d9b361748a6dd712a4d404
GIT binary patch
delta 1637
zcmaD7{wZW4ldB0=NWK-PV~}UCr=yjXYnW@0hhtC(m$S1KCs%N3QkE5`Q>c%RYlx?x
zLTO26PG(7^9v9cdCJ#ogiD#S`xh4xR>M?Rnc3@Os<eHqs=*q}7c@?83BiH0>V38k;
zMvPpOb(mxsxhDHCNr{0hQ^2rnavhTvNF$RLGnWF_<XcP*U|NCMgOO`;7PE&mmr_A$
zQE`4=VvdqRK~ZX2YEf!la;lytNcAPKDj61eupTECcSf$sJuJ$MT$4AkfE;p<MTe1V
zG7qZ>Sl*2lWab1gd5hIUj4LfQv81#pRYxHszdW@pwFqLU4I4;V8<@PnrVQ5l3(Rw2
z2g&q-$s1r&i322(117hD$Vr@%U=0eKAc-t6xdlxA1Ct(HAn{3H@(!3(;|7TofXQ88
zl7$B(;s+*Y@R)(ky8`CP@q%PBz~m-g8?ek5UWa-vPD4!vSX}A3`3G@v8X*J>AR@*H
z5krWG2|~mOB4UaVF@}hkAw*0dBIXDYQ;0~t1wzOSB4mjWF^7m48X$x$ph8HlwuA~H
zx!Vxxa6@BF1xFtrUq|O)JzvKlE>1(J!=3$ogAMgOeB1-LI1Qmr2Z<T!dH8^Y;BGh6
zbN2V;;xvRi-3TgRp{Wqy>*5CHDR51m!4C@GM_^J%0K_f>lLrJKvG51Xa}xx~Ob`Sm
z`-6h=lP?JJPktaM%E&dDQOJI>fDk7aSD1pKo~1D;iTVjSGjdIyBIL!$HTi*%6*$Ti
zgh9L<VL32wg0Lqe*W^3Gt~^`{5RFD4jV2->;RX><nm#4sA;6WHlA2eNnU<MaRICS5
zpeAY!*I@_}C=t~L8@Nmqr00XEJY3oUB&{T-0hSIB^I_zgJWmXgvQLQlfkkD+LDpr6
zdw_Y{#6d1(l5hm`yd<2!^dt#LMmi&*1Lpse@MGkf>?a8#=SljBb0rp~D&*xW<mBh2
zrxq!c7N@3wUCJTlEyv~S=;@=7mS3chnvz+PnU}7Rn_66)n4SvpOqmoYOb<vogAL}A
z4q)V(93$-t=B<$S6Xi-tEJ;<!PeauuAOrGgl#B&f-3%F!$DYZ6oMR^I&B!&mMHVD-
zN!Fi{YqE+Qh%A$XcwvK_H&_poJV-PIOfHiLss17l((j@GGPzFyByvYV3as{z0w_>C
z6hS&>DcXa@9w>subd-D<xhB^rLEN!R$y=KXlpCD`6bg#+lT(YqesoMpNlj633<+^`
z_E1R9&&^HDg9MM2GRW^O%8&?Irwp?Bhcd_(FBM4S%u@mJKB$0faZm;MtWVV%Z2tvS
zkeGrRBtnAJK#@344Xj!XB;%kC^34Qwhz~ZXgUtS=4haJj4UkDqVDf^74>wm@eojhi
z5je_pG(oy+G+n^99Mc4;6wv~aNm`&V*`Nin|C1KTL>q08SeLdxcX57hszOO-ZmJ#^
E0F1AY=>Px#
delta 2059
zcmewq@+6$em0^ObJc9^BNWK-PV~}UCr=yjXYnW@0hhtC(3xl(>6{k4E!~}6x1_lNX
zhKZFPOim0F4>>XEF-&G<)Z<WKa4X8swNjYKC&lE-FgcXbm6<`4Ve)K7O=boKhRH`6
z6_|_|CO=~|Vv=Q;EXgEm${@uMT$+@Xnp|R~;1ufP;~L`Wr%+mwnUh&ksRwq20=g@-
z7$&DPX)$RrOrFG~#m2~>z~I0zc|Vf_nCZbVnTgqh$%A3CH?xO=ID=9_YEf~1USf`t
zLP1e#T53^hUUI6QCId*D2gBrb%pOeg43obz%d>-p+!-cIvbZxdC^Jk>WKjmYy_H3i
znL&qP@_H5>CKHCqcUVkd774S0EsB9qOIbangc#CN6H7{qQgswE^2<}pQj7F7p*AtI
zfff6(c`zw6OrFZ746)FIVe)Q>3=2D0fiHxb2BGdlC=Cv<Tp@>tk|aY>erZW&UTU#I
zW}bqhkB_gTbFiMTW00mE*asdAldnNk%X5M?Wk9Hn5b76%a^?cd^+2er5K4|4ESL_V
zHbAJK+#XD343nLB%wXQG<^d}^0-<<$J(z45CWrCbfaM(+CQs#cs25=1G}MGgsGggD
zkRSu65kkZOB*Y-dz-f#SGlYqmAjFJdVx|Z&W0;s3Ld*mvW)2ps2d5)bn4kq%5G-Z}
z6SG8!nS;fI7&r|L5P}vUL68`dKP*9F!VH{-NIo%ycm?EPV@+6mq=6y?q#5cJXMf*d
zLp=|l0FW5eD<Cl=kQhiS+$)B9&i=k25r{{8TtkdNBD@Toh8CI%0lqG7ATBJXrTD>7
zkqn{MK&Y?$;25(LfX7(509e@p0S_hxhRK|Q3QW!nlMMycCp!qTPmT~2WoGbTm|Q66
zDyXZg%f=9<V5nzl3`(}n43iHCIx{nPF-&F=@?x@LnCvfP1&(GfhRHobUQBWfldlWO
zfkiwSCjSufWM*(>nCv9%DhzfZ)GQ;AS)L4&CkuNrGq^KMzANkwwoz5YLxhJRGbJ^z
zBr`2DwWwGRq|lmSa;=CpiUEcoaczdlM?|zCxyGGg@+T2@W(IkN$yTEBC~6HrYBd-p
zr;2KT-Q~kDd4i}9D9_y$h2}XwhRMugeqdQohRGpfo?zF^6Y~HIc`;0WDdxrG$S~PN
z+!11(6T{>RaVM~>3B%;Q;*b(Rhhg#;aUHOzAH!s22|p%3hRH<`>Y#+5j4(rDQK~{-
zzCuoZUV3VgLTPbo3M7wuGfY;K^j2n&V(@kJ^ifF5FH%TN$t=mtOIOHEEiO(>PlW`9
z2gBrkNe@tD-H>#KI3<8#vYb=^sBF!ba)k)_F-+br<tHV`kdj!Es*s<CFasP3?hKQq
zq}`brEEpyyNn3!O>%%a4uCx!xxv!-Cn7kP#TgrGdGx#t}Zk6$2@@JTQNyeX<!JlEW
zlB_>7g9*drB3X!!y%{F2l=X(#>d!FwJ4o7}VY0iNKUnv4Ik1^e<ouZ2873RcyE7~J
zFiftN_fe8!NGUA>d9NfRRiU`DxFj`Kp|~WmsHC(26z8s943nSAdx5MrQ1E9qwP%>z
zpkU8l#K@rF>BTVlkb)PJFT-SBMPFt|3x>(jieO(Tc{5C&rs!>|z|R1xIGh6%3X1ZR
zQ;UoBJV8l7l)*72B{fCCF(ky%*+U^YKQ}iqFGVkhkwHPhgJCj{61W@=RZ<39lj6=W
zxmwAcImMr0@?j-^W(7Zn$->IuG@{_oFgZoppE<{uVe%GbUuI8lhRIAS-pq;C43qs-
ztl1S985Bx<87B9r_%f&JFigIs0!|Z|o(z*YRXv&W{23+(tNJs$`Z7#jtm?~L<i{}i
zqpBa16vJc(H7QVZD7Z6Bj#YDKRxn|hyi^Sw(%Ie&lkcc`Gy8foOx95M28Uybx{m-m
zLt1`LN@|f_DI<eIsxK&eicWr@Zo!=4!Z2A<!v$nqxi`b)1PyOy1#gDQYc#x>6MYya
y|IqMZvSyg<s%g!h$jG1o@@=!GJ9EAd!{pPN;7F6u^5<qK&d*I%D9OxC)dK+kP|Yy_
diff --git a/decus/vax90b1/gce90b/bulletin_beta/bullcoms1.hlp b/decus/vax90b1/gce90b/bulletin_beta/bullcoms1.hlp
new file mode 100644
index 0000000..f131c62
--- /dev/null
+++ b/decus/vax90b1/gce90b/bulletin_beta/bullcoms1.hlp
@@ -0,0 +1,789 @@
+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 <IN%"INFO-VAX@KL.SRI.COM">
+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 <IN%"INFO-VAX@KL.SRI.COM">
+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/gce90b/bulletin_beta/bullcoms2.hlp b/decus/vax90b1/gce90b/bulletin_beta/bullcoms2.hlp
new file mode 100644
index 0000000..a4793fa
--- /dev/null
+++ b/decus/vax90b1/gce90b/bulletin_beta/bullcoms2.hlp
@@ -0,0 +1,801 @@
+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 <RETURN> 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/gce90b/bulletin_beta/bullet1.com b/decus/vax90b1/gce90b/bulletin_beta/bullet1.com
new file mode 100644
index 0000000..a31c8db
--- /dev/null
+++ b/decus/vax90b1/gce90b/bulletin_beta/bullet1.com
@@ -0,0 +1,1251 @@
+$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 <stdio.h>
+#include <descrip.h>
+#include <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
+
+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: <DD-MMM-YYYY]HH:MM:SS OR DELTA
+TIME: DDD HH:MM:SS
+
+A user then type the date of expiration and press the 'return'
+button. The time input may be ignored. For example, typing:
+20-JUL-1988 or type "10" - for ten days in the future.
+
+BULLETIN responds:
+ENTER DESCRIPTION HEADER. LIMIT HEADER TO 53 CHARACTERS.
+
+Now the user may enter the subject of the message.
+
+BULLETIN>
+
+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/gce90b/bulletin_beta/bullet2.com b/decus/vax90b1/gce90b/bulletin_beta/bullet2.com
new file mode 100644
index 0000000..51e1c9b
--- /dev/null
+++ b/decus/vax90b1/gce90b/bulletin_beta/bullet2.com
@@ -0,0 +1,1142 @@
+$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/gce90b/bulletin_beta/bulletin.for b/decus/vax90b1/gce90b/bulletin_beta/bulletin.for
new file mode 100644
index 0000000..751a0ff
--- /dev/null
+++ b/decus/vax90b1/gce90b/bulletin_beta/bulletin.for
@@ -0,0 +1,1648 @@
+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<LEN_P>)') 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<LEN_P>)',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<LEN_P>)',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<LEN_P>)') 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/gce90b/bulletin_beta/bulletin0.for b/decus/vax90b1/gce90b/bulletin_beta/bulletin0.for
new file mode 100644
index 0000000..94c70f4
--- /dev/null
+++ b/decus/vax90b1/gce90b/bulletin_beta/bulletin0.for
@@ -0,0 +1,1645 @@
+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<ILEN>)',INPUT,IOSTAT=IER) SVAL
+ EVAL = SVAL
+ ELSE
+ DECODE(DELIM-1,'(I<DELIM-1>)',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<ILEN>)',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<ILEN>)',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,'(<PAGE_WIDTH-FLEN+1>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<N>,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(' ',<S1>('*'),A,' System Messages',<S2>('*'))
+1027 FORMAT(/,' ',<S1>('*'),A,<S2>('*'))
+1028 FORMAT('+',<S1>('*'),A,<S2>('*'))
+1030 FORMAT(' ',<PAGE_WIDTH>('*'))
+1035 FORMAT(' ',<S1>('*'),A,<S2>('*'))
+1040 FORMAT(A<53>,2X,A12,1X,A6,<N1>X,I<N>)
+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/gce90b/bulletin_beta/bulletin1.for b/decus/vax90b1/gce90b/bulletin_beta/bulletin1.for
new file mode 100644
index 0000000..b5b2f0d
--- /dev/null
+++ b/decus/vax90b1/gce90b/bulletin_beta/bulletin1.for
@@ -0,0 +1,1786 @@
+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<NLEN>)',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<NLEN>)',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,<PAGE_WIDTH>('-'),/,' Type Q(Quit),
+ & F(File it), D(Dir), R(Read msg #) or other for next message: ',$)
+1030 FORMAT(1X,<PAGE_WIDTH>('-'),/,' 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<EX_LEN>)') 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/gce90b/bulletin_beta/bulletin10.for b/decus/vax90b1/gce90b/bulletin_beta/bulletin10.for
new file mode 100644
index 0000000..7ff3d32
--- /dev/null
+++ b/decus/vax90b1/gce90b/bulletin_beta/bulletin10.for
@@ -0,0 +1,1980 @@
+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/gce90b/bulletin_beta/bulletin2.for b/decus/vax90b1/gce90b/bulletin_beta/bulletin2.for
new file mode 100644
index 0000000..b364a46
--- /dev/null
+++ b/decus/vax90b1/gce90b/bulletin_beta/bulletin2.for
@@ -0,0 +1,1773 @@
+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<EX_LEN>)') 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<LEN_P>)',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<LEN_P>)
+ 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/gce90b/bulletin_beta/bulletin3.for b/decus/vax90b1/gce90b/bulletin_beta/bulletin3.for
new file mode 100644
index 0000000..91711fe
--- /dev/null
+++ b/decus/vax90b1/gce90b/bulletin_beta/bulletin3.for
@@ -0,0 +1,1757 @@
+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<LEN_P>)',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<LEN_P>)',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/gce90b/bulletin_beta/bulletin4.for b/decus/vax90b1/gce90b/bulletin_beta/bulletin4.for
new file mode 100644
index 0000000..1834332
--- /dev/null
+++ b/decus/vax90b1/gce90b/bulletin_beta/bulletin4.for
@@ -0,0 +1,1803 @@
+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/gce90b/bulletin_beta/bulletin5.for b/decus/vax90b1/gce90b/bulletin_beta/bulletin5.for
new file mode 100644
index 0000000..076a390
--- /dev/null
+++ b/decus/vax90b1/gce90b/bulletin_beta/bulletin5.for
@@ -0,0 +1,2017 @@
+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<DIG>,'' 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<FLEN>,''.'')')
+ & 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/gce90b/bulletin_beta/bulletin6.for b/decus/vax90b1/gce90b/bulletin_beta/bulletin6.for
new file mode 100644
index 0000000..b48bb7a
--- /dev/null
+++ b/decus/vax90b1/gce90b/bulletin_beta/bulletin6.for
@@ -0,0 +1,1693 @@
+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<RECL>)',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/gce90b/bulletin_beta/bulletin7.for b/decus/vax90b1/gce90b/bulletin_beta/bulletin7.for
new file mode 100644
index 0000000..055151a
--- /dev/null
+++ b/decus/vax90b1/gce90b/bulletin_beta/bulletin7.for
@@ -0,0 +1,2026 @@
+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<DIG>,'' 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/gce90b/bulletin_beta/bulletin8.for b/decus/vax90b1/gce90b/bulletin_beta/bulletin8.for
new file mode 100644
index 0000000..bf14be7
--- /dev/null
+++ b/decus/vax90b1/gce90b/bulletin_beta/bulletin8.for
@@ -0,0 +1,1907 @@
+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/gce90b/bulletin_beta/bulletin9.for b/decus/vax90b1/gce90b/bulletin_beta/bulletin9.for
new file mode 100644
index 0000000..06127d8
--- /dev/null
+++ b/decus/vax90b1/gce90b/bulletin_beta/bulletin9.for
@@ -0,0 +1,1977 @@
+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<LEN_P>)',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 <net-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/gce90b/bulletin_beta/bulletin_beta_ann.txt b/decus/vax90b1/gce90b/bulletin_beta/bulletin_beta_ann.txt
old mode 100755
new mode 100644
index e6548f6c7682e2eb28c20b082698123c92b63284..904e2856e87cf051fb0f5e3a16ee936d6e4385c3
GIT binary patch
delta 485
zcmX>ne_w7QlY=%_NWK-PV~}UCr=yjXYnW@0hhtC(m$S1KCs%N3QkE5`Q>c%RYlx>G
z7uUoh4@Rzudz=`#CNb(Ua!od1lxF0b?8oTJ$TfKyqoxuUXIg%d0>msm7eCh!z4TPQ
z<osMkxUrL;Fd8v(O_pGi)c~8Gnp|R~0Jk6{-wLW5$t9DMn6wzVCigLEF>@(!P2R`k
z&B!&GhuK_!OM%P1C^fYtGcUc^3M3W9?90eCc@>!a#q7h#HQ9p&Br=1=iIHpa9TtB^
zuE~0=Ani4*evDj`&#;0-<k&!J^4LHk``Ek~xh8Y5gY-tQgTz;`doXfM{=^Q_<-p<2
z$Thi(Lk8@SH5?$ZUtrRM)02^F@)S;xjwfK!gv%AIs(}k+?gcK8i~_g5C>JLT_y+lK
zDR2eo73*<L&f*5yvV|L@mW2o8h5#NAdjSu~j(1?vhS!aeYjO)O$fgUtVDtDuvUz+U
V_C7Gl#}CpK#}5);!>`E51pp1jb&mi5
delta 625
zcmcaFcTS$kfnkCJlL*5^M-eF&24`n0PCka<(xfaaPNz^GAJ-61KL!R5hKbo8Oim0F
zw>UBBF--ifry$MXR+OJ>rQjRn<KX8S6dJ4-;O4C7>lvcw>JrM}$}ri9(UqA&lVNfP
zqoyi@0t07SevyJ>kY})`qn?YOYlvQYs$Oz_uA*z0YmkRyP>2!3<jagkKC%ohi6yC4
z3T{Q2ItqpgZmCHMmWB!jrdGy=3a-H+41!>%r6!kHDZpJP!Vr>g1vT5s3TB`d!(?wJ
zEha67$z@DhY>W&F4BiZr7c+S?Gng|>e$Qks&HxhQVsI}?O)bgHOE0zp@qHO4n=$(`
zGx#!0ZUNCg43jT0`!M-3OqOTyWoB?<n4HVv#N^K~c>{|-GlMt7Bvx-`20w<$KCFHq
z(b=s2V7;$deZj((Y<^5$43j(9yqJ6#CSPU)o20<*%go@xFgcIigUOp=@^*G_W(IeL
z$;=$?%nULNlf5})V9w3r@CI2jc^ioKWSGpv=?OO8hZEw&Ss>b#Ve$)3S9Y*>{1_%1
zaQT6pThHao%%IOO`7D>dGy@L<Ck*%o`GEY%!VsWWtmnZnS&-X<$&X=j6gSwRE4jTu
zyf55-AeTAwK&<Zv(QXWrZ}Ye@c`{5^;)S>(hu0VEx?Q~9U{|s6L0lCAqWu^qFX986
S@{!M*nL&|ZvMs+NBLe_Jql%>f
diff --git a/decus/vax90b1/gce90b/bulletin_beta/pmdf.com b/decus/vax90b1/gce90b/bulletin_beta/pmdf.com
new file mode 100644
index 0000000..469515b
--- /dev/null
+++ b/decus/vax90b1/gce90b/bulletin_beta/pmdf.com
@@ -0,0 +1,1019 @@
+$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 <Postmaster@ ', 35);
+ catvstring (line, mm_local_channel^.official_hostname);
+ catchar (line, '>');
+ 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 <Postmaster@ ', 35);
+ catvstring (line, mm_local_channel^.official_hostname);
+ catchar (line, '>');
+ 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
--
GitLab