X-Git-Url: http://git.sven.stormbind.net/?a=blobdiff_plain;f=generic%2Fmulti.c;fp=generic%2Fmulti.c;h=c3dc20254756ced3d1207fefd4a6f91b35912cc1;hb=b0e6fb6e4379fb87fa2854b84a56c5ad49c644da;hp=0000000000000000000000000000000000000000;hpb=c9a5bcd9d76f699909b24e71a2a216d36062ab0b;p=sven%2Ftclcurl.git diff --git a/generic/multi.c b/generic/multi.c new file mode 100755 index 0000000..c3dc202 --- /dev/null +++ b/generic/multi.c @@ -0,0 +1,905 @@ +/* + * multi.c -- + * + * Implementation of the part of the TclCurl extension that deals with libcurl's + * 'multi' interface. + * + * Copyright (c)2002-2009 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 + +/* + *---------------------------------------------------------------------- + * + * 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;imcurl, + 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; +} + +