wrath/shaniqua-tclcurl-fa
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

initial checkin of TclCurl

Browse Source
This commit is contained in:
Steve Havelka
2014-02-05 16:43:59 -08:00
commit 639b49517b
95 changed files with 30934 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

905
generic/multi.c Executable file
View File

@ -0,0 +1,905 @@
/*
* 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;
}

115
generic/multi.h Executable file
View File

@ -0,0 +1,115 @@
/*
* multi.h --
*
* Header file for 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.
*
*/
#define multi_h
#include "tclcurl.h"
#ifdef __cplusplus
extern "C" {
#endif
struct easyHandleList {
CURL *curl;
char *name;
struct easyHandleList *next;
};
struct curlMultiObjData {
CURLM *mcurl;
Tcl_Command token;
Tcl_Interp *interp;
struct easyHandleList *handleListFirst;
struct easyHandleList *handleListLast;
fd_set fdread;
fd_set fdwrite;
fd_set fdexcep;
int runningTransfers;
char *postCommand;
};
struct curlEvent {
Tcl_EventProc *proc;
struct Tcl_Event *nextPtr;
struct curlMultiObjData *curlMultiData;
};
CONST static char *multiCommandTable[] = {
"addhandle",
"removehandle",
"perform",
"cleanup",
"getinfo",
"active",
"auto",
"configure",
(char *) NULL
};
CONST static char *multiConfigTable[] = {
"-pipelining", "-maxconnects",
(char *)NULL
};
char *curlCreateMultiObjCmd (Tcl_Interp *interp,struct curlMultiObjData *curlMultiData);
int Tclcurl_MultiInit (Tcl_Interp *interp);
int curlMultiDeleteCmd(ClientData clientData);
int curlInitMultiObjCmd (ClientData clientData, Tcl_Interp *interp,
int objc,Tcl_Obj *CONST objv[]);
int curlMultiObjCmd (ClientData clientData, Tcl_Interp *interp,
int objc,Tcl_Obj *CONST objv[]);
CURLMcode curlAddMultiHandle(Tcl_Interp *interp,CURLM *curlMultiHandle
,Tcl_Obj *objvPtr);
CURLMcode curlRemoveMultiHandle(Tcl_Interp *interp,CURLM *curlMultiHandle
,Tcl_Obj *objvPtr);
int curlMultiPerform(Tcl_Interp *interp,CURLM *curlMultiHandle);
int curlMultiGetInfo(Tcl_Interp *interp,CURLM *curlMultiHandlePtr);
int curlMultiGetActiveTransfers( struct curlMultiObjData *curlMultiData);
int curlMultiActiveTransfers(Tcl_Interp *interp, struct curlMultiObjData *curlMultiData);
struct curlObjData *curlGetEasyHandle(Tcl_Interp *interp,Tcl_Obj *nameObjPtr);
void curlMultiFreeSpace(struct curlMultiObjData *curlMultiData);
int curlReturnCURLMcode(Tcl_Interp *interp,CURLMcode errorCode);
void curlEasyHandleListAdd(struct curlMultiObjData *multiDataPtr,CURL *easyHandle,char *name);
void curlEasyHandleListRemove(struct curlMultiObjData *multiDataPtr,CURL *easyHandle);
char *curlGetEasyName(struct curlMultiObjData *multiDataPtr,CURL *easyHandle);
int curlMultiAutoTransfer(Tcl_Interp *interp, struct curlMultiObjData *curlMultiData, int objc,Tcl_Obj *CONST objv[]);
int curlMultiSetOpts(Tcl_Interp *interp, struct curlMultiObjData *curlMultiData,Tcl_Obj *CONST objv,int tableIndex);
int SetMultiOptLong(Tcl_Interp *interp,CURLM *curlMultiHandle,CURLMoption opt,
int tableIndex,Tcl_Obj *tclObj);
int curlMultiConfigTransfer(Tcl_Interp *interp, struct curlMultiObjData *curlMultiData, int objc,Tcl_Obj *CONST objv[]);
void curlEventSetup(ClientData clientData, int flags);
void curlEventCheck(ClientData clientData, int flags);
int curlEventProc(Tcl_Event *evPtr,int flags);
#ifdef __cplusplus
}
#endif

