ext/Amiga-ARexx/ARexx.xs

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