/* * 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 /* *---------------------------------------------------------------------- * * 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; }