4500
generic/tclcurl.c Executable file
View File

File diff suppressed because it is too large Load Diff

512
generic/tclcurl.h Executable file
View File

@ -0,0 +1,512 @@
/*
* tclcurl.h --
*
* Header file for the TclCurl extension to enable Tcl interpreters
* to access libcurl.
*
* Copyright (c) 2001-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.
*
*/
#if (defined(WIN32) || defined(_WIN32))
#define CURL_STATICLIB 1
#endif
#include <curl/curl.h>
#include <curl/easy.h>
#include <tcl.h>
#include <tclDecls.h>
#include <stdio.h>
#include <string.h>
#define _MPRINTF_REPLACE
#include <curl/mprintf.h>
#ifdef __cplusplus
extern "C" {
#endif
/*
* Windows needs to know which symbols to export. Unix does not.
* BUILD_tclcurl should be undefined for Unix.
* Actually I don't use this, but it was in TEA so I keep in case
* I ever understand what it is for.
*/
#ifdef BUILD_tclcurl
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT
#endif
#define TclCurlVersion "7.22.0"
/*
* This struct will contain the data of a transfer if the user wants
* to put the body into a Tcl variable
*/
struct MemoryStruct {
char *memory;
size_t size;
};
/*
* Struct that will be used for a linked list with all the
* data for a post
*/
struct formArrayStruct {
struct curl_forms *formArray;
struct curl_slist *formHeaderList;
struct formArrayStruct *next;
};
struct curlObjData {
CURL *curl;
Tcl_Command token;
Tcl_Command shareToken;
Tcl_Interp *interp;
struct curl_slist *headerList;
struct curl_slist *quote;
struct curl_slist *prequote;
struct curl_slist *postquote;
struct curl_httppost *postListFirst;
struct curl_httppost *postListLast;
struct formArrayStruct *formArray;
char *outFile;
FILE *outHandle;
int outFlag;
char *inFile;
FILE *inHandle;
int inFlag;
char *proxy;
int transferText;
char *errorBuffer;
char *errorBufferName;
char *errorBufferKey;
char *headerFile;
FILE *headerHandle;
int headerFlag;
char *stderrFile;
FILE *stderrHandle;
int stderrFlag;
char *randomFile;
char *headerVar;
char *bodyVarName;
struct MemoryStruct bodyVar;
char *progressProc;
char *cancelTransVarName;
int cancelTrans;
char *writeProc;
char *readProc;
char *debugProc;
struct curl_slist *http200aliases;
char *command;
int anyAuthFlag;
char *sshkeycallProc;
struct curl_slist *mailrcpt;
char *chunkBgnProc;
char *chunkBgnVar;
char *chunkEndProc;
char *fnmatchProc;
struct curl_slist *resolve;
struct curl_slist *telnetoptions;
};
struct shcurlObjData {
Tcl_Command token;
CURLSH *shandle;
};
#ifndef multi_h
CONST static char *commandTable[] = {
"setopt",
"perform",
"getinfo",
"cleanup",
"configure",
"duphandle",
"reset",
"pause",
"resume",
(char *) NULL
};
CONST static char *optionTable[] = {
"CURLOPT_URL", "CURLOPT_FILE", "CURLOPT_READDATA",
"CURLOPT_USERAGENT", "CURLOPT_REFERER", "CURLOPT_VERBOSE",
"CURLOPT_HEADER", "CURLOPT_NOBODY", "CURLOPT_PROXY",
"CURLOPT_PROXYPORT", "CURLOPT_HTTPPROXYTUNNEL", "CURLOPT_FAILONERROR",
"CURLOPT_TIMEOUT", "CURLOPT_LOW_SPEED_LIMIT", "CURLOPT_LOW_SPEED_TIME",
"CURLOPT_RESUME_FROM", "CURLOPT_INFILESIZE", "CURLOPT_UPLOAD",
"CURLOPT_FTPLISTONLY", "CURLOPT_FTPAPPEND", "CURLOPT_NETRC",
"CURLOPT_FOLLOWLOCATION","CURLOPT_TRANSFERTEXT", "CURLOPT_PUT",
"CURLOPT_MUTE", "CURLOPT_USERPWD", "CURLOPT_PROXYUSERPWD",
"CURLOPT_RANGE", "CURLOPT_ERRORBUFFER", "CURLOPT_HTTPGET",
"CURLOPT_POST", "CURLOPT_POSTFIELDS", "CURLOPT_POSTFIELDSIZE",
"CURLOPT_FTPPORT", "CURLOPT_COOKIE", "CURLOPT_COOKIEFILE",
"CURLOPT_HTTPHEADER", "CURLOPT_HTTPPOST", "CURLOPT_SSLCERT",
"CURLOPT_SSLCERTPASSWD", "CURLOPT_SSLVERSION", "CURLOPT_CRLF",
"CURLOPT_QUOTE", "CURLOPT_POSTQUOTE", "CURLOPT_WRITEHEADER",
"CURLOPT_TIMECONDITION", "CURLOPT_TIMEVALUE", "CURLOPT_CUSTOMREQUEST",
"CURLOPT_STDERR", "CURLOPT_INTERFACE", "CURLOPT_KRB4LEVEL",
"CURLOPT_SSL_VERIFYPEER","CURLOPT_CAINFO", "CURLOPT_FILETIME",
"CURLOPT_MAXREDIRS", "CURLOPT_MAXCONNECTS", "CURLOPT_CLOSEPOLICY",
"CURLOPT_RANDOM_FILE", "CURLOPT_EGDSOCKET", "CURLOPT_CONNECTTIMEOUT",
"CURLOPT_NOPROGRESS", "CURLOPT_HEADERVAR", "CURLOPT_BODYVAR",
"CURLOPT_PROGRESSPROC","CURLOPT_CANCELTRANSVARNAME","CURLOPT_WRITEPROC",
"CURLOPT_READPROC", "CURLOPT_SSL_VERIFYHOST", "CURLOPT_COOKIEJAR",
"CURLOPT_SSL_CIPHER_LIST","CURLOPT_HTTP_VERSION", "CURLOPT_FTP_USE_EPSV",
"CURLOPT_SSLCERTTYPE", "CURLOPT_SSLKEY", "CURLOPT_SSLKEYTYPE",
"CURLOPT_SSLKEYPASSWD", "CURLOPT_SSL_ENGINE", "CURLOPT_SSL_ENGINEDEFAULT",
"CURLOPT_PREQUOTE", "CURLOPT_DEBUGPROC", "CURLOPT_DNS_CACHE_TIMEOUT",
"CURLOPT_DNS_USE_GLOBAL_CACHE", "CURLOPT_COOKIESESSION","CURLOPT_CAPATH",
"CURLOPT_BUFFERSIZE", "CURLOPT_NOSIGNAL", "CURLOPT_ENCODING",
"CURLOPT_PROXYTYPE", "CURLOPT_HTTP200ALIASES", "CURLOPT_UNRESTRICTED_AUTH",
"CURLOPT_FTP_USE_EPRT", "CURLOPT_NOSUCHOPTION", "CURLOPT_HTTPAUTH",
"CURLOPT_FTP_CREATE_MISSING_DIRS", "CURLOPT_PROXYAUTH",
"CURLOPT_FTP_RESPONSE_TIMEOUT", "CURLOPT_IPRESOLVE",
"CURLOPT_MAXFILESIZE", "CURLOPT_NETRC_FILE", "CURLOPT_FTP_SSL",
"CURLOPT_SHARE", "CURLOPT_PORT", "CURLOPT_TCP_NODELAY",
"CURLOPT_AUTOREFERER", "CURLOPT_SOURCE_HOST", "CURLOPT_SOURCE_USERPWD",
"CURLOPT_SOURCE_PATH", "CURLOPT_SOURCE_PORT", "CURLOPT_PASV_HOST",
"CURLOPT_SOURCE_PREQUOTE","CURLOPT_SOURCE_POSTQUOTE",
"CURLOPT_FTPSSLAUTH", "CURLOPT_SOURCE_URL", "CURLOPT_SOURCE_QUOTE",
"CURLOPT_FTP_ACCOUNT", "CURLOPT_IGNORE_CONTENT_LENGTH",
"CURLOPT_COOKIELIST", "CURLOPT_FTP_SKIP_PASV_IP",
"CURLOPT_FTP_FILEMETHOD", "CURLOPT_LOCALPORT", "CURLOPT_LOCALPORTRANGE",
"CURLOPT_MAX_SEND_SPEED_LARGE", "CURLOPT_MAX_RECV_SPEED_LARGE",
"CURLOPT_FTP_ALTERNATIVE_TO_USER", "CURLOPT_SSL_SESSIONID_CACHE",
"CURLOPT_SSH_AUTH_TYPES", "CURLOPT_SSH_PUBLIC_KEYFILE",
"CURLOPT_SSH_PRIVATE_KEYFILE", "CURLOPT_TIMEOUT_MS",
"CURLOPT_CONNECTTIMEOUT_MS", "CURLOPT_HTTP_CONTENT_DECODING",
"CURLOPT_HTTP_TRANSFER_DECODING", "CURLOPT_KRBLEVEL",
"CURLOPT_NEW_FILE_PERMS", "CURLOPT_NEW_DIRECTORY_PERMS",
"CURLOPT_KEYPASSWD", "CURLOPT_APPEND", "CURLOPT_DIRLISTONLY",
"CURLOPT_USE_SSL", "CURLOPT_POST301", "CURLOPT_SSH_HOST_PUBLIC_KEY_MD5",
"CURLOPT_PROXY_TRANSFER_MODE", "CURLOPT_CRLFILE",
"CURLOPT_ISSUERCERT", "CURLOPT_ADDRESS_SCOPE", "CURLOPT_CERTINFO",
"CURLOPT_POSTREDIR", "CURLOPT_USERNAME", "CURLOPT_PASSWORD",
"CURLOPT_PROXYUSERNAME", "CURLOPT_PROXYPASSWORD", "CURLOPT_TFTP_BLKSIZE",
"CURLOPT_SOCKS5_GSSAPI_SERVICE", "CURLOPT_SOCKS5_GSSAPI_NEC",
"CURLOPT_PROTOCOLS", "CURLOPT_REDIR_PROTOCOLS","CURLOPT_FTP_SSL_CC",
"CURLOPT_SSH_KNOWNHOSTS", "CURLOPT_SSH_KEYFUNCTION","CURLOPT_MAIL_FROM",
"CURLOPT_MAIL_RCPT", "CURLOPT_FTP_USE_PRET", "CURLOPT_WILDCARDMATCH",
"CURLOPT_CHUNK_BGN_PROC", "CURLOPT_CHUNK_BGN_VAR", "CURLOPT_CHUNK_END_PROC",
"CURLOPT_FNMATCH_PROC", "CURLOPT_RESOLVE", "CURLOPT_TLSAUTH_USERNAME",
"CURLOPT_TLSAUTH_PASSWORD","CURLOPT_GSSAPI_DELEGATION", "CURLOPT_NOPROXY",
"CURLOPT_TELNETOPTIONS",
(char *)NULL
};
CONST static char *configTable[] = {
"-url", "-file", "-infile",
"-useragent", "-referer", "-verbose",
"-header", "-nobody", "-proxy",
"-proxyport", "-httpproxytunnel", "-failonerror",
"-timeout", "-lowspeedlimit", "-lowspeedtime",
"-resumefrom", "-infilesize", "-upload",
"-ftplistonly", "-ftpappend", "-netrc",
"-followlocation", "-transfertext", "-put",
"-mute", "-userpwd", "-proxyuserpwd",
"-range", "-errorbuffer", "-httpget",
"-post", "-postfields", "-postfieldssize",
"-ftpport", "-cookie", "-cookiefile",
"-httpheader", "-httppost", "-sslcert",
"-sslcertpasswd", "-sslversion", "-crlf",
"-quote", "-postquote", "-writeheader",
"-timecondition", "-timevalue", "-customrequest",
"-stderr", "-interface", "-krb4level",
"-sslverifypeer", "-cainfo", "-filetime",
"-maxredirs", "-maxconnects", "-closepolicy",
"-randomfile", "-egdsocket", "-connecttimeout",
"-noprogress", "-headervar", "-bodyvar",
"-progressproc", "-canceltransvarname", "-writeproc",
"-readproc", "-sslverifyhost", "-cookiejar",
"-sslcipherlist", "-httpversion", "-ftpuseepsv",
"-sslcerttype", "-sslkey", "-sslkeytype",
"-sslkeypasswd", "-sslengine", "-sslenginedefault",
"-prequote", "-debugproc", "-dnscachetimeout",
"-dnsuseglobalcache", "-cookiesession", "-capath",
"-buffersize", "-nosignal", "-encoding",
"-proxytype", "-http200aliases", "-unrestrictedauth",
"-ftpuseeprt", "-command", "-httpauth",
"-ftpcreatemissingdirs", "-proxyauth",
"-ftpresponsetimeout", "-ipresolve",
"-maxfilesize", "-netrcfile", "-ftpssl",
"-share", "-port", "-tcpnodelay",
"-autoreferer", "-sourcehost", "-sourceuserpwd",
"-sourcepath", "-sourceport", "-pasvhost",
"-sourceprequote", "-sourcepostquote", "-ftpsslauth",
"-sourceurl", "-sourcequote", "-ftpaccount",
"-ignorecontentlength", "-cookielist",
"-ftpskippasvip", "-ftpfilemethod", "-localport",
"-localportrange",
"-maxsendspeed", "-maxrecvspeed",
"-ftpalternativetouser", "-sslsessionidcache",
"-sshauthtypes", "-sshpublickeyfile", "-sshprivatekeyfile",
"-timeoutms", "-connecttimeoutms", "-contentdecoding",
"-transferdecoding", "-krblevel", "-newfileperms",
"-newdirectoryperms", "-keypasswd", "-append",
"-dirlistonly", "-usessl", "-post301",
"-sshhostpublickeymd5", "-proxytransfermode",
"-crlfile", "-issuercert", "-addressscope",
"-certinfo", "-postredir", "-username",
"-password", "-proxyuser", "-proxypassword",
"-tftpblksize", "-socks5gssapiservice","-socks5gssapinec",
"-protocols", "-redirprotocols", "-ftpsslcc",
"-sshknownhosts", "-sshkeyproc", "-mailfrom",
"-mailrcpt", "-ftpusepret", "-wildcardmatch",
"-chunkbgnproc", "-chunkbgnvar", "-chunkendproc",
"-fnmatchproc", "-resolve", "-tlsauthusername",
"-tlsauthpassword", "-gssapidelegation", "-noproxy",
"-telnetoptions",
(char *) NULL
};
CONST static char *timeCond[] = {
"ifmodsince", "ifunmodsince",
(char *)NULL
};
CONST static char *getInfoTable[]={
"effectiveurl", "httpcode", "responsecode",
"filetime", "totaltime", "namelookuptime",
"connecttime", "pretransfertime","sizeupload",
"sizedownload", "speeddownload", "speedupload",
"headersize", "requestsize", "sslverifyresult",
"contentlengthdownload", "contentlengthupload",
"starttransfertime", "contenttype",
"redirecttime", "redirectcount", "httpauthavail",
"proxyauthavail", "oserrno", "numconnects",
"sslengines", "httpconnectcode","cookielist",
"ftpentrypath", "redirecturl", "primaryip",
"appconnecttime", "certinfo", "conditionunmet",
"primaryport", "localip", "localport",
(char *)NULL
};
CONST static char *curlFormTable[]={
"name", "contents", "file", "contenttype", "contentheader", "filename",
"bufferName", "buffer", "filecontent", (char *)NULL
};
CONST static char *httpVersionTable[] = {
"none", "1.0", "1.1", (char *)NULL
};
CONST static char *netrcTable[] = {
"optional", "ignored", "required", (char *)NULL
};
CONST static char *encodingTable[] = {
"identity", "deflated", "all", (char *)NULL
};
CONST static char *versionInfoTable[] = {
"-version", "-versionnum", "-host", "-features",
"-sslversion", "-sslversionnum", "-libzversion",
"-protocols", (char *)NULL
};
CONST static char *proxyTypeTable[] = {
"http", "http1.0", "socks4", "socks4a", "socks5", "socks5h", (char *)NULL
};
CONST static char *httpAuthMethods[] = {
"basic", "digest", "digestie", "gssnegotiate", "ntlm", "any", "anysafe", "ntlmwb",(char *)NULL
};
CONST static char *ipresolve[] = {
"whatever", "v4", "v6", (char *)NULL
};
CONST static char *ftpssl[] = {
"nope", "try", "control", "all", (char *)NULL
};
CONST static char *shareCmd[] = {
"share", "unshare", "cleanup", (char *)NULL
};
CONST static char *lockData[] = {
"cookies", "dns", (char *)NULL
};
CONST static char *ftpsslauth[] = {
"default", "ssl", "tls", (char *)NULL
};
CONST static char *ftpsslccc[] = {
"none", "passive", "active", (char *)NULL
};
CONST static char *sslversion[] = {
"default", "tlsv1", "sslv2", "sslv3", (char *)NULL
};
CONST static char *ftpfilemethod[] = {
"default", "multicwd", "nocwd", "singlecwd", (char *)NULL
};
CONST static char *sshauthtypes[] = {
"publickey", "password", "host", "keyboard", "any", (char *)NULL
};
CONST static char *postredir[] = {
"301", "302", "all", (char *)NULL
};
CONST static char *protocolNames[] = {
"http", "https", "ftp", "ftps", "scp", "sftp", "telnet", "ldap",
"ldaps","dict", "file","tftp", "all", "imap", "imaps", "pop3",
"pop3s", "smtp", "smtps", "rtsp", "rtmp", "rtmpt", "rtmpe",
"rtmpte", "rtmps", "rtmpts", "gopher", (char*)NULL
};
CONST static char *tlsauth[] = {
"none", "srp", (char *)NULL
};
CONST static char *gssapidelegation[] = {
"flag", "policyflag", (char *) NULL
};
int curlseek(void *instream, curl_off_t offset, int origin);
int Tclcurl_MultiInit (Tcl_Interp *interp);
#endif
int Tclcurl_Init(Tcl_Interp *interp);
char *curlCreateObjCmd(Tcl_Interp *interp,struct curlObjData *curlData);
int curlInitObjCmd(ClientData clientData, Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
int curlObjCmd(ClientData clientData, Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
int curlDeleteCmd(ClientData clientData);
int curlPerform(Tcl_Interp *interp,CURL *curlHandle,struct curlObjData *curlData);
int curlSetOptsTransfer(Tcl_Interp *interp, struct curlObjData *curlData,int objc,
Tcl_Obj *CONST objv[]);
int curlConfigTransfer(Tcl_Interp *interp, struct curlObjData *curlData,int objc,
Tcl_Obj *CONST objv[]);
int curlDupHandle(Tcl_Interp *interp, struct curlObjData *curlData,int objc,
Tcl_Obj *CONST objv[]);
int curlResetHandle(Tcl_Interp *interp, struct curlObjData *curlData);
int curlSetOpts(Tcl_Interp *interp, struct curlObjData *curlData,
Tcl_Obj *CONST objv,int tableIndex);
int SetoptInt(Tcl_Interp *interp,CURL *curlHandle,CURLoption opt,int tableIndex,
Tcl_Obj *tclObj);
int SetoptLong(Tcl_Interp *interp,CURL *curlHandle,CURLoption opt,int tableIndex,
Tcl_Obj *tclObj);
int SetoptCurlOffT(Tcl_Interp *interp,CURL *curlHandle,CURLoption opt,int tableIndex,
Tcl_Obj *tclObj);
int SetoptChar(Tcl_Interp *interp,CURL *curlHandle,CURLoption opt,
int tableIndex,Tcl_Obj *tclObj);
int SetoptSHandle(Tcl_Interp *interp,CURL *curlHandle,CURLoption opt,
int tableIndex,Tcl_Obj *tclObj);
int SetoptsList(Tcl_Interp *interp,struct curl_slist **slistPtr,Tcl_Obj *CONST objv);
CURLcode curlGetInfo(Tcl_Interp *interp,CURL *curlHandle,int tableIndex);
void curlFreeSpace(struct curlObjData *curlData);
void curlErrorSetOpt(Tcl_Interp *interp,CONST char **configTable, int option,CONST char *parPtr);
size_t curlHeaderReader(void *ptr,size_t size,size_t nmemb,FILE *stream);
size_t curlBodyReader(void *ptr,size_t size,size_t nmemb,FILE *curlDataPtr);
int curlProgressCallback(void *clientp,double dltotal,double dlnow,
double ultotal,double ulnow);
size_t curlWriteProcInvoke(void *ptr,size_t size,size_t nmemb,FILE *curlDataPtr);
size_t curlReadProcInvoke(void *ptr,size_t size,size_t nmemb,FILE *curlDataPtr);
long curlChunkBgnProcInvoke (const void *transfer_info, void *curlDataPtr, int remains);
long curlChunkEndProcInvoke (void *curlDataPtr);
int curlfnmatchProcInvoke(void *curlDataPtr, const char *pattern, const char *filename);
/* Puts a ssh key into a Tcl object */
Tcl_Obj *curlsshkeyextract(Tcl_Interp *interp,const struct curl_khkey *key);
/* Function that will be invoked by libcurl to see what the user wants to
do about the new ssh host */
size_t curlsshkeycallback(CURL *easy, /* easy handle */
const struct curl_khkey *knownkey, /* known */
const struct curl_khkey *foundkey, /* found */
enum curl_khmatch, /* libcurl's view on the keys */
void *curlData);
int curlDebugProcInvoke(CURL *curlHandle, curl_infotype infoType,
char * dataPtr, size_t size, void *curlData);
int curlVersion (ClientData clientData, Tcl_Interp *interp,
int objc,Tcl_Obj *CONST objv[]);
int curlEscape(ClientData clientData, Tcl_Interp *interp,
int objc,Tcl_Obj *CONST objv[]);
int curlUnescape(ClientData clientData, Tcl_Interp *interp,
int objc,Tcl_Obj *CONST objv[]);
int curlVersionInfo (ClientData clientData, Tcl_Interp *interp,
int objc,Tcl_Obj *CONST objv[]);
int curlCopyCurlData (struct curlObjData *curlDataOld,
struct curlObjData *curlDataNew);
int curlOpenFile(Tcl_Interp *interp,char *fileName, FILE **handle, int writing, int text);
int curlOpenFiles (Tcl_Interp *interp,struct curlObjData *curlData);
void curlCloseFiles(struct curlObjData *curlData);
int curlSetPostData(Tcl_Interp *interp,struct curlObjData *curlData);
void curlResetPostData(struct curlObjData *curlDataPtr);
void curlResetFormArray(struct curl_forms *formArray);
void curlSetBodyVarName(Tcl_Interp *interp,struct curlObjData *curlDataPtr);
char *curlstrdup (char *old);
char *curlCreateShareObjCmd (Tcl_Interp *interp,struct shcurlObjData *shcurlData);
int curlShareInitObjCmd (ClientData clientData, Tcl_Interp *interp,
int objc,Tcl_Obj *CONST objv[]);
int curlShareObjCmd (ClientData clientData, Tcl_Interp *interp,
int objc,Tcl_Obj *CONST objv[]);
int curlCleanUpShareCmd(ClientData clientData);
#ifdef TCL_THREADS
TCL_DECLARE_MUTEX(cookieLock)
TCL_DECLARE_MUTEX(dnsLock)
TCL_DECLARE_MUTEX(sslLock)
TCL_DECLARE_MUTEX(connectLock)
void curlShareLockFunc (CURL *handle, curl_lock_data data
, curl_lock_access access, void *userptr);
void curlShareUnLockFunc(CURL *handle, curl_lock_data data, void *userptr);
#endif
int curlErrorStrings (Tcl_Interp *interp, Tcl_Obj *CONST objv,int type);
int curlEasyStringError (ClientData clientData, Tcl_Interp *interp,
int objc,Tcl_Obj *CONST objv[]);
int curlShareStringError (ClientData clientData, Tcl_Interp *interp,
int objc,Tcl_Obj *CONST objv[]);
int curlMultiStringError (ClientData clientData, Tcl_Interp *interp,
int objc,Tcl_Obj *CONST objv[]);
#ifdef __cplusplus
}
#endif

145
generic/tclcurl.tcl Executable file
View File

@ -0,0 +1,145 @@
################################################################################
################################################################################
#### tclcurl.tcl
################################################################################
################################################################################
## Includes the tcl part of TclCurl
################################################################################
################################################################################
## (c) 2001-2011 Andres Garcia Garcia. fandom@telefonica.net
## See the file "license.terms" for information on usage and redistribution
## of this file and for a DISCLAIMER OF ALL WARRANTIES.
################################################################################
################################################################################
package provide TclCurl 7.22.0
namespace eval curl {
################################################################################
# configure
# Invokes the 'curl-config' script to be able to know what features have
# been compiled in the installed version of libcurl.
# Possible options are '-prefix', '-feature' and 'vernum'
################################################################################
proc ::curl::curlConfig {option} {
if {$::tcl_platform(platform)=="windows"} {
error "This command is not available in Windows"
}
switch -exact -- $option {
-prefix {
return [exec curl-config --prefix]
}
-feature {
set featureList [exec curl-config --feature]
regsub -all {\\n} $featureList { } featureList
return $featureList
}
-vernum {
return [exec curl-config --vernum]
}
-ca {
return [exec curl-config --ca]
}
default {
error "bad option '$option': must be '-prefix', '-feature', '-vernum' or '-ca'"
}
}
return
}
################################################################################
# transfer
# The transfer command is used for simple transfers in which you don't
# want to request more than one file.
#
# Parameters:
# Use the same parameters you would use in the 'configure' command to
# configure the download and the same as in 'getinfo' with a 'info'
# prefix to get info about the transfer.
################################################################################
proc ::curl::transfer {args} {
variable getInfo
variable curlBodyVar
set i 0
set newArgs ""
catch {unset getInfo}
if {[llength $args]==0} {
puts "No transfer configured"
return
}
foreach {option value} $args {
set noPassOption 0
set block 1
switch -regexp -- $option {
-info.* {
set noPassOption 1
regsub -- {-info} $option {} option
set getInfo($option) $value
}
-block {
set noPassOption 1
set block $value
}
-bodyvar {
upvar $value curlBodyVar
set value curlBodyVar
}
-headervar {
upvar $value curlHeaderVar
set value curlHeaderVar
}
-errorbuffer {
upvar $value curlErrorVar
set value curlErrorVar
}
}
if {$noPassOption==0} {
lappend newArgs $option $value
}
}
if {[catch {::curl::init} curlHandle]} {
error "Could not init a curl session: $curlHandle"
}
if {[catch {eval $curlHandle configure $newArgs} result]} {
$curlHandle cleanup
error $result
}
if {$block==1} {
if {[catch {$curlHandle perform} result]} {
$curlHandle cleanup
error $result
}
if {[info exists getInfo]} {
foreach {option var} [array get getInfo] {
upvar $var info
set info [eval $curlHandle getinfo $option]
}
}
if {[catch {$curlHandle cleanup} result]} {
error $result
}
} else {
# We create a multiHandle
set multiHandle [curl::multiinit]
# We add the easy handle to the multi handle.
$multiHandle addhandle $curlHandle
# So now we create the event source passing the multiHandle as a parameter.
curl::createEventSource $multiHandle
# And we return, it is non blocking after all.
}
return 0
}
}