generic/multi.c

   1 /*
   2  * multi.c --
   3  *
   4  * Implementation of the part of the TclCurl extension that deals with libcurl's
   5  * 'multi' interface.
   6  *
   7  * Copyright (c)2002-2009 Andres Garcia Garcia.
   8  *
   9  * See the file "license.terms" for information on usage and redistribution
  10  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11  *
  12  */
  13
  14 #include "multi.h"
  15 #include <sys/time.h>
  16
  17 /*
  18  *----------------------------------------------------------------------
  19  *
  20  * Tclcurl_MultiInit --
  21  *
  22  *      This procedure initializes the 'multi' part of the package
  23  *
  24  * Results:
  25  *      A standard Tcl result.
  26  *
  27  *----------------------------------------------------------------------
  28  */
  29
  30 int
  31 Tclcurl_MultiInit (Tcl_Interp *interp) {
  32
  33     Tcl_CreateObjCommand (interp,"::curl::multiinit",curlInitMultiObjCmd,
  34             (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
  35
  36     return TCL_OK;
  37 }
  38
  39 /*
  40  *----------------------------------------------------------------------
  41  *
  42  * curlCreateMultiObjCmd --
  43  *
  44  *      Looks for the first free handle (mcurl1, mcurl2,...) and creates a
  45  *      Tcl command for it.
  46  *
  47  * Results:
  48  *  A string with the name of the handle, don't forget to free it.
  49  *
  50  * Side effects:
  51  *      See the user documentation.
  52  *
  53  *----------------------------------------------------------------------
  54  */
  55
  56 char *
  57 curlCreateMultiObjCmd (Tcl_Interp *interp,struct curlMultiObjData *curlMultiData) {
  58     char                *handleName;
  59     int                 i;
  60     Tcl_CmdInfo         info;
  61     Tcl_Command         cmdToken;
  62
  63     /* We try with mcurl1, if it already exists with mcurl2, ... */
  64     handleName=(char *)Tcl_Alloc(10);
  65     for (i=1;;i++) {
  66         sprintf(handleName,"mcurl%d",i);
  67         if (!Tcl_GetCommandInfo(interp,handleName,&info)) {
  68             cmdToken=Tcl_CreateObjCommand(interp,handleName,curlMultiObjCmd,
  69                                 (ClientData)curlMultiData,
  70                                 (Tcl_CmdDeleteProc *)curlMultiDeleteCmd);
  71             break;
  72         }
  73     }
  74
  75     curlMultiData->token=cmdToken;
  76
  77     return handleName;
  78 }
  79
  80 /*
  81  *----------------------------------------------------------------------
  82  *
  83  * curlInitMultiObjCmd --
  84  *
  85  *      This procedure is invoked to process the "curl::multiInit" Tcl command.
  86  *      See the user documentation for details on what it does.
  87  *
  88  * Results:
  89  *      A standard Tcl result.
  90  *
  91  * Side effects:
  92  *      See the user documentation.
  93  *
  94  *----------------------------------------------------------------------
  95  */
  96
  97 int
  98 curlInitMultiObjCmd (ClientData clientData, Tcl_Interp *interp,
  99         int objc,Tcl_Obj *CONST objv[]) {
 100
 101
 102     Tcl_Obj                     *result;
 103     struct curlMultiObjData     *curlMultiData;
 104     char                        *multiHandleName;
 105
 106     curlMultiData=(struct curlMultiObjData *)Tcl_Alloc(sizeof(struct curlMultiObjData));
 107     if (curlMultiData==NULL) {
 108         result=Tcl_NewStringObj("Couldn't allocate memory",-1);
 109         Tcl_SetObjResult(interp,result);
 110         return TCL_ERROR;
 111     }
 112
 113     memset(curlMultiData, 0, sizeof(struct curlMultiObjData));
 114     curlMultiData->interp=interp;
 115
 116     curlMultiData->mcurl=curl_multi_init();
 117
 118     if (curlMultiData->mcurl==NULL) {
 119         result=Tcl_NewStringObj("Couldn't open curl multi handle",-1);
 120         Tcl_SetObjResult(interp,result);
 121         return TCL_ERROR;
 122     }
 123
 124     multiHandleName=curlCreateMultiObjCmd(interp,curlMultiData);
 125
 126     result=Tcl_NewStringObj(multiHandleName,-1);
 127     Tcl_SetObjResult(interp,result);
 128     Tcl_Free(multiHandleName);
 129
 130     return TCL_OK;
 131 }
 132
 133 /*
 134  *----------------------------------------------------------------------
 135  *
 136  * curlMultiObjCmd --
 137  *
 138  *      This procedure is invoked to process the "multi curl" commands.
 139  *      See the user documentation for details on what it does.
 140  *
 141  * Results:
 142  *      A standard Tcl result.
 143  *
 144  * Side effects:
 145  *      See the user documentation.
 146  *
 147  *----------------------------------------------------------------------
 148  */
 149 int
 150 curlMultiObjCmd (ClientData clientData, Tcl_Interp *interp,
 151     int objc,Tcl_Obj *CONST objv[]) {
 152
 153     struct curlMultiObjData    *curlMultiData=(struct curlMultiObjData *)clientData;
 154     CURLMcode                   errorCode;
 155     int                         tableIndex;
 156
 157     if (objc<2) {
 158         Tcl_WrongNumArgs(interp,1,objv,"option arg ?arg?");
 159         return TCL_ERROR;
 160     }
 161     if (Tcl_GetIndexFromObj(interp, objv[1], multiCommandTable, "option",
 162             TCL_EXACT,&tableIndex)==TCL_ERROR) {
 163         return TCL_ERROR;
 164     }
 165     switch(tableIndex) {
 166         case 0:
 167 /*            fprintf(stdout,"Multi add handle\n"); */
 168             errorCode=curlAddMultiHandle(interp,curlMultiData->mcurl,objv[2]);
 169             return curlReturnCURLMcode(interp,errorCode);
 170             break;
 171         case 1:
 172 /*            fprintf(stdout,"Multi remove handle\n"); */
 173             errorCode=curlRemoveMultiHandle(interp,curlMultiData->mcurl,objv[2]);
 174             return curlReturnCURLMcode(interp,errorCode);
 175             break;
 176         case 2:
 177 /*            fprintf(stdout,"Multi perform\n"); */
 178             errorCode=curlMultiPerform(interp,curlMultiData->mcurl);
 179             return errorCode;
 180             break;
 181         case 3:
 182 /*            fprintf(stdout,"Multi cleanup\n"); */
 183             Tcl_DeleteCommandFromToken(interp,curlMultiData->token);
 184             break;
 185         case 4:
 186 /*            fprintf(stdout,"Multi getInfo\n"); */
 187             curlMultiGetInfo(interp,curlMultiData->mcurl);
 188             break;
 189         case 5:
 190 /*            fprintf(stdout,"Multi activeTransfers\n"); */
 191             curlMultiActiveTransfers(interp,curlMultiData);
 192             break;
 193         case 6:
 194 /*            fprintf(stdout,"Multi auto transfer\n");*/
 195             curlMultiAutoTransfer(interp,curlMultiData,objc,objv);
 196             break;
 197         case 7:
 198 /*            fprintf(stdout,"Multi configure\n");*/
 199             curlMultiConfigTransfer(interp,curlMultiData,objc,objv);
 200             break;
 201     }
 202     return TCL_OK;
 203 }
 204
 205 /*
 206  *----------------------------------------------------------------------
 207  *
 208  * curlAddMultiHandle --
 209  *
 210  *      Adds an 'easy' curl handle to the stack of a 'multi' handle.
 211  *
 212  *  Parameter:
 213  *      interp: Pointer to the interpreter we are using.
 214  *      curlMultiHandle: The handle into which we will add the easy one.
 215  *      objvPtr: The Tcl object with the name of the easy handle.
 216  *
 217  * Results:
 218  *  '0' all went well.
 219  *  'non-zero' in case of error.
 220  *----------------------------------------------------------------------
 221  */
 222 CURLMcode
 223 curlAddMultiHandle(Tcl_Interp *interp,CURLM *curlMultiHandlePtr
 224         ,Tcl_Obj *objvPtr) {
 225
 226     struct curlObjData        *curlDataPtr;
 227     CURLMcode                  errorCode;
 228
 229
 230     curlDataPtr=curlGetEasyHandle(interp,objvPtr);
 231
 232     if (curlOpenFiles(interp,curlDataPtr)) {
 233         return TCL_ERROR;
 234     }
 235     if (curlSetPostData(interp,curlDataPtr)) {
 236         return TCL_ERROR;
 237     }
 238
 239     errorCode=curl_multi_add_handle(curlMultiHandlePtr,curlDataPtr->curl);
 240
 241     curlEasyHandleListAdd(curlMultiHandlePtr,curlDataPtr->curl
 242             ,Tcl_GetString(objvPtr));
 243
 244     return errorCode;
 245 }
 246
 247 /*
 248  *----------------------------------------------------------------------
 249  *
 250  * curlRemoveMultiHandle --
 251  *
 252  *      Removes an 'easy' curl handle to the stack of a 'multi' handle.
 253  *
 254  *  Parameter:
 255  *      interp: Pointer to the interpreter we are using.
 256  *      curlMultiHandle: The handle into which we will add the easy one.
 257  *      objvPtr: The Tcl object with the name of the easy handle.
 258  *
 259  * Results:
 260  *  '0' all went well.
 261  *  'non-zero' in case of error.
 262  *----------------------------------------------------------------------
 263  */
 264 CURLMcode
 265 curlRemoveMultiHandle(Tcl_Interp *interp,CURLM *curlMultiHandle
 266         ,Tcl_Obj *objvPtr) {
 267     struct curlObjData        *curlDataPtr;
 268     CURLMcode                  errorCode;
 269
 270     curlDataPtr=curlGetEasyHandle(interp,objvPtr);
 271     errorCode=curl_multi_remove_handle(curlMultiHandle,curlDataPtr->curl);
 272     curlEasyHandleListRemove(curlMultiHandle,curlDataPtr->curl);
 273
 274     curlCloseFiles(curlDataPtr);
 275     curlResetPostData(curlDataPtr);
 276
 277     if (curlDataPtr->bodyVarName) {
 278         curlSetBodyVarName(interp,curlDataPtr);
 279     }
 280
 281     return errorCode;
 282 }
 283
 284 /*
 285  *----------------------------------------------------------------------
 286  *
 287  * curlMultiPerform --
 288  *
 289  *      Invokes the 'curl_multi_perform' function to update the current
 290  *  transfers.
 291  *
 292  *  Parameter:
 293  *      interp: Pointer to the interpreter we are using.
 294  *      curlMultiHandle: The handle of the transfer to update.
 295  *      objvPtr: The Tcl object with the name of the easy handle.
 296  *
 297  * Results:
 298         Usual Tcl result.
 299  *----------------------------------------------------------------------
 300  */
 301 int
 302 curlMultiPerform(Tcl_Interp *interp,CURLM *curlMultiHandlePtr) {
 303
 304     CURLMcode        errorCode;
 305     int              runningTransfers;
 306
 307     for (errorCode=-1;errorCode<0;) {
 308         errorCode=curl_multi_perform(curlMultiHandlePtr,&runningTransfers);
 309     }
 310
 311     if (errorCode==0) {
 312         curlReturnCURLMcode(interp,runningTransfers);
 313         return TCL_OK;
 314     }
 315
 316     curlReturnCURLMcode(interp,errorCode);
 317
 318     return TCL_ERROR;
 319 }
 320
 321 /*
 322  *----------------------------------------------------------------------
 323  *
 324  * curlMultiDeleteCmd --
 325  *
 326  *      This procedure is invoked when curl multi handle is deleted.
 327  *      See the user documentation for details on what it does.
 328  *
 329  * Results:
 330  *      A standard Tcl result.
 331  *
 332  * Side effects:
 333  *      Cleans the curl handle and frees the memory.
 334  *
 335  *----------------------------------------------------------------------
 336  */
 337 int
 338 curlMultiDeleteCmd(ClientData clientData) {
 339     struct curlMultiObjData     *curlMultiData=(struct curlMultiObjData *)clientData;
 340     CURLM                       *curlMultiHandle=curlMultiData->mcurl;
 341     CURLMcode                    errorCode;
 342     Tcl_Interp                  *interp=curlMultiData->interp;
 343     struct easyHandleList       *listPtr1,*listPtr2;
 344
 345     listPtr1=curlMultiData->handleListFirst;
 346     while (listPtr1!=NULL) {
 347         listPtr2=listPtr1->next;
 348         Tcl_Free(listPtr1->name);
 349         Tcl_Free((char *)listPtr1);
 350         listPtr1=listPtr2;
 351     }
 352     errorCode=curl_multi_cleanup(curlMultiHandle);
 353     curlMultiFreeSpace(curlMultiData);
 354     return curlReturnCURLMcode(interp,errorCode);
 355 }
 356
 357 /*
 358  *----------------------------------------------------------------------
 359  *
 360  * curlGetMultiInfo --
 361  *    Invokes the curl_multi_info_read function in libcurl to get
 362  *    some info about the transfer, like if they are done and
 363  *    things like that.
 364  *
 365  * Parameter:
 366  *    interp: The Tcl interpreter we are using, mainly to report errors.
 367  *    curlMultiHandlePtr: Pointer to the multi handle of the transfer.
 368  *
 369  * Results:
 370  *    Standard Tcl codes. The Tcl command will return a list with the
 371  *    name of the Tcl command and other info.
 372  *----------------------------------------------------------------------
 373  */
 374 int
 375 curlMultiGetInfo(Tcl_Interp *interp,CURLM *curlMultiHandlePtr) {
 376     struct CURLMsg        *multiInfo;
 377     int                    msgLeft;
 378     Tcl_Obj               *resultPtr;
 379
 380     multiInfo=curl_multi_info_read(curlMultiHandlePtr, &msgLeft);
 381     resultPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
 382     if (multiInfo==NULL) {
 383         Tcl_ListObjAppendElement(interp,resultPtr,Tcl_NewStringObj("",-1));
 384         Tcl_ListObjAppendElement(interp,resultPtr,Tcl_NewIntObj(0));
 385         Tcl_ListObjAppendElement(interp,resultPtr,Tcl_NewIntObj(0));
 386         Tcl_ListObjAppendElement(interp,resultPtr,Tcl_NewIntObj(0));
 387     } else {
 388         Tcl_ListObjAppendElement(interp,resultPtr,
 389             Tcl_NewStringObj(curlGetEasyName(curlMultiHandlePtr,multiInfo->easy_handle),-1));
 390         Tcl_ListObjAppendElement(interp,resultPtr,Tcl_NewIntObj(multiInfo->msg));
 391         Tcl_ListObjAppendElement(interp,resultPtr,Tcl_NewIntObj(multiInfo->data.result));
 392         Tcl_ListObjAppendElement(interp,resultPtr,Tcl_NewIntObj(msgLeft));
 393     }
 394     Tcl_SetObjResult(interp,resultPtr);
 395
 396     return TCL_OK;
 397 }
 398
 399 /*
 400  *----------------------------------------------------------------------
 401  *
 402  * curlMultiActiveTransfers --
 403  *    This function is used to know whether an connection is ready to
 404  *    transfer data. This code has been copied almost verbatim from
 405  *    libcurl's examples.
 406  *
 407  * Parameter:
 408  *    multiHandlePtr: Pointer to the multi handle of the transfer.
 409  *
 410  * Results:
 411  *
 412  *----------------------------------------------------------------------
 413  */
 414 int
 415 curlMultiGetActiveTransfers( struct curlMultiObjData *curlMultiData) {
 416     struct timeval  timeout;
 417     int             selectCode;
 418     int             maxfd;
 419
 420     FD_ZERO(&(curlMultiData->fdread));
 421     FD_ZERO(&(curlMultiData->fdwrite));
 422     FD_ZERO(&(curlMultiData->fdexcep));
 423
 424     /* set a suitable timeout to play around with */
 425     timeout.tv_sec  = 1;
 426     timeout.tv_usec = 0;
 427
 428     /* get file descriptors from the transfers */
 429     curl_multi_fdset(curlMultiData->mcurl,
 430             &(curlMultiData->fdread),
 431             &(curlMultiData->fdwrite),
 432             &(curlMultiData->fdexcep), &maxfd);
 433
 434     selectCode = select(maxfd+1, &(curlMultiData->fdread)
 435             , &(curlMultiData->fdwrite), &(curlMultiData->fdexcep)
 436             , &timeout);
 437
 438     return selectCode;
 439 }
 440
 441 /*
 442  *----------------------------------------------------------------------
 443  *
 444  * curlMultiActiveTransfers --
 445  *    Implements the Tcl 'active', it queries the multi handle to know
 446  *    if any of the connections are ready to transfer data.
 447  *
 448  * Parameter:
 449  *    interp: The Tcl interpreter we are using, mainly to report errors.
 450  *    curlMultiHandlePtr: Pointer to the multi handle of the transfer.
 451  *
 452  * Results:
 453  *    Standard Tcl codes. The Tcl command will return the number of
 454  *    transfers.
 455  *----------------------------------------------------------------------
 456  */
 457 int
 458 curlMultiActiveTransfers(Tcl_Interp *interp, struct curlMultiObjData *curlMultiData) {
 459     int             selectCode;
 460     Tcl_Obj        *resultPtr;
 461
 462     selectCode = curlMultiGetActiveTransfers(curlMultiData);
 463
 464     if (selectCode==-1) {
 465         return TCL_ERROR;
 466     }
 467
 468     resultPtr=Tcl_NewIntObj(selectCode);
 469     Tcl_SetObjResult(interp,resultPtr);
 470     return TCL_OK;
 471 }
 472
 473 /*
 474  *----------------------------------------------------------------------
 475  *
 476  * curlGetEasyHandle --
 477  *
 478  *      Given the name of an easy curl handle (curl1,...), in a Tcl object
 479  *  this function  will return the pointer the 'internal' libcurl handle.
 480  *
 481  * Parameter:
 482  *  The Tcl object with the name.
 483  *
 484  * Results:
 485  *  The pointer to the libcurl handle
 486  *----------------------------------------------------------------------
 487  */
 488 struct curlObjData *
 489 curlGetEasyHandle(Tcl_Interp *interp,Tcl_Obj *nameObjPtr) {
 490
 491     char                    *handleName;
 492     Tcl_CmdInfo             *infoPtr=(Tcl_CmdInfo *)Tcl_Alloc(sizeof(Tcl_CmdInfo));
 493     struct curlObjData      *curlDataPtr;
 494
 495     handleName=Tcl_GetString(nameObjPtr);
 496
 497     if (0==Tcl_GetCommandInfo(interp,handleName,infoPtr)) {
 498         return NULL;
 499     }
 500     curlDataPtr=(struct curlObjData *)(infoPtr->objClientData);
 501     Tcl_Free((char *)infoPtr);
 502     return curlDataPtr;
 503 }
 504
 505 /*
 506  *----------------------------------------------------------------------
 507  *
 508  * curlMultiFreeSpace --
 509  *
 510  *      Frees the space taken by a curlMultiObjData struct.
 511  *
 512  *  Parameter:
 513  *      interp: Pointer to the interpreter we are using.
 514  *      curlMultiHandle: the curl handle for which the option is set.
 515  *      objc and objv: The usual in Tcl.
 516  *
 517  * Results:
 518  *  A standard Tcl result.
 519  *----------------------------------------------------------------------
 520  */
 521 void
 522 curlMultiFreeSpace(struct curlMultiObjData *curlMultiData) {
 523
 524     curl_multi_cleanup(curlMultiData->mcurl);
 525
 526     Tcl_Free(curlMultiData->postCommand);
 527     Tcl_Free((char *)curlMultiData);
 528 }
 529
 530 /*
 531  *----------------------------------------------------------------------
 532  *
 533  * curlEasyHandleListAdd
 534  *      Adds an easy handle to the list of handles in a multiHandle.
 535  *
 536  *  Parameter:
 537  *      multiDataPtr: Pointer to the struct of the multi handle.
 538  *      easyHandle: The easy handle to add to the list.
 539  *
 540  * Results:
 541  *----------------------------------------------------------------------
 542  */
 543 void
 544 curlEasyHandleListAdd(struct curlMultiObjData *multiDataPtr,CURL *easyHandlePtr,char *name) {
 545     struct easyHandleList    *easyHandleListPtr;
 546
 547     easyHandleListPtr=(struct easyHandleList *)Tcl_Alloc(sizeof(struct easyHandleList));
 548     easyHandleListPtr->curl   =easyHandlePtr;
 549     easyHandleListPtr->name   =curlstrdup(name);
 550     easyHandleListPtr->next=NULL;
 551     if (multiDataPtr->handleListLast==NULL) {
 552         multiDataPtr->handleListFirst=easyHandleListPtr;
 553         multiDataPtr->handleListLast =easyHandleListPtr;
 554     } else {
 555         multiDataPtr->handleListLast->next=easyHandleListPtr;
 556         multiDataPtr->handleListLast=easyHandleListPtr;
 557     }
 558 }
 559
 560 /*
 561  *----------------------------------------------------------------------
 562  *
 563  * curlEasyHandleListRemove
 564  *      When we remove an easy handle from the multiHandle, this function
 565  *  will remove said handle from the linked list.
 566  *
 567  *  Parameter:
 568  *      multiDataPtr: Pointer to the struct of the multi handle.
 569  *      easyHandle: The easy handle to add to the list.
 570  *
 571  * Results:
 572  *----------------------------------------------------------------------
 573  */
 574 void
 575 curlEasyHandleListRemove(struct curlMultiObjData *multiDataPtr,CURL *easyHandle) {
 576     struct easyHandleList *listPtr1,*listPtr2;
 577
 578     listPtr1=NULL;
 579     listPtr2=multiDataPtr->handleListFirst;
 580     while(listPtr2!=NULL) {
 581         if (listPtr2->curl==easyHandle) {
 582             if (listPtr1==NULL) {
 583                 multiDataPtr->handleListFirst=listPtr2->next;
 584             } else {
 585                 listPtr1->next=listPtr2->next;
 586             }
 587             if (listPtr2==multiDataPtr->handleListLast) {
 588                 multiDataPtr->handleListLast=listPtr1;
 589             }
 590             Tcl_Free(listPtr2->name);
 591             Tcl_Free((char *)listPtr2);
 592             break;
 593         }
 594         listPtr1=listPtr2;
 595         listPtr2=listPtr2->next;
 596     }
 597 }
 598 /*
 599  *----------------------------------------------------------------------
 600  *
 601  * curlGetEasyName
 602  *
 603  *      Given the pointer to an easy handle, this function will return
 604  *  the name of the Tcl command.
 605  *
 606  *  Parameter:
 607  *      multiDataPtr: Multi handle we are using.
 608  *      easyHandle: The easy handle whose Tcl command we want to know.
 609  *
 610  * Results:
 611  *  A string with the name of the command.
 612  *----------------------------------------------------------------------
 613  */
 614 char *
 615 curlGetEasyName(struct curlMultiObjData *multiDataPtr,CURL *easyHandle) {
 616     struct easyHandleList    *listPtr;
 617
 618     listPtr=multiDataPtr->handleListFirst;
 619     while(listPtr!=NULL) {
 620         if (listPtr->curl==easyHandle) {
 621             return listPtr->name;
 622         }
 623         listPtr=listPtr->next;
 624     }
 625     return NULL;
 626 }
 627
 628 /*
 629  *----------------------------------------------------------------------
 630  *
 631  * curlReturnCURLMcode
 632  *
 633  *      When one of the command wants to return a CURLMcode, it calls
 634  *  this function.
 635  *
 636  *  Parameter:
 637  *      interp: Pointer to the interpreter we are using.
 638  *      errorCode: the value to be returned.
 639  *
 640  * Results:
 641  *  A standard Tcl result.
 642  *----------------------------------------------------------------------
 643  */
 644 int
 645 curlReturnCURLMcode (Tcl_Interp *interp,CURLMcode errorCode) {
 646     Tcl_Obj        *resultPtr;
 647
 648     resultPtr=Tcl_NewIntObj(errorCode);
 649     Tcl_SetObjResult(interp,resultPtr);
 650
 651     if (errorCode>0) {
 652         return TCL_ERROR;
 653     }
 654     return TCL_OK;
 655 }
 656
 657
 658 /*----------------------------------------------------------------------
 659  *
 660  * curlMultiAutoTransfer --
 661  *
 662  *      Creates the event source that will take care of downloading using
 663  *  the multi interface driven by Tcl's event loop.
 664  *
 665  * Parameters:
 666  *  The usual Tcl command parameters.
 667  *
 668  * Results:
 669  *      Standard Tcl return code.
 670  *----------------------------------------------------------------------
 671  */
 672
 673 int
 674 curlMultiAutoTransfer(Tcl_Interp *interp, struct curlMultiObjData *curlMultiData,
 675         int objc,Tcl_Obj *CONST objv[]) {
 676
 677     if (objc==4) {
 678         Tcl_Free(curlMultiData->postCommand);
 679         curlMultiData->postCommand=curlstrdup(Tcl_GetString(objv[3]));
 680     }
 681
 682     Tcl_CreateEventSource((Tcl_EventSetupProc *)curlEventSetup,
 683             (Tcl_EventCheckProc *)curlEventCheck, (ClientData *)curlMultiData);
 684
 685     /* We have to call perform once to boot the transfer, otherwise it seems nothing
 686        works *shrug* */
 687
 688     while(CURLM_CALL_MULTI_PERFORM ==
 689             curl_multi_perform(curlMultiData->mcurl,&(curlMultiData->runningTransfers))) {
 690     }
 691
 692     return TCL_OK;
 693 }
 694
 695 /*----------------------------------------------------------------------
 696  *
 697  * curlMultiConfigTrasnfer --
 698  *  This procedure is invoked by the user command 'configure', it reads
 699  *  the options passed by the user to configure a multi handle.
 700  *
 701  * Parameters:
 702  *  The usual Tcl command parameters.
 703  *
 704  * Results:
 705  *      Standard Tcl return code.
 706  *----------------------------------------------------------------------
 707  */
 708
 709 int
 710 curlMultiConfigTransfer(Tcl_Interp *interp, struct curlMultiObjData *curlMultiData,
 711         int objc,Tcl_Obj *CONST objv[]) {
 712     int            tableIndex;
 713     int            i,j;
 714
 715     Tcl_Obj       *resultPtr;
 716     char           errorMsg[500];
 717
 718     for(i=2,j=3;i<objc;i=i+2,j=j+2) {
 719         if (Tcl_GetIndexFromObj(interp, objv[i], multiConfigTable, "option",
 720                 TCL_EXACT, &tableIndex)==TCL_ERROR) {
 721             return TCL_ERROR;
 722         }
 723         if (i==objc-1) {
 724             snprintf(errorMsg,500,"Empty value for %s",multiConfigTable[tableIndex]);
 725             resultPtr=Tcl_NewStringObj(errorMsg,-1);
 726             Tcl_SetObjResult(interp,resultPtr);
 727             return TCL_ERROR;
 728         }
 729         if (curlMultiSetOpts(interp,curlMultiData,objv[j],tableIndex)==TCL_ERROR) {
 730             return TCL_ERROR;
 731         }
 732     }
 733     return TCL_OK;
 734 }
 735
 736 /*
 737  *----------------------------------------------------------------------
 738  *
 739  * curlMultiSetOpts --
 740  *
 741  *      This procedure takes care of setting the transfer options.
 742  *
 743  *  Parameter:
 744  *      interp: Pointer to the interpreter we are using.
 745  *      curlMultiHandle: the curl handle for which the option is set.
 746  *      objv: A pointer to the object where the data to set is stored.
 747  *      tableIndex: The index of the option in the options table.
 748  *
 749  * Results:
 750  *  A standard Tcl result.
 751  *----------------------------------------------------------------------
 752  */
 753 int
 754 curlMultiSetOpts(Tcl_Interp *interp, struct curlMultiObjData *curlMultiData,
 755         Tcl_Obj *CONST objv,int tableIndex) {
 756
 757     switch(tableIndex) {
 758         case 0:
 759             if (SetMultiOptLong(interp,curlMultiData->mcurl,
 760                     CURLMOPT_PIPELINING,tableIndex,objv)) {
 761                 return TCL_ERROR;
 762             }
 763             break;
 764         case 1:
 765             if (SetMultiOptLong(interp,curlMultiData->mcurl,
 766                     CURLMOPT_MAXCONNECTS,tableIndex,objv)) {
 767                 return TCL_ERROR;
 768             }
 769             break;
 770     }
 771     return TCL_OK;
 772 }
 773
 774 /*
 775  *----------------------------------------------------------------------
 776  *
 777  * SetMultiOptLong --
 778  *
 779  *      Set the curl options that require a long
 780  *
 781  *  Parameter:
 782  *      interp: The interpreter we are working with.
 783  *      curlMultiHandle: and the multi curl handle
 784  *      opt: the option to set
 785  *      tclObj: The Tcl with the value for the option.
 786  *
 787  * Results:
 788  *  0 if all went well.
 789  *  1 in case of error.
 790  *----------------------------------------------------------------------
 791  */
 792 int
 793 SetMultiOptLong(Tcl_Interp *interp,CURLM *curlMultiHandle,CURLMoption opt,
 794         int tableIndex,Tcl_Obj *tclObj) {
 795     long        longNumber;
 796     char        *parPtr;
 797
 798     if (Tcl_GetLongFromObj(interp,tclObj,&longNumber)) {
 799         parPtr=curlstrdup(Tcl_GetString(tclObj));
 800         curlErrorSetOpt(interp,multiConfigTable,tableIndex,parPtr);
 801         Tcl_Free(parPtr);
 802         return 1;
 803     }
 804     if (curl_multi_setopt(curlMultiHandle,opt,longNumber)) {
 805         parPtr=curlstrdup(Tcl_GetString(tclObj));
 806         curlErrorSetOpt(interp,multiConfigTable,tableIndex,parPtr);
 807         Tcl_Free(parPtr);
 808         return 1;
 809     }
 810     return 0;
 811 }
 812
 813 /*----------------------------------------------------------------------
 814  *
 815  * curlEventSetup --
 816  *
 817  *  This function is invoked by Tcl just after curlMultiAutoTransfer and
 818  *  then every time just before curlEventCheck, I only use to set the
 819  *  maximun time without checking for events
 820  *
 821  *  NOTE: I hate having a fixed value, I will have to look into it.
 822  *
 823  * Parameters:
 824  *  They are passed automagically by Tcl, but I don't use them.
 825  *----------------------------------------------------------------------
 826  */
 827
 828 void
 829 curlEventSetup(ClientData clientData, int flags) {
 830     Tcl_Time     time = {0 , 0};
 831
 832     Tcl_SetMaxBlockTime(&time);
 833 }
 834
 835 /*----------------------------------------------------------------------
 836  *
 837  * curlEventCheck --
 838  *
 839  *      Invoked automagically by Tcl from time to time, we check if there
 840  *  are any active transfer, if so we put an event in the queue so that
 841  *  'curl_multi_perfom' will be eventually called, if not we delete
 842  *  the event source.
 843  *
 844  * Parameters:
 845  *  They are passed automagically by Tcl.
 846  *----------------------------------------------------------------------
 847  */
 848
 849 void
 850 curlEventCheck(ClientData clientData, int flags) {
 851     struct curlMultiObjData    *curlMultiData=(struct curlMultiObjData *)clientData;
 852     struct curlEvent           *curlEventPtr;
 853     int                         selectCode;
 854
 855     selectCode=curlMultiGetActiveTransfers(curlMultiData);
 856
 857     if (curlMultiData->runningTransfers==0) {
 858         Tcl_DeleteEventSource((Tcl_EventSetupProc *)curlEventSetup,
 859                 (Tcl_EventCheckProc *)curlEventCheck, (ClientData *)curlMultiData);
 860     } else {
 861         if (selectCode>=0) {
 862             curlEventPtr=(struct curlEvent *)Tcl_Alloc(sizeof(struct curlEvent));
 863             curlEventPtr->proc=curlEventProc;
 864             curlEventPtr->curlMultiData=curlMultiData;
 865             Tcl_QueueEvent((Tcl_Event *)curlEventPtr, TCL_QUEUE_TAIL);
 866         }
 867     }
 868 }
 869
 870 /*----------------------------------------------------------------------
 871  *
 872  * curlEventProc --
 873  *
 874  *      Finally Tcl event loop decides it is time to transfer something.
 875  *
 876  * Parameters:
 877  *  They are passed automagically by Tcl.
 878  *----------------------------------------------------------------------
 879 */
 880
 881 int
 882 curlEventProc(Tcl_Event *evPtr,int flags) {
 883     struct curlMultiObjData   *curlMultiData
 884             =(struct curlMultiObjData *)((struct curlEvent *)evPtr)->curlMultiData;
 885     CURLMcode                  errorCode;
 886     Tcl_Obj                   *tclCommandObjPtr;
 887     char                       tclCommand[300];
 888
 889     errorCode=curl_multi_perform(curlMultiData->mcurl,&curlMultiData->runningTransfers);
 890     if (curlMultiData->runningTransfers==0) {
 891         if (curlMultiData->postCommand!=NULL) {
 892             snprintf(tclCommand,299,"%s",curlMultiData->postCommand);
 893             tclCommandObjPtr=Tcl_NewStringObj(tclCommand,-1);
 894             if (Tcl_EvalObjEx(curlMultiData->interp,tclCommandObjPtr,TCL_EVAL_GLOBAL)!=TCL_OK) {
 895 /*
 896                 fprintf(stdout,"Error invoking command\n");
 897                 fprintf(stdout,"Error: %s\n",Tcl_GetString(Tcl_GetObjResult(curlMultiData->interp)));
 898 */
 899             }
 900         }
 901     }
 902     return 1;
 903 }
 904
 905