dorl@vms.macc.wisc.edu (Michael Dorl - MACC) (07/29/88)
End Do
If (.not. Done) Then
Goto 1
EndIf
C Disconnect from server
Status = Srv_Cmd ('quit', Buf, Lg)
If (.not. Status) Then
Print '(A)', ' Server failed'
Stop
EndIf
Call SMG_All_Print (' ', '|')
Call SMG_All_Print
$ ('Closing News server connection...', '|')
Call SMG_All_Print (Buf(1:Lg), '|')
Status = Srv_NetClose ()
If (.not. Status) Then
Print '(A)', ' Socket failure'
Stop
EndIf
C Update xx.newsrc
Call SMG_All_Print (' ', '|')
Call SMG_All_Print ('Updating XX.Newsrc...', '|')
Status = Close_Newsrc ()
If (.not. Status) Then
Print '(A)', ' Error closing XX.NEWSRC'
Stop
End If
End ! News
Integer Function UnRead (G)
Include 'News.Def'
C Parameter definitions
Integer G
C Local definitions
Integer *4 E, R, RS, RE, RU, S
C Begin UnRead
S = Group(G).Active_Start
E = Group(G).Active_End
If (S .eq. 0) Then
S = 1
EndIf
UnRead = E - S + 1
R = Group(G).Range_First
Do While (R .ne. 0)
If (Range(R).Start .lt. S) Then
RS = S
Else
RS = Range(R).Start
EndIf
If (Range(R).End .gt. E) Then
RE = E
Else
RE = Range(R).End
EndIf
RU = RE - RS + 1
If (RU .gt. 0) Then
UnRead = UnRead - RU
EndIf
R = Range(R).Next
EndDo
If (UnRead .lt. 0) Then
UnRead = 0
EndIf
End ! Unread
Subroutine Down_Case (Str)
Implicit None
C Parameter definitions
Character *(*) Str
C Local definitions
Integer *4 X, Lg
C Begin Down_Case
Lg = Len (Str)
Do X = 1, Lg
If ((Str(X:X) .ge. 'A') .and. (Str(X:X) .le. 'Z')) Then
Str(X:X) = Char (IChar(Str(X:X)) + IChar(' '))
EndIf
EndDo
End ! Down_Case
Subroutine Rotate (Str)
C Parameter definitions
Character *(*) Str
C Local definitions
Integer *4 Lg, N, X
Character *(1) C
C Begin Rotate
Lg = Len(Str)
Do X = 1, Lg
C = Str(X:X)
If (
$ ((C .ge. 'a') .and. (C .le. 'z'))
$ .or.
$ ((C .ge. 'A') .and. (C .le. 'Z'))
$ ) Then
N = IChar(C)
If (IAnd(N,31) .le. 13) Then
N = N + 13
Else
N = N - 13
EndIf
Str(X:X) = Char(N)
EndIf
EndDo
End ! Rotate
Subroutine Read_Init
Include 'News.Def'
C Local definitions
Logical Eof
Integer *4 Status
Integer *4 I
Character *256 Img
Integer *4 Img_Lg
Character *64 Img_Field
Integer *4 IP
Byte IP_Byte
Equivalence (IP,IP_Byte)
Character *15 IP_Number
Integer *4 X
C Begin Read_Init
SiteId = ' '
Distribution_Count = 0
Open
$ (
$ Unit = LU_Init,
$ File = 'NewsDir:Config.Dat',
$ ReadOnly,
$ Shared,
$ Status = 'Old',
$ IOStat = Status
$ )
If (Status .ne. 0) Then
Call SMG_All_Print ('Error opening NewsDir:Config.Dat', '|')
Stop
EndIf
Eof = .false.
Do While (.not. Eof)
Read (LU_Init, '(Q,A)', IOStat = Status) Img_Lg, Img
If (Status .eq. 0) Then
X = Index (Img(1:Img_Lg),':')
If (X .eq. 0) Then
X = Img_Lg
EndIf
If (Img(1:X) .eq. 'distribution:') Then
X = X + 1
Do While (X .lt. Img_Lg)
Call Field (Img(1:Img_Lg), X, Img_Field)
If (Img_Field .ne. ' ') Then
Distribution_Count = Distribution_Count + 1
Distribution(Distribution_Count) = Img_Field
EndIf
EndDo
ElseIf (Img(1:X) .eq. 'siteid:') Then
X = X + 1
Call Field (Img(1:Img_Lg), X, SiteId)
ElseIf (Img(1:X) .eq. 'organization:') Then
X = X + 1
Organization = Img(X:Img_Lg)
ElseIf (Img(1:X) .eq. 'server:') Then
X = X + 1
Call Field (Img(1:Img_Lg), X, IP_Number)
IP = 0
I = 1
Do X = 1,15
If (IP_Number(X:X) .eq. '.') Then
Server_IP_Number(I) = IP_Byte
IP = 0
I = I + 1
Else If (IP_Number(X:X) .eq. ' ') Then
Else If
$ (
$ (IP_Number(X:X) .ge. '0')
$ .and.
$ (IP_Number(X:X) .le. '9')
$ )
$ Then
IP = 10 * IP + IChar(IP_Number(X:X)) - IChar('0')
EndIF
EndDo
Server_IP_Number(I) = IP_Byte
ElseIf (Img(1:X) .eq. ' ') Then
Else
Call SMG_All_Print
$ ('Unrecognized initialization image', '|')
Call SMG_All_Print (Img(1:Img_Lg), '|')
Stop
EndIf
Else
Eof = .true.
EndIf
EndDo
Close (LU_Init)
Return
End ! Read_Init
Subroutine Field (Src, Src_X, Dst)
Implicit None
C Parameter definition
Character *(*) Src,Dst
Integer *4 Src_X
C Local definitions
Integer *4 Src_Lg, Dst_Lg, Dst_X
Logical Done
C Begin Field
Done = .false.
Src_Lg = Len (Src)
Dst_Lg = Len (Dst)
Dst_X = 1
Dst= ' '
Do While ((.not. Done) .and. (Src_X .le. Src_Lg))
If (Src(Src_X:Src_X) .eq. ' ') Then
Else If (Src(Src_X:Src_X) .eq. ',') Then
Done = .true.
Else
If (Dst_X .le. Dst_Lg) Then
Dst(Dst_X:Dst_X) = Src(Src_X:Src_X)
Dst_X = Dst_X + 1
EndIf
EndIf
Src_X = Src_X + 1
EndDo
End ! Field
Subroutine Unavail_Print (S,E)
Implicit None
Integer *4 S, E
C Local definitions
Character *8 S_C, E_C
Integer *4 S_Lg, E_Lg
C Begin Unavail_Print
Call ItoS (S, S_C, S_Lg)
If (E .eq. S) Then
Call SMG_All_Print
$ (
$ 'Skipped unavailable article ' //
$ S_C(1:S_Lg),
$ '|'
$ )
Else
Call ItoS (E, E_C, E_Lg)
Call SMG_All_Print
$ (
$ 'Skipped unavailable articles ' //
$ S_C(1:S_Lg) // '-' // E_C(1:E_Lg),
$ '|'
$ )
EndIf
S = 0
E = 0
End ! Unavail_Print
Integer Function GetUserName (UserId)
C Description:
C
C Function to obtain the user's name
C Returns success or failure.
Include 'News.Def'
C Parameter Definitions
Character *32 UserId
C External Routines
External Sys$GetJPI
Integer Sys$GetJPI
C Local Definitions
Include '($JPIDEF)'
Character *32 LUserId
Integer *4 LUserIdLg
Integer *2 WJPIItmLst(12)
Integer *4 JPIItmLst(6)
Equivalence (JPIItmLst,WJPIItmLst)
C Begin GetUserName
WJPIItmLst(1) = 32
WJPIItmLst(2) = JPI$_UserName
JPIItmLst(2) = %Loc(LUserId)
JPIItmLst(3) = %Loc(LUserIdLg)
JPIItmLst(4) = 0
GetUserName = Sys$GetJPI (,,,JPIItmLst,,,)
If (GetUserName) Then
UserId = LUserId(1:LUserIdLg)
Call Down_Case (UserName)
EndIf
Return
End ! GetUserName
Integer Function GetUserDirectory (Dir)
Include 'News.Def'
C Parameter definitions
Character *(*) Dir
C External definitions
Integer Sys$GetUAI
Integer TrimLg
C Local Definitions
Include '($UAIDEF)'
Character *16 Device
Integer *4 DeviceLg
Character *64 Directory
Integer *4 DirectoryLg
Integer *4 DirItmLst(9)
Integer *2 WDirItmLst(18)
Equivalence (DirItmLst,WDirItmLst)
C Begin GetUserDirectory
WDirItmLst(1) = 64
WDirItmLst(2) = UAI$_DefDir
DirItmLst(2) = %Loc(Directory)
DirItmLst(3) = %Loc(DirectoryLg)
WDirItmLst(7) = 16
WDirItmLst(8) = UAI$_DefDev
DirItmLst(5) = %Loc(Device)
DirItmLst(6) = %Loc(DeviceLg)
DirItmLst(7) = 0
GetUserDirectory = Sys$GetUAI (,,UserName,DirItmLst,,,)
If (GetUserDirectory) Then
Else
Return
EndIf
DeviceLg = IChar(Device(1:1))
DirectoryLg = IChar(Directory(1:1))
Dir = Device(2:DeviceLg+1) //
1 Directory(2:DirectoryLg) //
2 '.NEWS]'
Return
End ! GetUserDirectory
Integer Function Group_Find (Name)
Include 'News.Def'
C Parameter definition
Character *(*) Name
C Local definitions
Integer *4 I
C Begin Group_Find
Group_Find = 0
I = 1
Do While ((I .le. Group_Count) .and. (Group_Find .eq. 0))
If (Name .eq. Group(I).Name) Then
Group_Find = I
Else
I = I + 1
EndIf
EndDo
Return
End ! Group_Find
Subroutine Cmd_GroupNone
Implicit None
Call SMG_All_Print ('No group selected.', '|')
End ! Cmd_GroupNone
Subroutine Cmd_GroupList (Cmd)
Include 'News.Def'
C Parameter definition
Character *(*) Cmd
C External routines
Logical SMG_More_Print
Integer Str$Match_Wild
Integer TrimLg
C Local definitions
Character *1 Active
Logical Any
Integer *4 G
Character *80 Text
Integer *4 R
Character *1 Subscribed
Logical Ok
Character *32 Pattern
Character *1 Post
Integer *4 X
C Begin Cmd_GroupList
Pattern = ' '
X = Index (Cmd,' ')
If (X .ne. 0) Then
Do While ((X .lt. Len(Cmd)) .and. (Cmd(X:X) .eq. ' '))
X = X + 1
EndDo
Pattern = Cmd(X:Len(Cmd))
Call Down_Case (Pattern)
EndIf
Ok = .true.
G = 0
Any = .false.
Do While (Ok .and. (G .lt. Group_Count))
G = G + 1
If
$ (
$ (Pattern .eq. ' ')
$ .or.
$ (
$ Str$Match_Wild
$ (
$ Group(G).Name(1:TrimLg(Group(G).Name)),
$ Pattern(1:TrimLg(Pattern))
$ )
$ )
$ )
$ Then
Any =.true.
If (Group(G).Subscribed) Then
Subscribed = 'y'
Else
Subscribed = 'n'
EndIf
If (Group(G).Active_File) Then
Active = 'y'
Else
Active = 'n'
EndIf
If (Group(G).Active_Post) Then
Post = 'y'
Else
Post = 'n'
EndIf
Write (Text,'(4(x,A),2I7)')
$ Group(G).Name,
$ Active,
$ Subscribed,
$ Post,
$ Group(G).Active_Start,
$ Group(G).Active_End
Ok = SMG_More_Print (Text, '|')
R = Group(G).Range_First
Do While (Ok .and. (R .ne. 0))
Write (Text, '(x,I,A,I)')
$ Range(R).Start, ':', Range(R).End
Ok = SMG_More_Print (Text, '|')
R = Range(R).Next
End Do
EndIf
EndDo
If (.not. Any) Then
Call SMG_All_Print
$ (
$ 'No groups matching ' // Pattern(1:TrimLg(Pattern)) //
$ ' found.',
$ '|'
$ )
EndIf
Return
End ! Cmd_GroupList
Subroutine Cmd_ArticleList (G, CatchUp_Cmd)
Include 'News.Def'
Include 'SMG.Def'
C Description
C
C Handles the....
C
C Dir [article]
C
C command. Produces a short list of the subject lines
C of un read articles in the group starting with article.
C Default article is first available from the active file.
C Parameter definitions
Integer *4 G
Character *(*) CatchUp_Cmd
C External Routines
Integer Range_Find
Integer Srv_Cmd
Integer Srv_RdTxt
Integer TrimLg
C Local definitions
Integer *4 A
Integer *4 X
Integer *4 Subject_Lg
Character *128 Subject
C Begin Cmd_ArticleList
Call More_Heading
More_Input = ' '
C Get the article number
X = Index (CatchUp_Cmd, ' ')
A = 0
Do While ((X .ne. 0) .and. (X .le. Len(CatchUp_Cmd)))
If
$ (
$ (CatchUp_Cmd(X:X) .ge. '0')
$ .and.
$ (CatchUp_Cmd(X:X) .le. '9')
$ )
$ Then
A = 10 * A + IChar(CatchUp_Cmd(X:X)) - IChar('0')
EndIf
X = X + 1
EndDo
If (A .eq. 0) Then
A = Group(G).Active_Start
EndIf
C Get all the subject lines
Do While
$ (
$ (A .le. Group(G).Active_End)
$ .and.
$ (More_Input .eq. ' ')
$ )
If (Range_Find (G, A, .false.) .eq. 0) Then
Call CacheHdr (G, A, Subject, Subject_Lg)
Call SMG_More_Print (Subject(1:Subject_Lg), '|')
EndIf
A = A + 1
End Do
Return
End ! Cmd_ArticleList
Subroutine Cmd_ArticleMark (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_Allocate
C Local definitions
Logical Found
Integer *4 P, Q, R
C Begin Cmd_ArticleMark
C Find range contining this article
Found = .false.
P = 0
R = Group(G).Range_First
Do While ((.not. Found) .and. (R .ne. 0))
If ((A .ge. Range(R).Start) .and. (A .le. Range(R).End)) Then
Found = .true.
Else
P = R
R = Range(R).Next
EndIf
EndDo
C If no range found for this article, then we are done since its already
C marked as unread.
If (.not. Found) Then
Return
EndIf
C Range found, three cases can arise
If (A . eq. Range(R).Start) Then
C Article is first in range
Range(R).Start = Range(R).Start + 1
ElseIf (A .eq. Range(R).End) Then
C Article is last in range
Range(R).End = Range(R).End - 1
Else
C Article is within the range but not at either end point
C Get a new range and set it up from the old start through A - 1
Q = Range_Allocate ()
Range(Q).Start = Range(R).Start
Range(Q).End = A - 1
C The old range becomes the end of the range from A+1 through the old end
Range(R).Start = A + 1
C Chain P -> Q -> R
Range(Q).Next = R
If (P .ne. 0) Then
Range(P).Next = Q
Else
Group(G).Range_First = Q
EndIf
P = Q
EndIf
C Now, we may have left a nonsense group at R
If (Range(R).Start .gt. Range(R).End) Then
If (P .ne. 0) Then
Range(P).Next = Range(R).Next
If (Group(G).Range_Last .eq. R) Then
Group(G).Range_Last = P
EndIf
Else
Group(G).Range_First = Range(R).Next
If (Group(G).Range_Last .eq. R) Then
Group(G).Range_Last = Group(G).Range_First
EndIf
EndIf
Range(R).Next = 0
Call Range_Deallocate (R)
EndIf
C Finally, update unread count
U = U + 1
C That's all folks
Return
End ! Cmd_ArticleMark
Subroutine Cmd_ArticlePost (G, Cmd)
Include 'News.Def'
C Parameter definitions
Integer G ! Group number
Integer A ! Article number
Character *(*)Cmd ! Command text
C External routines
Integer Edt$Edit
Integer Group_Find
Integer SMG_Prompt
Integer Srv_Cmd
Integer Srv_Recv
Integer Srv_Send
Integer TrimLg
Integer User_Edit
C Local definitions
Character *22 Date_Time
Character *128 Distribution_Fld
Logical Eof
Character *(File_Name_Size) File_In
Character *(File_Name_Size) File_Out
Character *32 Fld
Logical FollowUp
Character *128 From
Character *128 Group_Name
Integer *4 Group_Name_Lg
Integer *4 I
Character *256 Img
Integer *4 Img_Lg
Logical *4 InHeader
Character *128 MessageID
Logical *4 Rotx
Integer *4 Status
Character *128 Subject
Integer *4 Subject_Lg
Integer *4 X
C Begin Cmd_ArticlePost
FollowUp = .false.
Group_Name = ' '
Group_Name_Lg = 0
Subject = ' '
Distribution_Fld = ' '
Goto 1
C Begin Cmd_ArticleFollowUp
Entry Cmd_ArticleFollowUp (G, A, Cmd)
FollowUp = .true.
Write (Img, '(A,I8)') 'head ', A
Status = Srv_Cmd (Img(1:13), Img, Img_Lg)
If (.not. Status) Then
Call SMG_All_Print ('Server failed', '|')
Stop
EndIf
If (Img(1:3) .ne. '221') Then
Call SMG_All_Print ('Unexpected server reply', '|')
Call Smg_All_Print (Img(1:Img_Lg), '|')
Stop
EndIf
From = ' '
Group_Name = ' '
Group_Name_Lg = 0
MessageID = ' '
Subject = ' '
Distribution_Fld = ' '
Do While (Img(1:Img_Lg) .ne. '.')
Status = Srv_Recv (Img, Img_Lg)
If (.not. Status) Then
Call SMG_All_Print ('Server failed', '|')
Stop
EndIf
If (Img(1:13) .eq. 'Distribution:') Then
If (Img_Lg .ge. 15) Then
Distribution_Fld = Img(15:Img_Lg)
EndIf
Else If (Img(1:8) .eq. 'Subject:') Then
If (Img_Lg .ge. 10) Then
Subject = Img(10:Img_Lg)
If (Subject(1:4) .ne. 'Re: ') Then
Subject = 'Re: ' // Subject
EndIf
EndIf
ElseIf (Img(1:11) .eq. 'Newsgroups:') Then
If (Img_Lg .ge. 13) Then
Group_Name = Img(13:Img_Lg)
Group_Name_Lg = Img_Lg - 12
EndIf
ElseIf (Img(1:5) .eq. 'From:') Then
If (Img_Lg .ge. 7) Then
From = Img(7:Img_Lg)
EndIf
ElseIf (Img(1:11) .eq. 'Message-ID:') Then
If (Img_Lg .ge. 13) Then
MessageID = Img(13:Img_Lg)
EndIf
EndIf
EndDo
Goto 1
C Begin common Cmd_ArticlePost - Cmd_ArticleFollowUp
1 If ((Len(Cmd) .lt. 3) .or. (Cmd(2:3) .ne. '/x')) Then
Rotx = .false.
Else
Rotx = .true.
EndIf
File_In = 'Sys$Login:News$In.News'
File_Out = 'Sys$Login:News$Out.News'
Call Smg_Erase
C Get group to post to
If (Group_Name_Lg .eq. 0) Then
I = 0
Do While (I .eq. 0)
Status = SMG_Prompt
$ (
$ Group_Name,
$ 'Group (' // Group(G).Name(1:TrimLg(Group(G).Name))
$ // ') ',
$ Group_Name_Lg
$ )
If (.not. Status) Then
Call SMG_All_Print ('Post aborted.', '|')
Return
EndIf
C Make sure group is legal
If (Group_Name(1:Group_Name_Lg) .eq. ' ') Then
Group_Name = Group(G).Name
Group_Name_Lg = TrimLg(Group(G).Name)
I = G
Else
I = Group_Find (Group_Name(1:Group_Name_Lg))
If (I .eq. 0) Then
Call SMG_All_Print
$ (
$ 'No such group as ' // Group_Name(1:Group_Name_Lg),
$ '|'
$ )
EndIf
EndIf
EndDo
EndIf
C Get subject
If (Subject .eq. ' ') Then
Status = SMG_Prompt (Subject, 'Subject: ', Subject_Lg)
If (.not. Status) Then
Call SMG_All_Print ('Post aborted.', '|')
Return
EndIf
EndIf
C Get distribution
If (Distribution_Fld .eq. ' ') Then
Distribution_Fld = ' '
Status = SMG_Prompt (Img, 'Distribution: ', Img_Lg)
X = 1
Do While (X .le. Img_Lg)
Call Field (Img(1:Img_Lg), X, Fld)
If (Fld .ne. ' ') Then
I = 1
Do While
$ (
$ (I .le. Distribution_Count)
$ .and.
$ (Distribution(I) .ne. Fld)
$ )
I = I + 1
EndDo
If (I .le. Distribution_Count) Then
If (Distribution_Fld .ne. ' ') Then
Distribution_Fld =
$ Distribution_Fld(1:TrimLg(Distribution_Fld)) // ', '
EndIf
Distribution_Fld =
$ Distribution_Fld(1:TrimLg(Distribution_Fld)) // Fld
Else
Call SMG_All_Print
$ (
$ 'Illegal Distribution field ' // Fld(1:TrimLg(Fld)),
$ '|'
$ )
Return
EndIf
EndIf
EndDo
EndIf
C Build date and time header
Date_Time = ' '
Call Date (Date_Time(1:9))
Call Time (Date_Time(11:18))
Date_Time(3:3) = ' '
Date_Time(7:7) = ' '
C Open the edit input file
Open
$ (
$ Unit = LU_EditIn,
$ File = File_In,
$ Status = 'New',
$ Form = 'Formatted',
$ CarriageControl = 'List',
$ Recl = 1024,
$ IOStat = Status
$ )
If (Status .ne. 0) Then
Call SMG_All_Print
$ (
$ 'Error opening file ' // File_In(1:TrimLg(File_In)) //
$ '. Post aborted.', '|'
$ )
Return
EndIf
C Write the article header
If (UserPersonalName .ne. ' ') Then
Write (LU_EditIn, '(A)')
$ 'From: ' //
$ UserName(1:TrimLg(UserName)) //
$ SiteId(1:TrimLg(SiteId)) //
$ ' (' //
$ UserPersonalName(1:TrimLg(UserPersonalName)) //
$ ')'
Else
Write (LU_EditIn, '(A)')
$ 'From: ' //
$ UserName(1:TrimLg(UserName)) //
$ SiteId(1:TrimLg(SiteId))
EndIf
Write (LU_EditIn, '(A)') 'Newsgroups: ' //
$ Group_Name(1:Group_Name_Lg)
Write (LU_EditIn, '(A)') 'Subject: ' // Subject(1:TrimLg(Subject))
Write (LU_EditIn, '(A)') 'Date: ' // Date_Time
If (Distribution_Fld .ne. ' ') Then
Write (LU_EditIn, '(A)') 'Distribution: ' //
$ Distribution_Fld(1:TrimLg(Distribution_Fld))
EndIf
Write (LU_EditIn, '(A)') 'Organization: ' //
$ Organization(1:TrimLg(Organization))
Write (LU_EditIn, '(A)') ' '
If (FollowUp) Then
Write (LU_EditIn, '(A)')
$ 'In article ' // MessageID(1:TrimLg(MessageID)) // ', ' //
$ From(1:TrimLg(From)) // ' writes...'
Write (LU_EditIn, '(A)') ' '
EndIf
C If followup, copy the article to the file
If (Followup) Then
Write (Img, '(A,I8)') 'body ', A
Status = Srv_Cmd (Img(1:13), Img, Img_Lg)
If (.not. Status) Then
Call SMG_All_Print ('Server failed', '|')
Stop
EndIf
If (Img(1:3) .ne. '222') Then
Call SMG_All_Print ('Unexpected server reply', '|')
Call Smg_All_Print (Img(1:Img_Lg), '|')
Stop
EndIf
Call Srv_CopyTxt (LU_EditIn, Mark_Character, Rotated)
EndIf
C Copy Signature file if any
Open
$ (
$ Unit = LU_Signature,
$ File = 'SIGNATURE.MAI',
$ DefaultFile = UserMailDirectory,
$ Form = 'Formatted',
$ CarriageControl = 'None',
$ Status = 'Old',
$ ReadOnly,
$ IOStat = Status
$ )
If (Status .eq. 0) Then
Do While (Status .eq. 0)
Read
$ (
$ Unit = LU_Signature,
$ Fmt = '(Q,A)',
$ IOStat = Status
$ ) Img_Lg, Img
If (Status .eq. 0) Then
Write (LU_EditIn, '(A)') Img(1:Img_Lg)
EndIf
EndDo
Close (LU_Signature)
EndIf
C Done building edit input file
Close (LU_EditIn)
C Edit the file
If (.not. Mail_Cmd_Mail$Edit) Then
Status = Edt$Edit (File_In,File_Out,,,4,,,)
Else
Status = User_Edit (File_In, File_Out)
EndIf
Call SMG_Erase
If (.not. Status) Then
Call Smg_All_Print
$ (
$ ' Error editing file, post aborted.', '|'
$ )
Return
EndIf
C Open the output file
Open
$ (
$ Unit = LU_EditOut,
$ File = File_Out,
$ Status = 'Old',
$ IOStat = Status,
$ Dispose = 'Delete'
$ )
If (Status .ne. 0) Then
Call SMG_All_Print
$ (
$ 'Error opening file ' // File_Out(1:TrimLg(File_Out)) //
$ '. Post aborted.', '|',
$ )
Return
EndIf
C Start a post command on the server
Status = Srv_Cmd ('post', Img, Img_Lg)
If (.not. Status) Then
Call SMG_All_Print ('Server failed', '|')
Stop
EndIf
If (Img(1:3) .eq. '340') Then
C Copy the file to the server postnews process
Call SMG_All_Print ('Sending article to server', '|')
Call SMG_All_Print (Img(1:Img_Lg), '|')
InHeader = .true.
Eof = .false.
Do While (.not. Eof)
Read
$ (
$ Unit = LU_EditOut,
$ Fmt = '(Q,A)',
$ IOStat = Status
$ ) Img_Lg, Img
If ((Img_Lg .eq. 0) .or. (Img(1:Img_Lg) .eq. ' ')) Then
InHeader = .false.
EndIf
If ((.not. InHeader) .and. RotX) Then
Call Rotate (Img(1:Img_Lg))
EndIf
If (Status .eq. 0) Then
If (Img(1:Img_Lg) .eq. '.') Then
Img = '..'
Img_Lg = 2
EndIf
Status = Srv_Send (Img(1:Img_Lg))
If (.not. Status) Then
Call SMG_All_Print ('Server failed.', '|')
Stop
EndIf
c Call Smg_All_Print (Img(1:Img_Lg), '|')
Else
Eof = .true.
EndIf
EndDo
C Mark end of input with a .
Status = Srv_Send ('.')
If (.not. Status) Then
Call SMG_All_Print ('Server failed.', '|')
Stop
EndIf
C Retrieve final status
Status = Srv_Recv (Img, Img_Lg)
If (.not. Status) Then
Call SMG_All_Print ('Server failed', '|')
Stop
EndIf
Call SMG_All_Print (Img(1:Img_Lg), '|')
C Server not accepting postings
Else
Call SMG_All_Print ('Server refusing posting requests.', '|')
Call SMG_All_Print (Img(1:Img_Lg), '|')
EndIf
C Close the edit output file
Close (LU_EditOut)
C Return
Return
End ! Cmd_ArticlePost
Subroutine Cmd_ArticleSave (G, A, Cmd)
Include 'News.Def'
C Description
C
C Handles the S filename command.
C
C Parameter definitions
Integer *4 G ! Group number
Integer *4 A ! Article number
Character *(*) Cmd ! Save command line
C External routines
Integer Srv_Cmd
Integer Srv_Recv
Integer Lib$Create_Dir
Integer TrimLg
Integer User_Open
External User_Open
Integer User_Open_Get_What_Happened
C Local definitions
Character *64 FileName
Character *128 Buf
Logical FirstDot
Integer *4 Lg
Integer *4 Status
Integer *4 X
Logical SecondTry
Character *128 Msg
Logical FileOpen
C Begin Cmd_ArticleSave
C Get the file name from the command line
X = 1
Lg = Len(Cmd)
Call GetField (FileName, Cmd, X, Lg)
Call GetField (FileName, Cmd, X, Lg)
C If user specified no file name, build default from group name
If (FileName .eq. ' ') Then
FileName = Group(G).Name
FirstDot = .true.
X = 1
Lg = TrimLg (FileName)
Do While (X .le. Lg)
If (FileName(X:X) .eq. '.') Then
If (FirstDot) Then
FirstDot = .false.
Else
FileName(X:X) = '_'
EndIf
EndIf
X = X + 1
EndDo
EndIf
C Open the file
FileOpen = .false.
SecondTry = .false.
Do While (.not. FileOpen)
Call User_Open_Init ('STATUS_UNKNOWN',0,0,0,0,0,0,0,0)
Open
$ (
$ Unit = LU_Save,
$ File = FileName,
$ DefaultFile = UserDirectory,
$ Status = 'Unknown',
$ Form = 'Formatted',
$ CarriageControl = 'List',
$ Recl = 1024,
$ Access = 'Append',
$ UserOpen = User_Open,
$ IOStat = Status
$ )
If (Status .ne. 0) Then
If
$ (
$ (Index(FileName,':') .eq. 0)
$ .and.
$ (Index(FileName,'[') .eq. 0)
$ .and.
$ (.not. SecondTry)
$ ) Then
SecondTry = .true.
Status = Lib$Create_Dir
$ (
$ UserDirectory(1:TrimLg(UserDirectory)), ! Name
$ , ! Owner
$ 'FF00'X, ! Prot enable
$ 'FF00'X, ! Prot mask
$ , ! Max versions
$ ! Rvn
$ )
If (Status) Then
Call SMG_All_Print
$ ('Created directory ' //
$ UserDirectory(1:TrimLg(UserDirectory)),
$ '|'
$ )
Else
Call SMG_All_Print
$ ('Error creating directory ' //
$ UserDirectory(1:TrimLg(UserDirectory)),
$ '|'
$ )
Return
EndIf
Else
Call SMG_All_Print
$ (
$ 'Error opening file ' // FileName(1:TrimLg(FileName)),
$ '|'
$ )
Return
EndIf
Else
FileOpen = .true.
EndIf
End Do
If (.not. Srv_Cmd('head',Buf,Lg)) Then
Call SMG_All_Print ('Server failed', '|')
Stop
EndIf
If (Buf(1:3) .ne. '221') Then
Call SMG_All_Print ('Unexpected server response', '|')
Call SMG_All_Print (Buf(1:Lg), '|')
Stop
EndIf
Call Srv_CopyTxt (LU_Save, ' ', .false.)
If (.not. Srv_Cmd('body',Buf,Lg)) Then
Call SMG_All_Print ('Server failed', '|')
Stop
EndIf
Write (LU_Save, '(A)') ' '
If (Buf(1:3) .ne. '222') Then
Call SMG_All_Print ('Unexpected server response', '|')
Call SMG_All_Print (Buf(1:Lg), '|')
Stop
EndIf
Call Srv_CopyTxt (LU_Save, ' ', Rotated)
Msg = 'Article '
Call ItoS (A, Msg(9:Len(Msg)), Lg)
Lg = 8 + Lg
If (User_Open_Get_What_Happened() .eq. 1) Then
Msg (Lg+1:Len(Msg)) = ' appended'
Lg = Lg + 9
Else
Msg (Lg+1:Len(Msg)) = ' saved'
Lg = Lg + 6
EndIf
Msg (Lg+1:Len(Msg)) = ' to file ' // FileName
Lg = TrimLg(Msg)
Call SMG_All_Print (Msg(1:Lg), '|')
Close (LU_Save)
Return
End ! Cmd_ArticleSave
Logical Function Cmd_ArticleCatchUp (G, A, Cmd, U)
Include 'News.Def'
C Description
C
C Handles the catchup command...
C
C Catchup [article]
C
C Marks all articles through and including article as read.
C Default article is last article in the group.
C
C Returns:
C
C .true. all articles read
C .false. some articles remain
C Parameter definitions
Integer *4 G ! Group number
Integer *4 A ! Article
Character *(*) Cmd ! Catchup command string
Integer *4 U ! Unread article count, updated
C External routines
Integer Range_Allocate
Integer UnRead
C Local definitions
Integer *4 L, R, X
C Begin Cmd_ArticleCatchUp
C Get the last article to be caught up from the command
X = Index (Cmd, ' ')
L = 0
Do While ((X .ne. 0) .and. (X .le. Len(Cmd)))
If ((Cmd(X:X) .ge. '0') .and. (Cmd(X:X) .le. '9')) Then
L = 10 * L + IChar(Cmd(X:X)) - IChar('0')
EndIf
X = X + 1
EndDo
C If no last article, use entire group active file range
If (L .eq. 0) Then
L = Group(G).Active_End
EndIf
C Calulate return value
%%end part b
Michael Dorl (608) 262-0466
dorl@vms.macc.wisc.edu
dorl@wiscmacc.bitnet