4 * Implementation of the TclCurl extension that creates the curl namespace
5 * so that Tcl interpreters can access libcurl.
7 * Copyright (c) 2001-2009 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.19.6");
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[]) {
355 fprintf(stdout,"Llegamos a curlSetOptsTrasnfer\n");
356 if (Tcl_GetIndexFromObj(interp, objv[2], optionTable, "option",
357 TCL_EXACT, &tableIndex)==TCL_ERROR) {
360 fprintf(stdout,"La opcion es la %d\n",tableIndex);
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;
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;
751 formArray[formArrayIndex].value = (char *)
752 memcpy(Tcl_Alloc(curlformBufferSize), tmpStr, curlformBufferSize);
755 formArray[formArrayIndex].option = CURLFORM_CONTENTSLENGTH;
756 contentslen=curlformBufferSize++;
757 formArray[formArrayIndex].value = (char *)contentslen;
760 /* fprintf(stdout,"File name %d: %s\n",formArrayIndex,Tcl_GetString(httpPostData[i+1]));*/
761 formArray[formArrayIndex].option = CURLFORM_FILE;
762 formArray[formArrayIndex].value = curlstrdup(Tcl_GetString(httpPostData[i+1]));
765 /* fprintf(stdout,"Data type: %s\n",Tcl_GetString(httpPostData[i+1]));*/
766 formArray[formArrayIndex].option = CURLFORM_CONTENTTYPE;
767 formArray[formArrayIndex].value = curlstrdup(Tcl_GetString(httpPostData[i+1]));
770 /* fprintf(stdout,"ContentHeader: %s\n",Tcl_GetString(httpPostData[i+1]));*/
771 formArray[formArrayIndex].option = CURLFORM_CONTENTHEADER;
772 if(SetoptsList(interp,&newFormArray->formHeaderList,httpPostData[i+1])) {
773 curlErrorSetOpt(interp,configTable,tableIndex,"Header list invalid");
777 formArray[formArrayIndex].value = (char *)newFormArray->formHeaderList;
780 /* fprintf(stdout,"FileName: %s\n",Tcl_GetString(httpPostData[i+1])); */
781 formArray[formArrayIndex].option = CURLFORM_FILENAME;
782 formArray[formArrayIndex].value = curlstrdup(Tcl_GetString(httpPostData[i+1]));
785 /* fprintf(stdout,"BufferName: %s\n",Tcl_GetString(httpPostData[i+1])); */
786 formArray[formArrayIndex].option = CURLFORM_BUFFER;
787 formArray[formArrayIndex].value = curlstrdup(Tcl_GetString(httpPostData[i+1]));
790 /* fprintf(stdout,"Buffer: %s\n",Tcl_GetString(httpPostData[i+1])); */
791 tmpUStr=Tcl_GetByteArrayFromObj
792 (httpPostData[i+1],&curlformBufferSize);
793 formArray[formArrayIndex].option = CURLFORM_BUFFERPTR;
794 formArray[formArrayIndex].value = (char *)
795 memcpy(Tcl_Alloc(curlformBufferSize), tmpUStr, curlformBufferSize);
797 formArray[formArrayIndex].option = CURLFORM_BUFFERLENGTH;
798 contentslen=curlformBufferSize;
799 formArray[formArrayIndex].value = (char *)contentslen;
802 /* fprintf(stdout,"FileName: %s\n",Tcl_GetString(httpPostData[i+1])); */
803 formArray[formArrayIndex].option = CURLFORM_FILECONTENT;
804 formArray[formArrayIndex].value = curlstrdup(Tcl_GetString(httpPostData[i+1]));
809 formArray[formArrayIndex].option=CURLFORM_END;
810 curlData->formArray=newFormArray;
812 if (0==formaddError) {
813 formaddError=curl_formadd(&(curlData->postListFirst)
814 ,&(curlData->postListLast), CURLFORM_ARRAY, formArray
817 if (formaddError!=CURL_FORMADD_OK) {
818 curlResetFormArray(formArray);
819 curlData->formArray=newFormArray->next;
820 Tcl_Free((char *)newFormArray);
821 tmpStr=Tcl_Alloc(10);
822 snprintf(tmpStr,10,"%d",formaddError);
823 resultObjPtr=Tcl_NewStringObj(tmpStr,-1);
824 Tcl_SetObjResult(interp,resultObjPtr);
831 if (SetoptChar(interp,curlHandle,CURLOPT_SSLCERT,tableIndex,objv)) {
836 if (SetoptChar(interp,curlHandle,CURLOPT_SSLCERTPASSWD,tableIndex,objv)) {
841 if (Tcl_GetIndexFromObj(interp, objv, sslversion,
842 "sslversion ",TCL_EXACT,&intNumber)==TCL_ERROR) {
847 longNumber=CURL_SSLVERSION_DEFAULT;
850 longNumber=CURL_SSLVERSION_TLSv1;
853 longNumber=CURL_SSLVERSION_SSLv2;
856 longNumber=CURL_SSLVERSION_SSLv3;
858 tmpObjPtr=Tcl_NewLongObj(longNumber);
859 if (SetoptLong(interp,curlHandle,CURLOPT_SSLVERSION,
860 tableIndex,tmpObjPtr)) {
865 if (SetoptInt(interp,curlHandle,CURLOPT_CRLF,tableIndex,objv)) {
870 if(SetoptsList(interp,&curlData->quote,objv)) {
871 curlErrorSetOpt(interp,configTable,tableIndex,"quote list invalid");
874 if (curl_easy_setopt(curlHandle,CURLOPT_QUOTE,curlData->quote)) {
875 curl_slist_free_all(curlData->quote);
876 curlData->quote=NULL;
882 if(SetoptsList(interp,&curlData->postquote,objv)) {
883 curlErrorSetOpt(interp,configTable,tableIndex,"postqoute invalid");
886 if (curl_easy_setopt(curlHandle,CURLOPT_POSTQUOTE,curlData->postquote)) {
887 curlErrorSetOpt(interp,configTable,tableIndex,"postqoute invalid");
888 curl_slist_free_all(curlData->postquote);
889 curlData->postquote=NULL;
895 Tcl_Free(curlData->headerFile);
896 curlData->headerFile=curlstrdup(Tcl_GetString(objv));
897 if ((strcmp(curlData->headerFile,""))&&(strcmp(curlData->headerFile,"stdout"))
898 &&(strcmp(curlData->headerFile,"stderr"))) {
899 curlData->headerFlag=1;
901 if ((strcmp(curlData->headerFile,"stdout"))) {
902 curl_easy_setopt(curlHandle,CURLOPT_HEADERDATA,stderr);
904 curl_easy_setopt(curlHandle,CURLOPT_HEADERDATA,stdout);
906 curlData->headerFlag=0;
907 curlData->headerFile=NULL;
911 if (Tcl_GetIndexFromObj(interp, objv, timeCond,
912 "time cond option",TCL_EXACT, &intNumber)==TCL_ERROR) {
916 longNumber=CURL_TIMECOND_IFMODSINCE;
918 longNumber=CURL_TIMECOND_IFUNMODSINCE;
920 if (curl_easy_setopt(curlHandle,CURLOPT_TIMECONDITION,longNumber)) {
925 if (SetoptLong(interp,curlHandle,CURLOPT_TIMEVALUE,tableIndex,
931 if (SetoptChar(interp,curlHandle,CURLOPT_CUSTOMREQUEST,tableIndex,objv)) {
936 Tcl_Free(curlData->stderrFile);
937 curlData->stderrFile=curlstrdup(Tcl_GetString(objv));
938 if ((strcmp(curlData->stderrFile,""))&&(strcmp(curlData->stderrFile,"stdout"))
939 &&(strcmp(curlData->stderrFile,"stderr"))) {
940 curlData->stderrFlag=1;
942 curlData->stderrFlag=0;
943 if (strcmp(curlData->stderrFile,"stdout")) {
944 curl_easy_setopt(curlHandle,CURLOPT_STDERR,stderr);
946 curl_easy_setopt(curlHandle,CURLOPT_STDERR,stdout);
948 curlData->stderrFile=NULL;
952 if (SetoptChar(interp,curlHandle,CURLOPT_INTERFACE,tableIndex,objv)) {
958 if (SetoptChar(interp,curlHandle,CURLOPT_KRBLEVEL,tableIndex,objv)) {
963 if (SetoptLong(interp,curlHandle,CURLOPT_SSL_VERIFYPEER,tableIndex,
969 if (SetoptChar(interp,curlHandle,CURLOPT_CAINFO,tableIndex,objv)) {
974 if (SetoptLong(interp,curlHandle,CURLOPT_FILETIME,tableIndex,
980 if (SetoptLong(interp,curlHandle,CURLOPT_MAXREDIRS,tableIndex,
986 if (SetoptLong(interp,curlHandle,CURLOPT_MAXCONNECTS,tableIndex,
992 curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
996 if (SetoptChar(interp,curlHandle,CURLOPT_RANDOM_FILE,tableIndex,objv)) {
1001 if (SetoptChar(interp,curlHandle,CURLOPT_EGDSOCKET,tableIndex,objv)) {
1006 if (SetoptLong(interp,curlHandle,CURLOPT_CONNECTTIMEOUT,
1012 if (SetoptLong(interp,curlHandle,CURLOPT_NOPROGRESS,
1018 if (curl_easy_setopt(curlHandle,CURLOPT_HEADERFUNCTION,
1019 curlHeaderReader)) {
1022 Tcl_Free(curlData->headerVar);
1023 curlData->headerVar=curlstrdup(Tcl_GetString(objv));
1024 if (curl_easy_setopt(curlHandle,CURLOPT_HEADERDATA,
1025 (FILE *)curlData)) {
1030 Tcl_Free(curlData->bodyVarName);
1031 curlData->bodyVarName=curlstrdup(Tcl_GetString(objv));
1032 if (curl_easy_setopt(curlHandle,CURLOPT_WRITEFUNCTION,
1036 if (curl_easy_setopt(curlHandle,CURLOPT_WRITEDATA,curlData)) {
1041 Tcl_Free(curlData->progressProc);
1042 curlData->progressProc=curlstrdup(Tcl_GetString(objv));
1043 if (strcmp(curlData->progressProc,"")) {
1044 if (curl_easy_setopt(curlHandle,CURLOPT_PROGRESSFUNCTION,
1045 curlProgressCallback)) {
1048 if (curl_easy_setopt(curlHandle,CURLOPT_PROGRESSDATA,
1053 if (curl_easy_setopt(curlHandle,CURLOPT_PROGRESSFUNCTION,NULL)) {
1059 if (curlData->cancelTransVarName) {
1060 Tcl_UnlinkVar(curlData->interp,curlData->cancelTransVarName);
1061 Tcl_Free(curlData->cancelTransVarName);
1063 curlData->cancelTransVarName=curlstrdup(Tcl_GetString(objv));
1064 Tcl_LinkVar(interp,curlData->cancelTransVarName,
1065 (char *)&(curlData->cancelTrans),TCL_LINK_INT);
1068 curlData->writeProc=curlstrdup(Tcl_GetString(objv));
1069 curlData->outFlag=0;
1070 if (curl_easy_setopt(curlHandle,CURLOPT_WRITEFUNCTION,
1071 curlWriteProcInvoke)) {
1072 curl_easy_setopt(curlHandle,CURLOPT_WRITEFUNCTION,NULL);
1075 if (curl_easy_setopt(curlHandle,CURLOPT_WRITEDATA,curlData)) {
1076 curl_easy_setopt(curlHandle,CURLOPT_WRITEFUNCTION,NULL);
1081 curlData->readProc=curlstrdup(Tcl_GetString(objv));
1083 if (strcmp(curlData->readProc,"")) {
1084 if (curl_easy_setopt(curlHandle,CURLOPT_READFUNCTION,
1085 curlReadProcInvoke)) {
1089 curl_easy_setopt(curlHandle,CURLOPT_READFUNCTION,NULL);
1092 if (curl_easy_setopt(curlHandle,CURLOPT_READDATA,curlData)) {
1097 if (SetoptLong(interp,curlHandle,CURLOPT_SSL_VERIFYHOST,
1103 if (SetoptChar(interp,curlHandle,CURLOPT_COOKIEJAR,tableIndex,objv)) {
1108 if (SetoptChar(interp,curlHandle,CURLOPT_SSL_CIPHER_LIST,tableIndex,objv)) {
1113 if (Tcl_GetIndexFromObj(interp, objv, httpVersionTable,
1114 "http version",TCL_EXACT,&tableIndex)==TCL_ERROR) {
1117 if (curl_easy_setopt(curlHandle,CURLOPT_HTTP_VERSION,
1119 tmpStr=curlstrdup(Tcl_GetString(objv));
1120 curlErrorSetOpt(interp,configTable,70,tmpStr);
1126 if (SetoptLong(interp,curlHandle,CURLOPT_FTP_USE_EPSV,
1132 if (SetoptChar(interp,curlHandle,CURLOPT_SSLCERTTYPE,tableIndex,objv)) {
1137 if (SetoptChar(interp,curlHandle,CURLOPT_SSLKEY,tableIndex,objv)) {
1142 if (SetoptChar(interp,curlHandle,CURLOPT_SSLKEYTYPE,tableIndex,objv)) {
1148 if (SetoptChar(interp,curlHandle,CURLOPT_KEYPASSWD,tableIndex,objv)) {
1153 if (SetoptChar(interp,curlHandle,CURLOPT_SSLENGINE,tableIndex,objv)) {
1158 if (SetoptLong(interp,curlHandle,CURLOPT_SSLENGINE_DEFAULT,tableIndex,objv)) {
1163 if(SetoptsList(interp,&curlData->prequote,objv)) {
1164 curlErrorSetOpt(interp,configTable,tableIndex,"pretqoute invalid");
1167 if (curl_easy_setopt(curlHandle,CURLOPT_PREQUOTE,curlData->prequote)) {
1168 curlErrorSetOpt(interp,configTable,tableIndex,"preqoute invalid");
1169 curl_slist_free_all(curlData->prequote);
1170 curlData->prequote=NULL;
1176 curlData->debugProc=curlstrdup(Tcl_GetString(objv));
1177 if (curl_easy_setopt(curlHandle,CURLOPT_DEBUGFUNCTION,
1178 curlDebugProcInvoke)) {
1181 if (curl_easy_setopt(curlHandle,CURLOPT_DEBUGDATA,curlData)) {
1186 if (SetoptLong(interp,curlHandle,CURLOPT_DNS_CACHE_TIMEOUT,
1192 if (SetoptLong(interp,curlHandle,CURLOPT_DNS_USE_GLOBAL_CACHE,
1198 if (SetoptLong(interp,curlHandle,CURLOPT_COOKIESESSION,
1204 if (SetoptChar(interp,curlHandle,CURLOPT_CAPATH,tableIndex,objv)) {
1209 if (SetoptLong(interp,curlHandle,CURLOPT_BUFFERSIZE,
1215 if (SetoptLong(interp,curlHandle,CURLOPT_NOSIGNAL,
1221 if (Tcl_GetIndexFromObj(interp, objv, encodingTable,
1222 "encoding",TCL_EXACT,&tableIndex)==TCL_ERROR) {
1225 if (tableIndex==2) {
1226 if (curl_easy_setopt(curlHandle,CURLOPT_ENCODING,"")) {
1227 curlErrorSetOpt(interp,configTable,86,"all");
1231 if (SetoptChar(interp,curlHandle,CURLOPT_ENCODING,86,objv)) {
1237 if (Tcl_GetIndexFromObj(interp, objv, proxyTypeTable,
1238 "proxy type",TCL_EXACT,&tableIndex)==TCL_ERROR) {
1241 switch(tableIndex) {
1243 curl_easy_setopt(curlHandle,CURLOPT_PROXYTYPE,
1246 curl_easy_setopt(curlHandle,CURLOPT_PROXYTYPE,
1249 curl_easy_setopt(curlHandle,CURLOPT_PROXYTYPE,
1252 curl_easy_setopt(curlHandle,CURLOPT_PROXYTYPE,
1255 curl_easy_setopt(curlHandle,CURLOPT_PROXYTYPE,
1256 CURLPROXY_SOCKS5_HOSTNAME);
1260 if(SetoptsList(interp,&curlData->http200aliases,objv)) {
1261 curlErrorSetOpt(interp,configTable,tableIndex,"http200aliases invalid");
1264 if (curl_easy_setopt(curlHandle,CURLOPT_HTTP200ALIASES,curlData->http200aliases)) {
1265 curlErrorSetOpt(interp,configTable,tableIndex,"http200aliases invalid");
1266 curl_slist_free_all(curlData->http200aliases);
1267 curlData->http200aliases=NULL;
1273 if (SetoptInt(interp,curlHandle,CURLOPT_UNRESTRICTED_AUTH
1274 ,tableIndex,objv)) {
1279 if (SetoptLong(interp,curlHandle,CURLOPT_FTP_USE_EPRT,
1285 Tcl_Free(curlData->command);
1286 curlData->command=curlstrdup(Tcl_GetString(objv));
1289 if (Tcl_GetIndexFromObj(interp, objv, httpAuthMethods,
1290 "authentication method",TCL_EXACT,&intNumber)==TCL_ERROR) {
1293 curlData->anyAuthFlag=0;
1296 longNumber=CURLAUTH_BASIC;
1299 longNumber=CURLAUTH_DIGEST;
1302 longNumber=CURLAUTH_DIGEST_IE;
1305 longNumber=CURLAUTH_GSSNEGOTIATE;
1308 longNumber=CURLAUTH_NTLM;
1311 longNumber=CURLAUTH_ANY;
1312 curlData->anyAuthFlag=1;
1315 longNumber=CURLAUTH_ANYSAFE;
1318 tmpObjPtr=Tcl_NewLongObj(longNumber);
1319 if (SetoptLong(interp,curlHandle,CURLOPT_HTTPAUTH
1320 ,tableIndex,tmpObjPtr)) {
1325 if (SetoptLong(interp,curlHandle,CURLOPT_FTP_CREATE_MISSING_DIRS,
1331 if (Tcl_GetIndexFromObj(interp, objv, httpAuthMethods,
1332 "authentication method",TCL_EXACT,&intNumber)==TCL_ERROR) {
1337 longNumber=CURLAUTH_BASIC;
1340 longNumber=CURLAUTH_DIGEST;
1343 longNumber=CURLAUTH_GSSNEGOTIATE;
1346 longNumber=CURLAUTH_NTLM;
1349 longNumber=CURLAUTH_ANY;
1352 longNumber=CURLAUTH_ANYSAFE;
1355 tmpObjPtr=Tcl_NewLongObj(longNumber);
1356 if (SetoptLong(interp,curlHandle,CURLOPT_PROXYAUTH
1357 ,tableIndex,tmpObjPtr)) {
1362 if (SetoptLong(interp,curlHandle,CURLOPT_FTP_RESPONSE_TIMEOUT,
1368 if (Tcl_GetIndexFromObj(interp, objv, ipresolve,
1369 "ip version",TCL_EXACT,&curlTableIndex)==TCL_ERROR) {
1372 switch(curlTableIndex) {
1374 longNumber=CURL_IPRESOLVE_WHATEVER;
1377 longNumber=CURL_IPRESOLVE_V4;
1380 longNumber=CURL_IPRESOLVE_V6;
1383 tmpObjPtr=Tcl_NewLongObj(longNumber);
1384 if (SetoptLong(interp,curlHandle,CURLOPT_IPRESOLVE
1385 ,tableIndex,tmpObjPtr)) {
1390 if (SetoptLong(interp,curlHandle,CURLOPT_MAXFILESIZE,
1396 if (SetoptChar(interp,curlHandle,CURLOPT_NETRC_FILE,tableIndex,objv)) {
1402 if (Tcl_GetIndexFromObj(interp, objv, ftpssl,
1403 "ftps method ",TCL_EXACT,&intNumber)==TCL_ERROR) {
1408 longNumber=CURLUSESSL_NONE;
1411 longNumber=CURLUSESSL_TRY;
1414 longNumber=CURLUSESSL_CONTROL;
1417 longNumber=CURLUSESSL_ALL;
1420 tmpObjPtr=Tcl_NewLongObj(longNumber);
1421 if (SetoptLong(interp,curlHandle,CURLOPT_USE_SSL,
1422 tableIndex,tmpObjPtr)) {
1427 if (SetoptSHandle(interp,curlHandle,CURLOPT_SHARE,
1433 if (SetoptLong(interp,curlHandle,CURLOPT_PORT,
1439 if (SetoptLong(interp,curlHandle,CURLOPT_TCP_NODELAY,
1445 if (SetoptLong(interp,curlHandle,CURLOPT_AUTOREFERER,
1451 curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1455 curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1459 curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1463 curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete, check '-ftpport'");
1467 curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete, check '-ftpport'");
1471 curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1475 curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1479 if (Tcl_GetIndexFromObj(interp, objv, ftpsslauth,
1480 "ftpsslauth method ",TCL_EXACT,&intNumber)==TCL_ERROR) {
1485 longNumber=CURLFTPAUTH_DEFAULT;
1488 longNumber=CURLFTPAUTH_SSL;
1491 longNumber=CURLFTPAUTH_TLS;
1494 tmpObjPtr=Tcl_NewLongObj(longNumber);
1495 if (SetoptLong(interp,curlHandle,CURLOPT_FTPSSLAUTH,
1496 tableIndex,tmpObjPtr)) {
1501 curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1505 curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1509 if (SetoptChar(interp,curlHandle,CURLOPT_FTP_ACCOUNT,tableIndex,objv)) {
1514 if (SetoptLong(interp,curlHandle,CURLOPT_IGNORE_CONTENT_LENGTH,
1520 if (SetoptChar(interp,curlHandle,CURLOPT_COOKIELIST,tableIndex,objv)) {
1525 if (SetoptLong(interp,curlHandle,CURLOPT_FTP_SKIP_PASV_IP,
1531 if (Tcl_GetIndexFromObj(interp, objv, ftpfilemethod,
1532 "ftp file method ",TCL_EXACT,&intNumber)==TCL_ERROR) {
1538 longNumber=1; /* FTPFILE_MULTICWD */
1541 longNumber=2; /* FTPFILE_NOCWD */
1544 longNumber=3; /* FTPFILE_SINGLECWD */
1547 tmpObjPtr=Tcl_NewLongObj(longNumber);
1548 if (SetoptLong(interp,curlHandle,CURLOPT_FTP_FILEMETHOD,
1549 tableIndex,tmpObjPtr)) {
1554 if (SetoptLong(interp,curlHandle,CURLOPT_LOCALPORT,
1560 if (SetoptLong(interp,curlHandle,CURLOPT_LOCALPORTRANGE,
1566 if (SetoptCurlOffT(interp,curlHandle,CURLOPT_MAX_SEND_SPEED_LARGE,
1572 if (SetoptCurlOffT(interp,curlHandle,CURLOPT_MAX_RECV_SPEED_LARGE,
1578 if (SetoptChar(interp,curlHandle,
1579 CURLOPT_FTP_ALTERNATIVE_TO_USER,tableIndex,objv)) {
1584 if (SetoptLong(interp,curlHandle,CURLOPT_SSL_SESSIONID_CACHE,
1590 if (Tcl_GetIndexFromObj(interp, objv, sshauthtypes,
1591 "ssh auth type ",TCL_EXACT,&intNumber)==TCL_ERROR) {
1596 longNumber=CURLSSH_AUTH_PUBLICKEY;
1599 longNumber=CURLSSH_AUTH_PASSWORD;
1602 longNumber=CURLSSH_AUTH_HOST;
1605 longNumber=CURLSSH_AUTH_KEYBOARD;
1608 longNumber=CURLSSH_AUTH_ANY;
1611 tmpObjPtr=Tcl_NewLongObj(longNumber);
1612 if (SetoptLong(interp,curlHandle,CURLOPT_SSH_AUTH_TYPES,
1613 tableIndex,tmpObjPtr)) {
1618 if (SetoptChar(interp,curlHandle,CURLOPT_SSH_PUBLIC_KEYFILE,
1624 if (SetoptChar(interp,curlHandle,CURLOPT_SSH_PRIVATE_KEYFILE,
1630 if (SetoptLong(interp,curlHandle,CURLOPT_TIMEOUT_MS,
1636 if (SetoptLong(interp,curlHandle,CURLOPT_CONNECTTIMEOUT_MS,
1642 if (SetoptLong(interp,curlHandle,CURLOPT_HTTP_CONTENT_DECODING,
1648 if (SetoptLong(interp,curlHandle,CURLOPT_HTTP_TRANSFER_DECODING,
1653 /* 132 is together with case 50 */
1655 if (SetoptLong(interp,curlHandle,CURLOPT_NEW_FILE_PERMS,
1661 if (SetoptLong(interp,curlHandle,CURLOPT_NEW_DIRECTORY_PERMS,
1666 /* case 135 with 75, case 136 with 19, case 137 with 18 and case 138 with 99 */
1669 if (Tcl_GetIndexFromObj(interp, objv, postredir,
1670 "Postredir option ",TCL_EXACT,&intNumber)==TCL_ERROR) {
1675 longNumber=CURL_REDIR_POST_301;
1678 longNumber=CURL_REDIR_POST_302;
1681 longNumber=CURL_REDIR_POST_ALL;
1684 tmpObjPtr=Tcl_NewLongObj(longNumber);
1685 if (SetoptLong(interp,curlHandle,CURLOPT_POSTREDIR,
1686 tableIndex,tmpObjPtr)) {
1691 if (SetoptChar(interp,curlHandle,CURLOPT_SSH_HOST_PUBLIC_KEY_MD5,
1697 if (SetoptLong(interp,curlHandle,CURLOPT_PROXY_TRANSFER_MODE,
1703 if (SetoptChar(interp,curlHandle,CURLOPT_CRLFILE,
1709 if (SetoptChar(interp,curlHandle,CURLOPT_ISSUERCERT,
1715 if (SetoptLong(interp,curlHandle,CURLOPT_ADDRESS_SCOPE,
1721 if (SetoptLong(interp,curlHandle,CURLOPT_CERTINFO,
1726 /* case 146 is together with 139*/
1728 if (SetoptChar(interp,curlHandle,CURLOPT_USERNAME,
1734 if (SetoptChar(interp,curlHandle,CURLOPT_PASSWORD,
1740 if (SetoptChar(interp,curlHandle,CURLOPT_PROXYUSERNAME,
1746 if (SetoptChar(interp,curlHandle,CURLOPT_PROXYPASSWORD,
1752 if (SetoptLong(interp,curlHandle,CURLOPT_TFTP_BLKSIZE,
1758 if (SetoptChar(interp,curlHandle,CURLOPT_SOCKS5_GSSAPI_SERVICE,
1764 if (SetoptLong(interp,curlHandle,CURLOPT_SOCKS5_GSSAPI_NEC,
1771 if (Tcl_ListObjGetElements(interp,objv,&j,&protocols)==TCL_ERROR) {
1775 for (i=0,protocolMask=0;i<j;i++) {
1776 tmpStr=curlstrdup(Tcl_GetString(protocols[i]));
1777 if (Tcl_GetIndexFromObj(interp,protocols[i],protocolNames,
1778 "protocol",TCL_EXACT,&curlTableIndex)==TCL_ERROR) {
1781 switch(curlTableIndex) {
1782 case 0: /* http 1 */
1783 protocolMask|=CURLPROTO_HTTP;
1785 case 1: /* https 2 */
1786 protocolMask|=CURLPROTO_HTTPS;
1789 protocolMask|=CURLPROTO_FTP;
1791 case 3: /* ftps 8 */
1792 protocolMask|=CURLPROTO_FTPS;
1794 case 4: /* scp 16 */
1795 protocolMask|=CURLPROTO_SCP;
1797 case 5: /* sftp 32 */
1798 protocolMask|=CURLPROTO_SFTP;
1800 case 6: /* telnet 64 */
1801 protocolMask|=CURLPROTO_TELNET;
1803 case 7: /* ldap 128 */
1804 protocolMask|=CURLPROTO_LDAP;
1806 case 8: /* ldaps 256 */
1807 protocolMask|=CURLPROTO_LDAPS;
1809 case 9: /* dict 512 */
1810 protocolMask|=CURLPROTO_DICT;
1812 case 10: /* file 1024 */
1813 protocolMask|=CURLPROTO_FILE;
1815 case 11: /* tftp 2048 */
1816 protocolMask|=CURLPROTO_TFTP;
1818 case 12: /* all FFFF */
1819 protocolMask|=CURLPROTO_ALL;
1822 tmpObjPtr=Tcl_NewLongObj(protocolMask);
1823 if (tableIndex==154) {
1824 longNumber=CURLOPT_PROTOCOLS;
1826 longNumber=CURLOPT_REDIR_PROTOCOLS;
1828 if (SetoptLong(interp,curlHandle,longNumber,tableIndex,tmpObjPtr)) {
1833 if (Tcl_GetIndexFromObj(interp, objv, ftpsslccc,
1834 "Clear Command Channel option ",TCL_EXACT,&intNumber)==TCL_ERROR) {
1839 longNumber=CURLFTPSSL_CCC_NONE;
1842 longNumber=CURLFTPSSL_CCC_PASSIVE;
1845 longNumber=CURLFTPSSL_CCC_ACTIVE;
1848 tmpObjPtr=Tcl_NewLongObj(longNumber);
1849 if (SetoptLong(interp,curlHandle,CURLOPT_FTP_SSL_CCC,
1850 tableIndex,tmpObjPtr)) {
1855 if (SetoptChar(interp,curlHandle,CURLOPT_SSH_KNOWNHOSTS,
1861 if (curl_easy_setopt(curlHandle,CURLOPT_SSH_KEYFUNCTION,curlsshkeycallback)) {
1864 if (curl_easy_setopt(curlHandle,CURLOPT_SSH_KEYDATA,curlData)) {
1867 curlData->sshkeycallProc=curlstrdup(Tcl_GetString(objv));
1874 *----------------------------------------------------------------------
1878 * Sets the curl options that require an int
1881 * interp: The interpreter we are working with.
1882 * curlHandle: and the curl handle
1883 * opt: the option to set
1884 * tclObj: The Tcl with the value for the option.
1887 * 0 if all went well.
1888 * 1 in case of error.
1889 *----------------------------------------------------------------------
1892 SetoptInt(Tcl_Interp *interp,CURL *curlHandle,CURLoption opt,
1893 int tableIndex,Tcl_Obj *tclObj) {
1897 if (Tcl_GetIntFromObj(interp,tclObj,&intNumber)) {
1898 parPtr=curlstrdup(Tcl_GetString(tclObj));
1899 curlErrorSetOpt(interp,configTable,tableIndex,parPtr);
1903 if (curl_easy_setopt(curlHandle,opt,intNumber)) {
1904 parPtr=curlstrdup(Tcl_GetString(tclObj));
1905 curlErrorSetOpt(interp,configTable,tableIndex,parPtr);
1913 *----------------------------------------------------------------------
1917 * Set the curl options that require a long
1920 * interp: The interpreter we are working with.
1921 * curlHandle: and the curl handle
1922 * opt: the option to set
1923 * tclObj: The Tcl with the value for the option.
1926 * 0 if all went well.
1927 * 1 in case of error.
1928 *----------------------------------------------------------------------
1931 SetoptLong(Tcl_Interp *interp,CURL *curlHandle,CURLoption opt,
1932 int tableIndex,Tcl_Obj *tclObj) {
1936 if (Tcl_GetLongFromObj(interp,tclObj,&longNumber)) {
1937 parPtr=curlstrdup(Tcl_GetString(tclObj));
1938 curlErrorSetOpt(interp,configTable,tableIndex,parPtr);
1942 if (curl_easy_setopt(curlHandle,opt,longNumber)) {
1943 parPtr=curlstrdup(Tcl_GetString(tclObj));
1944 curlErrorSetOpt(interp,configTable,tableIndex,parPtr);
1953 *----------------------------------------------------------------------
1955 * curlSetoptCurlOffT --
1957 * Set the curl options that require a curl_off_t, even if we really
1958 * use a long to do it. (Cutting and pasting at its worst)
1961 * interp: The interpreter we are working with.
1962 * curlHandle: and the curl handle
1963 * opt: the option to set
1964 * tclObj: The Tcl with the value for the option.
1967 * 0 if all went well.
1968 * 1 in case of error.
1969 *----------------------------------------------------------------------
1972 SetoptCurlOffT(Tcl_Interp *interp,CURL *curlHandle,CURLoption opt,
1973 int tableIndex,Tcl_Obj *tclObj) {
1977 if (Tcl_GetLongFromObj(interp,tclObj,&longNumber)) {
1978 parPtr=curlstrdup(Tcl_GetString(tclObj));
1979 curlErrorSetOpt(interp,configTable,tableIndex,parPtr);
1984 if (curl_easy_setopt(curlHandle,opt,(curl_off_t)longNumber)) {
1985 parPtr=curlstrdup(Tcl_GetString(tclObj));
1986 curlErrorSetOpt(interp,configTable,tableIndex,parPtr);
1996 *----------------------------------------------------------------------
2000 * Set the curl options that require a string
2003 * interp: The interpreter we are working with.
2004 * curlHandle: and the curl handle
2005 * opt: the option to set
2006 * tclObj: The Tcl with the value for the option.
2009 * 0 if all went well.
2010 * 1 in case of error.
2011 *----------------------------------------------------------------------
2014 SetoptChar(Tcl_Interp *interp,CURL *curlHandle,
2015 CURLoption opt,int tableIndex,Tcl_Obj *tclObj) {
2018 optionPtr=curlstrdup(Tcl_GetString(tclObj));
2019 if (curl_easy_setopt(curlHandle,opt,optionPtr)) {
2020 curlErrorSetOpt(interp,configTable,tableIndex,optionPtr);
2021 Tcl_Free(optionPtr);
2024 Tcl_Free(optionPtr);
2029 *----------------------------------------------------------------------
2033 * Set the curl options that require a share handle (there is only
2034 * one but you never know.
2037 * interp: The interpreter we are working with.
2038 * curlHandle: the curl handle
2039 * opt: the option to set
2040 * tclObj: The Tcl with the value for the option.
2043 * 0 if all went well.
2044 * 1 in case of error.
2045 *----------------------------------------------------------------------
2048 SetoptSHandle(Tcl_Interp *interp,CURL *curlHandle,
2049 CURLoption opt,int tableIndex,Tcl_Obj *tclObj) {
2052 Tcl_CmdInfo *infoPtr=(Tcl_CmdInfo *)Tcl_Alloc(sizeof(Tcl_CmdInfo));
2053 struct shcurlObjData *shandleDataPtr;
2055 shandleName=Tcl_GetString(tclObj);
2056 if (0==Tcl_GetCommandInfo(interp,shandleName,infoPtr)) {
2059 shandleDataPtr=(struct shcurlObjData *)(infoPtr->objClientData);
2060 Tcl_Free((char *)infoPtr);
2061 if (curl_easy_setopt(curlHandle,opt,shandleDataPtr->shandle)) {
2062 curlErrorSetOpt(interp,configTable,tableIndex,shandleName);
2069 *----------------------------------------------------------------------
2073 * Prepares a slist for future use.
2076 * slistPtr: Pointer to the slist to prepare.
2077 * objv: Tcl object with a list of the data.
2080 * 0 if all went well.
2081 * 1 in case of error.
2082 *----------------------------------------------------------------------
2085 SetoptsList(Tcl_Interp *interp,struct curl_slist **slistPtr,
2086 Tcl_Obj *CONST objv) {
2090 if (slistPtr!=NULL) {
2091 curl_slist_free_all(*slistPtr);
2095 if (Tcl_ListObjGetElements(interp,objv,&headerNumber,&headers)
2100 for (i=0;i<headerNumber;i++) {
2101 *slistPtr=curl_slist_append(*slistPtr,Tcl_GetString(headers[i]));
2102 if (slistPtr==NULL) {
2110 *----------------------------------------------------------------------
2112 * curlErrorSetOpt --
2114 * When an error happens when setting an option, this function
2115 * takes cares of reporting it
2118 * interp: Pointer to the interpreter we are using.
2119 * option: The index of the option in 'optionTable'
2120 * parPtr: String with the parameter we wanted to set the option to.
2121 *----------------------------------------------------------------------
2125 curlErrorSetOpt(Tcl_Interp *interp,CONST char **configTable, int option,
2126 CONST char *parPtr) {
2130 snprintf(errorMsg,500,"setting option %s: %s",configTable[option],parPtr);
2131 resultPtr=Tcl_NewStringObj(errorMsg,-1);
2132 Tcl_SetObjResult(interp,resultPtr);
2136 *----------------------------------------------------------------------
2140 * This is the function that will be invoked if the user wants to put
2141 * the headers into a variable
2144 * header: string with the header line.
2145 * size and nmemb: it so happens size * nmemb if the size of the
2147 * curlData: A pointer to the curlData structure for the transfer.
2150 * The number of bytes actually written or -1 in case of error, in
2151 * which case 'libcurl' will abort the transfer.
2152 *-----------------------------------------------------------------------
2155 curlHeaderReader(void *ptr,size_t size,size_t nmemb,FILE *curlDataPtr) {
2158 struct curlObjData *curlData=(struct curlObjData *)curlDataPtr;
2161 CONST char *startPtr;
2165 char *headerContent;
2168 int match,charLength;
2170 regExp=Tcl_RegExpCompile(curlData->interp,"(.*?)(?::\\s*)(.*?)(\\r*)(\\n)");
2171 match=Tcl_RegExpExec(curlData->interp,regExp,header,header);
2174 Tcl_RegExpRange(regExp,1,&startPtr,&endPtr);
2175 charLength=endPtr-startPtr;
2176 headerName=Tcl_Alloc(charLength+1);
2177 strncpy(headerName,startPtr,charLength);
2178 headerName[charLength]=0;
2180 Tcl_RegExpRange(regExp,2,&startPtr,&endPtr);
2181 charLength=endPtr-startPtr;
2182 headerContent=Tcl_Alloc(charLength+1);
2183 strncpy(headerContent,startPtr,charLength);
2184 headerContent[charLength]=0;
2185 /* There may be multiple 'Set-Cookie' headers, so we use a list */
2186 if (Tcl_StringCaseMatch(headerName,"Set-Cookie",1)) {
2187 Tcl_SetVar2(curlData->interp,curlData->headerVar,headerName, \
2188 headerContent,TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
2190 Tcl_SetVar2(curlData->interp,curlData->headerVar,headerName,
2194 regExp=Tcl_RegExpCompile(curlData->interp,"(^(HTTP|http)[^\r]+)(\r*)(\n)");
2195 match=Tcl_RegExpExec(curlData->interp,regExp,header,header);
2197 Tcl_RegExpRange(regExp,1,&startPtr,&endPtr);
2198 charLength=endPtr-startPtr;
2199 httpStatus=Tcl_Alloc(charLength+1);
2200 strncpy(httpStatus,startPtr,charLength);
2201 httpStatus[charLength]=0;
2203 Tcl_SetVar2(curlData->interp,curlData->headerVar,"http",
2210 *----------------------------------------------------------------------
2214 * This is the function that will be invoked as a callback while
2215 * transferring the body of a request into a Tcl variable.
2217 * This function has been adapted from an example in libcurl's FAQ.
2220 * header: string with the header line.
2221 * size and nmemb: it so happens size * nmemb if the size of the
2223 * curlData: A pointer to the curlData structure for the transfer.
2226 * The number of bytes actually written or -1 in case of error, in
2227 * which case 'libcurl' will abort the transfer.
2228 *-----------------------------------------------------------------------
2231 curlBodyReader(void *ptr,size_t size,size_t nmemb,FILE *curlDataPtr) {
2233 register int realsize = size * nmemb;
2234 struct MemoryStruct *mem=&(((struct curlObjData *)curlDataPtr)->bodyVar);
2236 mem->memory = (char *)Tcl_Realloc(mem->memory,mem->size + realsize);
2238 memcpy(&(mem->memory[mem->size]), ptr, realsize);
2239 mem->size += realsize;
2245 *----------------------------------------------------------------------
2247 * curlProgressCallback --
2249 * This is the function that will be invoked as a callback during a
2252 * This function has been adapted from an example in libcurl's FAQ.
2255 * clientData: The curlData struct for the transfer.
2256 * dltotal: Total amount of bytes to download.
2257 * dlnow: Bytes downloaded so far.
2258 * ultotal: Total amount of bytes to upload.
2259 * ulnow: Bytes uploaded so far.
2262 * Returning a non-zero value will make 'libcurl' abort the transfer
2263 * and return 'CURLE_ABORTED_BY_CALLBACK'.
2264 *-----------------------------------------------------------------------
2267 curlProgressCallback(void *clientData,double dltotal,double dlnow,
2268 double ultotal,double ulnow) {
2270 struct curlObjData *curlData=(struct curlObjData *)clientData;
2271 Tcl_Obj *tclProcPtr;
2272 char tclCommand[300];
2274 snprintf(tclCommand,299,"%s %f %f %f %f",curlData->progressProc,dltotal,
2275 dlnow,ultotal,ulnow);
2276 tclProcPtr=Tcl_NewStringObj(tclCommand,-1);
2277 if (curlData->cancelTransVarName) {
2278 if (curlData->cancelTrans) {
2279 curlData->cancelTrans=0;
2283 if (Tcl_EvalObjEx(curlData->interp,tclProcPtr,TCL_EVAL_GLOBAL)!=TCL_OK) {
2290 *----------------------------------------------------------------------
2292 * curlWriteProcInvoke --
2294 * This is the function that will be invoked as a callback when the user
2295 * wants to invoke a Tcl procedure to write the recieved data.
2297 * This function has been adapted from an example in libcurl's FAQ.
2300 * ptr: A pointer to the data.
2301 * size and nmemb: it so happens size * nmemb if the size of the
2303 * curlData: A pointer to the curlData structure for the transfer.
2306 * The number of bytes actually written or -1 in case of error, in
2307 * which case 'libcurl' will abort the transfer.
2308 *-----------------------------------------------------------------------
2311 curlWriteProcInvoke(void *ptr,size_t size,size_t nmemb,FILE *curlDataPtr) {
2312 register int realsize = size * nmemb;
2313 struct curlObjData *curlData=(struct curlObjData *)curlDataPtr;
2316 objv[0]=Tcl_NewStringObj(curlData->writeProc,-1);
2317 objv[1]=Tcl_NewByteArrayObj(ptr,realsize);
2318 if (curlData->cancelTransVarName) {
2319 if (curlData->cancelTrans) {
2320 curlData->cancelTrans=0;
2324 if (Tcl_EvalObjv(curlData->interp,2,objv,TCL_EVAL_GLOBAL)!=TCL_OK) {
2332 *----------------------------------------------------------------------
2334 * curlReadProcInvoke --
2336 * This is the function that will be invoked as a callback when the user
2337 * wants to invoke a Tcl procedure to read the data to send.
2340 * header: string with the header line.
2341 * size and nmemb: it so happens size * nmemb if the size of the
2343 * curlData: A pointer to the curlData structure for the transfer.
2346 * The number of bytes actually read or CURL_READFUNC_ABORT in case
2347 * of error, in which case 'libcurl' will abort the transfer.
2348 *-----------------------------------------------------------------------
2351 curlReadProcInvoke(void *ptr,size_t size,size_t nmemb,FILE *curlDataPtr) {
2352 register int realsize = size * nmemb;
2353 struct curlObjData *curlData=(struct curlObjData *)curlDataPtr;
2354 Tcl_Obj *tclProcPtr;
2355 Tcl_Obj *readDataPtr;
2356 char tclCommand[300];
2357 unsigned char *readBytes;
2360 snprintf(tclCommand,300,"%s %d",curlData->readProc,realsize);
2361 tclProcPtr=Tcl_NewStringObj(tclCommand,-1);
2363 if (curlData->cancelTransVarName) {
2364 if (curlData->cancelTrans) {
2365 curlData->cancelTrans=0;
2366 return CURL_READFUNC_ABORT;
2369 if (Tcl_EvalObjEx(curlData->interp,tclProcPtr,TCL_EVAL_GLOBAL)!=TCL_OK) {
2370 return CURL_READFUNC_ABORT;
2372 readDataPtr=Tcl_GetObjResult(curlData->interp);
2373 readBytes=Tcl_GetByteArrayFromObj(readDataPtr,&sizeRead);
2374 memcpy(ptr,readBytes,sizeRead);
2380 *----------------------------------------------------------------------
2382 * curlshkeyextract --
2384 * Out of one of libcurl's ssh key struct, this function will return a
2385 * Tcl_Obj with a list, the first element is the type ok key, the second
2389 * interp: The interp need to deal with the objects.
2390 * key: a curl_khkey struct with the key.
2393 * The object with the list.
2394 *-----------------------------------------------------------------------
2397 curlsshkeyextract(Tcl_Interp *interp,const struct curl_khkey *key) {
2401 keyObjPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
2403 switch(key->keytype) {
2404 case CURLKHTYPE_RSA1:
2405 Tcl_ListObjAppendElement(interp,keyObjPtr,Tcl_NewStringObj("rsa1",-1));
2407 case CURLKHTYPE_RSA:
2408 Tcl_ListObjAppendElement(interp,keyObjPtr,Tcl_NewStringObj("rsa",-1));
2410 case CURLKHTYPE_DSS:
2411 Tcl_ListObjAppendElement(interp,keyObjPtr,Tcl_NewStringObj("dss",-1));
2414 Tcl_ListObjAppendElement(interp,keyObjPtr,Tcl_NewStringObj("unknnown",-1));
2417 Tcl_ListObjAppendElement(interp,keyObjPtr,Tcl_NewStringObj(key->key,-1));
2423 *----------------------------------------------------------------------
2425 * curlshkeycallback --
2427 * This is the function that will be invoked as a callback when the user
2428 * wants to invoke a Tcl procedure to decide about this new ssh host
2431 * curl: curl's easy handle for the connection.
2432 * knownkey: The key from the hosts_file.
2433 * foundkey: The key from the remote site.
2434 * match: What libcurl thinks about how they match
2435 * curlDataPtr: Points to the structure with all the TclCurl data
2436 * for the connection.
2439 * A libcurl return code so that libcurl knows what to do.
2440 *-----------------------------------------------------------------------
2443 curlsshkeycallback(CURL *curl ,const struct curl_khkey *knownkey,
2444 const struct curl_khkey *foundkey, enum curl_khmatch match,void *curlDataPtr) {
2446 struct curlObjData *tclcurlDataPtr=(struct curlObjData *)curlDataPtr;
2450 Tcl_Obj *returnObjPtr;
2454 interp=tclcurlDataPtr->interp;
2456 objv[0]=Tcl_NewStringObj(tclcurlDataPtr->sshkeycallProc,-1);
2457 objv[1]=curlsshkeyextract(interp,knownkey);
2458 objv[2]=curlsshkeyextract(interp,foundkey);
2461 case CURLKHMATCH_OK:
2462 objv[3]=Tcl_NewStringObj("match",-1);
2464 case CURLKHMATCH_MISMATCH:
2465 objv[3]=Tcl_NewStringObj("mismatch",-1);
2467 case CURLKHMATCH_MISSING:
2468 objv[3]=Tcl_NewStringObj("missing",-1);
2470 case CURLKHMATCH_LAST:
2471 objv[3]=Tcl_NewStringObj("error",-1);
2474 if (Tcl_EvalObjv(interp,4,objv,TCL_EVAL_GLOBAL)!=TCL_OK) {return CURLKHSTAT_REJECT;}
2476 returnObjPtr=Tcl_GetObjResult(interp);
2478 if (Tcl_GetIntFromObj(interp,returnObjPtr,&action)!=TCL_OK) {return CURLKHSTAT_REJECT;}
2482 return CURLKHSTAT_FINE_ADD_TO_FILE;
2484 return CURLKHSTAT_FINE;
2486 return CURLKHSTAT_REJECT;
2488 return CURLKHSTAT_DEFER;
2490 return CURLKHSTAT_REJECT;
2494 *----------------------------------------------------------------------
2496 * curlDebugProcInvoke --
2498 * This is the function that will be invoked as a callback when the user
2499 * wants to invoke a Tcl procedure to write the debug data produce by
2500 * the verbose option.
2503 * curlHandle: A pointer to the handle for the transfer.
2504 * infoType: Integer with the type of data.
2505 * dataPtr: the data passed to the procedure.
2506 * curlDataPtr: ointer to the curlData structure for the transfer.
2509 * The number of bytes actually written or -1 in case of error, in
2510 * which case 'libcurl' will abort the transfer.
2511 *-----------------------------------------------------------------------
2514 curlDebugProcInvoke(CURL *curlHandle, curl_infotype infoType,
2515 unsigned char * dataPtr, size_t size, void *curlDataPtr) {
2516 struct curlObjData *curlData=(struct curlObjData *)curlDataPtr;
2517 Tcl_Obj *tclProcPtr;
2519 char tclCommand[300];
2521 snprintf(tclCommand,300,"%s %d %d",curlData->debugProc,infoType,size);
2522 tclProcPtr=Tcl_NewStringObj(tclCommand,-1);
2524 objv[0]=Tcl_NewStringObj(curlData->debugProc,-1);
2525 objv[1]=Tcl_NewIntObj(infoType);
2526 objv[2]=Tcl_NewByteArrayObj(dataPtr,size);
2528 if (curlData->cancelTransVarName) {
2529 if (curlData->cancelTrans) {
2530 curlData->cancelTrans=0;
2535 Tcl_EvalObjv(curlData->interp,3,objv,TCL_EVAL_GLOBAL);
2541 *----------------------------------------------------------------------
2545 * Invokes the 'curl_easy_getinfo' function in libcurl.
2550 * 0 if all went well.
2551 * The CURLcode for the error.
2552 *----------------------------------------------------------------------
2555 curlGetInfo(Tcl_Interp *interp,CURL *curlHandle,int tableIndex) {
2558 double doubleNumber;
2559 struct curl_slist *slistPtr;
2560 struct curl_certinfo *certinfoPtr=NULL;
2565 Tcl_Obj *resultObjPtr;
2567 switch(tableIndex) {
2569 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_EFFECTIVE_URL,&charPtr);
2573 resultObjPtr=Tcl_NewStringObj(charPtr,-1);
2574 Tcl_SetObjResult(interp,resultObjPtr);
2578 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_RESPONSE_CODE,&longNumber);
2582 resultObjPtr=Tcl_NewLongObj(longNumber);
2583 Tcl_SetObjResult(interp,resultObjPtr);
2586 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_FILETIME,&longNumber);
2590 resultObjPtr=Tcl_NewLongObj(longNumber);
2591 Tcl_SetObjResult(interp,resultObjPtr);
2594 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_TOTAL_TIME,&doubleNumber);
2598 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2599 Tcl_SetObjResult(interp,resultObjPtr);
2602 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_NAMELOOKUP_TIME,
2607 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2608 Tcl_SetObjResult(interp,resultObjPtr);
2611 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_CONNECT_TIME,
2616 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2617 Tcl_SetObjResult(interp,resultObjPtr);
2620 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_PRETRANSFER_TIME,
2625 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2626 Tcl_SetObjResult(interp,resultObjPtr);
2629 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_SIZE_UPLOAD,
2634 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2635 Tcl_SetObjResult(interp,resultObjPtr);
2638 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_SIZE_DOWNLOAD,
2643 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2644 Tcl_SetObjResult(interp,resultObjPtr);
2647 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_SPEED_DOWNLOAD,
2652 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2653 Tcl_SetObjResult(interp,resultObjPtr);
2656 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_SPEED_UPLOAD,
2661 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2662 Tcl_SetObjResult(interp,resultObjPtr);
2665 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_HEADER_SIZE,
2670 resultObjPtr=Tcl_NewLongObj(longNumber);
2671 Tcl_SetObjResult(interp,resultObjPtr);
2674 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_REQUEST_SIZE,
2679 resultObjPtr=Tcl_NewLongObj(longNumber);
2680 Tcl_SetObjResult(interp,resultObjPtr);
2683 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_SSL_VERIFYRESULT,
2688 resultObjPtr=Tcl_NewLongObj(longNumber);
2689 Tcl_SetObjResult(interp,resultObjPtr);
2692 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_CONTENT_LENGTH_DOWNLOAD,
2697 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2698 Tcl_SetObjResult(interp,resultObjPtr);
2701 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_CONTENT_LENGTH_UPLOAD,
2706 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2707 Tcl_SetObjResult(interp,resultObjPtr);
2710 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_STARTTRANSFER_TIME,&doubleNumber);
2714 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2715 Tcl_SetObjResult(interp,resultObjPtr);
2718 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_CONTENT_TYPE,&charPtr);
2722 resultObjPtr=Tcl_NewStringObj(charPtr,-1);
2723 Tcl_SetObjResult(interp,resultObjPtr);
2726 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_REDIRECT_TIME,&doubleNumber);
2730 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2731 Tcl_SetObjResult(interp,resultObjPtr);
2734 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_REDIRECT_COUNT,&longNumber);
2738 resultObjPtr=Tcl_NewLongObj(longNumber);
2739 Tcl_SetObjResult(interp,resultObjPtr);
2743 if (tableIndex==21) {
2744 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_HTTPAUTH_AVAIL,&longNumber);
2746 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_PROXYAUTH_AVAIL,&longNumber);
2751 resultObjPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
2752 if (longNumber&CURLAUTH_BASIC) {
2753 Tcl_ListObjAppendElement(interp,resultObjPtr
2754 ,Tcl_NewStringObj("basic",-1));
2756 if (longNumber&CURLAUTH_DIGEST) {
2757 Tcl_ListObjAppendElement(interp,resultObjPtr
2758 ,Tcl_NewStringObj("digest",-1));
2760 if (longNumber&CURLAUTH_GSSNEGOTIATE) {
2761 Tcl_ListObjAppendElement(interp,resultObjPtr
2762 ,Tcl_NewStringObj("gssnegotiate",-1));
2764 if (longNumber&CURLAUTH_NTLM) {
2765 Tcl_ListObjAppendElement(interp,resultObjPtr
2766 ,Tcl_NewStringObj("NTLM",-1));
2768 Tcl_SetObjResult(interp,resultObjPtr);
2771 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_OS_ERRNO,&longNumber);
2775 resultObjPtr=Tcl_NewLongObj(longNumber);
2776 Tcl_SetObjResult(interp,resultObjPtr);
2779 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_NUM_CONNECTS,&longNumber);
2783 resultObjPtr=Tcl_NewLongObj(longNumber);
2784 Tcl_SetObjResult(interp,resultObjPtr);
2787 exitCode=curl_easy_getinfo \
2788 (curlHandle,CURLINFO_SSL_ENGINES,&slistPtr);
2792 resultObjPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
2793 while(slistPtr!=NULL) {
2794 Tcl_ListObjAppendElement(interp,resultObjPtr
2795 ,Tcl_NewStringObj(slistPtr->data,-1));
2796 slistPtr=slistPtr->next;
2798 curl_slist_free_all(slistPtr);
2799 Tcl_SetObjResult(interp,resultObjPtr);
2802 exitCode=curl_easy_getinfo \
2803 (curlHandle,CURLINFO_HTTP_CONNECTCODE,&longNumber);
2807 resultObjPtr=Tcl_NewLongObj(longNumber);
2808 Tcl_SetObjResult(interp,resultObjPtr);
2811 exitCode=curl_easy_getinfo \
2812 (curlHandle,CURLINFO_COOKIELIST,&slistPtr);
2816 resultObjPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
2817 while(slistPtr!=NULL) {
2818 Tcl_ListObjAppendElement(interp,resultObjPtr
2819 ,Tcl_NewStringObj(slistPtr->data,-1));
2820 slistPtr=slistPtr->next;
2822 curl_slist_free_all(slistPtr);
2823 Tcl_SetObjResult(interp,resultObjPtr);
2826 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_FTP_ENTRY_PATH,&charPtr);
2830 resultObjPtr=Tcl_NewStringObj(charPtr,-1);
2831 Tcl_SetObjResult(interp,resultObjPtr);
2834 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_REDIRECT_URL,&charPtr);
2838 resultObjPtr=Tcl_NewStringObj(charPtr,-1);
2839 Tcl_SetObjResult(interp,resultObjPtr);
2842 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_PRIMARY_IP,&charPtr);
2846 resultObjPtr=Tcl_NewStringObj(charPtr,-1);
2847 Tcl_SetObjResult(interp,resultObjPtr);
2850 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_APPCONNECT_TIME,&doubleNumber);
2854 resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2855 Tcl_SetObjResult(interp,resultObjPtr);
2858 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_CERTINFO,&certinfoPtr);
2862 charPtr=(char *)Tcl_Alloc(3);
2863 sprintf(charPtr,"%d",certinfoPtr->num_of_certs);
2864 resultObjPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
2865 Tcl_ListObjAppendElement(interp,resultObjPtr,Tcl_NewStringObj(charPtr,-1));
2867 for(i=0; i < certinfoPtr->num_of_certs; i++) {
2868 for(slistPtr = certinfoPtr->certinfo[i]; slistPtr; slistPtr=slistPtr->next) {
2869 Tcl_ListObjAppendElement(interp,resultObjPtr,Tcl_NewStringObj(slistPtr->data,-1));
2872 Tcl_SetObjResult(interp,resultObjPtr);
2875 exitCode=curl_easy_getinfo \
2876 (curlHandle,CURLINFO_CONDITION_UNMET,&longNumber);
2880 resultObjPtr=Tcl_NewLongObj(longNumber);
2881 Tcl_SetObjResult(interp,resultObjPtr);
2888 *----------------------------------------------------------------------
2892 * Frees the space taken by a curlObjData struct either because we are
2893 * deleting the handle or reseting it.
2896 * interp: Pointer to the interpreter we are using.
2897 * curlHandle: the curl handle for which the option is set.
2898 * objc and objv: The usual in Tcl.
2901 * A standard Tcl result.
2902 *----------------------------------------------------------------------
2905 curlFreeSpace(struct curlObjData *curlData) {
2907 curl_slist_free_all(curlData->headerList);
2908 curl_slist_free_all(curlData->quote);
2909 curl_slist_free_all(curlData->prequote);
2910 curl_slist_free_all(curlData->postquote);
2912 Tcl_Free(curlData->outFile);
2913 Tcl_Free(curlData->inFile);
2914 Tcl_Free(curlData->proxy);
2915 Tcl_Free(curlData->errorBuffer);
2916 Tcl_Free(curlData->errorBufferName);
2917 Tcl_Free(curlData->errorBufferKey);
2918 Tcl_Free(curlData->stderrFile);
2919 Tcl_Free(curlData->randomFile);
2920 Tcl_Free(curlData->headerVar);
2921 Tcl_Free(curlData->bodyVarName);
2922 if (curlData->bodyVar.memory) {
2923 Tcl_Free(curlData->bodyVar.memory);
2925 Tcl_Free(curlData->progressProc);
2926 if (curlData->cancelTransVarName) {
2927 Tcl_UnlinkVar(curlData->interp,curlData->cancelTransVarName);
2928 Tcl_Free(curlData->cancelTransVarName);
2930 Tcl_Free(curlData->writeProc);
2931 Tcl_Free(curlData->readProc);
2932 Tcl_Free(curlData->debugProc);
2933 curl_slist_free_all(curlData->http200aliases);
2934 Tcl_Free(curlData->sshkeycallProc);
2935 Tcl_Free(curlData->command);
2939 *----------------------------------------------------------------------
2943 * This function is invoked by the 'duphandle' command, it will
2944 * create a duplicate of the given handle.
2947 * The stantard parameters for Tcl commands
2950 * A standard Tcl result.
2953 * See the user documentation.
2955 *----------------------------------------------------------------------
2958 curlDupHandle(Tcl_Interp *interp, struct curlObjData *curlData,
2959 int objc, Tcl_Obj *CONST objv[]) {
2961 CURL *newCurlHandle;
2963 struct curlObjData *newCurlData;
2966 newCurlHandle=curl_easy_duphandle(curlData->curl);
2967 if (newCurlHandle==NULL) {
2968 result=Tcl_NewStringObj("Couldn't create new handle.",-1);
2969 Tcl_SetObjResult(interp,result);
2973 newCurlData=(struct curlObjData *)Tcl_Alloc(sizeof(struct curlObjData));
2975 curlCopyCurlData(curlData,newCurlData);
2977 handleName=curlCreateObjCmd(interp,newCurlData);
2979 newCurlData->curl=newCurlHandle;
2981 result=Tcl_NewStringObj(handleName,-1);
2982 Tcl_SetObjResult(interp,result);
2983 Tcl_Free(handleName);
2990 *----------------------------------------------------------------------
2992 * curlResetHandle --
2994 * This function is invoked by the 'reset' command, it reset all the
2995 * options in the handle to the state it had when 'init' was invoked.
2998 * The stantard parameters for Tcl commands
3001 * A standard Tcl result.
3004 * See the user documentation.
3006 *----------------------------------------------------------------------
3009 curlResetHandle(Tcl_Interp *interp, struct curlObjData *curlData) {
3010 struct curlObjData *tmpPtr=
3011 (struct curlObjData *)Tcl_Alloc(sizeof(struct curlObjData));
3013 tmpPtr->curl = curlData->curl;
3014 tmpPtr->token = curlData->token;
3015 tmpPtr->shareToken = curlData->shareToken;
3016 tmpPtr->interp = curlData->interp;
3018 curlFreeSpace(curlData);
3019 memset(curlData, 0, sizeof(struct curlObjData));
3021 curlData->curl = tmpPtr->curl;
3022 curlData->token = tmpPtr->token;
3023 curlData->shareToken = tmpPtr->shareToken;
3024 curlData->interp = tmpPtr->interp;
3026 curl_easy_reset(curlData->curl);
3028 Tcl_Free((char *)tmpPtr);
3035 *----------------------------------------------------------------------
3039 * This procedure is invoked to process the "curl::init" Tcl command.
3040 * See the user documentation for details on what it does.
3043 * The stantard parameters for Tcl commands
3046 * A standard Tcl result.
3049 * See the user documentation.
3051 *----------------------------------------------------------------------
3054 curlVersion (ClientData clientData, Tcl_Interp *interp,
3055 int objc,Tcl_Obj *CONST objv[]) {
3057 Tcl_Obj *versionPtr;
3058 char tclversion[200];
3060 sprintf(tclversion,"TclCurl Version %s (%s)",TclCurlVersion,
3062 versionPtr=Tcl_NewStringObj(tclversion,-1);
3063 Tcl_SetObjResult(interp,versionPtr);
3069 *----------------------------------------------------------------------
3073 * This function is invoked to process the "curl::escape" Tcl command.
3074 * See the user documentation for details on what it does.
3078 * The stantard parameters for Tcl commands
3081 * A standard Tcl result.
3084 * See the user documentation.
3086 *----------------------------------------------------------------------
3089 curlEscape(ClientData clientData, Tcl_Interp *interp,
3090 int objc,Tcl_Obj *CONST objv[]) {
3095 escapedStr=curl_easy_escape(NULL,Tcl_GetString(objv[1]),0);
3098 resultObj=Tcl_NewStringObj("curl::escape bad parameter",-1);
3099 Tcl_SetObjResult(interp,resultObj);
3102 resultObj=Tcl_NewStringObj(escapedStr,-1);
3103 Tcl_SetObjResult(interp,resultObj);
3104 curl_free(escapedStr);
3110 *----------------------------------------------------------------------
3114 * This function is invoked to process the "curl::Unescape" Tcl command.
3115 * See the user documentation for details on what it does.
3119 * The stantard parameters for Tcl commands
3122 * A standard Tcl result.
3125 * See the user documentation.
3127 *----------------------------------------------------------------------
3130 curlUnescape(ClientData clientData, Tcl_Interp *interp,
3131 int objc,Tcl_Obj *CONST objv[]) {
3136 unescapedStr=curl_easy_unescape(NULL,Tcl_GetString(objv[1]),0,NULL);
3138 resultObj=Tcl_NewStringObj("curl::unescape bad parameter",-1);
3139 Tcl_SetObjResult(interp,resultObj);
3142 resultObj=Tcl_NewStringObj(unescapedStr,-1);
3143 Tcl_SetObjResult(interp,resultObj);
3144 curl_free(unescapedStr);
3150 *----------------------------------------------------------------------
3152 * curlVersionInfo --
3154 * This function invokes 'curl_version_info' to query how 'libcurl' was
3158 * The standard parameters for Tcl commands, but nothing is used.
3161 * A standard Tcl result.
3164 * See the user documentation.
3166 *----------------------------------------------------------------------
3169 curlVersionInfo (ClientData clientData, Tcl_Interp *interp,
3170 int objc,Tcl_Obj *CONST objv[]) {
3174 curl_version_info_data *infoPtr;
3175 Tcl_Obj *resultObjPtr=NULL;
3179 resultObjPtr=Tcl_NewStringObj("usage: curl::versioninfo -option",-1);
3180 Tcl_SetObjResult(interp,resultObjPtr);
3184 if (Tcl_GetIndexFromObj(interp, objv[1], versionInfoTable, "option",
3185 TCL_EXACT,&tableIndex)==TCL_ERROR) {
3189 infoPtr=curl_version_info(CURLVERSION_NOW);
3191 switch(tableIndex) {
3193 resultObjPtr=Tcl_NewStringObj(infoPtr->version,-1);
3196 sprintf(tmp,"%X",infoPtr->version_num);
3197 resultObjPtr=Tcl_NewStringObj(tmp,-1);
3200 resultObjPtr=Tcl_NewStringObj(infoPtr->host,-1);
3203 resultObjPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
3204 if (infoPtr->features&CURL_VERSION_IPV6) {
3205 Tcl_ListObjAppendElement(interp,resultObjPtr
3206 ,Tcl_NewStringObj("IPV6",-1));
3208 if (infoPtr->features&CURL_VERSION_KERBEROS4) {
3209 Tcl_ListObjAppendElement(interp,resultObjPtr
3210 ,Tcl_NewStringObj("KERBEROS4",-1));
3212 if (infoPtr->features&CURL_VERSION_SSL) {
3213 Tcl_ListObjAppendElement(interp,resultObjPtr
3214 ,Tcl_NewStringObj("SSL",-1));
3216 if (infoPtr->features&CURL_VERSION_LIBZ) {
3217 Tcl_ListObjAppendElement(interp,resultObjPtr
3218 ,Tcl_NewStringObj("LIBZ",-1));
3220 if (infoPtr->features&CURL_VERSION_NTLM) {
3221 Tcl_ListObjAppendElement(interp,resultObjPtr
3222 ,Tcl_NewStringObj("NTLM",-1));
3224 if (infoPtr->features&CURL_VERSION_GSSNEGOTIATE) {
3225 Tcl_ListObjAppendElement(interp,resultObjPtr
3226 ,Tcl_NewStringObj("GSSNEGOTIATE",-1));
3228 if (infoPtr->features&CURL_VERSION_DEBUG) {
3229 Tcl_ListObjAppendElement(interp,resultObjPtr
3230 ,Tcl_NewStringObj("DEBUG",-1));
3232 if (infoPtr->features&CURL_VERSION_ASYNCHDNS) {
3233 Tcl_ListObjAppendElement(interp,resultObjPtr
3234 ,Tcl_NewStringObj("ASYNCHDNS",-1));
3236 if (infoPtr->features&CURL_VERSION_SPNEGO) {
3237 Tcl_ListObjAppendElement(interp,resultObjPtr
3238 ,Tcl_NewStringObj("SPNEGO",-1));
3240 if (infoPtr->features&CURL_VERSION_LARGEFILE) {
3241 Tcl_ListObjAppendElement(interp,resultObjPtr
3242 ,Tcl_NewStringObj("LARGEFILE",-1));
3244 if (infoPtr->features&CURL_VERSION_IDN) {
3245 Tcl_ListObjAppendElement(interp,resultObjPtr
3246 ,Tcl_NewStringObj("IDN",-1));
3248 if (infoPtr->features&CURL_VERSION_SSPI) {
3249 Tcl_ListObjAppendElement(interp,resultObjPtr
3250 ,Tcl_NewStringObj("SSPI",-1));
3253 if (infoPtr->features&CURL_VERSION_CONV) {
3254 Tcl_ListObjAppendElement(interp,resultObjPtr
3255 ,Tcl_NewStringObj("CONV",-1));
3258 resultObjPtr=Tcl_NewStringObj(infoPtr->ssl_version,-1);
3261 resultObjPtr=Tcl_NewLongObj(infoPtr->ssl_version_num);
3264 resultObjPtr=Tcl_NewStringObj(infoPtr->libz_version,-1);
3267 resultObjPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
3269 if (infoPtr->protocols[i]!=NULL) {
3270 Tcl_ListObjAppendElement(interp,resultObjPtr
3271 ,Tcl_NewStringObj(infoPtr->protocols[i],-1));
3278 Tcl_SetObjResult(interp,resultObjPtr);
3284 *----------------------------------------------------------------------
3286 * curlCopyCurlData --
3288 * This function copies the contents of a curlData struct into another.
3291 * curlDataOld: The original one.
3292 * curlDataNew: The new one
3295 * A standard Tcl result.
3298 * See the user documentation.
3300 *----------------------------------------------------------------------
3303 curlCopyCurlData (struct curlObjData *curlDataOld,
3304 struct curlObjData *curlDataNew) {
3306 /* This takes care of the int and long values */
3307 memcpy(curlDataNew, curlDataOld, sizeof(struct curlObjData));
3309 /* Some of the data doesn't get copied */
3311 curlDataNew->headerList=NULL;
3312 curlDataNew->quote=NULL;
3313 curlDataNew->prequote=NULL;
3314 curlDataNew->postquote=NULL;
3315 curlDataNew->formArray=NULL;
3316 curlDataNew->postListFirst=NULL;
3317 curlDataNew->postListLast=NULL;
3318 curlDataNew->formArray=NULL;
3319 curlDataNew->outHandle=NULL;
3320 curlDataNew->outFlag=0;
3321 curlDataNew->inHandle=NULL;
3322 curlDataNew->inFlag=0;
3323 curlDataNew->headerHandle=NULL;
3324 curlDataNew->headerFlag=0;
3325 curlDataNew->stderrHandle=NULL;
3326 curlDataNew->stderrFlag=0;
3327 curlDataNew->http200aliases=NULL;
3329 /* The strings need a special treatment. */
3331 curlDataNew->outFile=curlstrdup(curlDataOld->outFile);
3332 curlDataNew->inFile=curlstrdup(curlDataOld->inFile);
3333 curlDataNew->proxy=curlstrdup(curlDataOld->proxy);
3334 curlDataNew->errorBuffer=curlstrdup(curlDataOld->errorBuffer);
3335 curlDataNew->errorBufferName=curlstrdup(curlDataOld->errorBufferName);
3336 curlDataNew->errorBufferKey=curlstrdup(curlDataOld->errorBufferKey);
3337 curlDataNew->headerFile=curlstrdup(curlDataOld->headerFile);
3338 curlDataNew->stderrFile=curlstrdup(curlDataOld->stderrFile);
3339 curlDataNew->randomFile=curlstrdup(curlDataOld->randomFile);
3340 curlDataNew->headerVar=curlstrdup(curlDataOld->headerVar);
3341 curlDataNew->bodyVarName=curlstrdup(curlDataOld->bodyVarName);
3342 curlDataNew->progressProc=curlstrdup(curlDataOld->progressProc);
3343 curlDataNew->cancelTransVarName=curlstrdup(curlDataOld->cancelTransVarName);
3344 curlDataNew->writeProc=curlstrdup(curlDataOld->writeProc);
3345 curlDataNew->readProc=curlstrdup(curlDataOld->readProc);
3346 curlDataNew->debugProc=curlstrdup(curlDataOld->debugProc);
3347 curlDataNew->command=curlstrdup(curlDataOld->command);
3348 curlDataNew->sshkeycallProc=curlstrdup(curlDataOld->sshkeycallProc);
3350 curlDataNew->bodyVar.memory=(char *)Tcl_Alloc(curlDataOld->bodyVar.size);
3351 memcpy(curlDataNew->bodyVar.memory,curlDataOld->bodyVar.memory
3352 ,curlDataOld->bodyVar.size);
3353 curlDataNew->bodyVar.size=curlDataOld->bodyVar.size;
3358 /*----------------------------------------------------------------------
3362 * Before doing a transfer with the easy interface or adding an easy
3363 * handle to a multi one, this function takes care of opening all
3364 * necessary files for the transfer.
3367 * curlData: The pointer to the struct with the transfer data.
3370 * '0' all went well, '1' in case of error.
3371 *----------------------------------------------------------------------
3374 curlOpenFiles(Tcl_Interp *interp,struct curlObjData *curlData) {
3376 if (curlData->outFlag) {
3377 if (curlOpenFile(interp,curlData->outFile,&(curlData->outHandle),1,
3378 curlData->transferText)) {
3381 curl_easy_setopt(curlData->curl,CURLOPT_WRITEDATA,curlData->outHandle);
3383 if (curlData->inFlag) {
3384 if (curlOpenFile(interp,curlData->inFile,&(curlData->inHandle),0,
3385 curlData->transferText)) {
3388 curl_easy_setopt(curlData->curl,CURLOPT_READDATA,curlData->inHandle);
3389 if (curlData->anyAuthFlag) {
3390 curl_easy_setopt(curlData->curl, CURLOPT_SEEKFUNCTION, curlseek);
3391 curl_easy_setopt(curlData->curl, CURLOPT_SEEKDATA, curlData->inHandle);
3394 if (curlData->headerFlag) {
3395 if (curlOpenFile(interp,curlData->headerFile,&(curlData->headerHandle),1,1)) {
3398 curl_easy_setopt(curlData->curl,CURLOPT_HEADERDATA,curlData->headerHandle);
3400 if (curlData->stderrFlag) {
3401 if (curlOpenFile(interp,curlData->stderrFile,&(curlData->stderrHandle),1,1)) {
3404 curl_easy_setopt(curlData->curl,CURLOPT_STDERR,curlData->stderrHandle);
3409 /*----------------------------------------------------------------------
3413 * Closes the files opened during a transfer.
3416 * curlData: The pointer to the struct with the transfer data.
3418 *----------------------------------------------------------------------
3421 curlCloseFiles(struct curlObjData *curlData) {
3422 if (curlData->outHandle!=NULL) {
3423 fclose(curlData->outHandle);
3424 curlData->outHandle=NULL;
3426 if (curlData->inHandle!=NULL) {
3427 fclose(curlData->inHandle);
3428 curlData->inHandle=NULL;
3430 if (curlData->headerHandle!=NULL) {
3431 fclose(curlData->headerHandle);
3432 curlData->headerHandle=NULL;
3434 if (curlData->stderrHandle!=NULL) {
3435 fclose(curlData->stderrHandle);
3436 curlData->stderrHandle=NULL;
3440 /*----------------------------------------------------------------------
3444 * Opens a file to be used during a transfer.
3447 * fileName: name of the file.
3448 * handle: the handle for the file
3449 * writing: '0' if reading, '1' if writing.
3450 * text: '0' if binary, '1' if text.
3453 * '0' all went well, '1' in case of error.
3454 *----------------------------------------------------------------------
3457 curlOpenFile(Tcl_Interp *interp,char *fileName, FILE **handle, int writing, int text) {
3458 Tcl_Obj *resultObjPtr;
3461 if (*handle!=NULL) {
3466 *handle=fopen(fileName,"w");
3468 *handle=fopen(fileName,"wb");
3472 *handle=fopen(fileName,"r");
3474 *handle=fopen(fileName,"rb");
3477 if (*handle==NULL) {
3478 snprintf(errorMsg,300,"Couldn't open file %s.",fileName);
3479 resultObjPtr=Tcl_NewStringObj(errorMsg,-1);
3480 Tcl_SetObjResult(interp,resultObjPtr);
3486 /*----------------------------------------------------------------------
3490 * When the user requests the 'any' auth, libcurl may need
3491 * to send the PUT/POST data more than once and thus may need to ask
3492 * the app to "rewind" the read data stream to start.
3494 *----------------------------------------------------------------------
3497 static curlioerr curlseek(void *instream, curl_off_t offset, int origin)
3499 if(-1 == fseek((FILE *)instream, 0, origin)) {
3500 return CURLIOE_FAILRESTART;
3506 /*----------------------------------------------------------------------
3508 * curlSetPostData --
3510 * In case there is going to be a post transfer, this function sets the
3511 * data that is going to be posted.
3514 * interp: Tcl interpreter we are using.
3515 * curlData: A pointer to the struct with the transfer data.
3518 * A standard Tcl result.
3519 *----------------------------------------------------------------------
3522 curlSetPostData(Tcl_Interp *interp,struct curlObjData *curlDataPtr) {
3523 Tcl_Obj *errorMsgObjPtr;
3525 if (curlDataPtr->postListFirst!=NULL) {
3526 if (curl_easy_setopt(curlDataPtr->curl,CURLOPT_HTTPPOST,curlDataPtr->postListFirst)) {
3527 curl_formfree(curlDataPtr->postListFirst);
3528 errorMsgObjPtr=Tcl_NewStringObj("Error setting the data to post",-1);
3529 Tcl_SetObjResult(interp,errorMsgObjPtr);
3536 /*----------------------------------------------------------------------
3538 * curlResetPostData --
3540 * After performing a transfer, this function is invoked to erease the
3544 * curlData: A pointer to the struct with the transfer data.
3545 *----------------------------------------------------------------------
3548 curlResetPostData(struct curlObjData *curlDataPtr) {
3549 struct formArrayStruct *tmpPtr;
3551 if (curlDataPtr->postListFirst) {
3552 curl_formfree(curlDataPtr->postListFirst);
3553 curlDataPtr->postListFirst=NULL;
3554 curlDataPtr->postListLast=NULL;
3555 curl_easy_setopt(curlDataPtr->curl,CURLOPT_HTTPPOST,NULL);
3557 while(curlDataPtr->formArray!=NULL) {
3558 if (curlDataPtr->formArray->formHeaderList!=NULL) {
3559 curl_slist_free_all(curlDataPtr->formArray->formHeaderList);
3560 curlDataPtr->formArray->formHeaderList=NULL;
3562 curlResetFormArray(curlDataPtr->formArray->formArray);
3563 tmpPtr=curlDataPtr->formArray->next;
3564 Tcl_Free((char *)curlDataPtr->formArray);
3565 curlDataPtr->formArray=tmpPtr;
3569 /*----------------------------------------------------------------------
3571 * curlResetFormArray --
3573 * Cleans the contents of the formArray, it is done after a transfer or
3574 * if 'curl_formadd' returns an error.
3577 * formArray: A pointer to the array to clean up.
3578 *----------------------------------------------------------------------
3581 curlResetFormArray(struct curl_forms *formArray) {
3584 for (i=0;formArray[i].option!=CURLFORM_END;i++) {
3585 switch (formArray[i].option) {
3586 case CURLFORM_COPYNAME:
3587 case CURLFORM_COPYCONTENTS:
3589 case CURLFORM_CONTENTTYPE:
3590 case CURLFORM_FILENAME:
3591 case CURLFORM_FILECONTENT:
3592 case CURLFORM_BUFFER:
3593 case CURLFORM_BUFFERPTR:
3594 Tcl_Free((char *)(formArray[i].value));
3600 Tcl_Free((char *)formArray);
3603 /*----------------------------------------------------------------------
3605 * curlSetBodyVarName --
3607 * After performing a transfer, this function is invoked to set the
3608 * body of the recieved transfer into a user defined Tcl variable.
3611 * interp: The Tcl interpreter we are using.
3612 * curlData: A pointer to the struct with the transfer data.
3613 *----------------------------------------------------------------------
3616 curlSetBodyVarName(Tcl_Interp *interp,struct curlObjData *curlDataPtr) {
3617 Tcl_Obj *bodyVarNameObjPtr, *bodyVarObjPtr;
3619 bodyVarNameObjPtr=Tcl_NewStringObj(curlDataPtr->bodyVarName,-1);
3620 bodyVarObjPtr=Tcl_NewByteArrayObj((unsigned char *)curlDataPtr->bodyVar.memory,
3621 curlDataPtr->bodyVar.size);
3623 Tcl_ObjSetVar2(interp,bodyVarNameObjPtr,(Tcl_Obj *)NULL,bodyVarObjPtr,0);
3625 curlDataPtr->bodyVar.size=0;
3627 Tcl_Free(curlDataPtr->bodyVarName);
3628 curlDataPtr->bodyVarName=NULL;
3631 /*----------------------------------------------------------------------
3634 * The same as strdup, but won't seg fault if the string to copy is NULL.
3637 * old: The original one.
3640 * Returns a pointer to the new string.
3641 *----------------------------------------------------------------------
3644 *curlstrdup (char *old) {
3650 tmpPtr=Tcl_Alloc(strlen(old)+1);
3657 *----------------------------------------------------------------------
3659 * curlShareInitObjCmd --
3661 * Looks for the first free share handle (scurl1, scurl2,...) and
3662 * creates a Tcl command for it.
3665 * A string with the name of the handle, don't forget to free it.
3668 * See the user documentation.
3670 *----------------------------------------------------------------------
3674 curlCreateShareObjCmd (Tcl_Interp *interp,struct shcurlObjData *shcurlData) {
3678 Tcl_Command cmdToken;
3680 /* We try with scurl1, if it already exists with scurl2...*/
3681 shandleName=(char *)Tcl_Alloc(10);
3683 sprintf(shandleName,"scurl%d",i);
3684 if (!Tcl_GetCommandInfo(interp,shandleName,&info)) {
3685 cmdToken=Tcl_CreateObjCommand(interp,shandleName,curlShareObjCmd,
3686 (ClientData)shcurlData,
3687 (Tcl_CmdDeleteProc *)curlCleanUpShareCmd);
3691 shcurlData->token=cmdToken;
3697 *----------------------------------------------------------------------
3699 * curlShareInitObjCmd --
3701 * This procedure is invoked to process the "curl::shareinit" Tcl command.
3702 * See the user documentation for details on what it does.
3705 * A standard Tcl result.
3708 * See the user documentation.
3710 *----------------------------------------------------------------------
3714 curlShareInitObjCmd (ClientData clientData, Tcl_Interp *interp,
3715 int objc,Tcl_Obj *CONST objv[]) {
3719 struct shcurlObjData *shcurlData;
3722 shcurlData=(struct shcurlObjData *)Tcl_Alloc(sizeof(struct shcurlObjData));
3723 if (shcurlData==NULL) {
3724 resultPtr=Tcl_NewStringObj("Couldn't allocate memory",-1);
3725 Tcl_SetObjResult(interp,resultPtr);
3729 memset(shcurlData, 0, sizeof(struct shcurlObjData));
3731 shcurlHandle=curl_share_init();
3732 if (shcurlHandle==NULL) {
3733 resultPtr=Tcl_NewStringObj("Couldn't create share handle",-1);
3734 Tcl_SetObjResult(interp,resultPtr);
3738 shandleName=curlCreateShareObjCmd(interp,shcurlData);
3740 shcurlData->shandle=shcurlHandle;
3742 resultPtr=Tcl_NewStringObj(shandleName,-1);
3743 Tcl_SetObjResult(interp,resultPtr);
3744 Tcl_Free(shandleName);
3747 curl_share_setopt(shcurlHandle, CURLSHOPT_LOCKFUNC, curlShareLockFunc);
3748 curl_share_setopt(shcurlHandle, CURLSHOPT_LOCKFUNC, curlShareUnLockFunc);
3756 *----------------------------------------------------------------------
3758 * curlShareLockFunc --
3760 * This will be the function invoked by libcurl when it wants to lock
3761 * some data for the share interface.
3764 * See the user documentation.
3766 *----------------------------------------------------------------------
3770 curlShareLockFunc (CURL *handle, curl_lock_data data, curl_lock_access access
3774 CURL_LOCK_DATA_COOKIE:
3775 Tcl_MutexLock(&cookieLock);
3778 Tcl_MutexLock(&dnsLock);
3780 CURL_LOCK_DATA_SSL_SESSION:
3781 Tcl_MutexLock(&sslLock);
3783 CURL_LOCK_DATA_CONNECT:
3784 Tcl_MutexLock(&connectLock);
3787 /* Prevent useless compile warnings */
3793 *----------------------------------------------------------------------
3795 * curlShareUnLockFunc --
3797 * This will be the function invoked by libcurl when it wants to unlock
3798 * the previously locked data.
3801 * See the user documentation.
3803 *----------------------------------------------------------------------
3806 curlShareUnLockFunc(CURL *handle, curl_lock_data data, void *userptr) {
3809 CURL_LOCK_DATA_COOKIE:
3810 Tcl_MutexUnlock(&cookieLock);
3813 Tcl_MutexUnlock(&dnsLock);
3815 CURL_LOCK_DATA_SSL_SESSION:
3816 Tcl_MutexUnlock(&sslLock);
3818 CURL_LOCK_DATA_CONNECT:
3819 Tcl_MutexUnlock(&connectLock);
3829 *----------------------------------------------------------------------
3831 * curlShareObjCmd --
3833 * This procedure is invoked to process the "share curl" commands.
3834 * See the user documentation for details on what it does.
3837 * A standard Tcl result.
3840 * See the user documentation.
3842 *----------------------------------------------------------------------
3845 curlShareObjCmd (ClientData clientData, Tcl_Interp *interp,
3846 int objc,Tcl_Obj *CONST objv[]) {
3848 struct shcurlObjData *shcurlData=(struct shcurlObjData *)clientData;
3849 CURLSH *shcurlHandle=shcurlData->shandle;
3850 int tableIndex, dataIndex;
3854 Tcl_WrongNumArgs(interp,1,objv,"option arg ?arg?");
3858 if (Tcl_GetIndexFromObj(interp, objv[1], shareCmd, "option",TCL_EXACT,&tableIndex)==TCL_ERROR) {
3862 switch(tableIndex) {
3865 if (Tcl_GetIndexFromObj(interp, objv[2], lockData,
3866 "data to lock ",TCL_EXACT,&dataIndex)==TCL_ERROR) {
3871 dataToLock=CURL_LOCK_DATA_COOKIE;
3874 dataToLock=CURL_LOCK_DATA_DNS;
3877 if (tableIndex==0) {
3878 curl_share_setopt(shcurlHandle, CURLSHOPT_SHARE, dataToLock);
3880 curl_share_setopt(shcurlHandle, CURLSHOPT_UNSHARE, dataToLock);
3884 Tcl_DeleteCommandFromToken(interp,shcurlData->token);
3891 *----------------------------------------------------------------------
3893 * curlCleanUpShareCmd --
3895 * This procedure is invoked when curl share handle is deleted.
3898 * A standard Tcl result.
3901 * Cleans the curl share handle and frees the memory.
3903 *----------------------------------------------------------------------
3906 curlCleanUpShareCmd(ClientData clientData) {
3907 struct shcurlObjData *shcurlData=(struct shcurlObjData *)clientData;
3908 CURLSH *shcurlHandle=shcurlData->shandle;
3910 curl_share_cleanup(shcurlHandle);
3911 Tcl_Free((char *)shcurlData);
3917 *----------------------------------------------------------------------
3919 * curlErrorStrings --
3921 * All the commands to return the error string from the error code have
3922 * this function in common.
3925 * '0': All went well.
3926 * '1': The error code didn't make sense.
3927 *----------------------------------------------------------------------
3930 curlErrorStrings (Tcl_Interp *interp, Tcl_Obj *CONST objv,int type) {
3936 if (Tcl_GetIntFromObj(interp,objv,&errorCode)) {
3937 snprintf(errorMsg,500,"Invalid error code: %s",Tcl_GetString(objv));
3938 resultPtr=Tcl_NewStringObj(errorMsg,-1);
3939 Tcl_SetObjResult(interp,resultPtr);
3944 resultPtr=Tcl_NewStringObj(curl_easy_strerror(errorCode),-1);
3947 resultPtr=Tcl_NewStringObj(curl_share_strerror(errorCode),-1);
3950 resultPtr=Tcl_NewStringObj(curl_multi_strerror(errorCode),-1);
3953 resultPtr=Tcl_NewStringObj("You're kidding,right?",-1);
3955 Tcl_SetObjResult(interp,resultPtr);
3961 *----------------------------------------------------------------------
3963 * curlEasyStringError --
3965 * This function is invoked to process the "curl::easystrerror" Tcl command.
3966 * It will return a string with an explanation of the error code given.
3969 * A standard Tcl result.
3972 * The interpreter will contain as a result the string with the error
3975 *----------------------------------------------------------------------
3978 curlEasyStringError (ClientData clientData, Tcl_Interp *interp,
3979 int objc,Tcl_Obj *CONST objv[]) {
3982 Tcl_WrongNumArgs(interp,1,objv,"errorCode");
3986 if (curlErrorStrings(interp,objv[1],0)) {
3993 *----------------------------------------------------------------------
3995 * curlShareStringError --
3997 * This function is invoked to process the "curl::sharestrerror" Tcl command.
3998 * It will return a string with an explanation of the error code given.
4001 * A standard Tcl result.
4004 * The interpreter will contain as a result the string with the error
4007 *----------------------------------------------------------------------
4010 curlShareStringError (ClientData clientData, Tcl_Interp *interp,
4011 int objc,Tcl_Obj *CONST objv[]) {
4014 Tcl_WrongNumArgs(interp,1,objv,"errorCode");
4018 if (curlErrorStrings(interp,objv[1],1)) {
4025 *----------------------------------------------------------------------
4027 * curlMultiStringError --
4029 * This function is invoked to process the "curl::multirerror" Tcl command.
4030 * It will return a string with an explanation of the error code given.
4033 * A standard Tcl result.
4036 * The interpreter will contain as a result the string with the error
4039 *----------------------------------------------------------------------
4042 curlMultiStringError (ClientData clientData, Tcl_Interp *interp,
4043 int objc,Tcl_Obj *CONST objv[]) {
4046 Tcl_WrongNumArgs(interp,1,objv,"errorCode");
4050 if (curlErrorStrings(interp,objv[1],2)) {