shaniqua-tclcurl-fa/generic/multi.c

/*
 * multi.c --
 *
 * Implementation of the part of the TclCurl extension that deals with libcurl's
 * 'multi' interface.
 *
 * Copyright (c)2002-2011 Andres Garcia Garcia.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */

#include "multi.h"
#include <sys/time.h>

/*
 *----------------------------------------------------------------------
 *
 * Tclcurl_MultiInit --
 *
 *	This procedure initializes the 'multi' part of the package
 *
 * Results:
 *	A standard Tcl result.
 *
 *----------------------------------------------------------------------
 */

int
Tclcurl_MultiInit (Tcl_Interp *interp) {

    Tcl_CreateObjCommand (interp,"::curl::multiinit",curlInitMultiObjCmd,
            (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * curlCreateMultiObjCmd --
 *
 *	Looks for the first free handle (mcurl1, mcurl2,...) and creates a
 *	Tcl command for it.
 *
 * Results:
 *  A string with the name of the handle, don't forget to free it.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

char *
curlCreateMultiObjCmd (Tcl_Interp *interp,struct curlMultiObjData *curlMultiData) {
    char                *handleName;
    int                 i;
    Tcl_CmdInfo         info;
    Tcl_Command         cmdToken;

    /* We try with mcurl1, if it already exists with mcurl2, ... */
    handleName=(char *)Tcl_Alloc(10);
    for (i=1;;i++) {
        sprintf(handleName,"mcurl%d",i);
        if (!Tcl_GetCommandInfo(interp,handleName,&info)) {
            cmdToken=Tcl_CreateObjCommand(interp,handleName,curlMultiObjCmd,
                                (ClientData)curlMultiData, 
                                (Tcl_CmdDeleteProc *)curlMultiDeleteCmd);
            break;
        }
    }

    curlMultiData->token=cmdToken;

    return handleName;
}

/*
 *----------------------------------------------------------------------
 *
 * curlInitMultiObjCmd --
 *
 *	This procedure is invoked to process the "curl::multiInit" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
curlInitMultiObjCmd (ClientData clientData, Tcl_Interp *interp,
        int objc,Tcl_Obj *CONST objv[]) {


    Tcl_Obj                     *result;
    struct curlMultiObjData     *curlMultiData;
    char                        *multiHandleName;

    curlMultiData=(struct curlMultiObjData *)Tcl_Alloc(sizeof(struct curlMultiObjData));
    if (curlMultiData==NULL) {
        result=Tcl_NewStringObj("Couldn't allocate memory",-1);
        Tcl_SetObjResult(interp,result); 
        return TCL_ERROR;
    }

    memset(curlMultiData, 0, sizeof(struct curlMultiObjData));
    curlMultiData->interp=interp;

    curlMultiData->mcurl=curl_multi_init();

    if (curlMultiData->mcurl==NULL) {
        result=Tcl_NewStringObj("Couldn't open curl multi handle",-1);
        Tcl_SetObjResult(interp,result); 
        return TCL_ERROR;
    }

    multiHandleName=curlCreateMultiObjCmd(interp,curlMultiData);

    result=Tcl_NewStringObj(multiHandleName,-1);
    Tcl_SetObjResult(interp,result);
    Tcl_Free(multiHandleName);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * curlMultiObjCmd --
 *
 *	This procedure is invoked to process the "multi curl" commands.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */
int
curlMultiObjCmd (ClientData clientData, Tcl_Interp *interp,
    int objc,Tcl_Obj *CONST objv[]) {

    struct curlMultiObjData    *curlMultiData=(struct curlMultiObjData *)clientData;
    CURLMcode                   errorCode;
    int                         tableIndex;

    if (objc<2) {
        Tcl_WrongNumArgs(interp,1,objv,"option arg ?arg?");
        return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], multiCommandTable, "option",
            TCL_EXACT,&tableIndex)==TCL_ERROR) {
        return TCL_ERROR;
    }
    switch(tableIndex) {
        case 0:
/*            fprintf(stdout,"Multi add handle\n"); */
            errorCode=curlAddMultiHandle(interp,curlMultiData->mcurl,objv[2]);
            return curlReturnCURLMcode(interp,errorCode);
            break;
        case 1:
/*            fprintf(stdout,"Multi remove handle\n"); */
            errorCode=curlRemoveMultiHandle(interp,curlMultiData->mcurl,objv[2]);
            return curlReturnCURLMcode(interp,errorCode);
            break;
        case 2:
/*            fprintf(stdout,"Multi perform\n"); */
            errorCode=curlMultiPerform(interp,curlMultiData->mcurl);
            return errorCode;
            break;
        case 3:
/*            fprintf(stdout,"Multi cleanup\n"); */
            Tcl_DeleteCommandFromToken(interp,curlMultiData->token);
            break;
        case 4:
/*            fprintf(stdout,"Multi getInfo\n"); */
            curlMultiGetInfo(interp,curlMultiData->mcurl);
            break;
        case 5:
/*            fprintf(stdout,"Multi activeTransfers\n"); */
            curlMultiActiveTransfers(interp,curlMultiData);
            break;
        case 6:
/*            fprintf(stdout,"Multi auto transfer\n");*/
            curlMultiAutoTransfer(interp,curlMultiData,objc,objv);
            break;
        case 7:
/*            fprintf(stdout,"Multi configure\n");*/
            curlMultiConfigTransfer(interp,curlMultiData,objc,objv);
            break;            
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * curlAddMultiHandle --
 *
 *	Adds an 'easy' curl handle to the stack of a 'multi' handle.
 *
 *  Parameter:
 *      interp: Pointer to the interpreter we are using.
 *      curlMultiHandle: The handle into which we will add the easy one.
 *      objvPtr: The Tcl object with the name of the easy handle.
 *
 * Results:
 *  '0' all went well.
 *  'non-zero' in case of error.
 *----------------------------------------------------------------------
 */
CURLMcode
curlAddMultiHandle(Tcl_Interp *interp,CURLM *curlMultiHandlePtr
        ,Tcl_Obj *objvPtr) {

    struct curlObjData        *curlDataPtr;
    CURLMcode                  errorCode;


    curlDataPtr=curlGetEasyHandle(interp,objvPtr);

    if (curlOpenFiles(interp,curlDataPtr)) {
        return TCL_ERROR;
    }
    if (curlSetPostData(interp,curlDataPtr)) {
        return TCL_ERROR;
    }

    errorCode=curl_multi_add_handle(curlMultiHandlePtr,curlDataPtr->curl);

    curlEasyHandleListAdd(curlMultiHandlePtr,curlDataPtr->curl
            ,Tcl_GetString(objvPtr));

    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *
 * curlRemoveMultiHandle --
 *
 *	Removes an 'easy' curl handle to the stack of a 'multi' handle.
 *
 *  Parameter:
 *      interp: Pointer to the interpreter we are using.
 *      curlMultiHandle: The handle into which we will add the easy one.
 *      objvPtr: The Tcl object with the name of the easy handle.
 *
 * Results:
 *  '0' all went well.
 *  'non-zero' in case of error.
 *----------------------------------------------------------------------
 */
CURLMcode
curlRemoveMultiHandle(Tcl_Interp *interp,CURLM *curlMultiHandle
        ,Tcl_Obj *objvPtr) {
    struct curlObjData        *curlDataPtr;
    CURLMcode                  errorCode;

    curlDataPtr=curlGetEasyHandle(interp,objvPtr);
    errorCode=curl_multi_remove_handle(curlMultiHandle,curlDataPtr->curl);
    curlEasyHandleListRemove(curlMultiHandle,curlDataPtr->curl);

    curlCloseFiles(curlDataPtr);
    curlResetPostData(curlDataPtr);

    if (curlDataPtr->bodyVarName) {
        curlSetBodyVarName(interp,curlDataPtr);
    }

    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *
 * curlMultiPerform --
 *
 *	Invokes the 'curl_multi_perform' function to update the current
 *  transfers.
 *
 *  Parameter:
 *      interp: Pointer to the interpreter we are using.
 *      curlMultiHandle: The handle of the transfer to update.
 *      objvPtr: The Tcl object with the name of the easy handle.
 *
 * Results:
        Usual Tcl result.
 *----------------------------------------------------------------------
 */
int
curlMultiPerform(Tcl_Interp *interp,CURLM *curlMultiHandlePtr) {

    CURLMcode        errorCode;
    int              runningTransfers;

    for (errorCode=-1;errorCode<0;) {   
        errorCode=curl_multi_perform(curlMultiHandlePtr,&runningTransfers);
    }

    if (errorCode==0) {
        curlReturnCURLMcode(interp,runningTransfers);
        return TCL_OK;
    }

    curlReturnCURLMcode(interp,errorCode);

    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * curlMultiDeleteCmd --
 *
 *	This procedure is invoked when curl multi handle is deleted.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Cleans the curl handle and frees the memory.
 *
 *----------------------------------------------------------------------
 */
int
curlMultiDeleteCmd(ClientData clientData) {
    struct curlMultiObjData     *curlMultiData=(struct curlMultiObjData *)clientData;
    CURLM                       *curlMultiHandle=curlMultiData->mcurl;
    CURLMcode                    errorCode;
    Tcl_Interp                  *interp=curlMultiData->interp;
    struct easyHandleList       *listPtr1,*listPtr2;

    listPtr1=curlMultiData->handleListFirst;
    while (listPtr1!=NULL) {
        listPtr2=listPtr1->next;
        Tcl_Free(listPtr1->name);
        Tcl_Free((char *)listPtr1); 
        listPtr1=listPtr2;
    }
    errorCode=curl_multi_cleanup(curlMultiHandle);
    curlMultiFreeSpace(curlMultiData);
    return curlReturnCURLMcode(interp,errorCode);
}

/*
 *----------------------------------------------------------------------
 *
 * curlGetMultiInfo --
 *    Invokes the curl_multi_info_read function in libcurl to get
 *    some info about the transfer, like if they are done and
 *    things like that.
 *
 * Parameter:
 *    interp: The Tcl interpreter we are using, mainly to report errors.
 *    curlMultiHandlePtr: Pointer to the multi handle of the transfer.
 *
 * Results:
 *    Standard Tcl codes. The Tcl command will return a list with the
 *    name of the Tcl command and other info.
 *----------------------------------------------------------------------
 */
int
curlMultiGetInfo(Tcl_Interp *interp,CURLM *curlMultiHandlePtr) {
    struct CURLMsg        *multiInfo;
    int                    msgLeft;
    Tcl_Obj               *resultPtr;

    multiInfo=curl_multi_info_read(curlMultiHandlePtr, &msgLeft);
    resultPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL); 
    if (multiInfo==NULL) {
        Tcl_ListObjAppendElement(interp,resultPtr,Tcl_NewStringObj("",-1));
        Tcl_ListObjAppendElement(interp,resultPtr,Tcl_NewIntObj(0));
        Tcl_ListObjAppendElement(interp,resultPtr,Tcl_NewIntObj(0));
        Tcl_ListObjAppendElement(interp,resultPtr,Tcl_NewIntObj(0));
    } else {
        Tcl_ListObjAppendElement(interp,resultPtr,
            Tcl_NewStringObj(curlGetEasyName(curlMultiHandlePtr,multiInfo->easy_handle),-1));
        Tcl_ListObjAppendElement(interp,resultPtr,Tcl_NewIntObj(multiInfo->msg));
        Tcl_ListObjAppendElement(interp,resultPtr,Tcl_NewIntObj(multiInfo->data.result));
        Tcl_ListObjAppendElement(interp,resultPtr,Tcl_NewIntObj(msgLeft));
    }
    Tcl_SetObjResult(interp,resultPtr); 

    return TCL_OK;            
}

/*
 *----------------------------------------------------------------------
 *
 * curlMultiActiveTransfers --
 *    This function is used to know whether an connection is ready to
 *    transfer data. This code has been copied almost verbatim from
 *    libcurl's examples.
 *
 * Parameter:
 *    multiHandlePtr: Pointer to the multi handle of the transfer.
 *
 * Results:
 *    
 *----------------------------------------------------------------------
 */
int
curlMultiGetActiveTransfers( struct curlMultiObjData *curlMultiData) {
    struct timeval  timeout;
    int             selectCode;
    int             maxfd;

    FD_ZERO(&(curlMultiData->fdread));
    FD_ZERO(&(curlMultiData->fdwrite));
    FD_ZERO(&(curlMultiData->fdexcep));

    /* set a suitable timeout to play around with */
    timeout.tv_sec  = 1;
    timeout.tv_usec = 0;

    /* get file descriptors from the transfers */
    curl_multi_fdset(curlMultiData->mcurl,
            &(curlMultiData->fdread),
            &(curlMultiData->fdwrite),
            &(curlMultiData->fdexcep), &maxfd);

    selectCode = select(maxfd+1, &(curlMultiData->fdread)
            , &(curlMultiData->fdwrite), &(curlMultiData->fdexcep)
            , &timeout);

    return selectCode;
}

/*
 *----------------------------------------------------------------------
 *
 * curlMultiActiveTransfers --
 *    Implements the Tcl 'active', it queries the multi handle to know
 *    if any of the connections are ready to transfer data.
 *
 * Parameter:
 *    interp: The Tcl interpreter we are using, mainly to report errors.
 *    curlMultiHandlePtr: Pointer to the multi handle of the transfer.
 *
 * Results:
 *    Standard Tcl codes. The Tcl command will return the number of
 *    transfers.
 *----------------------------------------------------------------------
 */
int
curlMultiActiveTransfers(Tcl_Interp *interp, struct curlMultiObjData *curlMultiData) {
    int             selectCode;
    Tcl_Obj        *resultPtr;

    selectCode = curlMultiGetActiveTransfers(curlMultiData);

    if (selectCode==-1) {
        return TCL_ERROR;
    }

    resultPtr=Tcl_NewIntObj(selectCode);
    Tcl_SetObjResult(interp,resultPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * curlGetEasyHandle --
 *
 *	Given the name of an easy curl handle (curl1,...), in a Tcl object
 *  this function  will return the pointer the 'internal' libcurl handle.
 *
 * Parameter:
 *  The Tcl object with the name.
 *
 * Results:
 *  The pointer to the libcurl handle
 *----------------------------------------------------------------------
 */
struct curlObjData *
curlGetEasyHandle(Tcl_Interp *interp,Tcl_Obj *nameObjPtr) {

    char                    *handleName;
    Tcl_CmdInfo             *infoPtr=(Tcl_CmdInfo *)Tcl_Alloc(sizeof(Tcl_CmdInfo));
    struct curlObjData      *curlDataPtr;

    handleName=Tcl_GetString(nameObjPtr);

    if (0==Tcl_GetCommandInfo(interp,handleName,infoPtr)) {
        return NULL;
    }
    curlDataPtr=(struct curlObjData *)(infoPtr->objClientData);
    Tcl_Free((char *)infoPtr);
    return curlDataPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * curlMultiFreeSpace --
 *
 *	Frees the space taken by a curlMultiObjData struct.
 *
 *  Parameter:
 *      interp: Pointer to the interpreter we are using.
 *      curlMultiHandle: the curl handle for which the option is set.
 *      objc and objv: The usual in Tcl.
 *
 * Results:
 *  A standard Tcl result.
 *----------------------------------------------------------------------
 */
void
curlMultiFreeSpace(struct curlMultiObjData *curlMultiData) {

    curl_multi_cleanup(curlMultiData->mcurl);

    Tcl_Free(curlMultiData->postCommand);
    Tcl_Free((char *)curlMultiData);
}

/*
 *----------------------------------------------------------------------
 *
 * curlEasyHandleListAdd
 *	Adds an easy handle to the list of handles in a multiHandle.
 *
 *  Parameter:
 *      multiDataPtr: Pointer to the struct of the multi handle.
 *      easyHandle: The easy handle to add to the list.
 *
 * Results:
 *----------------------------------------------------------------------
 */
void
curlEasyHandleListAdd(struct curlMultiObjData *multiDataPtr,CURL *easyHandlePtr,char *name) {
    struct easyHandleList    *easyHandleListPtr;

    easyHandleListPtr=(struct easyHandleList *)Tcl_Alloc(sizeof(struct easyHandleList));
    easyHandleListPtr->curl   =easyHandlePtr;
    easyHandleListPtr->name   =curlstrdup(name);
    easyHandleListPtr->next=NULL;
    if (multiDataPtr->handleListLast==NULL) {
        multiDataPtr->handleListFirst=easyHandleListPtr;
        multiDataPtr->handleListLast =easyHandleListPtr;
    } else {
        multiDataPtr->handleListLast->next=easyHandleListPtr;
        multiDataPtr->handleListLast=easyHandleListPtr;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * curlEasyHandleListRemove
 *	When we remove an easy handle from the multiHandle, this function
 *  will remove said handle from the linked list.
 *
 *  Parameter:
 *      multiDataPtr: Pointer to the struct of the multi handle.
 *      easyHandle: The easy handle to add to the list.
 *
 * Results:
 *----------------------------------------------------------------------
 */
void
curlEasyHandleListRemove(struct curlMultiObjData *multiDataPtr,CURL *easyHandle) {
    struct easyHandleList *listPtr1,*listPtr2;

    listPtr1=NULL;
    listPtr2=multiDataPtr->handleListFirst;
    while(listPtr2!=NULL) {
        if (listPtr2->curl==easyHandle) {
            if (listPtr1==NULL) {
                multiDataPtr->handleListFirst=listPtr2->next;
            } else {
                listPtr1->next=listPtr2->next;
            }
            if (listPtr2==multiDataPtr->handleListLast) {
                multiDataPtr->handleListLast=listPtr1;
            }
            Tcl_Free(listPtr2->name);
            Tcl_Free((char *)listPtr2);
            break;
        }
        listPtr1=listPtr2;
        listPtr2=listPtr2->next;
    }
}
/*
 *----------------------------------------------------------------------
 *
 * curlGetEasyName
 *
 *	Given the pointer to an easy handle, this function will return
 *  the name of the Tcl command.
 *
 *  Parameter:
 *      multiDataPtr: Multi handle we are using.
 *      easyHandle: The easy handle whose Tcl command we want to know.
 *
 * Results:
 *  A string with the name of the command.
 *----------------------------------------------------------------------
 */
char *
curlGetEasyName(struct curlMultiObjData *multiDataPtr,CURL *easyHandle) {
    struct easyHandleList    *listPtr;

    listPtr=multiDataPtr->handleListFirst;
    while(listPtr!=NULL) {
        if (listPtr->curl==easyHandle) {
            return listPtr->name;
        }
        listPtr=listPtr->next;
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * curlReturnCURLMcode
 *
 *	When one of the command wants to return a CURLMcode, it calls
 *  this function.
 *
 *  Parameter:
 *      interp: Pointer to the interpreter we are using.
 *      errorCode: the value to be returned.
 *
 * Results:
 *  A standard Tcl result.
 *----------------------------------------------------------------------
 */
int
curlReturnCURLMcode (Tcl_Interp *interp,CURLMcode errorCode) {
    Tcl_Obj        *resultPtr;

    resultPtr=Tcl_NewIntObj(errorCode);
    Tcl_SetObjResult(interp,resultPtr);

    if (errorCode>0) {
        return TCL_ERROR;
    }
    return TCL_OK;
}


/*----------------------------------------------------------------------
 *
 * curlMultiAutoTransfer --
 *
 *	Creates the event source that will take care of downloading using
 *  the multi interface driven by Tcl's event loop.
 *
 * Parameters:
 *  The usual Tcl command parameters.
 *
 * Results:
 *	Standard Tcl return code.
 *----------------------------------------------------------------------
 */

int
curlMultiAutoTransfer(Tcl_Interp *interp, struct curlMultiObjData *curlMultiData,
        int objc,Tcl_Obj *CONST objv[]) {

    if (objc==4) {
        Tcl_Free(curlMultiData->postCommand);
        curlMultiData->postCommand=curlstrdup(Tcl_GetString(objv[3]));
    }

    Tcl_CreateEventSource((Tcl_EventSetupProc *)curlEventSetup, 
            (Tcl_EventCheckProc *)curlEventCheck, (ClientData *)curlMultiData);

    /* We have to call perform once to boot the transfer, otherwise it seems nothing
       works *shrug* */

    while(CURLM_CALL_MULTI_PERFORM ==
            curl_multi_perform(curlMultiData->mcurl,&(curlMultiData->runningTransfers))) {
    }

    return TCL_OK;
}

/*----------------------------------------------------------------------
 *
 * curlMultiConfigTrasnfer --
 *  This procedure is invoked by the user command 'configure', it reads 
 *  the options passed by the user to configure a multi handle.
 *
 * Parameters:
 *  The usual Tcl command parameters.
 *
 * Results:
 *	Standard Tcl return code.
 *----------------------------------------------------------------------
 */

int
curlMultiConfigTransfer(Tcl_Interp *interp, struct curlMultiObjData *curlMultiData,
        int objc,Tcl_Obj *CONST objv[]) {
    int            tableIndex;
    int            i,j;

    Tcl_Obj       *resultPtr;
    char           errorMsg[500];

    for(i=2,j=3;i<objc;i=i+2,j=j+2) {
        if (Tcl_GetIndexFromObj(interp, objv[i], multiConfigTable, "option", 
                TCL_EXACT, &tableIndex)==TCL_ERROR) {
            return TCL_ERROR;
        }
        if (i==objc-1) {
            snprintf(errorMsg,500,"Empty value for %s",multiConfigTable[tableIndex]);
            resultPtr=Tcl_NewStringObj(errorMsg,-1);
            Tcl_SetObjResult(interp,resultPtr);            
            return TCL_ERROR;
        }
        if (curlMultiSetOpts(interp,curlMultiData,objv[j],tableIndex)==TCL_ERROR) {
            return TCL_ERROR;
        }
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * curlMultiSetOpts --
 *
 *	This procedure takes care of setting the transfer options.
 *
 *  Parameter:
 *      interp: Pointer to the interpreter we are using.
 *      curlMultiHandle: the curl handle for which the option is set.
 *      objv: A pointer to the object where the data to set is stored.
 *      tableIndex: The index of the option in the options table.
 *
 * Results:
 *  A standard Tcl result.
 *----------------------------------------------------------------------
 */
int
curlMultiSetOpts(Tcl_Interp *interp, struct curlMultiObjData *curlMultiData,
        Tcl_Obj *CONST objv,int tableIndex) {

    switch(tableIndex) {
        case 0:
            if (SetMultiOptLong(interp,curlMultiData->mcurl,
                    CURLMOPT_PIPELINING,tableIndex,objv)) {
                return TCL_ERROR;
            }
            break;
        case 1:
            if (SetMultiOptLong(interp,curlMultiData->mcurl,
                    CURLMOPT_MAXCONNECTS,tableIndex,objv)) {
                return TCL_ERROR;
            }
            break;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * SetMultiOptLong --
 *
 *	Set the curl options that require a long
 *
 *  Parameter:
 *      interp: The interpreter we are working with.
 *      curlMultiHandle: and the multi curl handle
 *      opt: the option to set
 *      tclObj: The Tcl with the value for the option.
 *
 * Results:
 *  0 if all went well.
 *  1 in case of error.
 *----------------------------------------------------------------------
 */
int
SetMultiOptLong(Tcl_Interp *interp,CURLM *curlMultiHandle,CURLMoption opt,
        int tableIndex,Tcl_Obj *tclObj) {
    long        longNumber;
    char        *parPtr;

    if (Tcl_GetLongFromObj(interp,tclObj,&longNumber)) {
        parPtr=curlstrdup(Tcl_GetString(tclObj));
        curlErrorSetOpt(interp,multiConfigTable,tableIndex,parPtr);
        Tcl_Free(parPtr);
        return 1;
    }
    if (curl_multi_setopt(curlMultiHandle,opt,longNumber)) {
        parPtr=curlstrdup(Tcl_GetString(tclObj));
        curlErrorSetOpt(interp,multiConfigTable,tableIndex,parPtr);
        Tcl_Free(parPtr);
        return 1;
    }
    return 0;
}

/*----------------------------------------------------------------------
 *
 * curlEventSetup --
 *
 *  This function is invoked by Tcl just after curlMultiAutoTransfer and
 *  then every time just before curlEventCheck, I only use to set the
 *  maximun time without checking for events
 *
 *  NOTE: I hate having a fixed value, I will have to look into it.
 *
 * Parameters:
 *  They are passed automagically by Tcl, but I don't use them.
 *----------------------------------------------------------------------
 */

void
curlEventSetup(ClientData clientData, int flags) {
    Tcl_Time     time = {0 , 0};

    Tcl_SetMaxBlockTime(&time);
}

/*----------------------------------------------------------------------
 *
 * curlEventCheck --
 *
 *	Invoked automagically by Tcl from time to time, we check if there
 *  are any active transfer, if so we put an event in the queue so that
 *  'curl_multi_perfom' will be eventually called, if not we delete
 *  the event source.
 *
 * Parameters:
 *  They are passed automagically by Tcl.
 *----------------------------------------------------------------------
 */

void
curlEventCheck(ClientData clientData, int flags) {
    struct curlMultiObjData    *curlMultiData=(struct curlMultiObjData *)clientData;
    struct curlEvent           *curlEventPtr;
    int                         selectCode;

    selectCode=curlMultiGetActiveTransfers(curlMultiData);

    if (curlMultiData->runningTransfers==0) {
        Tcl_DeleteEventSource((Tcl_EventSetupProc *)curlEventSetup, 
                (Tcl_EventCheckProc *)curlEventCheck, (ClientData *)curlMultiData);
    } else {
        if (selectCode>=0) {
            curlEventPtr=(struct curlEvent *)Tcl_Alloc(sizeof(struct curlEvent));
            curlEventPtr->proc=curlEventProc;
            curlEventPtr->curlMultiData=curlMultiData;
            Tcl_QueueEvent((Tcl_Event *)curlEventPtr, TCL_QUEUE_TAIL);
        }
    }
}

/*----------------------------------------------------------------------
 *
 * curlEventProc --
 *
 *	Finally Tcl event loop decides it is time to transfer something.
 *
 * Parameters:
 *  They are passed automagically by Tcl.
 *----------------------------------------------------------------------
*/ 

int
curlEventProc(Tcl_Event *evPtr,int flags) {
    struct curlMultiObjData   *curlMultiData
            =(struct curlMultiObjData *)((struct curlEvent *)evPtr)->curlMultiData;
    CURLMcode                  errorCode;
    Tcl_Obj                   *tclCommandObjPtr;
    char                       tclCommand[300];

    errorCode=curl_multi_perform(curlMultiData->mcurl,&curlMultiData->runningTransfers);
    if (curlMultiData->runningTransfers==0) {
        if (curlMultiData->postCommand!=NULL) {
            snprintf(tclCommand,299,"%s",curlMultiData->postCommand);
            tclCommandObjPtr=Tcl_NewStringObj(tclCommand,-1);
            if (Tcl_EvalObjEx(curlMultiData->interp,tclCommandObjPtr,TCL_EVAL_GLOBAL)!=TCL_OK) {
/*
                fprintf(stdout,"Error invoking command\n");
                fprintf(stdout,"Error: %s\n",Tcl_GetString(Tcl_GetObjResult(curlMultiData->interp)));
*/
            }
        }
    }
    return 1;
}