This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
amigaos4: add Amiga::ARexx and Amiga::Exec
[perl5.git] / ext / Amiga-ARexx / ARexx.xs
1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4
5 #include "ppport.h"
6
7 #undef __USE_INLINE__
8 #include <exec/types.h>
9 #include <utility/tagitem.h>
10 #include <proto/exec.h>
11 #include <proto/intuition.h>
12 #include <proto/rexxsyslib.h>
13 #include <proto/utility.h>
14
15 #include <rexx/rxslib.h>
16 #include <rexx/errors.h>
17 //#include "rexxmsgext.h" // this should change depening on the ultimate location of the structures
18
19 /* utils */
20
21 /*
22  * Structure for the rexx host. Most of the code is inspired from Olaf
23  * Barthel's sample ARexx code from the developer CD 2.1
24  */
25
26
27 struct RexxHost
28 {
29         struct MsgPort *Port;
30         TEXT PortName[81];
31 } ;
32
33 struct ARexxMsg
34 {
35         struct RexxMsg *rexxMsg;
36         BOOL isReplied;
37         struct RexxHost *rexxHost;
38 };
39
40 STRPTR dupstr(STRPTR src)
41 {
42     STRPTR dest = NULL;
43     ULONG len;
44     if(src)
45     {
46         len = strlen(src);
47         if((dest = IExec->AllocVec(len + 1, MEMF_ANY)))
48         {
49             strcpy(dest,src);
50         }
51     }
52     return dest;
53 }
54
55
56 struct TimeRequest *
57 OpenTimer(void)
58 {
59         struct MsgPort *port = IExec->AllocSysObjectTags(ASOT_PORT, TAG_END);
60         if (port == NULL)
61         {
62                 return NULL;
63         }
64
65         struct TimeRequest *req = IExec->AllocSysObjectTags(ASOT_IOREQUEST,
66                 ASOIOR_Size, sizeof(struct TimeRequest),
67                 ASOIOR_ReplyPort, port,
68                 TAG_END);
69
70         if (req == NULL)
71         {
72                 IExec->FreeSysObject(ASOT_PORT, port);
73                 return NULL;
74         }
75
76         int8 deverr = IExec->OpenDevice("timer.device", UNIT_MICROHZ,
77                 &req->Request, 0);
78
79         if (deverr != IOERR_SUCCESS)
80         {
81                 IExec->FreeSysObject(ASOT_IOREQUEST, req);
82                 IExec->FreeSysObject(ASOT_PORT, port);
83                 return NULL;
84         }
85
86         return req;
87 }
88
89
90 void
91 CloseTimer(struct TimeRequest *req)
92 {
93         if (req != NULL)
94         {
95                 struct MsgPort *port = req->Request.io_Message.mn_ReplyPort;
96
97                 IExec->CloseDevice(&req->Request);
98                 IExec->FreeSysObject(ASOT_IOREQUEST, req);
99                 IExec->FreeSysObject(ASOT_PORT, port);
100         }
101 }
102
103 LONG
104 ReturnRexxMsg(struct RexxMsg * Message, CONST_STRPTR Result)
105 {
106         STRPTR ResultString = NULL;
107
108         /* No error has occured yet. */
109         int32 ErrorCode = 0;
110
111         /* Set up the RexxMsg to return no error. */
112         Message->rm_Result1 = RC_OK;
113         Message->rm_Result2 = 0;
114
115         /* Check if the command should return a result. */
116         if((Message->rm_Action & RXFF_RESULT) && Result != NULL)
117         {
118                 /* To return the result string we need to make
119                  * a copy for ARexx to use.
120                  */
121                 if((ResultString = IRexxSys->CreateArgstring(Result, strlen(Result))))
122                 {
123                         /* Put the string into the secondary
124                          * result field.
125                          */
126                         Message->rm_Result2 = (LONG)ResultString;
127                 }
128                 else
129                 {
130                         /* No memory available. */
131                         ErrorCode = ERR10_003;
132                 }
133         }
134
135         /* Reply the message, regardless of the error code. */
136         IExec->ReplyMsg((struct Message *)Message);
137
138         return(ErrorCode);
139 }
140
141
142 void
143 ReturnErrorMsg(struct RexxMsg *msg, CONST_STRPTR port, int32 rc, int32 rc2)
144 {
145         /* To signal an error the rc_Result1
146          * entry of the RexxMsg needs to be set to
147          * RC_ERROR. Unfortunately, we cannot convey
148          * the more meaningful error code through
149          * this interface which is why we set a
150          * Rexx variable to the error number. The
151          * Rexx script can then take a look at this
152          * variable and decide which further steps
153          * it should take.
154          */
155         msg->rm_Result1 = rc;
156         msg->rm_Result2 = rc2;
157
158         /* Turn the error number into a string as
159          * ARexx only deals with strings.
160          */
161         char value[12];
162         IUtility->SNPrintf(value, sizeof(value), "%ld", rc2);
163
164         /* Build the name of the variable to set to
165          * the error number. We will use the name of
166          * the host name and append ".LASTERROR".
167          */
168         IRexxSys->SetRexxVarFromMsg("RC2", value, msg);
169
170         IExec->ReplyMsg(&msg->rm_Node);
171 }
172
173 BOOL
174 PutMsgTo(CONST_STRPTR name, struct Message *msg)
175 {
176         BOOL done = FALSE;
177
178         IExec->Forbid();
179
180         struct MsgPort *port = IExec->FindPort(name);
181         if (port != NULL)
182         {
183                 IExec->PutMsg(port, msg);
184                 done = TRUE;
185         }
186
187         IExec->Permit();
188
189         return done;
190 }
191
192
193 STRPTR DoRexx(STRPTR port, STRPTR command, int32 *rc, int32 *rc2)
194 {
195         *rc = 0;
196         *rc2 = 0;
197         STRPTR result = NULL;
198         STRPTR dup = NULL;
199
200         struct MsgPort *replyPort = IExec->AllocSysObjectTags(ASOT_PORT, TAG_END);
201         if (replyPort == NULL)
202         {
203                 return NULL;
204         }
205
206         struct RexxMsg *rexxMsg = IRexxSys->CreateRexxMsg(replyPort, NULL, NULL);
207         ((struct Node *)rexxMsg)->ln_Name = "REXX";
208         if (rexxMsg == NULL)
209         {
210                 IExec->FreeSysObject(ASOT_PORT, replyPort);
211                 return NULL;
212         }
213         BOOL sent = FALSE;
214
215
216         rexxMsg->rm_Args[0] = IRexxSys->CreateArgstring(command, strlen(command));
217
218         if (rexxMsg->rm_Args[0] != NULL)
219         {
220                 rexxMsg->rm_Action = RXCOMM | RXFF_RESULT | RXFF_STRING;
221
222                 sent = PutMsgTo(port, (struct Message*)rexxMsg);
223
224                 if (sent)
225                 {
226                         IExec->WaitPort(replyPort);
227                         (void)IExec->GetMsg(replyPort);
228                 }
229                 else
230                 {
231
232                 }
233
234                 *rc = rexxMsg->rm_Result1;
235
236                 if (*rc == RC_OK)
237                 {
238                         if (rexxMsg->rm_Result2 != 0)
239                         {
240                                 result = (STRPTR)rexxMsg->rm_Result2;
241                         }
242                 }
243                 else
244                 {
245                         *rc2 = rexxMsg->rm_Result2;
246                 }
247
248                 IRexxSys->DeleteArgstring(rexxMsg->rm_Args[0]);
249                 rexxMsg->rm_Args[0] = NULL;
250         }
251
252         IRexxSys->DeleteRexxMsg(rexxMsg);
253         rexxMsg = NULL;
254
255         IExec->FreeSysObject(ASOT_PORT, replyPort);
256         replyPort = NULL;
257
258         if (result != NULL)
259         {
260                 dup = dupstr(result);
261
262                 IRexxSys->DeleteArgstring(result);
263                 result = NULL;
264         }
265
266         return dup;
267 }
268
269
270 struct RexxHost *CreateRexxHost(CONST_STRPTR PortName)
271 {
272         struct RexxHost *newHost = IExec->AllocVecTags(sizeof(struct RexxHost),
273         AVT_Type, MEMF_PRIVATE, AVT_ClearWithValue, 0, TAG_DONE);
274
275         if (newHost == NULL)
276         {
277         return NULL;
278         }
279
280         IUtility->Strlcpy(newHost->PortName, PortName, sizeof(newHost->PortName));
281
282         IExec->Forbid();
283
284         /* Check if the name already exists */
285         if (IExec->FindPort(PortName) != NULL)
286         {
287         int32 index = 1;
288         do
289         {
290         IUtility->SNPrintf(newHost->PortName, sizeof(newHost->PortName), "%s.%ld", PortName, index);
291         index++;
292
293         if (IExec->FindPort(newHost->PortName) == NULL)
294         {
295         break;
296         }
297         } while (1);
298         }
299
300         newHost->Port = IExec->AllocSysObjectTags(ASOT_PORT,
301         ASOPORT_Name,   newHost->PortName,
302         ASOPORT_Public, TRUE,
303         TAG_DONE);
304
305         IExec->Permit();
306
307         if (newHost->Port == NULL)
308         {
309         IExec->FreeVec(newHost);
310         return NULL;
311         }
312
313         return newHost;
314 }
315
316
317 void DeleteRexxHost(struct RexxHost *host)
318 {
319         if (host)
320         {
321         if (host->Port)
322         {
323         struct RexxMsg *msg;
324
325         IExec->Forbid();
326         while ((msg = (struct RexxMsg *)IExec->GetMsg(host->Port)) != NULL)
327         {
328         msg->rm_Result1 = RC_FATAL;
329         IExec->ReplyMsg((struct Message *)msg);
330         }
331
332         IExec->FreeSysObject(ASOT_PORT, host->Port);
333         IExec->Permit();
334         }
335
336         IExec->FreeVec(host);
337         }
338 }
339
340 void WaitRexxHost(struct RexxHost *rexxHost, int timeout)
341 {
342
343         struct TimeRequest *req = NULL;
344         uint32 timermask        = 0;
345
346         if (timeout > 0)
347         {
348                 req = OpenTimer();
349
350                 if (req != NULL)
351                 {
352                         timermask = 1L << req->Request.io_Message.mn_ReplyPort->mp_SigBit;
353
354                         req->Request.io_Command = TR_ADDREQUEST;
355                         req->Time.Seconds       = 0;
356                         req->Time.Microseconds  = timeout;
357
358                         IExec->SendIO(&req->Request);
359                 }
360         }
361
362         uint32 hostmask = 1L << rexxHost->Port->mp_SigBit;
363         uint32 waitmask = timermask | hostmask | SIGBREAKF_CTRL_C;
364
365         uint32 sigmask = IExec->Wait(waitmask);
366
367         if (req != NULL)
368         {
369                 IExec->AbortIO(&req->Request);
370                 IExec->WaitIO(&req->Request);
371                 CloseTimer(req);
372         }
373
374         if (sigmask & SIGBREAKF_CTRL_C)
375         {
376                 return;
377         }
378
379
380 }
381
382 struct ARexxMsg *GetMsgRexxHost(struct RexxHost *rexxHost)
383 {
384         struct ARexxMsg *am = NULL;
385
386         struct RexxMsg *rexxMsg = NULL;
387
388         rexxMsg = (struct RexxMsg *)IExec->GetMsg(rexxHost->Port);
389         if (rexxMsg != NULL)
390         {
391                 if((am = IExec->AllocVecTags(sizeof(struct ARexxMsg),AVT_Type, MEMF_PRIVATE, AVT_ClearWithValue, 0, TAG_DONE)))
392                 {
393                         am->rexxMsg = rexxMsg;
394                         am->rexxHost = rexxHost;
395                         am->isReplied = FALSE;
396                 }
397
398         }
399         return am;
400 }
401
402 uint32 GetSignalRexxHost(struct RexxHost *rexxHost)
403 {
404         return rexxHost->Port->mp_SigBit;
405 }
406
407
408 void ReplyARexxMsg(struct ARexxMsg *am, int rc, int rc2, STRPTR result)
409 {
410         if(am)
411         {
412                 if(!am->isReplied)
413                 {
414                         if(rc == 0)
415                         {
416                                 ReturnRexxMsg(am->rexxMsg, result);
417                         }
418                         else
419                         {
420                                 ReturnErrorMsg(am->rexxMsg, am->rexxHost->PortName,rc,rc2);
421                         }
422                         am->isReplied = TRUE;
423                 }
424         }
425 }
426
427 STRPTR GetVarARexxMsg(struct ARexxMsg *am, STRPTR varname)
428 {
429         STRPTR result = IExec->AllocVecTags(256,AVT_Type, MEMF_PRIVATE, AVT_ClearWithValue, 0, TAG_DONE);
430         if(result)
431         {
432                 IRexxSys->GetRexxVarFromMsg(varname, result, am->rexxMsg);
433         }
434         return result;
435 }
436
437 void SetVarARexxMsg(struct ARexxMsg *am, STRPTR varname, STRPTR value)
438 {
439         IRexxSys->SetRexxVarFromMsg(varname, value, am->rexxMsg);
440 }
441
442 void DeleteARexxMsg(struct ARexxMsg *am)
443 {
444         if(!am->isReplied)
445         {
446                 IExec->ReplyMsg(&am->rexxMsg->rm_Node);
447                 am->isReplied = TRUE;
448         }
449         IExec->FreeVec(am);
450 }
451
452 STRPTR GetArgsARexxMsg(struct ARexxMsg *am)
453 {
454         return am->rexxMsg->rm_Args[0];
455 }
456
457 MODULE = Amiga::ARexx              PACKAGE = Amiga::ARexx
458
459 PROTOTYPES: DISABLE
460
461
462 APTR Host_init(name)
463     STRPTR name;
464     CODE:
465         RETVAL = CreateRexxHost(name);
466     OUTPUT:
467         RETVAL
468
469 void Host_delete(rexxhost)
470         APTR rexxhost;
471         CODE:
472                 DeleteRexxHost(rexxhost);
473
474 void Host_wait(rexxhost,timeout)
475         APTR rexxhost
476         int timeout
477         CODE:
478                 WaitRexxHost(rexxhost,timeout);
479
480 uint32 Host_signal(rexxhost)
481         APTR rexxhost
482         CODE:
483                 RETVAL = GetSignalRexxHost(rexxhost);
484         OUTPUT:
485                 RETVAL
486
487 APTR Host_getmsg(rexxhost)
488         APTR rexxhost
489         CODE:
490                 RETVAL = GetMsgRexxHost(rexxhost);
491         OUTPUT:
492                 RETVAL
493
494 void Msg_reply(rexxmsg,rc,rc2,result)
495         APTR rexxmsg
496         int rc
497         int rc2
498         STRPTR result
499         CODE:
500                 ReplyARexxMsg(rexxmsg,rc,rc2,result);
501
502 void Msg_delete(rexxmsg)
503         APTR rexxmsg
504         CODE:
505                 DeleteARexxMsg(rexxmsg);
506
507 STRPTR Msg_argstr(rexxmsg)
508         APTR rexxmsg
509         CODE:
510                 RETVAL = GetArgsARexxMsg(rexxmsg);
511         OUTPUT:
512                 RETVAL
513
514 STRPTR Msg_getvar(rexxmsg,varname)
515         APTR rexxmsg
516         STRPTR varname
517         PPCODE:
518                 RETVAL = GetVarARexxMsg(rexxmsg,varname);
519                 sv_setpv(TARG, RETVAL); XSprePUSH; PUSHTARG;
520                 if (RETVAL) IExec->FreeVec(RETVAL);
521
522 void Msg_setvar(rexxmsg,varname,value)
523         APTR rexxmsg
524         STRPTR varname
525         STRPTR value
526         CODE:
527                 SetVarARexxMsg(rexxmsg,varname,value);
528
529 STRPTR _DoRexx(port,command,rc,rc2)
530         STRPTR port
531         STRPTR command
532         int32 &rc
533         int32 &rc2
534         PPCODE:
535                 RETVAL = DoRexx(port,command,&rc,&rc2);
536                 sv_setiv(ST(2), (IV)rc);
537                 SvSETMAGIC(ST(2));
538                 sv_setiv(ST(3), (IV)rc2);
539                 SvSETMAGIC(ST(3));
540                 sv_setpv(TARG, RETVAL); XSprePUSH; PUSHTARG;
541                 IExec->FreeVec(RETVAL);
542