dorl@vms.macc.wisc.edu (Michael Dorl - MACC) (07/29/88)
If (L .ge. Group(G).Active_End) Then
Cmd_ArticleCatchUp = .true.
Else
Cmd_ArticleCatchUp = .false.
EndIf
C Find the first range beyond L
R = Group(G).Range_First
X = 0
Do While ((R .ne. 0) .and. (L .ge. Range(R).End))
X = R
R = Range(R).Next
EndDo
C R is the Range following L or zero, X is the Range in front of
C L or zero.
C Release all ranges from Group(G).Range_First - X. These ranges
C contain articles less than L.
If (X .ne. 0) Then
Range(X).Next = 0
X = Group(G).Range_First
Call Range_Deallocate (X)
Group(G).Range_First = R
EndIf
C Several cases can arise.
C
C R = 0 All ranges have been released, get
C a new one and set it to 1-L
C
C L < R.Start Add a new range to the
C Group from 1-L
C
C R.Start <= L < R.End Set R.Start = 1
C
C L >= R.End Impossible
If (R .eq. 0) Then
R = Range_Allocate ()
Range(R).Start = 1
Range(R).End = L
Range(R).Next = 0
Group(G).Range_First = R
Group(G).Range_Last = R
Else If (L .lt. Range(R).Start) Then
X = Range_Allocate ()
Group(G).Range_First = X
Range(X).Start = 1
Range(X).End = L
Range(X).Next = R
Call Range_Combine (X, R)
Else If
$ ((L .ge. Range(R).Start) .and. (L .lt. Range(R).End)) Then
Range(R).Start = 1
Else
Stop 'Catchup error'
EndIf
A = L
U = UnRead (G) ! Update unread mail count
Return
End ! Cmd_ArticleCatchUp
Subroutine Cmd_ArticleDisplay (G, A, Rotate_Flag)
Include 'News.Def'
C Parameter definitions
Integer *4 G ! Group number
Integer *4 A ! Article number
Logical Rotate_Flag
C External routines
Integer Srv_Cmd
External Header_Check
C Local definitions
Character *128 Cmd
Integer *4 Lg
Integer *4 Status
Character *8 Num
C Begin Cmd_ArticleDisplay
Call More_Heading
Write (Cmd, '(A, I6)') 'head ', A
Status = Srv_Cmd (Cmd(1:11), Cmd, Lg)
If (.not. Status) Then
Call SMG_All_Print ('Server failed', '|')
Stop
EndIf
If (Cmd(1:3) .eq. '221') Then
Call Srv_RdTxt (.true., .false., Header_Check)
Else
Call SMG_All_Print ('Unexpected server response', '|')
Call SMG_All_Print (Cmd(1:Lg), '|')
Stop
EndIf
Call SMG_All_Print (' ', '|')
Write (Cmd, '(A, I6)') 'body ', A
Status = Srv_Cmd (Cmd(1:11), Cmd, Lg)
If (.not. Status) Then
Call SMG_All_Print ('Server failed', '|')
Stop
EndIf
If (Cmd(1:3) .eq. '222') Then
Call Srv_RdTxt (.true., Rotate_Flag, %Val(0))
Else
Call SMG_All_Print ('Unexpected server response', '|')
Call SMG_All_Print (Cmd(1:Lg), '|')
Stop
EndIf
End ! Cmd_ArticleDisplay
Integer Function Header_Check (Img)
Include 'News.Def'
C Parameter definition
Character *(*) Img
C Local definitions
Integer *4 X
Character *16 Fld
C Begin Header_Check
Header_Check = .true.
If ((Img .eq. ' ') .or. (.not. Header_Present)) Then
Return
EndIf
X = Index (Img, ':') - 1
If (X .le. 0) Then
Fld = Img
Else
Fld = Img(1:X)
EndIf
Call Str$Upcase (Fld, Fld)
X = 1
Do While (X .le. Header_Count)
If (Header(X) .eq. Fld) Then
Return
EndIf
X = X + 1
EndDo
Header_Check = .false.
Return
End ! Header_Check
Subroutine Cmd_ArticleNone
Call SMG_All_Print ('No article selected', '|')
End ! Cmd_ArticleNone
Integer Function Cmd_ArticleNumber (G, Text, S)
Include 'News.Def'
C Parameter definition
Integer *4 G
Character *(*) Text
Integer *4 S
C Local delinitions
Integer *4 Lg
Integer *4 N
Integer *4 X
Character *8 Num
C Begin Cmd_ArticleNUmber
Lg = Len(Text)
X = 1
N = 0
Cmd_ArticleNumber = .true.
Do While ((X .le. Lg) .and. Cmd_ArticleNumber)
If ((Text(X:X) .ge. '0') .and. (Text(X:X) .le. '9')) Then
N = 10 * N + IChar(Text(X:X)) - IChar('0')
Else
Cmd_ArticleNumber = .false.
EndIf
X = X + 1
EndDo
If (Cmd_ArticleNumber) Then
If
$ (
$ (N .ge. Group(G).Active_Start)
$ .and.
$ (N .le. Group(G).Active_End)
$ )
$ Then
S = N
Else
Call ItoS (N, Num, Lg)
Print '(A)', ' Article ' // Num(1:Lg) // ' not available'
Cmd_ArticleNumber = .false.
EndIf
EndIf
End ! Cmd_ArticleNumber
Subroutine Cmd_ArticleKill (G, A, U)
Include 'News.Def'
C Parameter definition
Integer *4 G ! Group number
Integer *4 A ! Article number
Integer *4 U ! Unread article count, updated
C External routines
Integer Range_Find
C Local definitions
Logical Any
Integer *4 I
Integer *4 I_Lg
Character *8 I_C
Integer *4 Subject_Lg
Integer *4 Status
Character *128 Subject
Integer *4 XSubject_Lg
Character *128 XSubject
C Begin Cmd_ArticleKill
Any = .false.
C Send XHdg Subject command to retrieve subject line for article
Call CacheHdr (G, A, Subject, Subject_Lg)
C% Call XHdr (A, 'subject', Subject, Subject_Lg)
C Remove article number from front of subject line
Call ItoS (A, I_C, I_Lg)
If (I_Lg .lt. Subject_Lg) Then
Subject(1:Subject_Lg-I_Lg) = Subject(1+I_Lg:Subject_Lg)
Subject_Lg = Subject_Lg - I_Lg
C Display subject being killed
Call SMG_All_Print
$ ('Searching for: ' // Subject(1:Subject_Lg), '|')
C Page through articles looking for this subject
Do I = Group(G).Active_Start, Group(G).Active_End
If (Range_Find(G, I, .false.) .eq. 0) Then
c Write (XSubject, '(A,I)') 'Looking at article ', I
c Call SMG_ALL_Print (XSubject, '|')
Call CacheHdr (G, I, XSubject, XSubject_Lg)
c% Call XHdr (I, 'subject', XSubject, XSubject_Lg)
c Call SMG_All_Print (XSubject(1:XSubject_Lg), '|')
C Remove article number from front of subject line
Call ItoS (I, I_C, I_Lg)
If (XSubject_Lg .gt. I_Lg) Then
XSubject(1:XSubject_Lg-I_Lg) =
$ XSubject(1+I_Lg:XSubject_Lg)
XSubject_Lg = XSubject_Lg - I_Lg
If
$ (Subject(1:Subject_Lg) .eq. XSubject(1:XSubject_Lg))
$ Then
Status = Range_Find (G, I, .true., U)
Call ItoS (I, I_C, I_Lg)
Call SMG_All_Print ('Killed: ' // I_C(1:I_Lg), '|')
Any = .true.
EndIf
EndIf ! (XSubject_Lg .gt. I_Lg)
EndIf ! (Range_Find(G, I, .false.) .eq. 0)
End Do
EndIf ! (I_Lg .lt. Subject_Lg)
If (.not. Any) Then
Call SMG_All_Print ('No articles killed', '|')
End If
End ! Cmd_ArticleKill
Integer Function Cmd_ArticleSameSubj (G, A)
Include 'News.Def'
C Parameter definition
Integer *4 G ! Group number
Integer *4 A ! Article number
C External routines
Integer Range_Find
C Local definitions
Integer *4 I
Integer *4 I_Lg
Character *8 I_C
Integer *4 Subject_Lg
Integer *4 Status
Character *128 Subject
Integer *4 XSubject_Lg
Character *128 XSubject
C Begin Cmd_ArticleSameSubj
C Send XHdg Subject command to retrieve subject line for article
Call CacheHdr (G, A, Subject, Subject_Lg)
C Remove article number from front of subject line
Call ItoS (A, I_C, I_Lg)
If (I_Lg .lt. Subject_Lg) Then
Subject(1:Subject_Lg-I_Lg) = Subject(1+I_Lg:Subject_Lg)
Subject_Lg = Subject_Lg - I_Lg
C Display subject being looked for
Call SMG_All_Print
$ ('Searching for: ' // Subject(1:Subject_Lg), '|')
C Page through articles looking for this subject
Do I = Group(G).Active_Start, Group(G).Active_End
If (Range_Find(G, I, .false.) .eq. 0) Then
Call CacheHdr (G, I, XSubject, XSubject_Lg)
C Remove article number from front of subject line
Call ItoS (I, I_C, I_Lg)
If (XSubject_Lg .gt. I_Lg) Then
XSubject(1:XSubject_Lg-I_Lg) =
$ XSubject(1+I_Lg:XSubject_Lg)
XSubject_Lg = XSubject_Lg - I_Lg
If
$ (Subject(1:Subject_Lg) .eq. XSubject(1:XSubject_Lg))
$ Then
Cmd_ArticleSameSubj = .true.
A = I
Return
EndIf
EndIf ! (XSubject_Lg .gt. I_Lg)
EndIf ! (Range_Find(G, I, .false.) .eq. 0)
End Do
EndIf ! (I_Lg .lt. Subject_Lg)
Call SMG_All_Print ('No other articles found', '|')
Cmd_ArticleSameSubj = .false.
Return
End ! Cmd_ArticleSameSubj
Integer Function Cmd_ArticleFirst (G, A)
Include 'News.Def'
C Parameter definition
Integer *4 G ! Group number
Integer *4 A ! Article number
C Entry point definitions
Integer Cmd_ArticleLast
C External routines
Integer Range_Find
C Local definitions
Integer *4 E, D, I, S
C Begin Cmd_ArticleFirst
S = Group(G).Active_Start
E = Group(G).Active_End
D = +1
Goto 1
C Begin Cmd_ArticleLast
Entry Cmd_ArticleLast (G, A)
S = Group(G).Active_End
E = Group(G).Active_Start
D = -1
Goto 1
C Page through articles looking for first unread
1 Do I = S, E, D
If (Range_Find(G, I, .false.) .eq. 0) Then
A = I
Cmd_ArticleFirst = .true.
Return
EndIf
End Do
C No unread articles found
Call SMG_All_Print ('No unread articles found', '|')
Cmd_ArticleFirst = .false.
Return
End ! Cmd_ArticleFirst
Subroutine XHdr (A, What, Result, Lg)
Include 'News.Def'
C Parameter definitions
Integer *4 A
Character *(*) What
Character *(*) Result
Integer *4 Lg
C External routines
Integer Srv_Cmd
Integer Srv_Recv
Integer Srv_RdTxt
C local definitions
Integer *4 Status
C Begin XHdr
C Request header line with a 'xhdr what article_number' command
Write (Result, '(A,I)') 'xhdr ' // What // ' ', A
Status = Srv_Cmd (Result, Result, Lg)
If (.not. Status) Then
Call SMG_All_Print ('Server failed', '|')
Stop
EndIf
If (Result(1:3) .ne. '221') Then
Call SMG_All_Print (Result(1:Lg), '|')
Call SMG_All_Print ('Unexpect server response', '|')
Stop
EndIf
C Get header line
Status = Srv_Recv (Result, Lg)
If (.not. Status) Then
Call SMG_All_Print ('Server failed', '|')
Stop
EndIf
C Skip rest of response
If (Result(1:Lg) .ne. '.') Then
Status = Srv_RdTxt (.false., .false., %Val(0))
If (.not. Status) Then
Call SMG_All_Print ('Server failed', '|')
Stop
EndIf
EndIf
C Return
Return
End ! XHdr
Subroutine Cmd_Help
Include 'News.Def'
C Begin Cmd_Help
Call SMG_Erase
Call SMG_All_Print ('b backup', '|')
Call SMG_All_Print ('c [#] catchup', '|')
Call SMG_All_Print ('d directory', '|')
Call SMG_All_Print ('d/g pattern group directory', '|')
Call SMG_All_Print ('f followup', '|')
Call SMG_All_Print ('g group go group', '|')
Call SMG_All_Print ('h help', '|')
Call SMG_All_Print ('k kill', '|')
Call SMG_All_Print ('m mark unread', '|')
Call SMG_All_Print ('n next', '|')
Call SMG_All_Print ('p post', '|')
Call SMG_All_Print ('q quit', '|')
Call SMG_All_Print ('r refresh', '|')
Call SMG_All_Print ('s save', '|')
Call SMG_All_Print ('u unsubscribe', '|')
Call SMG_All_Print ('x rotate', '|')
Call SMG_All_Print ('z next article same subject', '|')
Call SMG_All_Print ('# article number', '|')
Call SMG_All_Print ('^ first unread article', '|')
Call SMG_All_Print ('$ last unread article', '|')
Call SMG_All_Print (' ', '|')
Return
End ! Cmd_Help
Integer Function Open_Newsrc ()
Include 'News.Def'
C External routines
Integer Range_Allocate
Integer TrimLg
External User_Open
C Local Definitions
Character *1 C
Integer *4 Status
Character *512 Image
Integer *4 R
Integer *4 S, L, N, E, X
C Begin Open_Newsrc
Call User_Open_Init ('STATUS_OLD',0,0,0,0,0,0,0,0)
Open
$ (
$ Unit = LU_Newsrc,
$ File = 'Sys$Login:XX.Newsrc',
$ Status = 'Old',
$ Form = 'Formatted',
$ Recl = 512,
$ UserOpen = User_Open,
$ IOStat = Status
$ )
Group_Count = 0
If (Status .ne. 0) Then
Newsrc_Is_Open = .false.
Open_Newsrc = 0
Return
EndIf
Newsrc_Is_Open = .true.
C Get date of creation of XX.Newsrc
Call User_Open_Get_CDT (LU_Newsrc, Newsrc_CDT_VMS)
Newsrc_CDT_News(1:2) = Newsrc_CDT_VMS(10:11) ! Year
X = Index
$ (
$ 'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC',
$ Newsrc_CDT_VMS(4:6)
$ )
Write (Newsrc_CDT_News(3:4), '(I2.2)') X/3 + 1 ! Month
Newsrc_CDT_News( 5: 6) = Newsrc_CDT_VMS(1:2) ! Day
If (Newsrc_CDT_News(5:5) .eq. ' ') Then
Newsrc_CDT_News(5:5) = '0'
EndIf
Newsrc_CDT_News( 7: 7) = ' '
Newsrc_CDT_News( 8: 9) = Newsrc_CDT_VMS(13:14) ! Hour
If (Newsrc_CDT_News(8:8) .eq. ' ') Then
Newsrc_CDT_News(8:8) = '0'
EndIf
Newsrc_CDT_News(10:11) = Newsrc_CDT_VMS(16:17) ! Minute
If (Newsrc_CDT_News(10:10) .eq. ' ') Then
Newsrc_CDT_News(10:10) = '0'
EndIf
Newsrc_CDT_News(12:13) = Newsrc_CDT_VMS(19:20) ! Second
If (Newsrc_CDT_News(12:12) .eq. ' ') Then
Newsrc_CDT_News(12:12) = '0'
EndIf
C Now read users XX.Newsrc
Status = 1
Do While (Status)
Read
$ (
$ Unit = LU_Newsrc,
$ Fmt = '(A)',
$ IOStat = Status
$ )
$ Image
If (Status .lt. 0) Then
Open_Newsrc = 1
Status = 0
Else If (Status .ne. 0) Then
Close (LU_Newsrc)
Open_Newsrc = 0
Status = 0
Else
Status = 1
X = Index (Image, ':')
If (X .eq. 0) Then
X = Index (Image, '!')
EndIf
If (X .ne. 0) Then
C We have a new group
Group_Count = Group_Count + 1
Group(Group_Count).Range_First = 0
Group(Group_Count).Range_Last = 0
Group(Group_Count).Newsrc_File = .true.
C Record group's name
Group(Group_Count).Name = Image (1:X-1)
C Get subscribed information
If (Image(X:X) .eq. ':') Then
Group(Group_Count).Subscribed = .true.
Else
Group(Group_Count).Subscribed = .false.
EndIf
C Clear moderated and activefile flags, they will get set properly
C when we page through the news groups later.
Group(Group_Count).Active_Post = .false.
Group(Group_Count).Active_File = .false.
C Get article ranges
S = 0
N = 0
E = 0
L = 0
Do While (X .le. 512)
X = X + 1
If (X .eq. 512) Then
C = ','
Else
C = Image (X:X)
EndIf
If ((C .ge. '0') .and. (C .le. '9')) Then
N = 10 * N + IChar(C) - IChar('0')
Else If (C .eq. '-') Then
S = N
N = 0
Else If (C .eq. ',') Then
E = N
If (S .eq. 0) Then
S = E
EndIf
C Now add a new range entry to this group's control structure
If (S .ne. 0) Then
If ((S .le. L) .or. (S .gt. E)) Then
Call SMG_All_Print
$ (
$ 'Error in XX.Newsrc entry for group ' //
$ Group(Group_Count).Name
$ (1:TrimLg(Group(Group_Count).Name)),
$ '|'
$ )
Else
R = Range_Allocate ()
Range(R).Next = 0
Range(R).Start = S
Range(R).End = E
If (Group(Group_Count).Range_First .eq. 0) Then
Group(Group_Count).Range_First = R
Else
Range(Group(Group_Count).Range_Last).Next
$ = R
EndIf
Group(Group_Count).Range_Last = R
L = E
EndIf
EndIf
C Get ready for next range
S = 0
E = 0
N = 0
EndIf
EndDo
Else
EndIf
EndIf
End Do
End ! Open_Newsrc
Integer Function Close_Newsrc ()
Include 'News.Def'
C External definitions
Integer TrimLg
C Local Definitions
Logical First
Integer *4 G
Character *512 Image
Integer *4 R
Integer *4 Status
Integer *4 X
Integer *4 S, E
Character *8 S_C, E_C
Integer *4 S_Lg, E_Lg
C Begin Close_Newsrc
If (Newsrc_Is_Open) Then
Close (LU_Newsrc)
EndIf
Open
$ (
$ Unit = LU_Newsrc,
$ File = 'Sys$Login:XX.Newsrc',
$ Status = 'New',
$ Form = 'Formatted',
$ CarriageControl = 'List',
$ Recl = 512,
$ IOStat = Status
$ )
G = 1
If (Status .ne. 0) Then
Close_Newsrc = 0
Return
EndIf
C Wander through all groups
Do While (G .le. Group_Count)
If
$ (
$ (Group(G).Active_File .and. Group(G).Subscribed)
$ .or.
$ Group(G).Newsrc_File
$ )
$ Then
C Start image with group name
X = TrimLg (Group(G).Name)
Image(1:X) = Group(G).Name(1:X)
C Now add subscribed flag
X = X + 1
If (Group(G).Subscribed) Then
Image(X:X) = ':'
Else
Image(X:X) = '!'
EndIf
C Wander through all ranges for this group
R = Group(G).Range_First
First = .true.
Do While (R .ne. 0)
If (.not. First) Then
X = X + 1
Image(X:X) = ','
Else
First = .false.
EndIf
S = Range(R).Start
Call ItoS (S, S_C, S_Lg)
Image(X+1:X+S_Lg) = S_C(1:S_Lg)
X = X + S_Lg
If (Range(R).End .ne. Range(R).Start) Then
X = X + 1
Image(X:X) = '-'
E = Range(R).End
Call ItoS (E, E_C, E_Lg)
Image(X+1:X+E_Lg) = E_C(1:E_Lg)
X = X + E_Lg
EndIf
R = Range(R).Next
End Do ! (R .ne. 0)
Write (LU_Newsrc, '(A)') Image(1:X)
EndIf
G = G + 1
End Do ! (G .le. Group_Count)
C Return success
Close_Newsrc = 1
End ! Close_Newsrc
Integer Function Range_Allocate
Include 'News.Def'
C Begin Range_Allocate
If (Range_Free_List .ne. 0) Then
Range_Allocate = Range_Free_List
Range_Free_List = Range(Range_Free_List).Next
Else
If (Range_Count .lt. Mx_Range) Then
Range_Count = Range_Count + 1
Range_Allocate = Range_Count
Else
Call SMG_All_Print ('Range array exceeded', '|')
Stop
EndIf
EndIf
Range(Range_Allocate).Next = 0
Range(Range_Allocate).Start = 0
Range(Range_Allocate).End = 0
Return
End ! Range_Allocate
Subroutine Range_Deallocate (R)
Include 'News.Def'
C Parameter definitions
Integer *4 R ! Range index
C Local definitions
Integer *4 N, X
C Begin Range_Deallocate
X = R
Do While (X .ne. 0)
N = Range(X).Next
Range(X).Next = Range_Free_List
Range_Free_List = X
X = N
End Do
End ! Range_Deallocate
Integer Function Range_Find (G, A, Create, U)
Include 'News.Def'
C Description
C
C Locates the Range entry for article number A in group G.
C If a range entry does not exist for A and Create is true,
C one is created.
C
C Returns the Range entry index or zero if none.
C
C Parameter definitions
Integer *4 G ! Group number
Integer *4 A ! Article number
Logical Create ! .true. if create on no find
Integer *4 U ! Unread article count, updated
C External routines
Integer Range_Allocate
C Local definitions
Integer *4 P
Integer *4 R, RR
Logical Found
C Begin Range_Find
P = 0
R = Group(G).Range_First
Found = .false.
Range_Find = 0
Do While ((R .ne. 0) .and. (.not. Found))
If ((A .ge. Range(R).Start) .and. (A .le. Range(R).End)) Then
Found = .true.
Range_Find = R
Else If (A .lt. Range(R).Start) Then
Found = .true.
Else
P = R
R = Range(R).Next
End If
End Do
If ((Range_Find .eq. 0) .and. Create) Then
If
$ (
$ (P .ne. 0)
$ .and.
$ ((Range(P).End+1) .eq. A)
$ ) Then
Range(P).End = Range(P).End + 1
Range_Find = P
Call Range_Combine (P, R)
Else If
$ (
$ (R .ne. 0)
$ .and.
$ ((Range(R).Start-1) .eq. A)
$ ) Then
Range(R).Start = Range(R).Start - 1
Range_Find = R
Call Range_Combine (P, R)
Else
RR = Range_Allocate ()
Range_Find = RR
Range(RR).Start = A
Range(RR).End = A
Range(RR).Next = R
If (P .eq. 0) Then
Group(G).Range_First = Range_Find
Group(G).Range_Last = Range_Find
Else
Range(P).Next = Range_Find
EndIf
EndIf
U = U - 1
If (U .lt. 0) Then
U = 0
EndIf
EndIf
End ! Range_Find
Subroutine Range_Combine (P, R)
Include 'News.Def'
C Parameter definitions
Integer *4 P
Integer *4 R
C Begin Range_Combine
If ((P .ne. 0) .and. (R .ne. 0)) Then
C Are range entries ajacent?
If ((Range(P).End + 1) .eq. Range(R).Start) Then
C Mark entry P with entire range
Range(P).End = Range(R).End
C Remove entry R from the chain
Range(P).Next = Range(R).Next
C Release entry R
Range(R).Next = 0
Call Range_Deallocate (R)
EndIf
EndIf
End ! Range_Combine
Integer Function Srv_Connect
Include 'News.Def'
C Description
C
C Connects to the Remote News server.
C
C Returns success or failure.
C
C Local Variables
Integer *4 I
Integer *4 Lg
Record /Socket_IN_Def/ Server_Socket
Integer *4 Status
Integer *4 IP_Address
Equivalence (IP_Address, Server_IP_Number)
C Empty Recv buffer
Recv_BufS = 2
Recv_BufE = 1
C Open a channel to INET0:
Channel = Socket
$ (
$ %Val(AF_INet),
$ %Val(Sock_Stream),
$ %Val(0)
$ )
If (Channel .eq. -1) Then
Srv_Connect = 2
Return
EndIf
C Connect to remote machine
Server_Socket.SIN_Family = AF_INet
Server_Socket.SIN_Port = HtoNS (%Val(119))
Server_Socket.SIN_Address = IP_Address ! '111e6880'X
Do I = 1,8
Server_Socket.SIN_Fill(I) = 0
EndDo
Status = Connect
$ (
$ %Val(Channel),
$ Server_Socket,
$ %Val(16)
$ )
If (Status .ne. 0) Then
Srv_Connect = 4
Return
EndIf
C Return success
Srv_Connect = 1
Return
End ! Srv_Connect
Integer Function Srv_NetClose()
Include 'News.Def'
C Description
C
C Close Connection to the Remote News server.
C
C Returns success or failure.
C
C External routines
Integer NetClose
C Local variables
Integer *4 Status
C Begin Srv_NetClose
C Disconnect from remote machine
Status = NetClose (%Val(Channel))
If (Status .ne. 0) Then
Srv_NetClose = 4
Return
EndIf
C Return success
Srv_NetClose = 1
Return
End ! Srv_NetClose
Integer Function Srv_Recv (Buf, Lg)
Include 'News.Def'
C Description
C
C Read data form server to Buf.
C
C Returns success or failure.
C Parameter Definitions
Character *(*) Buf
Integer *4 Lg
C Local definitions
Integer *4 Buf_Lg
Character *2 CRLF
Logical CR
Logical Done
Integer *4 I
Integer *4 III
Integer *4 N
Integer *4 NN
Integer *4 Recv_Buf_Addr
Integer *4 Recv_Buf_Lg
Logical Skip
C Begin Srv_Recv
Buf_Lg = Len(Buf)
CRLF(1:1) = Char(13)
CRLF(2:2) = Char(10)
Lg = 0 ! No bytes xferred so far
Done = .false.
CR = .false.
Do While (.not. Done)
C If there is no data in the receive buffer, get some
If (Recv_BufS .gt. Recv_BufE) Then
Recv_Buf_Addr = %Loc(Recv_Buf)
Recv_Buf_Lg = Len(Recv_Buf)
I = Recv
$ (
$ %Val(Channel),
$ %Val(Recv_Buf_Addr),
$ %Val(Recv_Buf_Lg),
$ %Val(0)
$ )
If (I .eq. -1) Then
Srv_Recv = 0
Else
Srv_Recv = 1
If (Debug) Then
Print '(8(x,o3.3))', (IChar(Recv_Buf(III:III)),III=1,I)
EndIf
EndIf
Recv_BufS = 1
Recv_BufE = I
EndIf
C Now we have some data
C If we last saw a carriage return and the next character is a LF
C then we have found the end of the image and we are done
If (CR .and. (Recv_Buf(Recv_BufS:Recv_BufS) .eq. CRLF(2:2))) Then
Done = .true.
Recv_BufS = Recv_BufS + 1
Else
C No terminator, look for the next hunk to transfer.
CR = .false.
I = Index (Recv_Buf(Recv_BufS:Recv_BufE), CRLF(1:1))
If (I .eq. 0) Then
N = Recv_BufE - Recv_BufS + 1
Skip = 0
Else
N = I - 1
Skip = 1
CR = .true.
EndIf
C Anything to tranfer?
If (N .gt. 0) Then
NN = Buf_Lg - Lg
If (NN .gt. N) Then
NN = N
EndIf
If (NN .gt. 0) Then
Buf(Lg+1:Lg+NN) = Recv_Buf(Recv_BufS:Recv_BufS+NN-1)
Lg = Lg + NN
EndIf
EndIf
Recv_BufS = Recv_BufS + N + Skip
EndIf
EndDo
If (Lg .le. 0) Then
Lg = 1
Buf(1:1) = ' '
EndIf
Return
End ! Srv_Recv
Integer Function Srv_Send (Msg)
Include 'News.Def'
C Description
C
C Send data from Buffer to News Server
C
C Returns success or failure.
C Parameter Definitions
Character *(*) Msg
C Local definitions
Character *512 Buf
Integer *4 Buf_Addr
Integer *4 Buf_Lg
Integer *4 CC
C Begin Srv_Send
Buf_Lg = Len(Msg)
Buf = Msg(1:Buf_Lg) // Char(13) // Char(10)
Buf_Addr = %Loc(Buf)
Buf_Lg = Buf_Lg+2
CC = Send
$ (
$ %Val(Channel),
$ %Val(Buf_Addr),
$ %Val(Buf_Lg),
$ %Val(0)
$ )
If (CC .eq. -1) Then
Srv_Send = 0
Else
Srv_Send = 1
EndIf
Return
End ! Srv_Send
Integer Function Srv_Cmd (Cmd, Rsp, Lg)
Include 'News.Def'
C Description
C
C Send Cmd to the news server and retrieve its response in Rsp
C
C Returns
C
C Srv_Cmd Success or failure
C Rsp Response text from server
C Lg Length of Rsp text
C Parameter definitions
Character *(*) Cmd
Character *(*) Rsp
Integer *4 Lg
C External Routines
Integer Srv_Send
Integer Srv_Recv
C Begin Srv_Cmd
Srv_Cmd = Srv_Send (Cmd)
If (.not. Srv_Cmd) Then
Return
EndIf
Srv_Cmd = Srv_Recv (Rsp, Lg)
C Return
Return
End ! Srv_Cmd
Integer Function Srv_RdTxt (P, Rot, Image_Routine)
Include 'News.Def'
C Parameters
Logical P ! .true. means print
! .false. means skip
Logical Rot ! .true. means rotate
External Image_Routine ! Called for each image
Integer Image_Routine
C External Routines
Integer Srv_Recv
Logical SMG_More_Print
C Local definitions
Character *512 Buf
Integer *4 Lg
Logical Ok
C Begin Srv_RdTxt
Buf(1:1) = ' '
Ok = P
Do While (Buf(1:Lg) .ne. '.')
Srv_RdTxt = Srv_Recv (Buf, Lg)
If (.not. Srv_RdTxt) Then
Return
EndIf
If (Buf(1:Lg) .ne. '.') Then
If (Ok) Then
If (Rot) Then
Call Rotate (Buf(1:Lg))
EndIf
If
$ (
$ (%Loc(Image_Routine) .eq. 0)
$ .or.
$ (Image_Routine(Buf(1:Lg)))
$ )
$ Then
If (Debug) Then
Call SMG_More_Print ('RdTxt image:', '|')
EndIf
OK = SMG_More_Print (Buf(1:Lg), '|')
EndIf
EndIf
EndIf
EndDo
C All done, return
End ! Srv_RdTxt
Subroutine Srv_CopyTxt (LU, Pre, Rotate_Flag)
Include 'News.Def'
C Parameter definitions
Integer *4 LU
Character *(*) Pre
Logical Rotate_Flag
C External routines
Integer Srv_Recv
C Local definitions
Character *1024 Buf
Integer *4 Buf_S, Buf_E ! Buf pointers
Integer *4 Lg
Integer *4 MxLg ! Recl for LU_Save
Integer *4 Pre_Lg
Integer *4 X
C Begin Srv_CopyTxt
If (Pre .eq. ' ') Then
Pre_Lg = 0
Else
Pre_Lg = Len (Pre)
EndIf
Inquire (Unit = LU, Recl = MxLg)
MxLg = MxLg - 4
Buf = ' '
Lg = 1
Do While ((Buf(1:Lg) .ne. '.') .and. (Srv_Recv(Buf,Lg)))
If (Lg .eq. 0) Then
Lg = 1
Buf(1:1) = ' '
EndIf
If (Buf(1:lg) .ne. '.') Then
If (Rotate_Flag) Then
Call Rotate (Buf(1:Lg))
%%end part c
Michael Dorl (608) 262-0466
dorl@vms.macc.wisc.edu
dorl@wiscmacc.bitnet