4 * Implementation of the TclCurl extension that creates the curl namespace
5 * so that Tcl interpreters can access libcurl.
7 * Copyright (c) 2001-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.
16 #include <sys/types.h>
20 *----------------------------------------------------------------------
24 * This procedure initializes the package
27 * A standard Tcl result.
29 *----------------------------------------------------------------------
33 Tclcurl_Init (Tcl_Interp *interp) {
35 if(Tcl_InitStubs(interp,"8.1",0)==NULL) {
39 Tcl_CreateObjCommand (interp,"::curl::init",curlInitObjCmd,
40 (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
41 Tcl_CreateObjCommand (interp,"::curl::version",curlVersion,
42 (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
43 Tcl_CreateObjCommand (interp,"::curl::escape",curlEscape,
44 (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
45 Tcl_CreateObjCommand (interp,"::curl::unescape",curlUnescape,
46 (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
47 Tcl_CreateObjCommand (interp,"::curl::versioninfo",curlVersionInfo,
48 (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
49 Tcl_CreateObjCommand (interp,"::curl::shareinit",curlShareInitObjCmd,
50 (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
51 Tcl_CreateObjCommand (interp,"::curl::easystrerror", curlEasyStringError,
52 (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
53 Tcl_CreateObjCommand (interp,"::curl::sharestrerror",curlShareStringError,
54 (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
55 Tcl_CreateObjCommand (interp,"::curl::multistrerror",curlMultiStringError,
56 (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
58 Tclcurl_MultiInit(interp);
60 Tcl_PkgProvide(interp,"TclCurl","7.22.0");
66 *----------------------------------------------------------------------
70 * Looks for the first free handle (curl1, curl2,...) and creates a
74 * A string with the name of the handle, don't forget to free it.
77 * See the user documentation.
79 *----------------------------------------------------------------------
83 curlCreateObjCmd (Tcl_Interp *interp,struct curlObjData *curlData) {
89 /* We try with curl1, if it already exists with curl2...*/
90 handleName=(char *)Tcl_Alloc(10);
92 sprintf(handleName,"curl%d",i);
93 if (!Tcl_GetCommandInfo(interp,handleName,&info)) {
94 cmdToken=Tcl_CreateObjCommand(interp,handleName,curlObjCmd,
96 (Tcl_CmdDeleteProc *)curlDeleteCmd);
100 curlData->token=cmdToken;
106 *----------------------------------------------------------------------
110 * This procedure is invoked to process the "curl::init" Tcl command.
111 * See the user documentation for details on what it does.
114 * A standard Tcl result.
117 * See the user documentation.
119 *----------------------------------------------------------------------
123 curlInitObjCmd (ClientData clientData, Tcl_Interp *interp,
124 int objc,Tcl_Obj *CONST objv[]) {
128 struct curlObjData *curlData;
131 curlData=(struct curlObjData *)Tcl_Alloc(sizeof(struct curlObjData));
132 if (curlData==NULL) {
133 resultPtr=Tcl_NewStringObj("Couldn't allocate memory",-1);
134 Tcl_SetObjResult(interp,resultPtr);
138 memset(curlData, 0, sizeof(struct curlObjData));
139 curlData->interp=interp;
141 curlHandle=curl_easy_init();
142 if (curlHandle==NULL) {
143 resultPtr=Tcl_NewStringObj("Couldn't open curl handle",-1);
144 Tcl_SetObjResult(interp,resultPtr);
148 handleName=curlCreateObjCmd(interp,curlData);
150 curlData->curl=curlHandle;
152 resultPtr=Tcl_NewStringObj(handleName,-1);
153 Tcl_SetObjResult(interp,resultPtr);
154 Tcl_Free(handleName);
160 *----------------------------------------------------------------------
164 * This procedure is invoked to process the "curl" commands.
165 * See the user documentation for details on what it does.
168 * A standard Tcl result.
171 * See the user documentation.
173 *----------------------------------------------------------------------
176 curlObjCmd (ClientData clientData, Tcl_Interp *interp,
177 int objc,Tcl_Obj *CONST objv[]) {
179 struct curlObjData *curlData=(struct curlObjData *)clientData;
180 CURL *curlHandle=curlData->curl;
184 Tcl_WrongNumArgs(interp,1,objv,"option arg ?arg?");
187 if (Tcl_GetIndexFromObj(interp, objv[1], commandTable, "option",
188 TCL_EXACT,&tableIndex)==TCL_ERROR) {
194 if (curlSetOptsTransfer(interp,curlData,objc,objv)==TCL_ERROR) {
199 /* fprintf(stdout,"Perform\n"); */
200 if (curlPerform(interp,curlHandle,curlData)) {
201 if (curlData->errorBuffer!=NULL) {
202 if (curlData->errorBufferKey==NULL) {
203 Tcl_SetVar(interp,curlData->errorBufferName,
204 curlData->errorBuffer,0);
206 Tcl_SetVar2(interp,curlData->errorBufferName,
207 curlData->errorBufferKey,
208 curlData->errorBuffer,0);
215 /* fprintf(stdout,"Getinfo\n"); */
216 if (Tcl_GetIndexFromObj(interp,objv[2],getInfoTable,
217 "getinfo option",TCL_EXACT,&tableIndex)==TCL_ERROR) {
220 if (curlGetInfo(interp,curlHandle,tableIndex)) {
225 /* fprintf(stdout,"Cleanup\n"); */
226 Tcl_DeleteCommandFromToken(interp,curlData->token);
229 /* fprintf(stdout,"Configure\n"); */
230 if (curlConfigTransfer(interp,curlData,objc,objv)==TCL_ERROR) {
235 /* fprintf(stdout,"DupHandle\n"); */
236 if (curlDupHandle(interp,curlData,objc,objv)==TCL_ERROR) {
241 /* fprintf(stdout,"Reset\n"); */
242 if (curlResetHandle(interp,curlData)==TCL_ERROR) {
247 /* fprintf(stdout,"Pause\n"); */
248 if (curl_easy_pause(curlData->curl,CURLPAUSE_ALL)==TCL_ERROR) {
254 /* fprintf(stdout,"Resume\n"); */
255 if (curl_easy_pause(curlData->curl,CURLPAUSE_CONT)==TCL_ERROR) {
264 *----------------------------------------------------------------------
268 * This procedure is invoked when curl handle is deleted.
271 * A standard Tcl result.
274 * Cleans the curl handle and frees the memory.
276 *----------------------------------------------------------------------
279 curlDeleteCmd(ClientData clientData) {
280 struct curlObjData *curlData=(struct curlObjData *)clientData;
281 CURL *curlHandle=curlData->curl;
283 curl_easy_cleanup(curlHandle);
284 curlFreeSpace(curlData);
286 Tcl_Free((char *)curlData);
292 *----------------------------------------------------------------------
296 * Invokes the libcurl function 'curl_easy_perform'
299 * interp: Pointer to the interpreter we are using.
300 * curlHandle: the curl handle for which the option is set.
301 * objc and objv: The usual in Tcl.
304 * Standard Tcl return codes.
305 *----------------------------------------------------------------------
308 curlPerform(Tcl_Interp *interp,CURL *curlHandle,
309 struct curlObjData *curlData) {
313 if (curlOpenFiles(interp,curlData)) {
316 if (curlSetPostData(interp,curlData)) {
319 exitCode=curl_easy_perform(curlHandle);
320 resultPtr=Tcl_NewIntObj(exitCode);
321 Tcl_SetObjResult(interp,resultPtr);
322 curlCloseFiles(curlData);
323 curlResetPostData(curlData);
324 if (curlData->bodyVarName) {
325 curlSetBodyVarName(interp,curlData);
327 if (curlData->command) {
328 Tcl_GlobalEval(interp,curlData->command);
334 *----------------------------------------------------------------------
336 * curlSetOptsTransfer --
338 * This procedure is invoked when the user invokes the 'setopt'
339 * command, it is used to set the 'curl' options
342 * interp: Pointer to the interpreter we are using.
343 * curlHandle: the curl handle for which the option is set.
344 * objc and objv: The usual in Tcl.
347 * A standard Tcl result.
348 *----------------------------------------------------------------------
351 curlSetOptsTransfer(Tcl_Interp *interp, struct curlObjData *curlData,
352 int objc, Tcl_Obj *CONST objv[]) {
356 if (Tcl_GetIndexFromObj(interp, objv[2], optionTable, "option",
357 TCL_EXACT, &tableIndex)==TCL_ERROR) {
361 return curlSetOpts(interp,curlData,objv[3],tableIndex);
365 *----------------------------------------------------------------------
367 * curlConfigTransfer --
369 * This procedure is invoked by the user command 'configure', it reads
370 * the options passed by the user to configure a transfer, and passes
371 * then, one by one to 'curlSetOpts'.
374 * interp: Pointer to the interpreter we are using.
375 * curlHandle: the curl handle for which the option is set.
376 * objc and objv: The usual in Tcl.
379 * A standard Tcl result.
380 *----------------------------------------------------------------------
383 curlConfigTransfer(Tcl_Interp *interp, struct curlObjData *curlData,
384 int objc, Tcl_Obj *CONST objv[]) {
392 for(i=2,j=3;i<objc;i=i+2,j=j+2) {
393 if (Tcl_GetIndexFromObj(interp, objv[i], configTable, "option",
394 TCL_EXACT, &tableIndex)==TCL_ERROR) {
398 snprintf(errorMsg,500,"Empty value for %s",configTable[tableIndex]);
399 resultPtr=Tcl_NewStringObj(errorMsg,-1);
400 Tcl_SetObjResult(interp,resultPtr);
403 if (curlSetOpts(interp,curlData,objv[j],tableIndex)==TCL_ERROR) {
411 *----------------------------------------------------------------------
415 * This procedure takes care of setting the transfer options.
418 * interp: Pointer to the interpreter we are using.
419 * curlHandle: the curl handle for which the option is set.
420 * objv: A pointer to the object where the data to set is stored.
421 * tableIndex: The index of the option in the options table.
424 * A standard Tcl result.
425 *----------------------------------------------------------------------
428 curlSetOpts(Tcl_Interp *interp, struct curlObjData *curlData,
429 Tcl_Obj *CONST objv,int tableIndex) {
432 CURL *curlHandle=curlData->curl;
435 Tcl_Obj *resultObjPtr;
439 CONST char *startPtr;
446 unsigned char *tmpUStr;
448 Tcl_Obj **httpPostData;
450 int curlTableIndex,formaddError,formArrayIndex;
451 struct formArrayStruct *newFormArray;
452 struct curl_forms *formArray;
453 int curlformBufferSize;
456 unsigned long int protocolMask;
460 if (SetoptChar(interp,curlHandle,CURLOPT_URL,
466 Tcl_Free(curlData->outFile);
467 curlData->outFile=curlstrdup(Tcl_GetString(objv));
468 if ((strcmp(curlData->outFile,""))&&(strcmp(curlData->outFile,"stdout"))) {
472 curl_easy_setopt(curlHandle,CURLOPT_WRITEDATA,stdout);
473 curlData->outFile=NULL;
475 curl_easy_setopt(curlHandle,CURLOPT_WRITEFUNCTION,NULL);
478 Tcl_Free(curlData->inFile);
479 curlData->inFile=curlstrdup(Tcl_GetString(objv));
480 if ((strcmp(curlData->inFile,""))&&(strcmp(curlData->inFile,"stdin"))) {
483 curl_easy_setopt(curlHandle,CURLOPT_READDATA,stdin);
485 curlData->inFile=NULL;
487 curl_easy_setopt(curlHandle,CURLOPT_READFUNCTION,NULL);
490 if (SetoptChar(interp,curlHandle,
491 CURLOPT_USERAGENT,tableIndex,objv)) {
496 if (SetoptChar(interp,curlHandle,CURLOPT_REFERER,tableIndex,objv)) {
501 if (SetoptInt(interp,curlHandle,CURLOPT_VERBOSE,tableIndex,objv)) {
506 if (SetoptInt(interp,curlHandle,CURLOPT_HEADER,tableIndex,objv)) {
511 if (SetoptInt(interp,curlHandle,CURLOPT_NOBODY,tableIndex,objv)) {
516 if (SetoptChar(interp,curlHandle,CURLOPT_PROXY,tableIndex,objv)) {
521 if (SetoptLong(interp,curlHandle,CURLOPT_PROXYPORT,tableIndex,
527 if (SetoptInt(interp,curlHandle,CURLOPT_HTTPPROXYTUNNEL,tableIndex,
533 if (SetoptInt(interp,curlHandle,CURLOPT_FAILONERROR,tableIndex,
539 if (SetoptLong(interp,curlHandle,CURLOPT_TIMEOUT,tableIndex,
545 if (SetoptLong(interp,curlHandle,CURLOPT_LOW_SPEED_LIMIT,tableIndex,
551 if (SetoptLong(interp,curlHandle,CURLOPT_LOW_SPEED_TIME,tableIndex,
557 if (SetoptLong(interp,curlHandle,CURLOPT_RESUME_FROM,tableIndex,
563 if (SetoptLong(interp,curlHandle,CURLOPT_INFILESIZE,tableIndex,
569 if (SetoptInt(interp,curlHandle,CURLOPT_UPLOAD,tableIndex,
576 if (SetoptInt(interp,curlHandle,CURLOPT_DIRLISTONLY,tableIndex,
583 if (SetoptInt(interp,curlHandle,CURLOPT_APPEND,tableIndex,
589 if (Tcl_GetIndexFromObj(interp, objv, netrcTable,
590 "netrc option",TCL_EXACT,&curlTableIndex)==TCL_ERROR) {
593 if (curl_easy_setopt(curlHandle,CURLOPT_NETRC,curlTableIndex)) {
594 curlErrorSetOpt(interp,configTable,tableIndex,netrcTable[curlTableIndex]);
599 if (SetoptInt(interp,curlHandle,CURLOPT_FOLLOWLOCATION,tableIndex,
605 if (SetoptInt(interp,curlHandle,CURLOPT_TRANSFERTEXT,tableIndex,
609 Tcl_GetIntFromObj(interp,objv,&curlData->transferText);
612 if (SetoptInt(interp,curlHandle,CURLOPT_PUT,tableIndex,objv)) {
616 case 24: /* The CURLOPT_MUTE option no longer does anything.*/
619 if (SetoptChar(interp,curlHandle,CURLOPT_USERPWD,tableIndex,objv)) {
624 if (SetoptChar(interp,curlHandle,CURLOPT_PROXYUSERPWD,tableIndex,objv)) {
629 if (SetoptChar(interp,curlHandle,CURLOPT_RANGE,tableIndex,objv)) {
634 tmpStr=curlstrdup(Tcl_GetString(objv));
635 regExp=Tcl_RegExpCompile(interp,"(.*)(?:\\()(.*)(?:\\))");
636 exitCode=Tcl_RegExpExec(interp,regExp,tmpStr,tmpStr);
639 Tcl_Free((char *)tmpStr);
644 curlData->errorBufferName=curlstrdup(tmpStr);
646 curlData->errorBuffer=NULL;
648 curlData->errorBufferKey=NULL;
651 Tcl_RegExpRange(regExp,1,&startPtr,&endPtr);
652 charLength=endPtr-startPtr;
653 curlData->errorBufferName=Tcl_Alloc(charLength+1);
654 strncpy(curlData->errorBufferName,startPtr,charLength);
655 curlData->errorBufferName[charLength]=0;
656 Tcl_RegExpRange(regExp,2,&startPtr,&endPtr);
657 charLength=endPtr-startPtr;
658 curlData->errorBufferKey=Tcl_Alloc(charLength+1);
659 strncpy(curlData->errorBufferKey,startPtr,charLength);
660 curlData->errorBufferKey[charLength]=0;
663 Tcl_Free((char *)tmpStr);
664 if (curlData->errorBufferName!=NULL) {
665 curlData->errorBuffer=Tcl_Alloc(CURL_ERROR_SIZE);
666 if (curl_easy_setopt(curlHandle,CURLOPT_ERRORBUFFER,
667 curlData->errorBuffer)) {
668 Tcl_Free((char *)curlData->errorBuffer);
669 curlData->errorBuffer=NULL;
673 Tcl_Free(curlData->errorBuffer);
677 if (SetoptLong(interp,curlHandle,CURLOPT_HTTPGET,tableIndex,
683 if (SetoptInt(interp,curlHandle,CURLOPT_POST,tableIndex,objv)) {
688 if (SetoptChar(interp,curlHandle,
689 CURLOPT_COPYPOSTFIELDS,tableIndex,objv)) {
694 if (SetoptChar(interp,curlHandle,
695 CURLOPT_FTPPORT,tableIndex,objv)) {
700 if (SetoptChar(interp,curlHandle,CURLOPT_COOKIE,tableIndex,objv)) {
705 if (SetoptChar(interp,curlHandle,CURLOPT_COOKIEFILE,tableIndex,objv)) {
710 if(SetoptsList(interp,&curlData->headerList,objv)) {
711 curlErrorSetOpt(interp,configTable,tableIndex,"Header list invalid");
714 if (curl_easy_setopt(curlHandle,CURLOPT_HTTPHEADER,curlData->headerList)) {
715 curl_slist_free_all(curlData->headerList);
716 curlData->headerList=NULL;
722 if (Tcl_ListObjGetElements(interp,objv,&k,&httpPostData)
727 newFormArray=(struct formArrayStruct *)Tcl_Alloc(sizeof(struct formArrayStruct));
728 formArray=(struct curl_forms *)Tcl_Alloc(k*(sizeof(struct curl_forms)));
731 newFormArray->next=curlData->formArray;
732 newFormArray->formArray=formArray;
733 newFormArray->formHeaderList=NULL;
735 for(i=0,j=0;i<k;i+=2,j+=1) {
736 if (Tcl_GetIndexFromObj(interp,httpPostData[i],curlFormTable,
737 "CURLFORM option",TCL_EXACT,&curlTableIndex)==TCL_ERROR) {
741 switch(curlTableIndex) {
743 /* fprintf(stdout,"Section name: %s\n",Tcl_GetString(httpPostData[i+1]));*/
744 formArray[formArrayIndex].option = CURLFORM_COPYNAME;
745 formArray[formArrayIndex].value = curlstrdup(Tcl_GetString(httpPostData[i+1]));
748 /* fprintf(stdout,"Section contents: %s\n",Tcl_GetString(httpPostData[i+1]));*/
749 tmpStr=Tcl_GetStringFromObj(httpPostData[i+1],&curlformBufferSize);
750 formArray[formArrayIndex].option = CURLFORM_COPYCONTENTS;
752 formArray[formArrayIndex].value = Tcl_Alloc((curlformBufferSize > 0) ? curlformBufferSize : 1);
753 if (curlformBufferSize > 0) {
754 memcpy((char *)formArray[formArrayIndex].value,tmpStr,curlformBufferSize);
756 memset((char *)formArray[formArrayIndex].value,0,1);
760 formArray[formArrayIndex].option = CURLFORM_CONTENTSLENGTH;
761 contentslen=curlformBufferSize++;
762 formArray[formArrayIndex].value = (char *)contentslen;
765 /* fprintf(stdout,"File name %d: %s\n",formArrayIndex,Tcl_GetString(httpPostData[i+1]));*/
766 formArray[formArrayIndex].option = CURLFORM_FILE;
767 formArray[formArrayIndex].value = curlstrdup(Tcl_GetString(httpPostData[i+1]));
770 /* fprintf(stdout,"Data type: %s\n",Tcl_GetString(httpPostData[i+1]));*/
771 formArray[formArrayIndex].option = CURLFORM_CONTENTTYPE;
772 formArray[formArrayIndex].value = curlstrdup(Tcl_GetString(httpPostData[i+1]));
775 /* fprintf(stdout,"ContentHeader: %s\n",Tcl_GetString(httpPostData[i+1]));*/
776 formArray[formArrayIndex].option = CURLFORM_CONTENTHEADER;
777 if(SetoptsList(interp,&newFormArray->formHeaderList,httpPostData[i+1])) {
778 curlErrorSetOpt(interp,configTable,tableIndex,"Header list invalid");
782 formArray[formArrayIndex].value = (char *)newFormArray->formHeaderList;
785 /* fprintf(stdout,"FileName: %s\n",Tcl_GetString(httpPostData[i+1])); */
786 formArray[formArrayIndex].option = CURLFORM_FILENAME;
787 formArray[formArrayIndex].value = curlstrdup(Tcl_GetString(httpPostData[i+1]));
790 /* fprintf(stdout,"BufferName: %s\n",Tcl_GetString(httpPostData[i+1])); */
791 formArray[formArrayIndex].option = CURLFORM_BUFFER;
792 formArray[formArrayIndex].value = curlstrdup(Tcl_GetString(httpPostData[i+1]));
795 /* fprintf(stdout,"Buffer: %s\n",Tcl_GetString(httpPostData[i+1])); */
796 tmpUStr=Tcl_GetByteArrayFromObj
797 (httpPostData[i+1],&curlformBufferSize);
798 formArray[formArrayIndex].option = CURLFORM_BUFFERPTR;
799 formArray[formArrayIndex].value = (char *)
800 memcpy(Tcl_Alloc(curlformBufferSize), tmpUStr, curlformBufferSize);
802 formArray[formArrayIndex].option = CURLFORM_BUFFERLENGTH;
803 contentslen=curlformBufferSize;
804 formArray[formArrayIndex].value = (char *)contentslen;
807 /* fprintf(stdout,"FileName: %s\n",Tcl_GetString(httpPostData[i+1])); */
808 formArray[formArrayIndex].option = CURLFORM_FILECONTENT;
809 formArray[formArrayIndex].value = curlstrdup(Tcl_GetString(httpPostData[i+1]));
814 formArray[formArrayIndex].option=CURLFORM_END;
815 curlData->formArray=newFormArray;
817 if (0==formaddError) {
818 formaddError=curl_formadd(&(curlData->postListFirst)
819 ,&(curlData->postListLast), CURLFORM_ARRAY, formArray
822 if (formaddError!=CURL_FORMADD_OK) {
823 curlResetFormArray(formArray);
824 curlData->formArray=newFormArray->next;
825 Tcl_Free((char *)newFormArray);
826 tmpStr=Tcl_Alloc(10);
827 snprintf(tmpStr,10,"%d",formaddError);
828 resultObjPtr=Tcl_NewStringObj(tmpStr,-1);
829 Tcl_SetObjResult(interp,resultObjPtr);
836 if (SetoptChar(interp,curlHandle,CURLOPT_SSLCERT,tableIndex,objv)) {
841 if (SetoptChar(interp,curlHandle,CURLOPT_SSLCERTPASSWD,tableIndex,objv)) {
846 if (Tcl_GetIndexFromObj(interp, objv, sslversion,
847 "sslversion ",TCL_EXACT,&intNumber)==TCL_ERROR) {
852 longNumber=CURL_SSLVERSION_DEFAULT;
855 longNumber=CURL_SSLVERSION_TLSv1;
858 longNumber=CURL_SSLVERSION_SSLv2;
861 longNumber=CURL_SSLVERSION_SSLv3;
864 longNumber=CURL_SSLVERSION_TLSv1_0;
867 longNumber=CURL_SSLVERSION_TLSv1_1;
870 longNumber=CURL_SSLVERSION_TLSv1_2;
872 tmpObjPtr=Tcl_NewLongObj(longNumber);
873 if (SetoptLong(interp,curlHandle,CURLOPT_SSLVERSION,
874 tableIndex,tmpObjPtr)) {
879 if (SetoptInt(interp,curlHandle,CURLOPT_CRLF,tableIndex,objv)) {
884 if(SetoptsList(interp,&curlData->quote,objv)) {
885 curlErrorSetOpt(interp,configTable,tableIndex,"quote list invalid");
888 if (curl_easy_setopt(curlHandle,CURLOPT_QUOTE,curlData->quote)) {
889 curl_slist_free_all(curlData->quote);
890 curlData->quote=NULL;
896 if(SetoptsList(interp,&curlData->postquote,objv)) {
897 curlErrorSetOpt(interp,configTable,tableIndex,"postqoute invalid");
900 if (curl_easy_setopt(curlHandle,CURLOPT_POSTQUOTE,curlData->postquote)) {
901 curlErrorSetOpt(interp,configTable,tableIndex,"postqoute invalid");
902 curl_slist_free_all(curlData->postquote);
903 curlData->postquote=NULL;
909 Tcl_Free(curlData->headerFile);
910 curlData->headerFile=curlstrdup(Tcl_GetString(objv));
911 if ((strcmp(curlData->headerFile,""))&&(strcmp(curlData->headerFile,"stdout"))
912 &&(strcmp(curlData->headerFile,"stderr"))) {
913 curlData->headerFlag=1;
915 if ((strcmp(curlData->headerFile,"stdout"))) {
916 curl_easy_setopt(curlHandle,CURLOPT_HEADERDATA,stderr);
918 curl_easy_setopt(curlHandle,CURLOPT_HEADERDATA,stdout);
920 curlData->headerFlag=0;
921 curlData->headerFile=NULL;
925 if (Tcl_GetIndexFromObj(interp, objv, timeCond,
926 "time cond option",TCL_EXACT, &intNumber)==TCL_ERROR) {
930 longNumber=CURL_TIMECOND_IFMODSINCE;
932 longNumber=CURL_TIMECOND_IFUNMODSINCE;
934 if (curl_easy_setopt(curlHandle,CURLOPT_TIMECONDITION,longNumber)) {
939 if (SetoptLong(interp,curlHandle,CURLOPT_TIMEVALUE,tableIndex,
945 if (SetoptChar(interp,curlHandle,CURLOPT_CUSTOMREQUEST,tableIndex,objv)) {
950 Tcl_Free(curlData->stderrFile);
951 curlData->stderrFile=curlstrdup(Tcl_GetString(objv));
952 if ((strcmp(curlData->stderrFile,""))&&(strcmp(curlData->stderrFile,"stdout"))
953 &&(strcmp(curlData->stderrFile,"stderr"))) {
954 curlData->stderrFlag=1;
956 curlData->stderrFlag=0;
957 if (strcmp(curlData->stderrFile,"stdout")) {
958 curl_easy_setopt(curlHandle,CURLOPT_STDERR,stderr);
960 curl_easy_setopt(curlHandle,CURLOPT_STDERR,stdout);
962 curlData->stderrFile=NULL;
966 if (SetoptChar(interp,curlHandle,CURLOPT_INTERFACE,tableIndex,objv)) {
972 if (SetoptChar(interp,curlHandle,CURLOPT_KRBLEVEL,tableIndex,objv)) {
977 if (SetoptLong(interp,curlHandle,CURLOPT_SSL_VERIFYPEER,tableIndex,
983 if (SetoptChar(interp,curlHandle,CURLOPT_CAINFO,tableIndex,objv)) {
988 if (SetoptLong(interp,curlHandle,CURLOPT_FILETIME,tableIndex,
994 if (SetoptLong(interp,curlHandle,CURLOPT_MAXREDIRS,tableIndex,
1000 if (SetoptLong(interp,curlHandle,CURLOPT_MAXCONNECTS,tableIndex,
1006 curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1010 if (SetoptChar(interp,curlHandle,CURLOPT_RANDOM_FILE,tableIndex,objv)) {
1015 if (SetoptChar(interp,curlHandle,CURLOPT_EGDSOCKET,tableIndex,objv)) {
1020 if (SetoptLong(interp,curlHandle,CURLOPT_CONNECTTIMEOUT,
1026 if (SetoptLong(interp,curlHandle,CURLOPT_NOPROGRESS,
1032 if (curl_easy_setopt(curlHandle,CURLOPT_HEADERFUNCTION,
1033 curlHeaderReader)) {
1036 Tcl_Free(curlData->headerVar);
1037 curlData->headerVar=curlstrdup(Tcl_GetString(objv));
1038 if (curl_easy_setopt(curlHandle,CURLOPT_HEADERDATA,
1039 (FILE *)curlData)) {
1044 Tcl_Free(curlData->bodyVarName);
1045 curlData->bodyVarName=curlstrdup(Tcl_GetString(objv));
1046 if (curl_easy_setopt(curlHandle,CURLOPT_WRITEFUNCTION,
1050 if (curl_easy_setopt(curlHandle,CURLOPT_WRITEDATA,curlData)) {
1055 Tcl_Free(curlData->progressProc);
1056 curlData->progressProc=curlstrdup(Tcl_GetString(objv));
1057 if (strcmp(curlData->progressProc,"")) {
1058 if (curl_easy_setopt(curlHandle,CURLOPT_PROGRESSFUNCTION,
1059 curlProgressCallback)) {
1062 if (curl_easy_setopt(curlHandle,CURLOPT_PROGRESSDATA,
1067 if (curl_easy_setopt(curlHandle,CURLOPT_PROGRESSFUNCTION,NULL)) {
1073 if (curlData->cancelTransVarName) {
1074 Tcl_UnlinkVar(curlData->interp,curlData->cancelTransVarName);
1075 Tcl_Free(curlData->cancelTransVarName);
1077 curlData->cancelTransVarName=curlstrdup(Tcl_GetString(objv));
1078 Tcl_LinkVar(interp,curlData->cancelTransVarName,
1079 (char *)&(curlData->cancelTrans),TCL_LINK_INT);
1082 curlData->writeProc=curlstrdup(Tcl_GetString(objv));
1083 curlData->outFlag=0;
1084 if (curl_easy_setopt(curlHandle,CURLOPT_WRITEFUNCTION,
1085 curlWriteProcInvoke)) {
1086 curl_easy_setopt(curlHandle,CURLOPT_WRITEFUNCTION,NULL);
1089 if (curl_easy_setopt(curlHandle,CURLOPT_WRITEDATA,curlData)) {
1090 curl_easy_setopt(curlHandle,CURLOPT_WRITEFUNCTION,NULL);
1095 curlData->readProc=curlstrdup(Tcl_GetString(objv));
1097 if (strcmp(curlData->readProc,"")) {
1098 if (curl_easy_setopt(curlHandle,CURLOPT_READFUNCTION,
1099 curlReadProcInvoke)) {
1103 curl_easy_setopt(curlHandle,CURLOPT_READFUNCTION,NULL);
1106 if (curl_easy_setopt(curlHandle,CURLOPT_READDATA,curlData)) {
1111 if (SetoptLong(interp,curlHandle,CURLOPT_SSL_VERIFYHOST,
1117 if (SetoptChar(interp,curlHandle,CURLOPT_COOKIEJAR,tableIndex,objv)) {
1122 if (SetoptChar(interp,curlHandle,CURLOPT_SSL_CIPHER_LIST,tableIndex,objv)) {
1127 if (Tcl_GetIndexFromObj(interp, objv, httpVersionTable,
1128 "http version",TCL_EXACT,&tableIndex)==TCL_ERROR) {
1131 if (curl_easy_setopt(curlHandle,CURLOPT_HTTP_VERSION,
1133 tmpStr=curlstrdup(Tcl_GetString(objv));
1134 curlErrorSetOpt(interp,configTable,70,tmpStr);
1140 if (SetoptLong(interp,curlHandle,CURLOPT_FTP_USE_EPSV,
1146 if (SetoptChar(interp,curlHandle,CURLOPT_SSLCERTTYPE,tableIndex,objv)) {
1151 if (SetoptChar(interp,curlHandle,CURLOPT_SSLKEY,tableIndex,objv)) {
1156 if (SetoptChar(interp,curlHandle,CURLOPT_SSLKEYTYPE,tableIndex,objv)) {
1162 if (SetoptChar(interp,curlHandle,CURLOPT_KEYPASSWD,tableIndex,objv)) {
1167 if (SetoptChar(interp,curlHandle,CURLOPT_SSLENGINE,tableIndex,objv)) {
1172 if (SetoptLong(interp,curlHandle,CURLOPT_SSLENGINE_DEFAULT,tableIndex,objv)) {
1177 if(SetoptsList(interp,&curlData->prequote,objv)) {
1178 curlErrorSetOpt(interp,configTable,tableIndex,"pretqoute invalid");
1181 if (curl_easy_setopt(curlHandle,CURLOPT_PREQUOTE,curlData->prequote)) {
1182 curlErrorSetOpt(interp,configTable,tableIndex,"preqoute invalid");
1183 curl_slist_free_all(curlData->prequote);
1184 curlData->prequote=NULL;
1190 curlData->debugProc=curlstrdup(Tcl_GetString(objv));
1191 if (curl_easy_setopt(curlHandle,CURLOPT_DEBUGFUNCTION,
1192 curlDebugProcInvoke)) {
1195 if (curl_easy_setopt(curlHandle,CURLOPT_DEBUGDATA,curlData)) {
1200 if (SetoptLong(interp,curlHandle,CURLOPT_DNS_CACHE_TIMEOUT,
1206 if (SetoptLong(interp,curlHandle,CURLOPT_DNS_USE_GLOBAL_CACHE,
1212 if (SetoptLong(interp,curlHandle,CURLOPT_COOKIESESSION,
1218 if (SetoptChar(interp,curlHandle,CURLOPT_CAPATH,tableIndex,objv)) {
1223 if (SetoptLong(interp,curlHandle,CURLOPT_BUFFERSIZE,
1229 if (SetoptLong(interp,curlHandle,CURLOPT_NOSIGNAL,
1235 if (Tcl_GetIndexFromObj(interp, objv, encodingTable,
1236 "encoding",TCL_EXACT,&tableIndex)==TCL_ERROR) {
1239 if (tableIndex==2) {
1240 if (curl_easy_setopt(curlHandle,CURLOPT_ACCEPT_ENCODING,"")) {
1241 curlErrorSetOpt(interp,configTable,86,"all");
1245 if (SetoptChar(interp,curlHandle,CURLOPT_ACCEPT_ENCODING,86,objv)) {
1251 if (Tcl_GetIndexFromObj(interp, objv, proxyTypeTable,
1252 "proxy type",TCL_EXACT,&tableIndex)==TCL_ERROR) {
1255 switch(tableIndex) {
1257 curl_easy_setopt(curlHandle,CURLOPT_PROXYTYPE,
1261 curl_easy_setopt(curlHandle,CURLOPT_PROXYTYPE,
1262 CURLPROXY_HTTP_1_0);
1265 curl_easy_setopt(curlHandle,CURLOPT_PROXYTYPE,
1269 curl_easy_setopt(curlHandle,CURLOPT_PROXYTYPE,
1273 curl_easy_setopt(curlHandle,CURLOPT_PROXYTYPE,
1277 curl_easy_setopt(curlHandle,CURLOPT_PROXYTYPE,
1278 CURLPROXY_SOCKS5_HOSTNAME);
1282 if(SetoptsList(interp,&curlData->http200aliases,objv)) {
1283 curlErrorSetOpt(interp,configTable,tableIndex,"http200aliases invalid");
1286 if (curl_easy_setopt(curlHandle,CURLOPT_HTTP200ALIASES,curlData->http200aliases)) {
1287 curlErrorSetOpt(interp,configTable,tableIndex,"http200aliases invalid");
1288 curl_slist_free_all(curlData->http200aliases);
1289 curlData->http200aliases=NULL;
1295 if (SetoptInt(interp,curlHandle,CURLOPT_UNRESTRICTED_AUTH
1296 ,tableIndex,objv)) {
1301 if (SetoptLong(interp,curlHandle,CURLOPT_FTP_USE_EPRT,
1307 Tcl_Free(curlData->command);
1308 curlData->command=curlstrdup(Tcl_GetString(objv));
1311 if (Tcl_GetIndexFromObj(interp, objv, httpAuthMethods,
1312 "authentication method",TCL_EXACT,&intNumber)==TCL_ERROR) {
1315 curlData->anyAuthFlag=0;
1318 longNumber=CURLAUTH_BASIC;
1321 longNumber=CURLAUTH_DIGEST;
1324 longNumber=CURLAUTH_DIGEST_IE;
1327 longNumber=CURLAUTH_GSSNEGOTIATE;
1330 longNumber=CURLAUTH_NTLM;
1333 longNumber=CURLAUTH_ANY;
1334 curlData->anyAuthFlag=1;
1337 longNumber=CURLAUTH_ANYSAFE;
1340 longNumber=CURLAUTH_NTLM_WB;
1343 tmpObjPtr=Tcl_NewLongObj(longNumber);
1344 if (SetoptLong(interp,curlHandle,CURLOPT_HTTPAUTH
1345 ,tableIndex,tmpObjPtr)) {
1350 if (SetoptLong(interp,curlHandle,CURLOPT_FTP_CREATE_MISSING_DIRS,
1356 if (Tcl_GetIndexFromObj(interp, objv, httpAuthMethods,
1357 "authentication method",TCL_EXACT,&intNumber)==TCL_ERROR) {
1362 longNumber=CURLAUTH_BASIC;
1365 longNumber=CURLAUTH_DIGEST;
1368 longNumber=CURLAUTH_GSSNEGOTIATE;
1371 longNumber=CURLAUTH_NTLM;
1374 longNumber=CURLAUTH_ANYSAFE;
1378 longNumber=CURLAUTH_ANY;
1381 tmpObjPtr=Tcl_NewLongObj(longNumber);
1382 if (SetoptLong(interp,curlHandle,CURLOPT_PROXYAUTH
1383 ,tableIndex,tmpObjPtr)) {
1388 if (SetoptLong(interp,curlHandle,CURLOPT_FTP_RESPONSE_TIMEOUT,
1394 if (Tcl_GetIndexFromObj(interp, objv, ipresolve,
1395 "ip version",TCL_EXACT,&curlTableIndex)==TCL_ERROR) {
1398 switch(curlTableIndex) {
1400 longNumber=CURL_IPRESOLVE_WHATEVER;
1403 longNumber=CURL_IPRESOLVE_V4;
1406 longNumber=CURL_IPRESOLVE_V6;
1409 tmpObjPtr=Tcl_NewLongObj(longNumber);
1410 if (SetoptLong(interp,curlHandle,CURLOPT_IPRESOLVE
1411 ,tableIndex,tmpObjPtr)) {
1416 if (SetoptLong(interp,curlHandle,CURLOPT_MAXFILESIZE,
1422 if (SetoptChar(interp,curlHandle,CURLOPT_NETRC_FILE,tableIndex,objv)) {
1428 if (Tcl_GetIndexFromObj(interp, objv, ftpssl,
1429 "ftps method ",TCL_EXACT,&intNumber)==TCL_ERROR) {
1434 longNumber=CURLUSESSL_NONE;
1437 longNumber=CURLUSESSL_TRY;
1440 longNumber=CURLUSESSL_CONTROL;
1443 longNumber=CURLUSESSL_ALL;
1446 tmpObjPtr=Tcl_NewLongObj(longNumber);
1447 if (SetoptLong(interp,curlHandle,CURLOPT_USE_SSL,
1448 tableIndex,tmpObjPtr)) {
1453 if (SetoptSHandle(interp,curlHandle,CURLOPT_SHARE,
1459 if (SetoptLong(interp,curlHandle,CURLOPT_PORT,
1465 if (SetoptLong(interp,curlHandle,CURLOPT_TCP_NODELAY,
1471 if (SetoptLong(interp,curlHandle,CURLOPT_AUTOREFERER,
1477 curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1481 curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1485 curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1489 curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete, check '-ftpport'");
1493 curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete, check '-ftpport'");
1497 curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1501 curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1505 if (Tcl_GetIndexFromObj(interp, objv, ftpsslauth,
1506 "ftpsslauth method ",TCL_EXACT,&intNumber)==TCL_ERROR) {
1511 longNumber=CURLFTPAUTH_DEFAULT;
1514 longNumber=CURLFTPAUTH_SSL;
1517 longNumber=CURLFTPAUTH_TLS;
1520 tmpObjPtr=Tcl_NewLongObj(longNumber);
1521 if (SetoptLong(interp,curlHandle,CURLOPT_FTPSSLAUTH,
1522 tableIndex,tmpObjPtr)) {
1527 curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1531 curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1535 if (SetoptChar(interp,curlHandle,CURLOPT_FTP_ACCOUNT,tableIndex,objv)) {
1540 if (SetoptLong(interp,curlHandle,CURLOPT_IGNORE_CONTENT_LENGTH,
1546 if (SetoptChar(interp,curlHandle,CURLOPT_COOKIELIST,tableIndex,objv)) {
1551 if (SetoptLong(interp,curlHandle,CURLOPT_FTP_SKIP_PASV_IP,
1557 if (Tcl_GetIndexFromObj(interp, objv, ftpfilemethod,
1558 "ftp file method ",TCL_EXACT,&intNumber)==TCL_ERROR) {
1564 longNumber=1; /* FTPFILE_MULTICWD */
1567 longNumber=2; /* FTPFILE_NOCWD */
1570 longNumber=3; /* FTPFILE_SINGLECWD */
1573 tmpObjPtr=Tcl_NewLongObj(longNumber);
1574 if (SetoptLong(interp,curlHandle,CURLOPT_FTP_FILEMETHOD,
1575 tableIndex,tmpObjPtr)) {
1580 if (SetoptLong(interp,curlHandle,CURLOPT_LOCALPORT,
1586 if (SetoptLong(interp,curlHandle,CURLOPT_LOCALPORTRANGE,
1592 if (SetoptCurlOffT(interp,curlHandle,CURLOPT_MAX_SEND_SPEED_LARGE,
1598 if (SetoptCurlOffT(interp,curlHandle,CURLOPT_MAX_RECV_SPEED_LARGE,
1604 if (SetoptChar(interp,curlHandle,
1605 CURLOPT_FTP_ALTERNATIVE_TO_USER,tableIndex,objv)) {
1610 if (SetoptLong(interp,curlHandle,CURLOPT_SSL_SESSIONID_CACHE,
1616 if (Tcl_GetIndexFromObj(interp, objv, sshauthtypes,
1617 "ssh auth type ",TCL_EXACT,&intNumber)==TCL_ERROR) {
1622 longNumber=CURLSSH_AUTH_PUBLICKEY;
1625 longNumber=CURLSSH_AUTH_PASSWORD;
1628 longNumber=CURLSSH_AUTH_HOST;
1631 longNumber=CURLSSH_AUTH_KEYBOARD;
1634 longNumber=CURLSSH_AUTH_ANY;
1637 tmpObjPtr=Tcl_NewLongObj(longNumber);
1638 if (SetoptLong(interp,curlHandle,CURLOPT_SSH_AUTH_TYPES,
1639 tableIndex,tmpObjPtr)) {
1644 if (SetoptChar(interp,curlHandle,CURLOPT_SSH_PUBLIC_KEYFILE,
1650 if (SetoptChar(interp,curlHandle,CURLOPT_SSH_PRIVATE_KEYFILE,
1656 if (SetoptLong(interp,curlHandle,CURLOPT_TIMEOUT_MS,
1662 if (SetoptLong(interp,curlHandle,CURLOPT_CONNECTTIMEOUT_MS,
1668 if (SetoptLong(interp,curlHandle,CURLOPT_HTTP_CONTENT_DECODING,
1674 if (SetoptLong(interp,curlHandle,CURLOPT_HTTP_TRANSFER_DECODING,
1679 /* 132 is together with case 50 */
1681 if (SetoptLong(interp,curlHandle,CURLOPT_NEW_FILE_PERMS,
1687 if (SetoptLong(interp,curlHandle,CURLOPT_NEW_DIRECTORY_PERMS,
1692 /* case 135 with 75, case 136 with 19, case 137 with 18 and case 138 with 99 */
1695 if (Tcl_GetIndexFromObj(interp, objv, postredir,
1696 "Postredir option ",TCL_EXACT,&intNumber)==TCL_ERROR) {
1701 longNumber=CURL_REDIR_POST_301;
1704 longNumber=CURL_REDIR_POST_302;
1707 longNumber=CURL_REDIR_POST_ALL;
1710 tmpObjPtr=Tcl_NewLongObj(longNumber);
1711 if (SetoptLong(interp,curlHandle,CURLOPT_POSTREDIR,
1712 tableIndex,tmpObjPtr)) {
1717 if (SetoptChar(interp,curlHandle,CURLOPT_SSH_HOST_PUBLIC_KEY_MD5,
1723 if (SetoptLong(interp,curlHandle,CURLOPT_PROXY_TRANSFER_MODE,
1729 if (SetoptChar(interp,curlHandle,CURLOPT_CRLFILE,
1735 if (SetoptChar(interp,curlHandle,CURLOPT_ISSUERCERT,
1741 if (SetoptLong(interp,curlHandle,CURLOPT_ADDRESS_SCOPE,
1747 if (SetoptLong(interp,curlHandle,CURLOPT_CERTINFO,
1752 /* case 146 is together with 139*/
1754 if (SetoptChar(interp,curlHandle,CURLOPT_USERNAME,
1760 if (SetoptChar(interp,curlHandle,CURLOPT_PASSWORD,
1766 if (SetoptChar(interp,curlHandle,CURLOPT_PROXYUSERNAME,
1772 if (SetoptChar(interp,curlHandle,CURLOPT_PROXYPASSWORD,
1778 if (SetoptLong(interp,curlHandle,CURLOPT_TFTP_BLKSIZE,
1784 if (SetoptChar(interp,curlHandle,CURLOPT_SOCKS5_GSSAPI_SERVICE,
1790 if (SetoptLong(interp,curlHandle,CURLOPT_SOCKS5_GSSAPI_NEC,
1797 if (Tcl_ListObjGetElements(interp,objv,&j,&protocols)==TCL_ERROR) {
1801 for (i=0,protocolMask=0;i<j;i++) {
1802 tmpStr=curlstrdup(Tcl_GetString(protocols[i]));
1803 if (Tcl_GetIndexFromObj(interp,protocols[i],protocolNames,
1804 "protocol",TCL_EXACT,&curlTableIndex)==TCL_ERROR) {
1807 switch(curlTableIndex) {
1808 case 0: /* http 1 */
1809 protocolMask|=CURLPROTO_HTTP;
1811 case 1: /* https 2 */
1812 protocolMask|=CURLPROTO_HTTPS;
1815 protocolMask|=CURLPROTO_FTP;
1817 case 3: /* ftps 8 */
1818 protocolMask|=CURLPROTO_FTPS;
1820 case 4: /* scp 16 */
1821 protocolMask|=CURLPROTO_SCP;
1823 case 5: /* sftp 32 */
1824 protocolMask|=CURLPROTO_SFTP;
1826 case 6: /* telnet 64 */
1827 protocolMask|=CURLPROTO_TELNET;
1829 case 7: /* ldap 128 */
1830 protocolMask|=CURLPROTO_LDAP;
1832 case 8: /* ldaps 256 */
1833 protocolMask|=CURLPROTO_LDAPS;
1835 case 9: /* dict 512 */
1836 protocolMask|=CURLPROTO_DICT;
1838 case 10: /* file 1024 */
1839 protocolMask|=CURLPROTO_FILE;
1841 case 11: /* tftp 2048 */
1842 protocolMask|=CURLPROTO_TFTP;
1844 case 12: /* imap 4096 */
1845 protocolMask|=CURLPROTO_IMAP;
1847 case 13: /* imaps */
1848 protocolMask|=CURLPROTO_IMAPS;
1851 protocolMask|=CURLPROTO_POP3;
1853 case 15: /* pop3s */
1854 protocolMask|=CURLPROTO_POP3S;
1857 protocolMask|=CURLPROTO_SMTP;
1859 case 17: /* smtps */
1860 protocolMask|=CURLPROTO_SMTPS;
1863 protocolMask|=CURLPROTO_RTSP;
1866 protocolMask|=CURLPROTO_RTMP;
1868 case 20: /* rtmpt */
1869 protocolMask|=CURLPROTO_RTMPT;
1871 case 21: /* rtmpe */
1872 protocolMask|=CURLPROTO_RTMPE;
1874 case 22: /* rtmpte */
1875 protocolMask|=CURLPROTO_RTMPTE;
1877 case 23: /* rtmps */
1878 protocolMask|=CURLPROTO_RTMPS;
1880 case 24: /* rtmpts */
1881 protocolMask|=CURLPROTO_RTMPTS;
1883 case 25: /* gopher */
1884 protocolMask|=CURLPROTO_GOPHER;
1886 case 26: /* all FFFF */
1887 protocolMask|=CURLPROTO_ALL;
1890 tmpObjPtr=Tcl_NewLongObj(protocolMask);
1891 if (tableIndex==154) {
1892 longNumber=CURLOPT_PROTOCOLS;
1894 longNumber=CURLOPT_REDIR_PROTOCOLS;
1896 if (SetoptLong(interp,curlHandle,longNumber,tableIndex,tmpObjPtr)) {
1901 if (Tcl_GetIndexFromObj(interp, objv, ftpsslccc,
1902 "Clear Command Channel option ",TCL_EXACT,&intNumber)==TCL_ERROR) {
1907 longNumber=CURLFTPSSL_CCC_NONE;
1910 longNumber=CURLFTPSSL_CCC_PASSIVE;
1913 longNumber=CURLFTPSSL_CCC_ACTIVE;
1916 tmpObjPtr=Tcl_NewLongObj(longNumber);
1917 if (SetoptLong(interp,curlHandle,CURLOPT_FTP_SSL_CCC,
1918 tableIndex,tmpObjPtr)) {
1923 if (SetoptChar(interp,curlHandle,CURLOPT_SSH_KNOWNHOSTS,
1929 if (curl_easy_setopt(curlHandle,CURLOPT_SSH_KEYFUNCTION,curlsshkeycallback)) {
1932 if (curl_easy_setopt(curlHandle,CURLOPT_SSH_KEYDATA,curlData)) {
1935 curlData->sshkeycallProc=curlstrdup(Tcl_GetString(objv));
1938 if (SetoptChar(interp,curlHandle,CURLOPT_MAIL_FROM,
1944 if(SetoptsList(interp,&curlData->mailrcpt,objv)) {
1945 curlErrorSetOpt(interp,configTable,tableIndex,"mailrcpt invalid");
1948 if (curl_easy_setopt(curlHandle,CURLOPT_MAIL_RCPT,curlData->mailrcpt)) {
1949 curlErrorSetOpt(interp,configTable,tableIndex,"mailrcpt invalid");
1950 curl_slist_free_all(curlData->mailrcpt);
1951 curlData->mailrcpt=NULL;
1957 if (SetoptLong(interp,curlHandle,CURLOPT_FTP_USE_PRET,
1963 if (SetoptLong(interp,curlHandle,CURLOPT_WILDCARDMATCH,
1969 curlData->chunkBgnProc=curlstrdup(Tcl_GetString(objv));
1970 if (strcmp(curlData->chunkBgnProc,"")) {
1971 if (curl_easy_setopt(curlHandle,CURLOPT_CHUNK_BGN_FUNCTION,
1972 curlChunkBgnProcInvoke)) {
1976 curl_easy_setopt(curlHandle,CURLOPT_CHUNK_BGN_FUNCTION,NULL);
1979 if (curl_easy_setopt(curlHandle,CURLOPT_CHUNK_DATA,curlData)) {
1984 curlData->chunkBgnVar=curlstrdup(Tcl_GetString(objv));
1985 if (!strcmp(curlData->chunkBgnVar,"")) {
1986 curlErrorSetOpt(interp,configTable,tableIndex,"invalid var name");
1991 curlData->chunkEndProc=curlstrdup(Tcl_GetString(objv));
1992 if (strcmp(curlData->chunkEndProc,"")) {
1993 if (curl_easy_setopt(curlHandle,CURLOPT_CHUNK_END_FUNCTION,
1994 curlChunkEndProcInvoke)) {
1998 curl_easy_setopt(curlHandle,CURLOPT_CHUNK_END_FUNCTION,NULL);
2003 curlData->fnmatchProc=curlstrdup(Tcl_GetString(objv));
2004 if (strcmp(curlData->fnmatchProc,"")) {
2005 if (curl_easy_setopt(curlHandle,CURLOPT_FNMATCH_FUNCTION,
2006 curlfnmatchProcInvoke)) {
2010 curl_easy_setopt(curlHandle,CURLOPT_FNMATCH_FUNCTION,NULL);
2013 if (curl_easy_setopt(curlHandle,CURLOPT_FNMATCH_DATA,curlData)) {
2018 if(SetoptsList(interp,&curlData->resolve,objv)) {
2019 curlErrorSetOpt(interp,configTable,tableIndex,"invalid list");
2022 if (curl_easy_setopt(curlHandle,CURLOPT_RESOLVE,curlData->resolve)) {
2023 curlErrorSetOpt(interp,configTable,tableIndex,"resolve list invalid");
2024 curl_slist_free_all(curlData->resolve);
2025 curlData->resolve=NULL;
2031 if (SetoptChar(interp,curlHandle,CURLOPT_TLSAUTH_USERNAME,
2037 if (SetoptChar(interp,curlHandle,CURLOPT_TLSAUTH_PASSWORD,
2043 if (Tcl_GetIndexFromObj(interp, objv, tlsauth,
2044 "TSL auth option ",TCL_EXACT,&intNumber)==TCL_ERROR) {
2049 longNumber=CURL_TLSAUTH_NONE;
2052 longNumber=CURL_TLSAUTH_SRP;
2054 tmpObjPtr=Tcl_NewLongObj(longNumber);
2055 if (SetoptLong(interp,curlHandle,CURLOPT_TLSAUTH_TYPE,
2056 tableIndex,tmpObjPtr)) {
2061 if (SetoptLong(interp,curlHandle,CURLOPT_TRANSFER_ENCODING,
2067 if (Tcl_GetIndexFromObj(interp, objv, gssapidelegation,
2068 "GSS API delegation option ",TCL_EXACT,&intNumber)==TCL_ERROR) {
2073 longNumber=CURLGSSAPI_DELEGATION_FLAG;
2076 longNumber=CURLGSSAPI_DELEGATION_POLICY_FLAG;
2078 tmpObjPtr=Tcl_NewLongObj(longNumber);
2079 if (SetoptLong(interp,curlHandle,CURLOPT_GSSAPI_DELEGATION,
2080 tableIndex,tmpObjPtr)) {
2085 if (SetoptChar(interp,curlHandle,CURLOPT_NOPROXY,
2091 if(SetoptsList(interp,&curlData->telnetoptions,objv)) {
2092 curlErrorSetOpt(interp,configTable,tableIndex,"invalid list");
2095 if (curl_easy_setopt(curlHandle,CURLOPT_TELNETOPTIONS,curlData->telnetoptions)) {
2096 curlErrorSetOpt(interp,configTable,tableIndex,"telnetoptions list invalid");
2097 curl_slist_free_all(curlData->telnetoptions);
2098 curlData->telnetoptions=NULL;
2108 *----------------------------------------------------------------------
2112 * Sets the curl options that require an int
2115 * interp: The interpreter we are working with.
2116 * curlHandle: and the curl handle
2117 * opt: the option to set
2118 * tclObj: The Tcl with the value for the option.
2121 * 0 if all went well.
2122 * 1 in case of error.
2123 *----------------------------------------------------------------------
2126 SetoptInt(Tcl_Interp *interp,CURL *curlHandle,CURLoption opt,
2127 int tableIndex,Tcl_Obj *tclObj) {
2131 if (Tcl_GetIntFromObj(interp,tclObj,&intNumber)) {
2132 parPtr=curlstrdup(Tcl_GetString(tclObj));
2133 curlErrorSetOpt(interp,configTable,tableIndex,parPtr);
2137 if (curl_easy_setopt(curlHandle,opt,intNumber)) {
2138 parPtr=curlstrdup(Tcl_GetString(tclObj));
2139 curlErrorSetOpt(interp,configTable,tableIndex,parPtr);
2147 *----------------------------------------------------------------------
2151 * Set the curl options that require a long
2154 * interp: The interpreter we are working with.
2155 * curlHandle: and the curl handle
2156 * opt: the option to set
2157 * tclObj: The Tcl with the value for the option.
2160 * 0 if all went well.
2161 * 1 in case of error.
2162 *----------------------------------------------------------------------
2165 SetoptLong(Tcl_Interp *interp,CURL *curlHandle,CURLoption opt,
2166 int tableIndex,Tcl_Obj *tclObj) {
2170 if (Tcl_GetLongFromObj(interp,tclObj,&longNumber)) {
2171 parPtr=curlstrdup(Tcl_GetString(tclObj));
2172 curlErrorSetOpt(interp,configTable,tableIndex,parPtr);
2176 if (curl_easy_setopt(curlHandle,opt,longNumber)) {
2177 parPtr=curlstrdup(Tcl_GetString(tclObj));
2178 curlErrorSetOpt(interp,configTable,tableIndex,parPtr);
2187 *----------------------------------------------------------------------
2189 * curlSetoptCurlOffT --
2191 * Set the curl options that require a curl_off_t, even if we really
2192 * use a long to do it. (Cutting and pasting at its worst)
2195 * interp: The interpreter we are working with.
2196 * curlHandle: and the curl handle
2197 * opt: the option to set
2198 * tclObj: The Tcl with the value for the option.
2201 * 0 if all went well.
2202 * 1 in case of error.
2203 *----------------------------------------------------------------------
2206 SetoptCurlOffT(Tcl_Interp *interp,CURL *curlHandle,CURLoption opt,
2207 int tableIndex,Tcl_Obj *tclObj) {
2211 if (Tcl_GetLongFromObj(interp,tclObj,&longNumber)) {
2212 parPtr=curlstrdup(Tcl_GetString(tclObj));
2213 curlErrorSetOpt(interp,configTable,tableIndex,parPtr);
2218 if (curl_easy_setopt(curlHandle,opt,(curl_off_t)longNumber)) {
2219 parPtr=curlstrdup(Tcl_GetString(tclObj));
2220 curlErrorSetOpt(interp,configTable,tableIndex,parPtr);
2230 *----------------------------------------------------------------------
2234 * Set the curl options that require a string
2237 * interp: The interpreter we are working with.
2238 * curlHandle: and the curl handle
2239 * opt: the option to set
2240 * tclObj: The Tcl with the value for the option.
2243 * 0 if all went well.
2244 * 1 in case of error.
2245 *----------------------------------------------------------------------
2248 SetoptChar(Tcl_Interp *interp,CURL *curlHandle,
2249 CURLoption opt,int tableIndex,Tcl_Obj *tclObj) {
2252 optionPtr=curlstrdup(Tcl_GetString(tclObj));
2253 if (curl_easy_setopt(curlHandle,opt,optionPtr)) {
2254 curlErrorSetOpt(interp,configTable,tableIndex,optionPtr);
2255 Tcl_Free(optionPtr);
2258 Tcl_Free(optionPtr);
2263 *----------------------------------------------------------------------
2267 * Set the curl options that require a share handle (there is only
2268 * one but you never know.
2271 * interp: The interpreter we are working with.
2272 * curlHandle: the curl handle
2273 * opt: the option to set
2274 * tclObj: The Tcl with the value for the option.
2277 * 0 if all went well.
2278 * 1 in case of error.
2279 *----------------------------------------------------------------------
2282 SetoptSHandle(Tcl_Interp *interp,CURL *curlHandle,
2283 CURLoption opt,int tableIndex,Tcl_Obj *tclObj) {
2286 Tcl_CmdInfo *infoPtr=(Tcl_CmdInfo *)Tcl_Alloc(sizeof(Tcl_CmdInfo));
2287 struct shcurlObjData *shandleDataPtr;
2289 shandleName=Tcl_GetString(tclObj);
2290 if (0==Tcl_GetCommandInfo(interp,shandleName,infoPtr)) {
2293 shandleDataPtr=(struct shcurlObjData *)(infoPtr->objClientData);
2294 Tcl_Free((char *)infoPtr);
2295 if (curl_easy_setopt(curlHandle,opt,shandleDataPtr->shandle)) {
2296 curlErrorSetOpt(interp,configTable,tableIndex,shandleName);
2303 *----------------------------------------------------------------------
2307 * Prepares a slist for future use.
2310 * slistPtr: Pointer to the slist to prepare.
2311 * objv: Tcl object with a list of the data.
2314 * 0 if all went well.
2315 * 1 in case of error.
2316 *----------------------------------------------------------------------
2319 SetoptsList(Tcl_Interp *interp,struct curl_slist **slistPtr,
2320 Tcl_Obj *CONST objv) {
2324 if (slistPtr!=NULL) {
2325 curl_slist_free_all(*slistPtr);
2329 if (Tcl_ListObjGetElements(interp,objv,&headerNumber,&headers)
2334 for (i=0;i<headerNumber;i++) {
2335 *slistPtr=curl_slist_append(*slistPtr,Tcl_GetString(headers[i]));
2336 if (slistPtr==NULL) {
2344 *----------------------------------------------------------------------
2346 * curlErrorSetOpt --
2348 * When an error happens when setting an option, this function
2349 * takes cares of reporting it
2352 * interp: Pointer to the interpreter we are using.
2353 * option: The index of the option in 'optionTable'
2354 * parPtr: String with the parameter we wanted to set the option to.
2355 *----------------------------------------------------------------------
2359 curlErrorSetOpt(Tcl_Interp *interp,CONST char **configTable, int option,
2360 CONST char *parPtr) {
2364 snprintf(errorMsg,500,"setting option %s: %s",configTable[option],parPtr);
2365 resultPtr=Tcl_NewStringObj(errorMsg,-1);
2366 Tcl_SetObjResult(interp,resultPtr);
2370 *----------------------------------------------------------------------
2374 * This is the function that will be invoked if the user wants to put
2375 * the headers into a variable
2378 * header: string with the header line.
2379 * size and nmemb: it so happens size * nmemb if the size of the
2381 * curlData: A pointer to the curlData structure for the transfer.
2384 * The number of bytes actually written or -1 in case of error, in
2385 * which case 'libcurl' will abort the transfer.
2386 *-----------------------------------------------------------------------
2389 curlHeaderReader(void *ptr,size_t size,size_t nmemb,FILE *curlDataPtr) {
2392 struct curlObjData *curlData=(struct curlObjData *)curlDataPtr;
2395 CONST char *startPtr;
2399 char *headerContent;
2402 int match,charLength;
2404 regExp=Tcl_RegExpCompile(curlData->interp,"(.*?)(?::\\s*)(.*?)(\\r*)(\\n)");
2405 match=Tcl_RegExpExec(curlData->interp,regExp,header,header);
2408 Tcl_RegExpRange(regExp,1,&startPtr,&endPtr);
2409 charLength=endPtr-startPtr;
2410 headerName=Tcl_Alloc(charLength+1);
2411 strncpy(headerName,startPtr,charLength);
2412 headerName[charLength]=0;
2414 Tcl_RegExpRange(regExp,2,&startPtr,&endPtr);
2415 charLength=endPtr-startPtr;
2416 headerContent=Tcl_Alloc(charLength+1);
2417 strncpy(headerContent,startPtr,charLength);
2418 headerContent[charLength]=0;
2419 /* There may be multiple 'Set-Cookie' headers, so we use a list */
2420 if (Tcl_StringCaseMatch(headerName,"Set-Cookie",1)) {
2421 Tcl_SetVar2(curlData->interp,curlData->headerVar,headerName, \
2422 headerContent,TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
2424 Tcl_SetVar2(curlData->interp,curlData->headerVar,headerName,
2428 regExp=Tcl_RegExpCompile(curlData->interp,"(^(HTTP|http)[^\r]+)(\r*)(\n)");
2429 match=Tcl_RegExpExec(curlData->interp,regExp,header,header);
2431 Tcl_RegExpRange(regExp,1,&startPtr,&endPtr);
2432 charLength=endPtr-startPtr;
2433 httpStatus=Tcl_Alloc(charLength+1);
2434 strncpy(httpStatus,startPtr,charLength);
2435 httpStatus[charLength]=0;
2437 Tcl_SetVar2(curlData->interp,curlData->headerVar,"http",
2444 *----------------------------------------------------------------------
2448 * This is the function that will be invoked as a callback while
2449 * transferring the body of a request into a Tcl variable.
2451 * This function has been adapted from an example in libcurl's FAQ.
2454 * header: string with the header line.
2455 * size and nmemb: it so happens size * nmemb if the size of the
2457 * curlData: A pointer to the curlData structure for the transfer.
2460 * The number of bytes actually written or -1 in case of error, in
2461 * which case 'libcurl' will abort the transfer.
2462 *-----------------------------------------------------------------------
2465 curlBodyReader(void *ptr,size_t size,size_t nmemb,FILE *curlDataPtr) {
2467 register int realsize = size * nmemb;
2468 struct MemoryStruct *mem=&(((struct curlObjData *)curlDataPtr)->bodyVar);
2470 mem->memory = (char *)Tcl_Realloc(mem->memory,mem->size + realsize);
2472 memcpy(&(mem->memory[mem->size]), ptr, realsize);
2473 mem->size += realsize;
2479 *----------------------------------------------------------------------
2481 * curlProgressCallback --
2483 * This is the function that will be invoked as a callback during a
2486 * This function has been adapted from an example in libcurl's FAQ.
2489 * clientData: The curlData struct for the transfer.
2490 * dltotal: Total amount of bytes to download.
2491 * dlnow: Bytes downloaded so far.
2492 * ultotal: Total amount of bytes to upload.
2493 * ulnow: Bytes uploaded so far.
2496 * Returning a non-zero value will make 'libcurl' abort the transfer
2497 * and return 'CURLE_ABORTED_BY_CALLBACK'.
2498 *-----------------------------------------------------------------------
2501 curlProgressCallback(void *clientData,double dltotal,double dlnow,
2502 double ultotal,double ulnow) {
2504 struct curlObjData *curlData=(struct curlObjData *)clientData;
2505 Tcl_Obj *tclProcPtr;
2506 char tclCommand[300];
2508 snprintf(tclCommand,299,"%s %f %f %f %f",curlData->progressProc,dltotal,
2509 dlnow,ultotal,ulnow);
2510 tclProcPtr=Tcl_NewStringObj(tclCommand,-1);
2511 if (curlData->cancelTransVarName) {
2512 if (curlData->cancelTrans) {
2513 curlData->cancelTrans=0;
2517 if (Tcl_EvalObjEx(curlData->interp,tclProcPtr,TCL_EVAL_GLOBAL)!=TCL_OK) {
2524 *----------------------------------------------------------------------
2526 * curlWriteProcInvoke --
2528 * This is the function that will be invoked as a callback when the user
2529 * wants to invoke a Tcl procedure to write the recieved data.
2531 * This function has been adapted from an example in libcurl's FAQ.
2534 * ptr: A pointer to the data.
2535 * size and nmemb: it so happens size * nmemb if the size of the
2537 * curlData: A pointer to the curlData structure for the transfer.
2540 * The number of bytes actually written or -1 in case of error, in
2541 * which case 'libcurl' will abort the transfer.
2542 *-----------------------------------------------------------------------
2545 curlWriteProcInvoke(void *ptr,size_t size,size_t nmemb,FILE *curlDataPtr) {
2546 register int realsize = size * nmemb;
2547 struct curlObjData *curlData=(struct curlObjData *)curlDataPtr;
2550 objv[0]=Tcl_NewStringObj(curlData->writeProc,-1);
2551 objv[1]=Tcl_NewByteArrayObj(ptr,realsize);
2552 if (curlData->cancelTransVarName) {
2553 if (curlData->cancelTrans) {
2554 curlData->cancelTrans=0;
2558 if (Tcl_EvalObjv(curlData->interp,2,objv,TCL_EVAL_GLOBAL)!=TCL_OK) {
2565 *----------------------------------------------------------------------
2567 * curlReadProcInvoke --
2569 * This is the function that will be invoked as a callback when the user
2570 * wants to invoke a Tcl procedure to read the data to send.
2573 * header: string with the header line.
2574 * size and nmemb: it so happens size * nmemb if the size of the
2576 * curlData: A pointer to the curlData structure for the transfer.
2579 * The number of bytes actually read or CURL_READFUNC_ABORT in case
2580 * of error, in which case 'libcurl' will abort the transfer.
2581 *-----------------------------------------------------------------------
2584 curlReadProcInvoke(void *ptr,size_t size,size_t nmemb,FILE *curlDataPtr) {
2585 register int realsize = size * nmemb;
2586 struct curlObjData *curlData=(struct curlObjData *)curlDataPtr;
2587 Tcl_Obj *tclProcPtr;
2588 Tcl_Obj *readDataPtr;
2589 char tclCommand[300];
2590 unsigned char *readBytes;
2593 snprintf(tclCommand,300,"%s %d",curlData->readProc,realsize);
2594 tclProcPtr=Tcl_NewStringObj(tclCommand,-1);
2596 if (curlData->cancelTransVarName) {
2597 if (curlData->cancelTrans) {
2598 curlData->cancelTrans=0;
2599 return CURL_READFUNC_ABORT;
2602 if (Tcl_EvalObjEx(curlData->interp,tclProcPtr,TCL_EVAL_GLOBAL)!=TCL_OK) {
2603 return CURL_READFUNC_ABORT;
2605 readDataPtr=Tcl_GetObjResult(curlData->interp);
2606 readBytes=Tcl_GetByteArrayFromObj(readDataPtr,&sizeRead);
2607 memcpy(ptr,readBytes,sizeRead);
2613 *----------------------------------------------------------------------
2615 * curlChunkBgnProcInvoke --
2617 * This is the function that will be invoked as a callback when the user
2618 * wants to invoke a Tcl procedure to process every wildcard matching file
2619 * on a ftp transfer.
2622 * transfer_info: a curl_fileinfo structure about the file.
2623 * curlData: A pointer to the curlData structure for the transfer.
2624 * remains: number of chunks remaining.
2625 *-----------------------------------------------------------------------
2628 curlChunkBgnProcInvoke (const void *transfer_info, void *curlDataPtr, int remains) {
2629 struct curlObjData *curlData=(struct curlObjData *)curlDataPtr;
2630 Tcl_Obj *tclProcPtr;
2631 char tclCommand[300];
2633 const struct curl_fileinfo *fileinfoPtr=(const struct curl_fileinfo *)transfer_info;
2635 tclProcPtr=Tcl_NewStringObj(tclCommand,-1);
2637 if (curlData->chunkBgnVar==NULL) {
2638 curlData->chunkBgnVar=curlstrdup("fileData");
2641 Tcl_SetVar2(curlData->interp,curlData->chunkBgnVar,"filename",
2642 fileinfoPtr->filename,0);
2644 switch(fileinfoPtr->filetype) {
2646 Tcl_SetVar2(curlData->interp,curlData->chunkBgnVar,"filetype",
2650 Tcl_SetVar2(curlData->interp,curlData->chunkBgnVar,"filetype",
2654 Tcl_SetVar2(curlData->interp,curlData->chunkBgnVar,"filetype",
2658 Tcl_SetVar2(curlData->interp,curlData->chunkBgnVar,"filetype",
2662 Tcl_SetVar2(curlData->interp,curlData->chunkBgnVar,"filetype",
2666 Tcl_SetVar2(curlData->interp,curlData->chunkBgnVar,"filetype",
2670 Tcl_SetVar2(curlData->interp,curlData->chunkBgnVar,"filetype",
2674 Tcl_SetVar2(curlData->interp,curlData->chunkBgnVar,"filetype",
2678 Tcl_SetVar2(curlData->interp,curlData->chunkBgnVar,"filetype",
2683 Tcl_SetVar2Ex(curlData->interp,curlData->chunkBgnVar,"time",
2684 Tcl_NewLongObj(fileinfoPtr->time),0);
2686 Tcl_SetVar2Ex(curlData->interp,curlData->chunkBgnVar,"perm",
2687 Tcl_NewIntObj(fileinfoPtr->perm),0);
2689 Tcl_SetVar2Ex(curlData->interp,curlData->chunkBgnVar,"uid",
2690 Tcl_NewIntObj(fileinfoPtr->uid),0);
2691 Tcl_SetVar2Ex(curlData->interp,curlData->chunkBgnVar,"gid",
2692 Tcl_NewIntObj(fileinfoPtr->gid),0);
2693 Tcl_SetVar2Ex(curlData->interp,curlData->chunkBgnVar,"size",
2694 Tcl_NewLongObj(fileinfoPtr->size),0);
2695 Tcl_SetVar2Ex(curlData->interp,curlData->chunkBgnVar,"hardlinks",
2696 Tcl_NewIntObj(fileinfoPtr->hardlinks),0);
2697 Tcl_SetVar2Ex(curlData->interp,curlData->chunkBgnVar,"flags",
2698 Tcl_NewIntObj(fileinfoPtr->flags),0);
2700 snprintf(tclCommand,300,"%s %d",curlData->chunkBgnProc,remains);
2701 tclProcPtr=Tcl_NewStringObj(tclCommand,-1);
2703 if (Tcl_EvalObjEx(curlData->interp,tclProcPtr,TCL_EVAL_GLOBAL)!=TCL_OK) {
2704 return CURL_CHUNK_BGN_FUNC_FAIL;
2707 if (Tcl_GetIntFromObj(curlData->interp,Tcl_GetObjResult(curlData->interp),&i)!=TCL_OK) {
2708 return CURL_CHUNK_BGN_FUNC_FAIL;
2712 return CURL_CHUNK_BGN_FUNC_OK;
2714 return CURL_CHUNK_BGN_FUNC_SKIP;
2716 return CURL_CHUNK_BGN_FUNC_FAIL;
2720 *----------------------------------------------------------------------
2722 * curlChunkEndProcInvoke --
2724 * This is the function that will be invoked every time a file has
2725 * been downloaded or skipped, it does little more than called the
2729 * curlData: A pointer to the curlData structure for the transfer.
2732 *-----------------------------------------------------------------------
2735 curlChunkEndProcInvoke (void *curlDataPtr) {
2737 struct curlObjData *curlData=(struct curlObjData *)curlDataPtr;
2738 Tcl_Obj *tclProcPtr;
2739 char tclCommand[300];
2742 snprintf(tclCommand,300,"%s",curlData->chunkEndProc);
2743 tclProcPtr=Tcl_NewStringObj(tclCommand,-1);
2745 if (Tcl_EvalObjEx(curlData->interp,tclProcPtr,TCL_EVAL_GLOBAL)!=TCL_OK) {
2746 return CURL_CHUNK_END_FUNC_FAIL;
2749 if (Tcl_GetIntFromObj(curlData->interp,Tcl_GetObjResult(curlData->interp),&i)!=TCL_OK) {
2750 return CURL_CHUNK_END_FUNC_FAIL;
2753 return CURL_CHUNK_BGN_FUNC_FAIL;
2755 return CURL_CHUNK_END_FUNC_OK;
2759 *----------------------------------------------------------------------
2761 * curlfnmatchProcInvoke --
2763 * This is the function that will be invoked to tell whether a filename
2764 * matches a pattern when doing a 'wildcard' download. It invokes a Tcl
2765 * proc to do the actual work.
2768 * curlData: A pointer to the curlData structure for the transfer.
2769 * pattern: The pattern to match.
2770 * filename: The file name to be matched.
2771 *-----------------------------------------------------------------------
2773 int curlfnmatchProcInvoke(void *curlDataPtr, const char *pattern, const char *filename) {
2775 struct curlObjData *curlData=(struct curlObjData *)curlDataPtr;
2776 Tcl_Obj *tclProcPtr;
2777 char tclCommand[500];
2780 snprintf(tclCommand,500,"%s %s %s",curlData->fnmatchProc,pattern,filename);
2781 tclProcPtr=Tcl_NewStringObj(tclCommand,-1);
2783 if (Tcl_EvalObjEx(curlData->interp,tclProcPtr,TCL_EVAL_GLOBAL)!=TCL_OK) {
2784 return CURL_FNMATCHFUNC_FAIL;
2787 if (Tcl_GetIntFromObj(curlData->interp,Tcl_GetObjResult(curlData->interp),&i)!=TCL_OK) {
2788 return CURL_FNMATCHFUNC_FAIL;
2792 return CURL_FNMATCHFUNC_MATCH;
2794 return CURL_FNMATCHFUNC_NOMATCH;
2796 return CURL_FNMATCHFUNC_FAIL;
2800 *----------------------------------------------------------------------
2802 * curlshkeyextract --
2804 * Out of one of libcurl's ssh key struct, this function will return a
2805 * Tcl_Obj with a list, the first element is the type ok key, the second
2809 * interp: The interp need to deal with the objects.
2810 * key: a curl_khkey struct with the key.
2813 * The object with the list.
2814 *-----------------------------------------------------------------------
2817 curlsshkeyextract(Tcl_Interp *interp,const struct curl_khkey *key) {
2821 keyObjPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
2823 switch(key->keytype) {
2824 case CURLKHTYPE_RSA1:
2825 Tcl_ListObjAppendElement(interp,keyObjPtr,Tcl_NewStringObj("rsa1",-1));
2827 case CURLKHTYPE_RSA:
2828 Tcl_ListObjAppendElement(interp,keyObjPtr,Tcl_NewStringObj("rsa",-1));
2830 case CURLKHTYPE_DSS:
2831 Tcl_ListObjAppendElement(interp,keyObjPtr,Tcl_NewStringObj("dss",-1));
2834 Tcl_ListObjAppendElement(interp,keyObjPtr,Tcl_NewStringObj("unknnown",-1));
2837 Tcl_ListObjAppendElement(interp,keyObjPtr,Tcl_NewStringObj(key->key,-1));
2843 *----------------------------------------------------------------------
2845 * curlshkeycallback --
2847 * This is the function that will be invoked as a callback when the user
2848 * wants to invoke a Tcl procedure to decide about this new ssh host
2851 * curl: curl's easy handle for the connection.
2852 * knownkey: The key from the hosts_file.
2853 * foundkey: The key from the remote site.
2854 * match: What libcurl thinks about how they match
2855 * curlDataPtr: Points to the structure with all the TclCurl data
2856 * for the connection.
2859 * A libcurl return code so that libcurl knows what to do.
2860 *-----------------------------------------------------------------------
2863 curlsshkeycallback(CURL *curl ,const struct curl_khkey *knownkey,
2864 const struct curl_khkey *foundkey, enum curl_khmatch match,void *curlDataPtr) {
2866 struct curlObjData *tclcurlDataPtr=(struct curlObjData *)curlDataPtr;
2870 Tcl_Obj *returnObjPtr;
2874 interp=tclcurlDataPtr->interp;
2876 objv[0]=Tcl_NewStringObj(tclcurlDataPtr->sshkeycallProc,-1);
2877 objv[1]=curlsshkeyextract(interp,knownkey);
2878 objv[2]=curlsshkeyextract(interp,foundkey);
2881 case CURLKHMATCH_OK:
2882 objv[3]=Tcl_NewStringObj("match",-1);
2884 case CURLKHMATCH_MISMATCH:
2885 objv[3]=Tcl_NewStringObj("mismatch",-1);
2887 case CURLKHMATCH_MISSING:
2888 objv[3]=Tcl_NewStringObj("missing",-1);
2890 case CURLKHMATCH_LAST:
2891 objv[3]=Tcl_NewStringObj("error",-1);
2894 if (Tcl_EvalObjv(interp,4,objv,TCL_EVAL_GLOBAL)!=TCL_OK) {return CURLKHSTAT_REJECT;}
2896 returnObjPtr=Tcl_GetObjResult(interp);
2898 if (Tcl_GetIntFromObj(interp,returnObjPtr,&action)!=TCL_OK) {return CURLKHSTAT_REJECT;}
2902 return CURLKHSTAT_FINE_ADD_TO_FILE;
2904 return CURLKHSTAT_FINE;
2906 return CURLKHSTAT_REJECT;
2908 return CURLKHSTAT_DEFER;
2910 return CURLKHSTAT_REJECT;
2914 *----------------------------------------------------------------------
2916 * curlDebugProcInvoke --
2918 * This is the function that will be invoked as a callback when the user
2919 * wants to invoke a Tcl procedure to write the debug data produce by
2920 * the verbose option.
2923 * curlHandle: A pointer to the handle for the transfer.
2924 * infoType: Integer with the type of data.
2925 * dataPtr: the data passed to the procedure.
2926 * curlDataPtr: ointer to the curlData structure for the transfer.
2929 * The number of bytes actually written or -1 in case of error, in
2930 * which case 'libcurl' will abort the transfer.
2931 *-----------------------------------------------------------------------
2934 curlDebugProcInvoke(CURL *curlHandle, curl_infotype infoType,
2935 char * dataPtr, size_t size, void *curlDataPtr) {
2936 struct curlObjData *curlData=(struct curlObjData *)curlDataPtr;
2937 Tcl_Obj *tclProcPtr;
2939 char tclCommand[300];
2941 snprintf(tclCommand,300,"%s %d %d",curlData->debugProc,infoType,size);
2942 tclProcPtr=Tcl_NewStringObj(tclCommand,-1);
2944 objv[0]=Tcl_NewStringObj(curlData->debugProc,-1);
2945 objv[1]=Tcl_NewIntObj(infoType);
2946 objv[2]=Tcl_NewByteArrayObj((CONST unsigned char *)dataPtr,size);
2948 if (curlData->cancelTransVarName) {
2949 if (curlData->cancelTrans) {
2950 curlData->cancelTrans=0;
2955 Tcl_EvalObjv(curlData->interp,3,objv,TCL_EVAL_GLOBAL);
2961 *----------------------------------------------------------------------
2965 * Invokes the 'curl_easy_getinfo' function in libcurl.
2970 * 0 if all went well.
2971 * The CURLcode for the error.
2972 *----------------------------------------------------------------------
2975 curlGetInfo(Tcl_Interp *interp,CURL *curlHandle,int tableIndex) {
2978 double doubleNumber;
2979 struct curl_slist *slistPtr;
2980 struct curl_certinfo *certinfoPtr=NULL;
2985 Tcl_Obj *resultObjPtr;
2987 switch(tableIndex) {
2989 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_EFFECTIVE_URL,&charPtr);
2993 resultObjPtr=Tcl_NewStringObj(charPtr,-1);
2994 Tcl_SetObjResult(interp,resultObjPtr);
2998 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_RESPONSE_CODE,&longNumber);
3002 resultObjPtr=Tcl_NewLongObj(longNumber);
3003 Tcl_SetObjResult(interp,resultObjPtr);
3006 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_FILETIME,&longNumber);
3010 resultObjPtr=Tcl_NewLongObj(longNumber);
3011 Tcl_SetObjResult(interp,resultObjPtr);
3014 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_TOTAL_TIME,&doubleNumber);
3018 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3019 Tcl_SetObjResult(interp,resultObjPtr);
3022 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_NAMELOOKUP_TIME,
3027 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3028 Tcl_SetObjResult(interp,resultObjPtr);
3031 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_CONNECT_TIME,
3036 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3037 Tcl_SetObjResult(interp,resultObjPtr);
3040 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_PRETRANSFER_TIME,
3045 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3046 Tcl_SetObjResult(interp,resultObjPtr);
3049 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_SIZE_UPLOAD,
3054 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3055 Tcl_SetObjResult(interp,resultObjPtr);
3058 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_SIZE_DOWNLOAD,
3063 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3064 Tcl_SetObjResult(interp,resultObjPtr);
3067 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_SPEED_DOWNLOAD,
3072 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3073 Tcl_SetObjResult(interp,resultObjPtr);
3076 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_SPEED_UPLOAD,
3081 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3082 Tcl_SetObjResult(interp,resultObjPtr);
3085 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_HEADER_SIZE,
3090 resultObjPtr=Tcl_NewLongObj(longNumber);
3091 Tcl_SetObjResult(interp,resultObjPtr);
3094 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_REQUEST_SIZE,
3099 resultObjPtr=Tcl_NewLongObj(longNumber);
3100 Tcl_SetObjResult(interp,resultObjPtr);
3103 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_SSL_VERIFYRESULT,
3108 resultObjPtr=Tcl_NewLongObj(longNumber);
3109 Tcl_SetObjResult(interp,resultObjPtr);
3112 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_CONTENT_LENGTH_DOWNLOAD,
3117 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3118 Tcl_SetObjResult(interp,resultObjPtr);
3121 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_CONTENT_LENGTH_UPLOAD,
3126 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3127 Tcl_SetObjResult(interp,resultObjPtr);
3130 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_STARTTRANSFER_TIME,&doubleNumber);
3134 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3135 Tcl_SetObjResult(interp,resultObjPtr);
3138 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_CONTENT_TYPE,&charPtr);
3142 resultObjPtr=Tcl_NewStringObj(charPtr,-1);
3143 Tcl_SetObjResult(interp,resultObjPtr);
3146 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_REDIRECT_TIME,&doubleNumber);
3150 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3151 Tcl_SetObjResult(interp,resultObjPtr);
3154 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_REDIRECT_COUNT,&longNumber);
3158 resultObjPtr=Tcl_NewLongObj(longNumber);
3159 Tcl_SetObjResult(interp,resultObjPtr);
3163 if (tableIndex==21) {
3164 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_HTTPAUTH_AVAIL,&longNumber);
3166 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_PROXYAUTH_AVAIL,&longNumber);
3171 resultObjPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
3172 if (longNumber&CURLAUTH_BASIC) {
3173 Tcl_ListObjAppendElement(interp,resultObjPtr
3174 ,Tcl_NewStringObj("basic",-1));
3176 if (longNumber&CURLAUTH_DIGEST) {
3177 Tcl_ListObjAppendElement(interp,resultObjPtr
3178 ,Tcl_NewStringObj("digest",-1));
3180 if (longNumber&CURLAUTH_GSSNEGOTIATE) {
3181 Tcl_ListObjAppendElement(interp,resultObjPtr
3182 ,Tcl_NewStringObj("gssnegotiate",-1));
3184 if (longNumber&CURLAUTH_NTLM) {
3185 Tcl_ListObjAppendElement(interp,resultObjPtr
3186 ,Tcl_NewStringObj("NTLM",-1));
3188 Tcl_SetObjResult(interp,resultObjPtr);
3191 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_OS_ERRNO,&longNumber);
3195 resultObjPtr=Tcl_NewLongObj(longNumber);
3196 Tcl_SetObjResult(interp,resultObjPtr);
3199 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_NUM_CONNECTS,&longNumber);
3203 resultObjPtr=Tcl_NewLongObj(longNumber);
3204 Tcl_SetObjResult(interp,resultObjPtr);
3207 exitCode=curl_easy_getinfo \
3208 (curlHandle,CURLINFO_SSL_ENGINES,&slistPtr);
3212 resultObjPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
3213 while(slistPtr!=NULL) {
3214 Tcl_ListObjAppendElement(interp,resultObjPtr
3215 ,Tcl_NewStringObj(slistPtr->data,-1));
3216 slistPtr=slistPtr->next;
3218 curl_slist_free_all(slistPtr);
3219 Tcl_SetObjResult(interp,resultObjPtr);
3222 exitCode=curl_easy_getinfo \
3223 (curlHandle,CURLINFO_HTTP_CONNECTCODE,&longNumber);
3227 resultObjPtr=Tcl_NewLongObj(longNumber);
3228 Tcl_SetObjResult(interp,resultObjPtr);
3231 exitCode=curl_easy_getinfo \
3232 (curlHandle,CURLINFO_COOKIELIST,&slistPtr);
3236 resultObjPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
3237 while(slistPtr!=NULL) {
3238 Tcl_ListObjAppendElement(interp,resultObjPtr
3239 ,Tcl_NewStringObj(slistPtr->data,-1));
3240 slistPtr=slistPtr->next;
3242 curl_slist_free_all(slistPtr);
3243 Tcl_SetObjResult(interp,resultObjPtr);
3246 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_FTP_ENTRY_PATH,&charPtr);
3250 resultObjPtr=Tcl_NewStringObj(charPtr,-1);
3251 Tcl_SetObjResult(interp,resultObjPtr);
3254 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_REDIRECT_URL,&charPtr);
3258 resultObjPtr=Tcl_NewStringObj(charPtr,-1);
3259 Tcl_SetObjResult(interp,resultObjPtr);
3262 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_PRIMARY_IP,&charPtr);
3266 resultObjPtr=Tcl_NewStringObj(charPtr,-1);
3267 Tcl_SetObjResult(interp,resultObjPtr);
3270 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_APPCONNECT_TIME,&doubleNumber);
3274 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3275 Tcl_SetObjResult(interp,resultObjPtr);
3278 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_CERTINFO,certinfoPtr);
3282 charPtr=(char *)Tcl_Alloc(3);
3283 sprintf(charPtr,"%d",certinfoPtr->num_of_certs);
3284 resultObjPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
3285 Tcl_ListObjAppendElement(interp,resultObjPtr,Tcl_NewStringObj(charPtr,-1));
3287 for(i=0; i < certinfoPtr->num_of_certs; i++) {
3288 for(slistPtr = certinfoPtr->certinfo[i]; slistPtr; slistPtr=slistPtr->next) {
3289 Tcl_ListObjAppendElement(interp,resultObjPtr,Tcl_NewStringObj(slistPtr->data,-1));
3292 Tcl_SetObjResult(interp,resultObjPtr);
3295 exitCode=curl_easy_getinfo \
3296 (curlHandle,CURLINFO_CONDITION_UNMET,&longNumber);
3300 resultObjPtr=Tcl_NewLongObj(longNumber);
3301 Tcl_SetObjResult(interp,resultObjPtr);
3304 exitCode=curl_easy_getinfo \
3305 (curlHandle,CURLINFO_PRIMARY_PORT,&longNumber);
3309 resultObjPtr=Tcl_NewLongObj(longNumber);
3310 Tcl_SetObjResult(interp,resultObjPtr);
3313 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_LOCAL_IP,&charPtr);
3317 resultObjPtr=Tcl_NewStringObj(charPtr,-1);
3318 Tcl_SetObjResult(interp,resultObjPtr);
3321 exitCode=curl_easy_getinfo \
3322 (curlHandle,CURLINFO_LOCAL_PORT,&longNumber);
3326 resultObjPtr=Tcl_NewLongObj(longNumber);
3327 Tcl_SetObjResult(interp,resultObjPtr);
3334 *----------------------------------------------------------------------
3338 * Frees the space taken by a curlObjData struct either because we are
3339 * deleting the handle or reseting it.
3342 * interp: Pointer to the interpreter we are using.
3343 * curlHandle: the curl handle for which the option is set.
3344 * objc and objv: The usual in Tcl.
3347 * A standard Tcl result.
3348 *----------------------------------------------------------------------
3351 curlFreeSpace(struct curlObjData *curlData) {
3353 curl_slist_free_all(curlData->headerList);
3354 curl_slist_free_all(curlData->quote);
3355 curl_slist_free_all(curlData->prequote);
3356 curl_slist_free_all(curlData->postquote);
3358 Tcl_Free(curlData->outFile);
3359 Tcl_Free(curlData->inFile);
3360 Tcl_Free(curlData->proxy);
3361 Tcl_Free(curlData->errorBuffer);
3362 Tcl_Free(curlData->errorBufferName);
3363 Tcl_Free(curlData->errorBufferKey);
3364 Tcl_Free(curlData->stderrFile);
3365 Tcl_Free(curlData->randomFile);
3366 Tcl_Free(curlData->headerVar);
3367 Tcl_Free(curlData->bodyVarName);
3368 if (curlData->bodyVar.memory) {
3369 Tcl_Free(curlData->bodyVar.memory);
3371 Tcl_Free(curlData->progressProc);
3372 if (curlData->cancelTransVarName) {
3373 Tcl_UnlinkVar(curlData->interp,curlData->cancelTransVarName);
3374 Tcl_Free(curlData->cancelTransVarName);
3376 Tcl_Free(curlData->writeProc);
3377 Tcl_Free(curlData->readProc);
3378 Tcl_Free(curlData->debugProc);
3379 curl_slist_free_all(curlData->http200aliases);
3380 Tcl_Free(curlData->sshkeycallProc);
3381 curl_slist_free_all(curlData->mailrcpt);
3382 Tcl_Free(curlData->chunkBgnProc);
3383 Tcl_Free(curlData->chunkBgnVar);
3384 Tcl_Free(curlData->chunkEndProc);
3385 Tcl_Free(curlData->fnmatchProc);
3386 curl_slist_free_all(curlData->resolve);
3387 curl_slist_free_all(curlData->telnetoptions);
3389 Tcl_Free(curlData->command);
3393 *----------------------------------------------------------------------
3397 * This function is invoked by the 'duphandle' command, it will
3398 * create a duplicate of the given handle.
3401 * The stantard parameters for Tcl commands
3404 * A standard Tcl result.
3407 * See the user documentation.
3409 *----------------------------------------------------------------------
3412 curlDupHandle(Tcl_Interp *interp, struct curlObjData *curlData,
3413 int objc, Tcl_Obj *CONST objv[]) {
3415 CURL *newCurlHandle;
3417 struct curlObjData *newCurlData;
3420 newCurlHandle=curl_easy_duphandle(curlData->curl);
3421 if (newCurlHandle==NULL) {
3422 result=Tcl_NewStringObj("Couldn't create new handle.",-1);
3423 Tcl_SetObjResult(interp,result);
3427 newCurlData=(struct curlObjData *)Tcl_Alloc(sizeof(struct curlObjData));
3429 curlCopyCurlData(curlData,newCurlData);
3431 handleName=curlCreateObjCmd(interp,newCurlData);
3433 newCurlData->curl=newCurlHandle;
3435 result=Tcl_NewStringObj(handleName,-1);
3436 Tcl_SetObjResult(interp,result);
3437 Tcl_Free(handleName);
3444 *----------------------------------------------------------------------
3446 * curlResetHandle --
3448 * This function is invoked by the 'reset' command, it reset all the
3449 * options in the handle to the state it had when 'init' was invoked.
3452 * The stantard parameters for Tcl commands
3455 * A standard Tcl result.
3458 * See the user documentation.
3460 *----------------------------------------------------------------------
3463 curlResetHandle(Tcl_Interp *interp, struct curlObjData *curlData) {
3464 struct curlObjData *tmpPtr=
3465 (struct curlObjData *)Tcl_Alloc(sizeof(struct curlObjData));
3467 tmpPtr->curl = curlData->curl;
3468 tmpPtr->token = curlData->token;
3469 tmpPtr->shareToken = curlData->shareToken;
3470 tmpPtr->interp = curlData->interp;
3472 curlFreeSpace(curlData);
3473 memset(curlData, 0, sizeof(struct curlObjData));
3475 curlData->curl = tmpPtr->curl;
3476 curlData->token = tmpPtr->token;
3477 curlData->shareToken = tmpPtr->shareToken;
3478 curlData->interp = tmpPtr->interp;
3480 curl_easy_reset(curlData->curl);
3482 Tcl_Free((char *)tmpPtr);
3489 *----------------------------------------------------------------------
3493 * This procedure is invoked to process the "curl::init" Tcl command.
3494 * See the user documentation for details on what it does.
3497 * The stantard parameters for Tcl commands
3500 * A standard Tcl result.
3503 * See the user documentation.
3505 *----------------------------------------------------------------------
3508 curlVersion (ClientData clientData, Tcl_Interp *interp,
3509 int objc,Tcl_Obj *CONST objv[]) {
3511 Tcl_Obj *versionPtr;
3512 char tclversion[200];
3514 sprintf(tclversion,"TclCurl Version %s (%s)",TclCurlVersion,
3516 versionPtr=Tcl_NewStringObj(tclversion,-1);
3517 Tcl_SetObjResult(interp,versionPtr);
3523 *----------------------------------------------------------------------
3527 * This function is invoked to process the "curl::escape" Tcl command.
3528 * See the user documentation for details on what it does.
3532 * The stantard parameters for Tcl commands
3535 * A standard Tcl result.
3538 * See the user documentation.
3540 *----------------------------------------------------------------------
3543 curlEscape(ClientData clientData, Tcl_Interp *interp,
3544 int objc,Tcl_Obj *CONST objv[]) {
3549 escapedStr=curl_easy_escape(NULL,Tcl_GetString(objv[1]),0);
3552 resultObj=Tcl_NewStringObj("curl::escape bad parameter",-1);
3553 Tcl_SetObjResult(interp,resultObj);
3556 resultObj=Tcl_NewStringObj(escapedStr,-1);
3557 Tcl_SetObjResult(interp,resultObj);
3558 curl_free(escapedStr);
3564 *----------------------------------------------------------------------
3568 * This function is invoked to process the "curl::Unescape" Tcl command.
3569 * See the user documentation for details on what it does.
3573 * The stantard parameters for Tcl commands
3576 * A standard Tcl result.
3579 * See the user documentation.
3581 *----------------------------------------------------------------------
3584 curlUnescape(ClientData clientData, Tcl_Interp *interp,
3585 int objc,Tcl_Obj *CONST objv[]) {
3590 unescapedStr=curl_easy_unescape(NULL,Tcl_GetString(objv[1]),0,NULL);
3592 resultObj=Tcl_NewStringObj("curl::unescape bad parameter",-1);
3593 Tcl_SetObjResult(interp,resultObj);
3596 resultObj=Tcl_NewStringObj(unescapedStr,-1);
3597 Tcl_SetObjResult(interp,resultObj);
3598 curl_free(unescapedStr);
3604 *----------------------------------------------------------------------
3606 * curlVersionInfo --
3608 * This function invokes 'curl_version_info' to query how 'libcurl' was
3612 * The standard parameters for Tcl commands, but nothing is used.
3615 * A standard Tcl result.
3618 * See the user documentation.
3620 *----------------------------------------------------------------------
3623 curlVersionInfo (ClientData clientData, Tcl_Interp *interp,
3624 int objc,Tcl_Obj *CONST objv[]) {
3628 curl_version_info_data *infoPtr;
3629 Tcl_Obj *resultObjPtr=NULL;
3633 resultObjPtr=Tcl_NewStringObj("usage: curl::versioninfo -option",-1);
3634 Tcl_SetObjResult(interp,resultObjPtr);
3638 if (Tcl_GetIndexFromObj(interp, objv[1], versionInfoTable, "option",
3639 TCL_EXACT,&tableIndex)==TCL_ERROR) {
3643 infoPtr=curl_version_info(CURLVERSION_NOW);
3645 switch(tableIndex) {
3647 resultObjPtr=Tcl_NewStringObj(infoPtr->version,-1);
3650 sprintf(tmp,"%X",infoPtr->version_num);
3651 resultObjPtr=Tcl_NewStringObj(tmp,-1);
3654 resultObjPtr=Tcl_NewStringObj(infoPtr->host,-1);
3657 resultObjPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
3658 if (infoPtr->features&CURL_VERSION_IPV6) {
3659 Tcl_ListObjAppendElement(interp,resultObjPtr
3660 ,Tcl_NewStringObj("IPV6",-1));
3662 if (infoPtr->features&CURL_VERSION_KERBEROS4) {
3663 Tcl_ListObjAppendElement(interp,resultObjPtr
3664 ,Tcl_NewStringObj("KERBEROS4",-1));
3666 if (infoPtr->features&CURL_VERSION_SSL) {
3667 Tcl_ListObjAppendElement(interp,resultObjPtr
3668 ,Tcl_NewStringObj("SSL",-1));
3670 if (infoPtr->features&CURL_VERSION_LIBZ) {
3671 Tcl_ListObjAppendElement(interp,resultObjPtr
3672 ,Tcl_NewStringObj("LIBZ",-1));
3674 if (infoPtr->features&CURL_VERSION_NTLM) {
3675 Tcl_ListObjAppendElement(interp,resultObjPtr
3676 ,Tcl_NewStringObj("NTLM",-1));
3678 if (infoPtr->features&CURL_VERSION_GSSNEGOTIATE) {
3679 Tcl_ListObjAppendElement(interp,resultObjPtr
3680 ,Tcl_NewStringObj("GSSNEGOTIATE",-1));
3682 if (infoPtr->features&CURL_VERSION_DEBUG) {
3683 Tcl_ListObjAppendElement(interp,resultObjPtr
3684 ,Tcl_NewStringObj("DEBUG",-1));
3686 if (infoPtr->features&CURL_VERSION_ASYNCHDNS) {
3687 Tcl_ListObjAppendElement(interp,resultObjPtr
3688 ,Tcl_NewStringObj("ASYNCHDNS",-1));
3690 if (infoPtr->features&CURL_VERSION_SPNEGO) {
3691 Tcl_ListObjAppendElement(interp,resultObjPtr
3692 ,Tcl_NewStringObj("SPNEGO",-1));
3694 if (infoPtr->features&CURL_VERSION_LARGEFILE) {
3695 Tcl_ListObjAppendElement(interp,resultObjPtr
3696 ,Tcl_NewStringObj("LARGEFILE",-1));
3698 if (infoPtr->features&CURL_VERSION_IDN) {
3699 Tcl_ListObjAppendElement(interp,resultObjPtr
3700 ,Tcl_NewStringObj("IDN",-1));
3702 if (infoPtr->features&CURL_VERSION_SSPI) {
3703 Tcl_ListObjAppendElement(interp,resultObjPtr
3704 ,Tcl_NewStringObj("SSPI",-1));
3707 if (infoPtr->features&CURL_VERSION_CONV) {
3708 Tcl_ListObjAppendElement(interp,resultObjPtr
3709 ,Tcl_NewStringObj("CONV",-1));
3712 resultObjPtr=Tcl_NewStringObj(infoPtr->ssl_version,-1);
3715 resultObjPtr=Tcl_NewLongObj(infoPtr->ssl_version_num);
3718 resultObjPtr=Tcl_NewStringObj(infoPtr->libz_version,-1);
3721 resultObjPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
3723 if (infoPtr->protocols[i]!=NULL) {
3724 Tcl_ListObjAppendElement(interp,resultObjPtr
3725 ,Tcl_NewStringObj(infoPtr->protocols[i],-1));
3732 Tcl_SetObjResult(interp,resultObjPtr);
3738 *----------------------------------------------------------------------
3740 * curlCopyCurlData --
3742 * This function copies the contents of a curlData struct into another.
3745 * curlDataOld: The original one.
3746 * curlDataNew: The new one
3749 * A standard Tcl result.
3752 * See the user documentation.
3754 *----------------------------------------------------------------------
3757 curlCopyCurlData (struct curlObjData *curlDataOld,
3758 struct curlObjData *curlDataNew) {
3760 /* This takes care of the int and long values */
3761 memcpy(curlDataNew, curlDataOld, sizeof(struct curlObjData));
3763 /* Some of the data doesn't get copied */
3765 curlDataNew->headerList=NULL;
3766 curlDataNew->quote=NULL;
3767 curlDataNew->prequote=NULL;
3768 curlDataNew->postquote=NULL;
3769 curlDataNew->formArray=NULL;
3770 curlDataNew->postListFirst=NULL;
3771 curlDataNew->postListLast=NULL;
3772 curlDataNew->formArray=NULL;
3773 curlDataNew->outHandle=NULL;
3774 curlDataNew->outFlag=0;
3775 curlDataNew->inHandle=NULL;
3776 curlDataNew->inFlag=0;
3777 curlDataNew->headerHandle=NULL;
3778 curlDataNew->headerFlag=0;
3779 curlDataNew->stderrHandle=NULL;
3780 curlDataNew->stderrFlag=0;
3781 curlDataNew->http200aliases=NULL;
3782 curlDataNew->mailrcpt=NULL;
3783 curlDataNew->resolve=NULL;
3784 curlDataNew->telnetoptions=NULL;
3786 /* The strings need a special treatment. */
3788 curlDataNew->outFile=curlstrdup(curlDataOld->outFile);
3789 curlDataNew->inFile=curlstrdup(curlDataOld->inFile);
3790 curlDataNew->proxy=curlstrdup(curlDataOld->proxy);
3791 curlDataNew->errorBuffer=curlstrdup(curlDataOld->errorBuffer);
3792 curlDataNew->errorBufferName=curlstrdup(curlDataOld->errorBufferName);
3793 curlDataNew->errorBufferKey=curlstrdup(curlDataOld->errorBufferKey);
3794 curlDataNew->headerFile=curlstrdup(curlDataOld->headerFile);
3795 curlDataNew->stderrFile=curlstrdup(curlDataOld->stderrFile);
3796 curlDataNew->randomFile=curlstrdup(curlDataOld->randomFile);
3797 curlDataNew->headerVar=curlstrdup(curlDataOld->headerVar);
3798 curlDataNew->bodyVarName=curlstrdup(curlDataOld->bodyVarName);
3799 curlDataNew->progressProc=curlstrdup(curlDataOld->progressProc);
3800 curlDataNew->cancelTransVarName=curlstrdup(curlDataOld->cancelTransVarName);
3801 curlDataNew->writeProc=curlstrdup(curlDataOld->writeProc);
3802 curlDataNew->readProc=curlstrdup(curlDataOld->readProc);
3803 curlDataNew->debugProc=curlstrdup(curlDataOld->debugProc);
3804 curlDataNew->command=curlstrdup(curlDataOld->command);
3805 curlDataNew->sshkeycallProc=curlstrdup(curlDataOld->sshkeycallProc);
3806 curlDataNew->chunkBgnProc=curlstrdup(curlDataOld->chunkBgnProc);
3807 curlDataNew->chunkBgnVar=curlstrdup(curlDataOld->chunkBgnVar);
3808 curlDataNew->chunkEndProc=curlstrdup(curlDataOld->chunkEndProc);
3809 curlDataNew->fnmatchProc=curlstrdup(curlDataOld->fnmatchProc);
3811 curlDataNew->bodyVar.memory=(char *)Tcl_Alloc(curlDataOld->bodyVar.size);
3812 memcpy(curlDataNew->bodyVar.memory,curlDataOld->bodyVar.memory
3813 ,curlDataOld->bodyVar.size);
3814 curlDataNew->bodyVar.size=curlDataOld->bodyVar.size;
3819 /*----------------------------------------------------------------------
3823 * Before doing a transfer with the easy interface or adding an easy
3824 * handle to a multi one, this function takes care of opening all
3825 * necessary files for the transfer.
3828 * curlData: The pointer to the struct with the transfer data.
3831 * '0' all went well, '1' in case of error.
3832 *----------------------------------------------------------------------
3835 curlOpenFiles(Tcl_Interp *interp,struct curlObjData *curlData) {
3837 if (curlData->outFlag) {
3838 if (curlOpenFile(interp,curlData->outFile,&(curlData->outHandle),1,
3839 curlData->transferText)) {
3842 curl_easy_setopt(curlData->curl,CURLOPT_WRITEDATA,curlData->outHandle);
3844 if (curlData->inFlag) {
3845 if (curlOpenFile(interp,curlData->inFile,&(curlData->inHandle),0,
3846 curlData->transferText)) {
3849 curl_easy_setopt(curlData->curl,CURLOPT_READDATA,curlData->inHandle);
3850 if (curlData->anyAuthFlag) {
3851 curl_easy_setopt(curlData->curl, CURLOPT_SEEKFUNCTION, curlseek);
3852 curl_easy_setopt(curlData->curl, CURLOPT_SEEKDATA, curlData->inHandle);
3855 if (curlData->headerFlag) {
3856 if (curlOpenFile(interp,curlData->headerFile,&(curlData->headerHandle),1,1)) {
3859 curl_easy_setopt(curlData->curl,CURLOPT_HEADERDATA,curlData->headerHandle);
3861 if (curlData->stderrFlag) {
3862 if (curlOpenFile(interp,curlData->stderrFile,&(curlData->stderrHandle),1,1)) {
3865 curl_easy_setopt(curlData->curl,CURLOPT_STDERR,curlData->stderrHandle);
3870 /*----------------------------------------------------------------------
3874 * Closes the files opened during a transfer.
3877 * curlData: The pointer to the struct with the transfer data.
3879 *----------------------------------------------------------------------
3882 curlCloseFiles(struct curlObjData *curlData) {
3883 if (curlData->outHandle!=NULL) {
3884 fclose(curlData->outHandle);
3885 curlData->outHandle=NULL;
3887 if (curlData->inHandle!=NULL) {
3888 fclose(curlData->inHandle);
3889 curlData->inHandle=NULL;
3891 if (curlData->headerHandle!=NULL) {
3892 fclose(curlData->headerHandle);
3893 curlData->headerHandle=NULL;
3895 if (curlData->stderrHandle!=NULL) {
3896 fclose(curlData->stderrHandle);
3897 curlData->stderrHandle=NULL;
3901 /*----------------------------------------------------------------------
3905 * Opens a file to be used during a transfer.
3908 * fileName: name of the file.
3909 * handle: the handle for the file
3910 * writing: '0' if reading, '1' if writing.
3911 * text: '0' if binary, '1' if text.
3914 * '0' all went well, '1' in case of error.
3915 *----------------------------------------------------------------------
3918 curlOpenFile(Tcl_Interp *interp,char *fileName, FILE **handle, int writing, int text) {
3919 Tcl_Obj *resultObjPtr;
3922 if (*handle!=NULL) {
3927 *handle=fopen(fileName,"w");
3929 *handle=fopen(fileName,"wb");
3933 *handle=fopen(fileName,"r");
3935 *handle=fopen(fileName,"rb");
3938 if (*handle==NULL) {
3939 snprintf(errorMsg,300,"Couldn't open file %s.",fileName);
3940 resultObjPtr=Tcl_NewStringObj(errorMsg,-1);
3941 Tcl_SetObjResult(interp,resultObjPtr);
3947 /*----------------------------------------------------------------------
3951 * When the user requests the 'any' auth, libcurl may need
3952 * to send the PUT/POST data more than once and thus may need to ask
3953 * the app to "rewind" the read data stream to start.
3955 *----------------------------------------------------------------------
3959 curlseek(void *instream, curl_off_t offset, int origin)
3961 if(-1 == fseek((FILE *)instream, 0, origin)) {
3962 return CURLIOE_FAILRESTART;
3967 /*----------------------------------------------------------------------
3969 * curlSetPostData --
3971 * In case there is going to be a post transfer, this function sets the
3972 * data that is going to be posted.
3975 * interp: Tcl interpreter we are using.
3976 * curlData: A pointer to the struct with the transfer data.
3979 * A standard Tcl result.
3980 *----------------------------------------------------------------------
3983 curlSetPostData(Tcl_Interp *interp,struct curlObjData *curlDataPtr) {
3984 Tcl_Obj *errorMsgObjPtr;
3986 if (curlDataPtr->postListFirst!=NULL) {
3987 if (curl_easy_setopt(curlDataPtr->curl,CURLOPT_HTTPPOST,curlDataPtr->postListFirst)) {
3988 curl_formfree(curlDataPtr->postListFirst);
3989 errorMsgObjPtr=Tcl_NewStringObj("Error setting the data to post",-1);
3990 Tcl_SetObjResult(interp,errorMsgObjPtr);
3997 /*----------------------------------------------------------------------
3999 * curlResetPostData --
4001 * After performing a transfer, this function is invoked to erease the
4005 * curlData: A pointer to the struct with the transfer data.
4006 *----------------------------------------------------------------------
4009 curlResetPostData(struct curlObjData *curlDataPtr) {
4010 struct formArrayStruct *tmpPtr;
4012 if (curlDataPtr->postListFirst) {
4013 curl_formfree(curlDataPtr->postListFirst);
4014 curlDataPtr->postListFirst=NULL;
4015 curlDataPtr->postListLast=NULL;
4016 curl_easy_setopt(curlDataPtr->curl,CURLOPT_HTTPPOST,NULL);
4018 while(curlDataPtr->formArray!=NULL) {
4019 if (curlDataPtr->formArray->formHeaderList!=NULL) {
4020 curl_slist_free_all(curlDataPtr->formArray->formHeaderList);
4021 curlDataPtr->formArray->formHeaderList=NULL;
4023 curlResetFormArray(curlDataPtr->formArray->formArray);
4024 tmpPtr=curlDataPtr->formArray->next;
4025 Tcl_Free((char *)curlDataPtr->formArray);
4026 curlDataPtr->formArray=tmpPtr;
4030 /*----------------------------------------------------------------------
4032 * curlResetFormArray --
4034 * Cleans the contents of the formArray, it is done after a transfer or
4035 * if 'curl_formadd' returns an error.
4038 * formArray: A pointer to the array to clean up.
4039 *----------------------------------------------------------------------
4042 curlResetFormArray(struct curl_forms *formArray) {
4045 for (i=0;formArray[i].option!=CURLFORM_END;i++) {
4046 switch (formArray[i].option) {
4047 case CURLFORM_COPYNAME:
4048 case CURLFORM_COPYCONTENTS:
4050 case CURLFORM_CONTENTTYPE:
4051 case CURLFORM_FILENAME:
4052 case CURLFORM_FILECONTENT:
4053 case CURLFORM_BUFFER:
4054 case CURLFORM_BUFFERPTR:
4055 Tcl_Free((char *)(formArray[i].value));
4061 Tcl_Free((char *)formArray);
4064 /*----------------------------------------------------------------------
4066 * curlSetBodyVarName --
4068 * After performing a transfer, this function is invoked to set the
4069 * body of the recieved transfer into a user defined Tcl variable.
4072 * interp: The Tcl interpreter we are using.
4073 * curlData: A pointer to the struct with the transfer data.
4074 *----------------------------------------------------------------------
4077 curlSetBodyVarName(Tcl_Interp *interp,struct curlObjData *curlDataPtr) {
4078 Tcl_Obj *bodyVarNameObjPtr, *bodyVarObjPtr;
4080 bodyVarNameObjPtr=Tcl_NewStringObj(curlDataPtr->bodyVarName,-1);
4081 bodyVarObjPtr=Tcl_NewByteArrayObj((unsigned char *)curlDataPtr->bodyVar.memory,
4082 curlDataPtr->bodyVar.size);
4084 Tcl_ObjSetVar2(interp,bodyVarNameObjPtr,(Tcl_Obj *)NULL,bodyVarObjPtr,0);
4086 Tcl_Free(curlDataPtr->bodyVar.memory);
4087 curlDataPtr->bodyVar.memory=NULL;
4088 curlDataPtr->bodyVar.size=0;
4091 /*----------------------------------------------------------------------
4094 * The same as strdup, but won't seg fault if the string to copy is NULL.
4097 * old: The original one.
4100 * Returns a pointer to the new string.
4101 *----------------------------------------------------------------------
4104 *curlstrdup (char *old) {
4110 tmpPtr=Tcl_Alloc(strlen(old)+1);
4117 *----------------------------------------------------------------------
4119 * curlShareInitObjCmd --
4121 * Looks for the first free share handle (scurl1, scurl2,...) and
4122 * creates a Tcl command for it.
4125 * A string with the name of the handle, don't forget to free it.
4128 * See the user documentation.
4130 *----------------------------------------------------------------------
4134 curlCreateShareObjCmd (Tcl_Interp *interp,struct shcurlObjData *shcurlData) {
4138 Tcl_Command cmdToken;
4140 /* We try with scurl1, if it already exists with scurl2...*/
4141 shandleName=(char *)Tcl_Alloc(10);
4143 sprintf(shandleName,"scurl%d",i);
4144 if (!Tcl_GetCommandInfo(interp,shandleName,&info)) {
4145 cmdToken=Tcl_CreateObjCommand(interp,shandleName,curlShareObjCmd,
4146 (ClientData)shcurlData,
4147 (Tcl_CmdDeleteProc *)curlCleanUpShareCmd);
4151 shcurlData->token=cmdToken;
4157 *----------------------------------------------------------------------
4159 * curlShareInitObjCmd --
4161 * This procedure is invoked to process the "curl::shareinit" Tcl command.
4162 * See the user documentation for details on what it does.
4165 * A standard Tcl result.
4168 * See the user documentation.
4170 *----------------------------------------------------------------------
4174 curlShareInitObjCmd (ClientData clientData, Tcl_Interp *interp,
4175 int objc,Tcl_Obj *CONST objv[]) {
4179 struct shcurlObjData *shcurlData;
4182 shcurlData=(struct shcurlObjData *)Tcl_Alloc(sizeof(struct shcurlObjData));
4183 if (shcurlData==NULL) {
4184 resultPtr=Tcl_NewStringObj("Couldn't allocate memory",-1);
4185 Tcl_SetObjResult(interp,resultPtr);
4189 memset(shcurlData, 0, sizeof(struct shcurlObjData));
4191 shcurlHandle=curl_share_init();
4192 if (shcurlHandle==NULL) {
4193 resultPtr=Tcl_NewStringObj("Couldn't create share handle",-1);
4194 Tcl_SetObjResult(interp,resultPtr);
4198 shandleName=curlCreateShareObjCmd(interp,shcurlData);
4200 shcurlData->shandle=shcurlHandle;
4202 resultPtr=Tcl_NewStringObj(shandleName,-1);
4203 Tcl_SetObjResult(interp,resultPtr);
4204 Tcl_Free(shandleName);
4207 curl_share_setopt(shcurlHandle, CURLSHOPT_LOCKFUNC, curlShareLockFunc);
4208 curl_share_setopt(shcurlHandle, CURLSHOPT_LOCKFUNC, curlShareUnLockFunc);
4216 *----------------------------------------------------------------------
4218 * curlShareLockFunc --
4220 * This will be the function invoked by libcurl when it wants to lock
4221 * some data for the share interface.
4224 * See the user documentation.
4226 *----------------------------------------------------------------------
4230 curlShareLockFunc (CURL *handle, curl_lock_data data, curl_lock_access access
4234 CURL_LOCK_DATA_COOKIE:
4235 Tcl_MutexLock(&cookieLock);
4238 Tcl_MutexLock(&dnsLock);
4240 CURL_LOCK_DATA_SSL_SESSION:
4241 Tcl_MutexLock(&sslLock);
4243 CURL_LOCK_DATA_CONNECT:
4244 Tcl_MutexLock(&connectLock);
4247 /* Prevent useless compile warnings */
4253 *----------------------------------------------------------------------
4255 * curlShareUnLockFunc --
4257 * This will be the function invoked by libcurl when it wants to unlock
4258 * the previously locked data.
4261 * See the user documentation.
4263 *----------------------------------------------------------------------
4266 curlShareUnLockFunc(CURL *handle, curl_lock_data data, void *userptr) {
4269 CURL_LOCK_DATA_COOKIE:
4270 Tcl_MutexUnlock(&cookieLock);
4273 Tcl_MutexUnlock(&dnsLock);
4275 CURL_LOCK_DATA_SSL_SESSION:
4276 Tcl_MutexUnlock(&sslLock);
4278 CURL_LOCK_DATA_CONNECT:
4279 Tcl_MutexUnlock(&connectLock);
4289 *----------------------------------------------------------------------
4291 * curlShareObjCmd --
4293 * This procedure is invoked to process the "share curl" commands.
4294 * See the user documentation for details on what it does.
4297 * A standard Tcl result.
4300 * See the user documentation.
4302 *----------------------------------------------------------------------
4305 curlShareObjCmd (ClientData clientData, Tcl_Interp *interp,
4306 int objc,Tcl_Obj *CONST objv[]) {
4308 struct shcurlObjData *shcurlData=(struct shcurlObjData *)clientData;
4309 CURLSH *shcurlHandle=shcurlData->shandle;
4310 int tableIndex, dataIndex;
4314 Tcl_WrongNumArgs(interp,1,objv,"option arg ?arg?");
4318 if (Tcl_GetIndexFromObj(interp, objv[1], shareCmd, "option",TCL_EXACT,&tableIndex)==TCL_ERROR) {
4322 switch(tableIndex) {
4325 if (Tcl_GetIndexFromObj(interp, objv[2], lockData,
4326 "data to lock ",TCL_EXACT,&dataIndex)==TCL_ERROR) {
4331 dataToLock=CURL_LOCK_DATA_COOKIE;
4334 dataToLock=CURL_LOCK_DATA_DNS;
4337 if (tableIndex==0) {
4338 curl_share_setopt(shcurlHandle, CURLSHOPT_SHARE, dataToLock);
4340 curl_share_setopt(shcurlHandle, CURLSHOPT_UNSHARE, dataToLock);
4344 Tcl_DeleteCommandFromToken(interp,shcurlData->token);
4351 *----------------------------------------------------------------------
4353 * curlCleanUpShareCmd --
4355 * This procedure is invoked when curl share handle is deleted.
4358 * A standard Tcl result.
4361 * Cleans the curl share handle and frees the memory.
4363 *----------------------------------------------------------------------
4366 curlCleanUpShareCmd(ClientData clientData) {
4367 struct shcurlObjData *shcurlData=(struct shcurlObjData *)clientData;
4368 CURLSH *shcurlHandle=shcurlData->shandle;
4370 curl_share_cleanup(shcurlHandle);
4371 Tcl_Free((char *)shcurlData);
4377 *----------------------------------------------------------------------
4379 * curlErrorStrings --
4381 * All the commands to return the error string from the error code have
4382 * this function in common.
4385 * '0': All went well.
4386 * '1': The error code didn't make sense.
4387 *----------------------------------------------------------------------
4390 curlErrorStrings (Tcl_Interp *interp, Tcl_Obj *CONST objv,int type) {
4396 if (Tcl_GetIntFromObj(interp,objv,&errorCode)) {
4397 snprintf(errorMsg,500,"Invalid error code: %s",Tcl_GetString(objv));
4398 resultPtr=Tcl_NewStringObj(errorMsg,-1);
4399 Tcl_SetObjResult(interp,resultPtr);
4404 resultPtr=Tcl_NewStringObj(curl_easy_strerror(errorCode),-1);
4407 resultPtr=Tcl_NewStringObj(curl_share_strerror(errorCode),-1);
4410 resultPtr=Tcl_NewStringObj(curl_multi_strerror(errorCode),-1);
4413 resultPtr=Tcl_NewStringObj("You're kidding,right?",-1);
4415 Tcl_SetObjResult(interp,resultPtr);
4421 *----------------------------------------------------------------------
4423 * curlEasyStringError --
4425 * This function is invoked to process the "curl::easystrerror" Tcl command.
4426 * It will return a string with an explanation of the error code given.
4429 * A standard Tcl result.
4432 * The interpreter will contain as a result the string with the error
4435 *----------------------------------------------------------------------
4438 curlEasyStringError (ClientData clientData, Tcl_Interp *interp,
4439 int objc,Tcl_Obj *CONST objv[]) {
4442 Tcl_WrongNumArgs(interp,1,objv,"errorCode");
4446 if (curlErrorStrings(interp,objv[1],0)) {
4453 *----------------------------------------------------------------------
4455 * curlShareStringError --
4457 * This function is invoked to process the "curl::sharestrerror" Tcl command.
4458 * It will return a string with an explanation of the error code given.
4461 * A standard Tcl result.
4464 * The interpreter will contain as a result the string with the error
4467 *----------------------------------------------------------------------
4470 curlShareStringError (ClientData clientData, Tcl_Interp *interp,
4471 int objc,Tcl_Obj *CONST objv[]) {
4474 Tcl_WrongNumArgs(interp,1,objv,"errorCode");
4478 if (curlErrorStrings(interp,objv[1],1)) {
4485 *----------------------------------------------------------------------
4487 * curlMultiStringError --
4489 * This function is invoked to process the "curl::multirerror" Tcl command.
4490 * It will return a string with an explanation of the error code given.
4493 * A standard Tcl result.
4496 * The interpreter will contain as a result the string with the error
4499 *----------------------------------------------------------------------
4502 curlMultiStringError (ClientData clientData, Tcl_Interp *interp,
4503 int objc,Tcl_Obj *CONST objv[]) {
4506 Tcl_WrongNumArgs(interp,1,objv,"errorCode");
4510 if (curlErrorStrings(interp,objv[1],2)) {