4 * Implementation of the part of the TclCurl extension that deals with libcurl's
7 * Copyright (c)2002-2011 Andres Garcia Garcia.
9 * See the file "license.terms" for information on usage and redistribution
10 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
18 *----------------------------------------------------------------------
20 * Tclcurl_MultiInit --
22 * This procedure initializes the 'multi' part of the package
25 * A standard Tcl result.
27 *----------------------------------------------------------------------
31 Tclcurl_MultiInit (Tcl_Interp *interp) {
33 Tcl_CreateObjCommand (interp,"::curl::multiinit",curlInitMultiObjCmd,
34 (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
40 *----------------------------------------------------------------------
42 * curlCreateMultiObjCmd --
44 * Looks for the first free handle (mcurl1, mcurl2,...) and creates a
48 * A string with the name of the handle, don't forget to free it.
51 * See the user documentation.
53 *----------------------------------------------------------------------
57 curlCreateMultiObjCmd (Tcl_Interp *interp,struct curlMultiObjData *curlMultiData) {
63 /* We try with mcurl1, if it already exists with mcurl2, ... */
64 handleName=(char *)Tcl_Alloc(10);
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);
75 curlMultiData->token=cmdToken;
81 *----------------------------------------------------------------------
83 * curlInitMultiObjCmd --
85 * This procedure is invoked to process the "curl::multiInit" Tcl command.
86 * See the user documentation for details on what it does.
89 * A standard Tcl result.
92 * See the user documentation.
94 *----------------------------------------------------------------------
98 curlInitMultiObjCmd (ClientData clientData, Tcl_Interp *interp,
99 int objc,Tcl_Obj *CONST objv[]) {
103 struct curlMultiObjData *curlMultiData;
104 char *multiHandleName;
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);
113 memset(curlMultiData, 0, sizeof(struct curlMultiObjData));
114 curlMultiData->interp=interp;
116 curlMultiData->mcurl=curl_multi_init();
118 if (curlMultiData->mcurl==NULL) {
119 result=Tcl_NewStringObj("Couldn't open curl multi handle",-1);
120 Tcl_SetObjResult(interp,result);
124 multiHandleName=curlCreateMultiObjCmd(interp,curlMultiData);
126 result=Tcl_NewStringObj(multiHandleName,-1);
127 Tcl_SetObjResult(interp,result);
128 Tcl_Free(multiHandleName);
134 *----------------------------------------------------------------------
138 * This procedure is invoked to process the "multi curl" commands.
139 * See the user documentation for details on what it does.
142 * A standard Tcl result.
145 * See the user documentation.
147 *----------------------------------------------------------------------
150 curlMultiObjCmd (ClientData clientData, Tcl_Interp *interp,
151 int objc,Tcl_Obj *CONST objv[]) {
153 struct curlMultiObjData *curlMultiData=(struct curlMultiObjData *)clientData;
158 Tcl_WrongNumArgs(interp,1,objv,"option arg ?arg?");
161 if (Tcl_GetIndexFromObj(interp, objv[1], multiCommandTable, "option",
162 TCL_EXACT,&tableIndex)==TCL_ERROR) {
167 /* fprintf(stdout,"Multi add handle\n"); */
168 errorCode=curlAddMultiHandle(interp,curlMultiData->mcurl,objv[2]);
169 return curlReturnCURLMcode(interp,errorCode);
172 /* fprintf(stdout,"Multi remove handle\n"); */
173 errorCode=curlRemoveMultiHandle(interp,curlMultiData->mcurl,objv[2]);
174 return curlReturnCURLMcode(interp,errorCode);
177 /* fprintf(stdout,"Multi perform\n"); */
178 errorCode=curlMultiPerform(interp,curlMultiData->mcurl);
182 /* fprintf(stdout,"Multi cleanup\n"); */
183 Tcl_DeleteCommandFromToken(interp,curlMultiData->token);
186 /* fprintf(stdout,"Multi getInfo\n"); */
187 curlMultiGetInfo(interp,curlMultiData->mcurl);
190 /* fprintf(stdout,"Multi activeTransfers\n"); */
191 curlMultiActiveTransfers(interp,curlMultiData);
194 /* fprintf(stdout,"Multi auto transfer\n");*/
195 curlMultiAutoTransfer(interp,curlMultiData,objc,objv);
198 /* fprintf(stdout,"Multi configure\n");*/
199 curlMultiConfigTransfer(interp,curlMultiData,objc,objv);
206 *----------------------------------------------------------------------
208 * curlAddMultiHandle --
210 * Adds an 'easy' curl handle to the stack of a 'multi' handle.
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.
219 * 'non-zero' in case of error.
220 *----------------------------------------------------------------------
223 curlAddMultiHandle(Tcl_Interp *interp,CURLM *curlMultiHandlePtr
226 struct curlObjData *curlDataPtr;
230 curlDataPtr=curlGetEasyHandle(interp,objvPtr);
232 if (curlOpenFiles(interp,curlDataPtr)) {
235 if (curlSetPostData(interp,curlDataPtr)) {
239 errorCode=curl_multi_add_handle(curlMultiHandlePtr,curlDataPtr->curl);
241 curlEasyHandleListAdd(curlMultiHandlePtr,curlDataPtr->curl
242 ,Tcl_GetString(objvPtr));
248 *----------------------------------------------------------------------
250 * curlRemoveMultiHandle --
252 * Removes an 'easy' curl handle to the stack of a 'multi' handle.
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.
261 * 'non-zero' in case of error.
262 *----------------------------------------------------------------------
265 curlRemoveMultiHandle(Tcl_Interp *interp,CURLM *curlMultiHandle
267 struct curlObjData *curlDataPtr;
270 curlDataPtr=curlGetEasyHandle(interp,objvPtr);
271 errorCode=curl_multi_remove_handle(curlMultiHandle,curlDataPtr->curl);
272 curlEasyHandleListRemove(curlMultiHandle,curlDataPtr->curl);
274 curlCloseFiles(curlDataPtr);
275 curlResetPostData(curlDataPtr);
277 if (curlDataPtr->bodyVarName) {
278 curlSetBodyVarName(interp,curlDataPtr);
285 *----------------------------------------------------------------------
287 * curlMultiPerform --
289 * Invokes the 'curl_multi_perform' function to update the current
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.
299 *----------------------------------------------------------------------
302 curlMultiPerform(Tcl_Interp *interp,CURLM *curlMultiHandlePtr) {
305 int runningTransfers;
307 for (errorCode=-1;errorCode<0;) {
308 errorCode=curl_multi_perform(curlMultiHandlePtr,&runningTransfers);
312 curlReturnCURLMcode(interp,runningTransfers);
316 curlReturnCURLMcode(interp,errorCode);
322 *----------------------------------------------------------------------
324 * curlMultiDeleteCmd --
326 * This procedure is invoked when curl multi handle is deleted.
327 * See the user documentation for details on what it does.
330 * A standard Tcl result.
333 * Cleans the curl handle and frees the memory.
335 *----------------------------------------------------------------------
338 curlMultiDeleteCmd(ClientData clientData) {
339 struct curlMultiObjData *curlMultiData=(struct curlMultiObjData *)clientData;
340 CURLM *curlMultiHandle=curlMultiData->mcurl;
342 Tcl_Interp *interp=curlMultiData->interp;
343 struct easyHandleList *listPtr1,*listPtr2;
345 listPtr1=curlMultiData->handleListFirst;
346 while (listPtr1!=NULL) {
347 listPtr2=listPtr1->next;
348 Tcl_Free(listPtr1->name);
349 Tcl_Free((char *)listPtr1);
352 errorCode=curl_multi_cleanup(curlMultiHandle);
353 curlMultiFreeSpace(curlMultiData);
354 return curlReturnCURLMcode(interp,errorCode);
358 *----------------------------------------------------------------------
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
366 * interp: The Tcl interpreter we are using, mainly to report errors.
367 * curlMultiHandlePtr: Pointer to the multi handle of the transfer.
370 * Standard Tcl codes. The Tcl command will return a list with the
371 * name of the Tcl command and other info.
372 *----------------------------------------------------------------------
375 curlMultiGetInfo(Tcl_Interp *interp,CURLM *curlMultiHandlePtr) {
376 struct CURLMsg *multiInfo;
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));
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));
394 Tcl_SetObjResult(interp,resultPtr);
400 *----------------------------------------------------------------------
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.
408 * multiHandlePtr: Pointer to the multi handle of the transfer.
412 *----------------------------------------------------------------------
415 curlMultiGetActiveTransfers( struct curlMultiObjData *curlMultiData) {
416 struct timeval timeout;
420 FD_ZERO(&(curlMultiData->fdread));
421 FD_ZERO(&(curlMultiData->fdwrite));
422 FD_ZERO(&(curlMultiData->fdexcep));
424 /* set a suitable timeout to play around with */
428 /* get file descriptors from the transfers */
429 curl_multi_fdset(curlMultiData->mcurl,
430 &(curlMultiData->fdread),
431 &(curlMultiData->fdwrite),
432 &(curlMultiData->fdexcep), &maxfd);
434 selectCode = select(maxfd+1, &(curlMultiData->fdread)
435 , &(curlMultiData->fdwrite), &(curlMultiData->fdexcep)
442 *----------------------------------------------------------------------
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.
449 * interp: The Tcl interpreter we are using, mainly to report errors.
450 * curlMultiHandlePtr: Pointer to the multi handle of the transfer.
453 * Standard Tcl codes. The Tcl command will return the number of
455 *----------------------------------------------------------------------
458 curlMultiActiveTransfers(Tcl_Interp *interp, struct curlMultiObjData *curlMultiData) {
462 selectCode = curlMultiGetActiveTransfers(curlMultiData);
464 if (selectCode==-1) {
468 resultPtr=Tcl_NewIntObj(selectCode);
469 Tcl_SetObjResult(interp,resultPtr);
474 *----------------------------------------------------------------------
476 * curlGetEasyHandle --
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.
482 * The Tcl object with the name.
485 * The pointer to the libcurl handle
486 *----------------------------------------------------------------------
489 curlGetEasyHandle(Tcl_Interp *interp,Tcl_Obj *nameObjPtr) {
492 Tcl_CmdInfo *infoPtr=(Tcl_CmdInfo *)Tcl_Alloc(sizeof(Tcl_CmdInfo));
493 struct curlObjData *curlDataPtr;
495 handleName=Tcl_GetString(nameObjPtr);
497 if (0==Tcl_GetCommandInfo(interp,handleName,infoPtr)) {
500 curlDataPtr=(struct curlObjData *)(infoPtr->objClientData);
501 Tcl_Free((char *)infoPtr);
506 *----------------------------------------------------------------------
508 * curlMultiFreeSpace --
510 * Frees the space taken by a curlMultiObjData struct.
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.
518 * A standard Tcl result.
519 *----------------------------------------------------------------------
522 curlMultiFreeSpace(struct curlMultiObjData *curlMultiData) {
524 curl_multi_cleanup(curlMultiData->mcurl);
526 Tcl_Free(curlMultiData->postCommand);
527 Tcl_Free((char *)curlMultiData);
531 *----------------------------------------------------------------------
533 * curlEasyHandleListAdd
534 * Adds an easy handle to the list of handles in a multiHandle.
537 * multiDataPtr: Pointer to the struct of the multi handle.
538 * easyHandle: The easy handle to add to the list.
541 *----------------------------------------------------------------------
544 curlEasyHandleListAdd(struct curlMultiObjData *multiDataPtr,CURL *easyHandlePtr,char *name) {
545 struct easyHandleList *easyHandleListPtr;
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;
555 multiDataPtr->handleListLast->next=easyHandleListPtr;
556 multiDataPtr->handleListLast=easyHandleListPtr;
561 *----------------------------------------------------------------------
563 * curlEasyHandleListRemove
564 * When we remove an easy handle from the multiHandle, this function
565 * will remove said handle from the linked list.
568 * multiDataPtr: Pointer to the struct of the multi handle.
569 * easyHandle: The easy handle to add to the list.
572 *----------------------------------------------------------------------
575 curlEasyHandleListRemove(struct curlMultiObjData *multiDataPtr,CURL *easyHandle) {
576 struct easyHandleList *listPtr1,*listPtr2;
579 listPtr2=multiDataPtr->handleListFirst;
580 while(listPtr2!=NULL) {
581 if (listPtr2->curl==easyHandle) {
582 if (listPtr1==NULL) {
583 multiDataPtr->handleListFirst=listPtr2->next;
585 listPtr1->next=listPtr2->next;
587 if (listPtr2==multiDataPtr->handleListLast) {
588 multiDataPtr->handleListLast=listPtr1;
590 Tcl_Free(listPtr2->name);
591 Tcl_Free((char *)listPtr2);
595 listPtr2=listPtr2->next;
599 *----------------------------------------------------------------------
603 * Given the pointer to an easy handle, this function will return
604 * the name of the Tcl command.
607 * multiDataPtr: Multi handle we are using.
608 * easyHandle: The easy handle whose Tcl command we want to know.
611 * A string with the name of the command.
612 *----------------------------------------------------------------------
615 curlGetEasyName(struct curlMultiObjData *multiDataPtr,CURL *easyHandle) {
616 struct easyHandleList *listPtr;
618 listPtr=multiDataPtr->handleListFirst;
619 while(listPtr!=NULL) {
620 if (listPtr->curl==easyHandle) {
621 return listPtr->name;
623 listPtr=listPtr->next;
629 *----------------------------------------------------------------------
631 * curlReturnCURLMcode
633 * When one of the command wants to return a CURLMcode, it calls
637 * interp: Pointer to the interpreter we are using.
638 * errorCode: the value to be returned.
641 * A standard Tcl result.
642 *----------------------------------------------------------------------
645 curlReturnCURLMcode (Tcl_Interp *interp,CURLMcode errorCode) {
648 resultPtr=Tcl_NewIntObj(errorCode);
649 Tcl_SetObjResult(interp,resultPtr);
658 /*----------------------------------------------------------------------
660 * curlMultiAutoTransfer --
662 * Creates the event source that will take care of downloading using
663 * the multi interface driven by Tcl's event loop.
666 * The usual Tcl command parameters.
669 * Standard Tcl return code.
670 *----------------------------------------------------------------------
674 curlMultiAutoTransfer(Tcl_Interp *interp, struct curlMultiObjData *curlMultiData,
675 int objc,Tcl_Obj *CONST objv[]) {
678 Tcl_Free(curlMultiData->postCommand);
679 curlMultiData->postCommand=curlstrdup(Tcl_GetString(objv[3]));
682 Tcl_CreateEventSource((Tcl_EventSetupProc *)curlEventSetup,
683 (Tcl_EventCheckProc *)curlEventCheck, (ClientData *)curlMultiData);
685 /* We have to call perform once to boot the transfer, otherwise it seems nothing
688 while(CURLM_CALL_MULTI_PERFORM ==
689 curl_multi_perform(curlMultiData->mcurl,&(curlMultiData->runningTransfers))) {
695 /*----------------------------------------------------------------------
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.
702 * The usual Tcl command parameters.
705 * Standard Tcl return code.
706 *----------------------------------------------------------------------
710 curlMultiConfigTransfer(Tcl_Interp *interp, struct curlMultiObjData *curlMultiData,
711 int objc,Tcl_Obj *CONST objv[]) {
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) {
724 snprintf(errorMsg,500,"Empty value for %s",multiConfigTable[tableIndex]);
725 resultPtr=Tcl_NewStringObj(errorMsg,-1);
726 Tcl_SetObjResult(interp,resultPtr);
729 if (curlMultiSetOpts(interp,curlMultiData,objv[j],tableIndex)==TCL_ERROR) {
737 *----------------------------------------------------------------------
739 * curlMultiSetOpts --
741 * This procedure takes care of setting the transfer options.
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.
750 * A standard Tcl result.
751 *----------------------------------------------------------------------
754 curlMultiSetOpts(Tcl_Interp *interp, struct curlMultiObjData *curlMultiData,
755 Tcl_Obj *CONST objv,int tableIndex) {
759 if (SetMultiOptLong(interp,curlMultiData->mcurl,
760 CURLMOPT_PIPELINING,tableIndex,objv)) {
765 if (SetMultiOptLong(interp,curlMultiData->mcurl,
766 CURLMOPT_MAXCONNECTS,tableIndex,objv)) {
775 *----------------------------------------------------------------------
779 * Set the curl options that require a long
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.
788 * 0 if all went well.
789 * 1 in case of error.
790 *----------------------------------------------------------------------
793 SetMultiOptLong(Tcl_Interp *interp,CURLM *curlMultiHandle,CURLMoption opt,
794 int tableIndex,Tcl_Obj *tclObj) {
798 if (Tcl_GetLongFromObj(interp,tclObj,&longNumber)) {
799 parPtr=curlstrdup(Tcl_GetString(tclObj));
800 curlErrorSetOpt(interp,multiConfigTable,tableIndex,parPtr);
804 if (curl_multi_setopt(curlMultiHandle,opt,longNumber)) {
805 parPtr=curlstrdup(Tcl_GetString(tclObj));
806 curlErrorSetOpt(interp,multiConfigTable,tableIndex,parPtr);
813 /*----------------------------------------------------------------------
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
821 * NOTE: I hate having a fixed value, I will have to look into it.
824 * They are passed automagically by Tcl, but I don't use them.
825 *----------------------------------------------------------------------
829 curlEventSetup(ClientData clientData, int flags) {
830 Tcl_Time time = {0 , 0};
832 Tcl_SetMaxBlockTime(&time);
835 /*----------------------------------------------------------------------
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
845 * They are passed automagically by Tcl.
846 *----------------------------------------------------------------------
850 curlEventCheck(ClientData clientData, int flags) {
851 struct curlMultiObjData *curlMultiData=(struct curlMultiObjData *)clientData;
852 struct curlEvent *curlEventPtr;
855 selectCode=curlMultiGetActiveTransfers(curlMultiData);
857 if (curlMultiData->runningTransfers==0) {
858 Tcl_DeleteEventSource((Tcl_EventSetupProc *)curlEventSetup,
859 (Tcl_EventCheckProc *)curlEventCheck, (ClientData *)curlMultiData);
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);
870 /*----------------------------------------------------------------------
874 * Finally Tcl event loop decides it is time to transfer something.
877 * They are passed automagically by Tcl.
878 *----------------------------------------------------------------------
882 curlEventProc(Tcl_Event *evPtr,int flags) {
883 struct curlMultiObjData *curlMultiData
884 =(struct curlMultiObjData *)((struct curlEvent *)evPtr)->curlMultiData;
886 Tcl_Obj *tclCommandObjPtr;
887 char tclCommand[300];
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) {
896 fprintf(stdout,"Error invoking command\n");
897 fprintf(stdout,"Error: %s\n",Tcl_GetString(Tcl_GetObjResult(curlMultiData->interp)));