1 private_daemon_server: pdsr: proc (mno, sender, time, message);
2
3 dcl (mno, sender, time, message) char (*);
4 dcl whoami char (32) static init ("private_daemon_server") options (constant);
5 dcl iox_$detach_iocb entry (ptr, fixed bin(35));
6 dcl iox_$find_iocb entry (char(*), ptr, fixed bin(35));
7 dcl iox_$destroy_iocb entry (ptr, fixed bin(35));
8 dcl iox_$attach_ptr entry (ptr, char(*), ptr, fixed bin(35));
9 dcl iox_$open entry (ptr, fixed bin, bit(1) aligned, fixed bin(35));
10 dcl iox_$write_record entry (ptr, ptr, fixed bin(21), fixed bin(35));
11 dcl iox_$close entry (ptr, fixed bin(35));
12 dcl cu_$arg_count entry () returns (fixed bin);
13 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin(21), fixed bin(35));
14 dcl com_err_ entry() options(variable);
15 dcl ioa_ entry() options(variable);
16 dcl ioa_$rsnnl entry() options(variable);
17 dcl debug bit (1) static init ("0"b);
18 dcl hcs_$initiate_count entry (char(*), char(*), char(*), fixed bin(24), fixed bin(2), ptr, fixed bin(35));
19 dcl hcs_$terminate_seg entry (ptr, fixed bin(1), fixed bin(35));
20 dcl send_admin_command entry options(variable);
21 dcl arg based (ap) char (al), ap ptr, al fixed bin (21);
22 dcl pathname char (168);
23 dcl seg_length fixed bin (24);
24 dcl seg_ptr ptr;
25 dcl seg_contents char (seg_length) based (seg_ptr);
26 dcl seg_initiated bit (1) init ("0"b);
27 dcl code fixed bin (35);
28 dcl expand_pathname_ entry (char(*), char(*), char(*), fixed bin(35));
29 dcl dirname char (168), entryname char (32);
30 dcl log_iocb_ptr ptr internal static init (null ());
31 dcl buffer char (128) aligned;
32 dcl channel char (256);
33 dcl channel_index fixed bin;
34 dcl (length, rtrim) builtin;
35 dcl cleanup condition;
36
37 %include iox_modes;
38
39 on cleanup call clean_up ();
40
41 pathname = "";
42 if cu_$arg_count () > 4 then do;
43 call cu_$arg_ptr (5, ap, al, code);
44 if code ^= 0 then call error (code, "Determining mailbox");
45 pathname = arg;
46 end;
47
48 if pathname = "" then call error (0, "No mailbox pathname supplied");
49
50 if log_iocb_ptr = null () then do;
51 call iox_$find_iocb ("pdsr_log_io", log_iocb_ptr, code);
52 if code ^= 0 then call error (code, "Finding log iocb");
53 call iox_$attach_ptr (log_iocb_ptr, "vfile_ >sc1>private_daemon_server_dir>pdsr_log -append",
54 null (), code);
55 if code ^= 0 then call error (code, "Attaching log iocb");
56 end;
57
58 call expand_pathname_ (pathname, dirname, entryname, code);
59 if code ^= 0 then call error (code, "Expanding mailbox path");
60
61 call hcs_$initiate_count (dirname, substr (entryname, 1, length (rtrim (entryname)) - 3) || "pdsr", "", seg_length, (0), seg_ptr, code);
62 if code ^= 0 then call error (code, "Initiating .pdsr segment");
63 seg_initiated = "1"b;
64 seg_length = divide (seg_length, 9, 24, 0);
65
66 if message = "login" then do;
67
68 if debug then do;
69 call announce ();
70 call ioa_ ("pdsr test: sc_command login ^a", rtrim (seg_contents, byte (10)));
71 end;
72 else do;
73 call announce ();
74 call send_admin_command ("sc_command login ", rtrim (seg_contents, byte(10)));
75 end;
76 goto done;
77 end;
78
79 if message = "logout" then do;
80 if debug then do;
81 call announce ();
82 call ioa_ ("pdsr test: sc_command logout ^a", rtrim (seg_contents, byte (10)));
83 end;
84 else do;
85 call announce ();
86 call send_admin_command ("sc_command logout ", rtrim (seg_contents, byte(10)));
87 end;
88 goto done;
89 end;
90
91 if message = "quit" then do;
92 channel = rtrim (seg_contents, byte (10));
93 channel_index = index (channel, " ");
94 channel = substr (channel, channel_index + 1, length (channel) - channel_index);
95 channel_index = index (channel, " ");
96 channel = substr (channel, channel_index + 1, length (channel) - channel_index);
97 if debug then do;
98 call announce ();
99 call ioa_ ("pdsr test: sc_command quit ^a", channel);
100 end;
101 else do;
102 call announce ();
103 call send_admin_command ("sc_command quit ", rtrim (channel));
104 end;
105 goto done;
106 end;
107
108 call announce_illegal ();
109
110 done:
111 if seg_initiated then call hcs_$terminate_seg (seg_ptr, (0), code);
112 return;
113
114 announce:
115 proc ();
116 call iox_$open (log_iocb_ptr, Sequential_output, "0"b, code);
117 if code ^= 0 then call error (code, "Opening log");
118 call ioa_$rsnnl ("^a: ^a: ^a Performing Daemon ^a",
119 buffer, 128, rtrim (entryname), rtrim(time), sender, message);
120 call iox_$write_record (log_iocb_ptr, addr (buffer), length (rtrim (buffer)),
121 code);
122 if code ^= 0 then call error (code, "Attempting to write log file");
123 call iox_$close (log_iocb_ptr, code);
124 if code ^= 0 then
125 call com_err_ (code, whoami, "Attempting to close log file");
126 return;
127 end announce;
128
129 announce_illegal:
130 proc ();
131 call iox_$open (log_iocb_ptr, Sequential_output, "0"b, code);
132 if code ^= 0 then call error (code, "Opening log");
133 call ioa_$rsnnl ("^a: ^a: Illegal request ^a received from ^a",
134 buffer, 128, entryname, time, message, sender);
135 call iox_$write_record (log_iocb_ptr, addr (buffer), length (rtrim (buffer)),
136 code);
137 if code ^= 0 then call error (code, "Attempting to write log file");
138 call iox_$close (log_iocb_ptr, code);
139 if code ^= 0 then
140 call com_err_ (code, whoami, "Attempting to close log file");
141 return;
142 end announce_illegal;
143
144 clean_up:
145 proc ();
146 if seg_initiated then call hcs_$terminate_seg (seg_ptr, (0), (0));
147 return;
148 end clean_up;
149
150
151 error:
152 proc (a_code, a_message);
153 dcl a_code fixed bin (35);
154 dcl a_message char (*);
155 call com_err_ (a_code, whoami, a_message);
156 goto done;
157 end error;
158
159 close_log:
160 entry ();
161 if log_iocb_ptr ^= null () then do;
162 call iox_$detach_iocb (log_iocb_ptr, code);
163 if code ^= 0 then do;
164 call com_err_ (code, whoami, "Attempting to detach log");
165 return;
166 end;
167 end;
168 log_iocb_ptr = null ();
169 return;
170
171 debug_on:
172 entry ();
173 debug = "1"b;
174 return;
175
176 debug_off:
177 entry ();
178 debug = "0"b;
179 return;
180
181 end private_daemon_server;
182
183
184