generic/tclcurl.c

   1 /*
   2  * tclcurl.c --
   3  *
   4  * Implementation of the TclCurl extension that creates the curl namespace
   5  * so that Tcl interpreters can access libcurl.
   6  *
   7  * Copyright (c) 2001-2009 Andres Garcia Garcia.
   8  *
   9  * See the file "license.terms" for information on usage and redistribution
  10  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11  *
  12  */
  13
  14 #include "tclcurl.h"
  15
  16 #include <sys/types.h>
  17 #include <unistd.h>
  18
  19 /*
  20  *----------------------------------------------------------------------
  21  *
  22  * Tclcurl_Init --
  23  *
  24  *  This procedure initializes the package
  25  *
  26  * Results:
  27  *  A standard Tcl result.
  28  *
  29  *----------------------------------------------------------------------
  30  */
  31
  32 int
  33 Tclcurl_Init (Tcl_Interp *interp) {
  34
  35     if(Tcl_InitStubs(interp,"8.1",0)==NULL) {
  36         return TCL_ERROR;
  37     }
  38
  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);
  57
  58     Tclcurl_MultiInit(interp);
  59
  60     Tcl_PkgProvide(interp,"TclCurl","7.19.6");
  61
  62     return TCL_OK;
  63 }
  64
  65 /*
  66  *----------------------------------------------------------------------
  67  *
  68  * curlCreateObjCmd --
  69  *
  70  *  Looks for the first free handle (curl1, curl2,...) and creates a
  71  *  Tcl command for it.
  72  *
  73  * Results:
  74  *  A string with the name of the handle, don't forget to free it.
  75  *
  76  * Side effects:
  77  *  See the user documentation.
  78  *
  79  *----------------------------------------------------------------------
  80  */
  81
  82 char *
  83 curlCreateObjCmd (Tcl_Interp *interp,struct curlObjData  *curlData) {
  84     char                *handleName;
  85     int                 i;
  86     Tcl_CmdInfo         info;
  87     Tcl_Command         cmdToken;
  88
  89     /* We try with curl1, if it already exists with curl2...*/
  90     handleName=(char *)Tcl_Alloc(10);
  91     for (i=1;;i++) {
  92         sprintf(handleName,"curl%d",i);
  93         if (!Tcl_GetCommandInfo(interp,handleName,&info)) {
  94             cmdToken=Tcl_CreateObjCommand(interp,handleName,curlObjCmd,
  95                                 (ClientData)curlData,
  96                                 (Tcl_CmdDeleteProc *)curlDeleteCmd);
  97             break;
  98         }
  99     }
 100     curlData->token=cmdToken;
 101
 102     return handleName;
 103 }
 104
 105 /*
 106  *----------------------------------------------------------------------
 107  *
 108  * curlInitObjCmd --
 109  *
 110  *  This procedure is invoked to process the "curl::init" Tcl command.
 111  *  See the user documentation for details on what it does.
 112  *
 113  * Results:
 114  *  A standard Tcl result.
 115  *
 116  * Side effects:
 117  *  See the user documentation.
 118  *
 119  *----------------------------------------------------------------------
 120  */
 121
 122 int
 123 curlInitObjCmd (ClientData clientData, Tcl_Interp *interp,
 124         int objc,Tcl_Obj *CONST objv[]) {
 125
 126     Tcl_Obj             *resultPtr;
 127     CURL                *curlHandle;
 128     struct curlObjData  *curlData;
 129     char                *handleName;
 130
 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);
 135         return TCL_ERROR;
 136     }
 137
 138     memset(curlData, 0, sizeof(struct curlObjData));
 139     curlData->interp=interp;
 140
 141     curlHandle=curl_easy_init();
 142     if (curlHandle==NULL) {
 143         resultPtr=Tcl_NewStringObj("Couldn't open curl handle",-1);
 144         Tcl_SetObjResult(interp,resultPtr);
 145         return TCL_ERROR;
 146     }
 147
 148     handleName=curlCreateObjCmd(interp,curlData);
 149
 150     curlData->curl=curlHandle;
 151
 152     resultPtr=Tcl_NewStringObj(handleName,-1);
 153     Tcl_SetObjResult(interp,resultPtr);
 154     Tcl_Free(handleName);
 155
 156     return TCL_OK;
 157 }
 158
 159 /*
 160  *----------------------------------------------------------------------
 161  *
 162  * curlObjCmd --
 163  *
 164  *  This procedure is invoked to process the "curl" commands.
 165  *  See the user documentation for details on what it does.
 166  *
 167  * Results:
 168  *  A standard Tcl result.
 169  *
 170  * Side effects:
 171  *  See the user documentation.
 172  *
 173  *----------------------------------------------------------------------
 174  */
 175 int
 176 curlObjCmd (ClientData clientData, Tcl_Interp *interp,
 177     int objc,Tcl_Obj *CONST objv[]) {
 178
 179     struct curlObjData     *curlData=(struct curlObjData *)clientData;
 180     CURL                   *curlHandle=curlData->curl;
 181     int                    tableIndex;
 182
 183     if (objc<2) {
 184         Tcl_WrongNumArgs(interp,1,objv,"option arg ?arg?");
 185         return TCL_ERROR;
 186     }
 187     if (Tcl_GetIndexFromObj(interp, objv[1], commandTable, "option",
 188             TCL_EXACT,&tableIndex)==TCL_ERROR) {
 189         return TCL_ERROR;
 190     }
 191
 192     switch(tableIndex) {
 193         case 0:
 194             if (curlSetOptsTransfer(interp,curlData,objc,objv)==TCL_ERROR) {
 195                 return TCL_ERROR;
 196             }
 197             break;
 198         case 1:
 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);
 205                     } else {
 206                         Tcl_SetVar2(interp,curlData->errorBufferName,
 207                                 curlData->errorBufferKey,
 208                                 curlData->errorBuffer,0);
 209                     }
 210                 }
 211                 return TCL_ERROR;
 212             }
 213             break;
 214         case 2:
 215 /*            fprintf(stdout,"Getinfo\n"); */
 216             if (Tcl_GetIndexFromObj(interp,objv[2],getInfoTable,
 217                     "getinfo option",TCL_EXACT,&tableIndex)==TCL_ERROR) {
 218                 return TCL_ERROR;
 219             }
 220             if (curlGetInfo(interp,curlHandle,tableIndex)) {
 221                 return TCL_ERROR;
 222             }
 223             break;
 224         case 3:
 225 /*            fprintf(stdout,"Cleanup\n");  */
 226             Tcl_DeleteCommandFromToken(interp,curlData->token);
 227             break;
 228         case 4:
 229 /*            fprintf(stdout,"Configure\n"); */
 230             if (curlConfigTransfer(interp,curlData,objc,objv)==TCL_ERROR) {
 231                 return TCL_ERROR;
 232             }
 233             break;
 234         case 5:
 235 /*            fprintf(stdout,"DupHandle\n"); */
 236             if (curlDupHandle(interp,curlData,objc,objv)==TCL_ERROR) {
 237                 return TCL_ERROR;
 238             }
 239             break;
 240         case 6:
 241 /*            fprintf(stdout,"Reset\n");     */
 242             if (curlResetHandle(interp,curlData)==TCL_ERROR) {
 243                 return TCL_ERROR;
 244             }
 245             break;
 246         case 7:
 247 /*            fprintf(stdout,"Pause\n");     */
 248             if (curl_easy_pause(curlData->curl,CURLPAUSE_ALL)==TCL_ERROR) {
 249                 return TCL_ERROR;
 250             }
 251             break;
 252
 253         case 8:
 254 /*            fprintf(stdout,"Resume\n");     */
 255             if (curl_easy_pause(curlData->curl,CURLPAUSE_CONT)==TCL_ERROR) {
 256                 return TCL_ERROR;
 257             }
 258             break;
 259     }
 260     return TCL_OK;
 261 }
 262
 263 /*
 264  *----------------------------------------------------------------------
 265  *
 266  * curlDeleteCmd --
 267  *
 268  *  This procedure is invoked when curl handle is deleted.
 269  *
 270  * Results:
 271  *  A standard Tcl result.
 272  *
 273  * Side effects:
 274  *  Cleans the curl handle and frees the memory.
 275  *
 276  *----------------------------------------------------------------------
 277  */
 278 int
 279 curlDeleteCmd(ClientData clientData) {
 280     struct curlObjData     *curlData=(struct curlObjData *)clientData;
 281     CURL                   *curlHandle=curlData->curl;
 282
 283     curl_easy_cleanup(curlHandle);
 284     curlFreeSpace(curlData);
 285
 286     Tcl_Free((char *)curlData);
 287
 288     return TCL_OK;
 289 }
 290
 291 /*
 292  *----------------------------------------------------------------------
 293  *
 294  * curlPerform --
 295  *
 296  *  Invokes the libcurl function 'curl_easy_perform'
 297  *
 298  * Parameter:
 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.
 302  *
 303  * Results:
 304  *  Standard Tcl return codes.
 305  *----------------------------------------------------------------------
 306  */
 307 int
 308 curlPerform(Tcl_Interp *interp,CURL *curlHandle,
 309             struct curlObjData *curlData) {
 310     int         exitCode;
 311     Tcl_Obj     *resultPtr;
 312
 313     if (curlOpenFiles(interp,curlData)) {
 314         return TCL_ERROR;
 315     }
 316     if (curlSetPostData(interp,curlData)) {
 317         return TCL_ERROR;
 318     }
 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);
 326     }
 327     if (curlData->command) {
 328         Tcl_GlobalEval(interp,curlData->command);
 329     }
 330     return exitCode;
 331 }
 332
 333 /*
 334  *----------------------------------------------------------------------
 335  *
 336  * curlSetOptsTransfer --
 337  *
 338  *  This procedure is invoked when the user invokes the 'setopt'
 339  *  command, it is used to set the 'curl' options
 340  *
 341  *  Parameter:
 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.
 345  *
 346  * Results:
 347  *  A standard Tcl result.
 348  *----------------------------------------------------------------------
 349  */
 350 int
 351 curlSetOptsTransfer(Tcl_Interp *interp, struct curlObjData *curlData,
 352         int objc, Tcl_Obj *CONST objv[]) {
 353
 354     int            tableIndex;
 355 fprintf(stdout,"Llegamos a curlSetOptsTrasnfer\n");
 356     if (Tcl_GetIndexFromObj(interp, objv[2], optionTable, "option",
 357             TCL_EXACT, &tableIndex)==TCL_ERROR) {
 358         return TCL_ERROR;
 359     }
 360 fprintf(stdout,"La opcion es la %d\n",tableIndex);
 361     return  curlSetOpts(interp,curlData,objv[3],tableIndex);
 362 }
 363
 364 /*
 365  *----------------------------------------------------------------------
 366  *
 367  * curlConfigTransfer --
 368  *
 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'.
 372  *
 373  *  Parameter:
 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.
 377  *
 378  * Results:
 379  *  A standard Tcl result.
 380  *----------------------------------------------------------------------
 381  */
 382 int
 383 curlConfigTransfer(Tcl_Interp *interp, struct curlObjData *curlData,
 384         int objc, Tcl_Obj *CONST objv[]) {
 385
 386     int            tableIndex;
 387     int            i,j;
 388
 389     Tcl_Obj     *resultPtr;
 390     char        errorMsg[500];
 391
 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) {
 395             return TCL_ERROR;
 396         }
 397         if (i==objc-1) {
 398             snprintf(errorMsg,500,"Empty value for %s",configTable[tableIndex]);
 399             resultPtr=Tcl_NewStringObj(errorMsg,-1);
 400             Tcl_SetObjResult(interp,resultPtr);
 401             return TCL_ERROR;
 402         }
 403         if (curlSetOpts(interp,curlData,objv[j],tableIndex)==TCL_ERROR) {
 404             return TCL_ERROR;
 405         }
 406     }
 407     return TCL_OK;
 408 }
 409
 410 /*
 411  *----------------------------------------------------------------------
 412  *
 413  * curlSetOpts --
 414  *
 415  *  This procedure takes care of setting the transfer options.
 416  *
 417  * Parameter:
 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.
 422  *
 423  * Results:
 424  *  A standard Tcl result.
 425  *----------------------------------------------------------------------
 426  */
 427 int
 428 curlSetOpts(Tcl_Interp *interp, struct curlObjData *curlData,
 429         Tcl_Obj *CONST objv,int tableIndex) {
 430
 431     int            exitCode;
 432     CURL           *curlHandle=curlData->curl;
 433     int            i,j,k;
 434
 435     Tcl_Obj        *resultObjPtr;
 436     Tcl_Obj        *tmpObjPtr;
 437
 438     Tcl_RegExp      regExp;
 439     CONST char     *startPtr;
 440     CONST char     *endPtr;
 441
 442     int             charLength;
 443     long            longNumber=0;
 444     int             intNumber;
 445     char           *tmpStr;
 446     unsigned char  *tmpUStr;
 447
 448     Tcl_Obj                 **httpPostData;
 449     Tcl_Obj                 **protocols;
 450     int                       curlTableIndex,formaddError,formArrayIndex;
 451     struct formArrayStruct   *newFormArray;
 452     struct curl_forms        *formArray;
 453     int                       curlformBufferSize;
 454     size_t                    contentslen;
 455
 456     ulong                     protocolMask;
 457
 458     switch(tableIndex) {
 459         case 0:
 460             if (SetoptChar(interp,curlHandle,CURLOPT_URL,
 461                     tableIndex,objv)) {
 462                 return TCL_ERROR;
 463             }
 464             break;
 465         case 1:
 466             Tcl_Free(curlData->outFile);
 467             curlData->outFile=curlstrdup(Tcl_GetString(objv));
 468             if ((strcmp(curlData->outFile,""))&&(strcmp(curlData->outFile,"stdout"))) {
 469                 curlData->outFlag=1;
 470             } else {
 471                 curlData->outFlag=0;
 472                 curl_easy_setopt(curlHandle,CURLOPT_WRITEDATA,stdout);
 473                 curlData->outFile=NULL;
 474             }
 475             curl_easy_setopt(curlHandle,CURLOPT_WRITEFUNCTION,NULL);
 476             break;
 477         case 2:
 478             Tcl_Free(curlData->inFile);
 479             curlData->inFile=curlstrdup(Tcl_GetString(objv));
 480             if ((strcmp(curlData->inFile,""))&&(strcmp(curlData->inFile,"stdin"))) {
 481                 curlData->inFlag=1;
 482             } else {
 483                 curl_easy_setopt(curlHandle,CURLOPT_READDATA,stdin);
 484                 curlData->inFlag=0;
 485                 curlData->inFile=NULL;
 486             }
 487             curl_easy_setopt(curlHandle,CURLOPT_READFUNCTION,NULL);
 488             break;
 489         case 3:
 490             if (SetoptChar(interp,curlHandle,
 491                     CURLOPT_USERAGENT,tableIndex,objv)) {
 492                 return TCL_ERROR;
 493             }
 494             break;
 495         case 4:
 496             if (SetoptChar(interp,curlHandle,CURLOPT_REFERER,tableIndex,objv)) {
 497                 return TCL_ERROR;
 498             }
 499             break;
 500         case 5:
 501             if (SetoptInt(interp,curlHandle,CURLOPT_VERBOSE,tableIndex,objv)) {
 502                 return TCL_ERROR;
 503             }
 504             break;
 505         case 6:
 506             if (SetoptInt(interp,curlHandle,CURLOPT_HEADER,tableIndex,objv)) {
 507                 return TCL_ERROR;
 508             }
 509             break;
 510         case 7:
 511             if (SetoptInt(interp,curlHandle,CURLOPT_NOBODY,tableIndex,objv)) {
 512                 return TCL_ERROR;
 513             }
 514             break;
 515         case 8:
 516             if (SetoptChar(interp,curlHandle,CURLOPT_PROXY,tableIndex,objv)) {
 517                 return TCL_ERROR;
 518             }
 519             break;
 520         case 9:
 521             if (SetoptLong(interp,curlHandle,CURLOPT_PROXYPORT,tableIndex,
 522                         objv)) {
 523                 return TCL_ERROR;
 524             }
 525             break;
 526         case 10:
 527             if (SetoptInt(interp,curlHandle,CURLOPT_HTTPPROXYTUNNEL,tableIndex,
 528                     objv)) {
 529                 return TCL_ERROR;
 530             }
 531             break;
 532         case 11:
 533             if (SetoptInt(interp,curlHandle,CURLOPT_FAILONERROR,tableIndex,
 534                     objv)) {
 535                 return TCL_ERROR;
 536             }
 537             break;
 538         case 12:
 539             if (SetoptLong(interp,curlHandle,CURLOPT_TIMEOUT,tableIndex,
 540                         objv)) {
 541                 return TCL_ERROR;
 542             }
 543             break;
 544         case 13:
 545             if (SetoptLong(interp,curlHandle,CURLOPT_LOW_SPEED_LIMIT,tableIndex,
 546                         objv)) {
 547                 return TCL_ERROR;
 548             }
 549             break;
 550         case 14:
 551             if (SetoptLong(interp,curlHandle,CURLOPT_LOW_SPEED_TIME,tableIndex,
 552                         objv)) {
 553                 return TCL_ERROR;
 554             }
 555             break;
 556         case 15:
 557             if (SetoptLong(interp,curlHandle,CURLOPT_RESUME_FROM,tableIndex,
 558                         objv)) {
 559                 return TCL_ERROR;
 560             }
 561             break;
 562         case 16:
 563             if (SetoptLong(interp,curlHandle,CURLOPT_INFILESIZE,tableIndex,
 564                         objv)) {
 565                 return TCL_ERROR;
 566             }
 567             break;
 568         case 17:
 569             if (SetoptInt(interp,curlHandle,CURLOPT_UPLOAD,tableIndex,
 570                     objv)) {
 571                 return TCL_ERROR;
 572             }
 573             break;
 574         case 137:
 575         case 18:
 576             if (SetoptInt(interp,curlHandle,CURLOPT_DIRLISTONLY,tableIndex,
 577                     objv)) {
 578                 return TCL_ERROR;
 579             }
 580             break;
 581         case 136:
 582         case 19:
 583             if (SetoptInt(interp,curlHandle,CURLOPT_APPEND,tableIndex,
 584                     objv)) {
 585                 return TCL_ERROR;
 586             }
 587             break;
 588         case 20:
 589             if (Tcl_GetIndexFromObj(interp, objv, netrcTable,
 590                     "netrc option",TCL_EXACT,&curlTableIndex)==TCL_ERROR) {
 591                 return TCL_ERROR;
 592             }
 593             if (curl_easy_setopt(curlHandle,CURLOPT_NETRC,curlTableIndex)) {
 594                 curlErrorSetOpt(interp,configTable,tableIndex,netrcTable[curlTableIndex]);
 595                 return 1;
 596             }
 597             break;
 598         case 21:
 599             if (SetoptInt(interp,curlHandle,CURLOPT_FOLLOWLOCATION,tableIndex,
 600                     objv)) {
 601                 return TCL_ERROR;
 602             }
 603             break;
 604         case 22:
 605             if (SetoptInt(interp,curlHandle,CURLOPT_TRANSFERTEXT,tableIndex,
 606                     objv)) {
 607                 return TCL_ERROR;
 608             }
 609             Tcl_GetIntFromObj(interp,objv,&curlData->transferText);
 610             break;
 611         case 23:
 612             if (SetoptInt(interp,curlHandle,CURLOPT_PUT,tableIndex,objv)) {
 613                 return TCL_ERROR;
 614             }
 615             break;
 616         case 24: /* The CURLOPT_MUTE option no longer does anything.*/
 617             break;
 618         case 25:
 619             if (SetoptChar(interp,curlHandle,CURLOPT_USERPWD,tableIndex,objv)) {
 620                 return TCL_ERROR;
 621             }
 622             break;
 623         case 26:
 624             if (SetoptChar(interp,curlHandle,CURLOPT_PROXYUSERPWD,tableIndex,objv)) {
 625                 return TCL_ERROR;
 626             }
 627             break;
 628         case 27:
 629             if (SetoptChar(interp,curlHandle,CURLOPT_RANGE,tableIndex,objv)) {
 630                 return TCL_ERROR;
 631             }
 632             break;
 633         case 28:
 634             tmpStr=curlstrdup(Tcl_GetString(objv));
 635             regExp=Tcl_RegExpCompile(interp,"(.*)(?:\\()(.*)(?:\\))");
 636             exitCode=Tcl_RegExpExec(interp,regExp,tmpStr,tmpStr);
 637             switch(exitCode) {
 638                 case -1:
 639                     Tcl_Free((char *)tmpStr);
 640                     return TCL_ERROR;
 641                     break;
 642                 case 0:
 643                     if (*tmpStr!=0) {
 644                         curlData->errorBufferName=curlstrdup(tmpStr);
 645                     } else {
 646                         curlData->errorBuffer=NULL;
 647                     }
 648                     curlData->errorBufferKey=NULL;
 649                     break;
 650                 case 1:
 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;
 661                     break;
 662             }
 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;
 670                     return TCL_ERROR;
 671                 }
 672             } else {
 673                 Tcl_Free(curlData->errorBuffer);
 674             }
 675             break;
 676         case 29:
 677             if (SetoptLong(interp,curlHandle,CURLOPT_HTTPGET,tableIndex,
 678                         objv)) {
 679                 return TCL_ERROR;
 680             }
 681             break;
 682         case 30:
 683             if (SetoptInt(interp,curlHandle,CURLOPT_POST,tableIndex,objv)) {
 684                 return TCL_ERROR;
 685             }
 686             break;
 687         case 31:
 688             if (SetoptChar(interp,curlHandle,
 689                     CURLOPT_COPYPOSTFIELDS,tableIndex,objv)) {
 690                 return TCL_ERROR;
 691             }
 692             break;
 693         case 33:
 694             if (SetoptChar(interp,curlHandle,
 695                     CURLOPT_FTPPORT,tableIndex,objv)) {
 696                 return TCL_ERROR;
 697             }
 698             break;
 699         case 34:
 700             if (SetoptChar(interp,curlHandle,CURLOPT_COOKIE,tableIndex,objv)) {
 701                 return TCL_ERROR;
 702             }
 703             break;
 704         case 35:
 705             if (SetoptChar(interp,curlHandle,CURLOPT_COOKIEFILE,tableIndex,objv)) {
 706                 return TCL_ERROR;
 707             }
 708             break;
 709         case 36:
 710             if(SetoptsList(interp,&curlData->headerList,objv)) {
 711                 curlErrorSetOpt(interp,configTable,tableIndex,"Header list invalid");
 712                 return TCL_ERROR;
 713             }
 714             if (curl_easy_setopt(curlHandle,CURLOPT_HTTPHEADER,curlData->headerList)) {
 715                 curl_slist_free_all(curlData->headerList);
 716                 curlData->headerList=NULL;
 717                 return TCL_ERROR;
 718             }
 719             return TCL_OK;
 720             break;
 721         case 37:
 722             if (Tcl_ListObjGetElements(interp,objv,&k,&httpPostData)
 723                     ==TCL_ERROR) {
 724                 return TCL_ERROR;
 725             }
 726             formaddError=0;
 727             newFormArray=(struct formArrayStruct *)Tcl_Alloc(sizeof(struct formArrayStruct));
 728             formArray=(struct curl_forms *)Tcl_Alloc(k*(sizeof(struct curl_forms)));
 729             formArrayIndex=0;
 730
 731             newFormArray->next=curlData->formArray;
 732             newFormArray->formArray=formArray;
 733             newFormArray->formHeaderList=NULL;
 734
 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) {
 738                     formaddError=1;
 739                     break;
 740                 }
 741                 switch(curlTableIndex) {
 742                     case 0:
 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]));
 746                         break;
 747                     case 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);
 753
 754                         formArrayIndex++;
 755                         formArray[formArrayIndex].option = CURLFORM_CONTENTSLENGTH;
 756                         contentslen=curlformBufferSize++;
 757                         formArray[formArrayIndex].value  = (char *)contentslen;
 758                         break;
 759                     case 2:
 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]));
 763                         break;
 764                     case 3:
 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]));
 768                         break;
 769                     case 4:
 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");
 774                             formaddError=1;
 775                             return TCL_ERROR;
 776                         }
 777                         formArray[formArrayIndex].value  = (char *)newFormArray->formHeaderList;
 778                         break;
 779                     case 5:
 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]));
 783                         break;
 784                     case 6:
 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]));
 788                         break;
 789                     case 7:
 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);
 796                         formArrayIndex++;
 797                         formArray[formArrayIndex].option = CURLFORM_BUFFERLENGTH;
 798                         contentslen=curlformBufferSize;
 799                         formArray[formArrayIndex].value  = (char *)contentslen;
 800                         break;
 801                     case 8:
 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]));
 805                         break;
 806                 }
 807                 formArrayIndex++;
 808             }
 809             formArray[formArrayIndex].option=CURLFORM_END;
 810             curlData->formArray=newFormArray;
 811
 812             if (0==formaddError) {
 813                 formaddError=curl_formadd(&(curlData->postListFirst)
 814                         ,&(curlData->postListLast), CURLFORM_ARRAY, formArray
 815                         , CURLFORM_END);
 816             }
 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);
 825                 Tcl_Free(tmpStr);
 826                 return TCL_ERROR;
 827             }
 828             return TCL_OK;
 829             break;
 830         case 38:
 831             if (SetoptChar(interp,curlHandle,CURLOPT_SSLCERT,tableIndex,objv)) {
 832                 return TCL_ERROR;
 833             }
 834             break;
 835         case 39:
 836             if (SetoptChar(interp,curlHandle,CURLOPT_SSLCERTPASSWD,tableIndex,objv)) {
 837                 return TCL_ERROR;
 838             }
 839             break;
 840         case 40:
 841             if (Tcl_GetIndexFromObj(interp, objv, sslversion,
 842                 "sslversion ",TCL_EXACT,&intNumber)==TCL_ERROR) {
 843                 return TCL_ERROR;
 844             }
 845             switch(intNumber) {
 846                 case 0:
 847                     longNumber=CURL_SSLVERSION_DEFAULT;
 848                     break;
 849                 case 1:
 850                     longNumber=CURL_SSLVERSION_TLSv1;
 851                     break;
 852                 case 2:
 853                     longNumber=CURL_SSLVERSION_SSLv2;
 854                     break;
 855                 case 3:
 856                     longNumber=CURL_SSLVERSION_SSLv3;
 857             }
 858             tmpObjPtr=Tcl_NewLongObj(longNumber);
 859             if (SetoptLong(interp,curlHandle,CURLOPT_SSLVERSION,
 860                         tableIndex,tmpObjPtr)) {
 861                 return TCL_ERROR;
 862             }
 863             break;
 864         case 41:
 865             if (SetoptInt(interp,curlHandle,CURLOPT_CRLF,tableIndex,objv)) {
 866                 return TCL_ERROR;
 867             }
 868             break;
 869         case 42:
 870             if(SetoptsList(interp,&curlData->quote,objv)) {
 871                 curlErrorSetOpt(interp,configTable,tableIndex,"quote list invalid");
 872                 return TCL_ERROR;
 873             }
 874             if (curl_easy_setopt(curlHandle,CURLOPT_QUOTE,curlData->quote)) {
 875                 curl_slist_free_all(curlData->quote);
 876                 curlData->quote=NULL;
 877                 return TCL_ERROR;
 878             }
 879             return TCL_OK;
 880             break;
 881         case 43:
 882             if(SetoptsList(interp,&curlData->postquote,objv)) {
 883                 curlErrorSetOpt(interp,configTable,tableIndex,"postqoute invalid");
 884                 return TCL_ERROR;
 885             }
 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;
 890                 return TCL_ERROR;
 891             }
 892             return TCL_OK;
 893             break;
 894         case 44:
 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;
 900             } else {
 901                 if ((strcmp(curlData->headerFile,"stdout"))) {
 902                     curl_easy_setopt(curlHandle,CURLOPT_HEADERDATA,stderr);
 903                 } else {
 904                     curl_easy_setopt(curlHandle,CURLOPT_HEADERDATA,stdout);
 905                 }
 906                 curlData->headerFlag=0;
 907                 curlData->headerFile=NULL;
 908             }
 909             break;
 910         case 45:
 911             if (Tcl_GetIndexFromObj(interp, objv, timeCond,
 912                 "time cond option",TCL_EXACT, &intNumber)==TCL_ERROR) {
 913                 return TCL_ERROR;
 914             }
 915             if (intNumber==0) {
 916                 longNumber=CURL_TIMECOND_IFMODSINCE;
 917             } else {
 918                 longNumber=CURL_TIMECOND_IFUNMODSINCE;
 919             }
 920             if (curl_easy_setopt(curlHandle,CURLOPT_TIMECONDITION,longNumber)) {
 921                 return TCL_ERROR;
 922             }
 923             break;
 924         case 46:
 925             if (SetoptLong(interp,curlHandle,CURLOPT_TIMEVALUE,tableIndex,
 926                         objv)) {
 927                 return TCL_ERROR;
 928             }
 929             break;
 930         case 47:
 931             if (SetoptChar(interp,curlHandle,CURLOPT_CUSTOMREQUEST,tableIndex,objv)) {
 932                 return TCL_ERROR;
 933             }
 934             break;
 935         case 48:
 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;
 941             } else {
 942                 curlData->stderrFlag=0;
 943                 if (strcmp(curlData->stderrFile,"stdout")) {
 944                     curl_easy_setopt(curlHandle,CURLOPT_STDERR,stderr);
 945                 } else {
 946                     curl_easy_setopt(curlHandle,CURLOPT_STDERR,stdout);
 947                 }
 948                 curlData->stderrFile=NULL;
 949             }
 950             break;
 951         case 49:
 952             if (SetoptChar(interp,curlHandle,CURLOPT_INTERFACE,tableIndex,objv)) {
 953                 return TCL_ERROR;
 954             }
 955             break;
 956         case 50:
 957         case 132:
 958             if (SetoptChar(interp,curlHandle,CURLOPT_KRBLEVEL,tableIndex,objv)) {
 959                 return TCL_ERROR;
 960             }
 961             break;
 962         case 51:
 963             if (SetoptLong(interp,curlHandle,CURLOPT_SSL_VERIFYPEER,tableIndex,
 964                         objv)) {
 965                 return TCL_ERROR;
 966             }
 967             break;
 968         case 52:
 969             if (SetoptChar(interp,curlHandle,CURLOPT_CAINFO,tableIndex,objv)) {
 970                 return TCL_ERROR;
 971             }
 972             break;
 973         case 53:
 974             if (SetoptLong(interp,curlHandle,CURLOPT_FILETIME,tableIndex,
 975                         objv)) {
 976                 return TCL_ERROR;
 977             }
 978             break;
 979         case 54:
 980             if (SetoptLong(interp,curlHandle,CURLOPT_MAXREDIRS,tableIndex,
 981                         objv)) {
 982                 return TCL_ERROR;
 983             }
 984             break;
 985         case 55:
 986             if (SetoptLong(interp,curlHandle,CURLOPT_MAXCONNECTS,tableIndex,
 987                         objv)) {
 988                 return TCL_ERROR;
 989             }
 990             break;
 991         case 56:
 992             curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
 993             return TCL_ERROR;
 994             break;
 995         case 57:
 996             if (SetoptChar(interp,curlHandle,CURLOPT_RANDOM_FILE,tableIndex,objv)) {
 997                 return TCL_ERROR;
 998             }
 999             break;
1000         case 58:
1001             if (SetoptChar(interp,curlHandle,CURLOPT_EGDSOCKET,tableIndex,objv)) {
1002                 return TCL_ERROR;
1003             }
1004             break;
1005         case 59:
1006             if (SetoptLong(interp,curlHandle,CURLOPT_CONNECTTIMEOUT,
1007                         tableIndex,objv)) {
1008                 return TCL_ERROR;
1009             }
1010             break;
1011         case 60:
1012             if (SetoptLong(interp,curlHandle,CURLOPT_NOPROGRESS,
1013                         tableIndex,objv)) {
1014                 return TCL_ERROR;
1015             }
1016             break;
1017         case 61:
1018             if (curl_easy_setopt(curlHandle,CURLOPT_HEADERFUNCTION,
1019                     curlHeaderReader)) {
1020                 return TCL_ERROR;
1021             }
1022             Tcl_Free(curlData->headerVar);
1023             curlData->headerVar=curlstrdup(Tcl_GetString(objv));
1024             if (curl_easy_setopt(curlHandle,CURLOPT_HEADERDATA,
1025                     (FILE *)curlData)) {
1026                 return TCL_ERROR;
1027             }
1028             break;
1029         case 62:
1030             Tcl_Free(curlData->bodyVarName);
1031             curlData->bodyVarName=curlstrdup(Tcl_GetString(objv));
1032             if (curl_easy_setopt(curlHandle,CURLOPT_WRITEFUNCTION,
1033                     curlBodyReader)) {
1034                 return TCL_ERROR;
1035             }
1036             if (curl_easy_setopt(curlHandle,CURLOPT_WRITEDATA,curlData)) {
1037                 return TCL_ERROR;
1038             }
1039             break;
1040         case 63:
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)) {
1046                     return TCL_ERROR;
1047                 }
1048                 if (curl_easy_setopt(curlHandle,CURLOPT_PROGRESSDATA,
1049                         curlData)) {
1050                     return TCL_ERROR;
1051                 }
1052             } else {
1053                 if (curl_easy_setopt(curlHandle,CURLOPT_PROGRESSFUNCTION,NULL)) {
1054                     return TCL_ERROR;
1055                 }
1056             }
1057             break;
1058         case 64:
1059             if (curlData->cancelTransVarName) {
1060                 Tcl_UnlinkVar(curlData->interp,curlData->cancelTransVarName);
1061                 Tcl_Free(curlData->cancelTransVarName);
1062             }
1063             curlData->cancelTransVarName=curlstrdup(Tcl_GetString(objv));
1064             Tcl_LinkVar(interp,curlData->cancelTransVarName,
1065                     (char *)&(curlData->cancelTrans),TCL_LINK_INT);
1066             break;
1067         case 65:
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);
1073                 return TCL_ERROR;
1074             }
1075             if (curl_easy_setopt(curlHandle,CURLOPT_WRITEDATA,curlData)) {
1076                 curl_easy_setopt(curlHandle,CURLOPT_WRITEFUNCTION,NULL);
1077                 return TCL_ERROR;
1078             }
1079             break;
1080         case 66:
1081             curlData->readProc=curlstrdup(Tcl_GetString(objv));
1082             curlData->inFlag=0;
1083             if (strcmp(curlData->readProc,"")) {
1084                 if (curl_easy_setopt(curlHandle,CURLOPT_READFUNCTION,
1085                         curlReadProcInvoke)) {
1086                     return TCL_ERROR;
1087                 }
1088             } else {
1089                 curl_easy_setopt(curlHandle,CURLOPT_READFUNCTION,NULL);
1090                 return TCL_OK;
1091             }
1092             if (curl_easy_setopt(curlHandle,CURLOPT_READDATA,curlData)) {
1093                 return TCL_ERROR;
1094             }
1095             break;
1096         case 67:
1097             if (SetoptLong(interp,curlHandle,CURLOPT_SSL_VERIFYHOST,
1098                         tableIndex,objv)) {
1099                 return TCL_ERROR;
1100             }
1101             break;
1102         case 68:
1103             if (SetoptChar(interp,curlHandle,CURLOPT_COOKIEJAR,tableIndex,objv)) {
1104                 return TCL_ERROR;
1105             }
1106             break;
1107         case 69:
1108             if (SetoptChar(interp,curlHandle,CURLOPT_SSL_CIPHER_LIST,tableIndex,objv)) {
1109                 return TCL_ERROR;
1110             }
1111             break;
1112         case 70:
1113             if (Tcl_GetIndexFromObj(interp, objv, httpVersionTable,
1114                 "http version",TCL_EXACT,&tableIndex)==TCL_ERROR) {
1115                 return TCL_ERROR;
1116             }
1117             if (curl_easy_setopt(curlHandle,CURLOPT_HTTP_VERSION,
1118                         tableIndex)) {
1119                 tmpStr=curlstrdup(Tcl_GetString(objv));
1120                 curlErrorSetOpt(interp,configTable,70,tmpStr);
1121                 Tcl_Free(tmpStr);
1122                 return TCL_ERROR;
1123             }
1124             break;
1125         case 71:
1126             if (SetoptLong(interp,curlHandle,CURLOPT_FTP_USE_EPSV,
1127                         tableIndex,objv)) {
1128                 return TCL_ERROR;
1129             }
1130             break;
1131         case 72:
1132             if (SetoptChar(interp,curlHandle,CURLOPT_SSLCERTTYPE,tableIndex,objv)) {
1133                 return TCL_ERROR;
1134             }
1135             break;
1136         case 73:
1137             if (SetoptChar(interp,curlHandle,CURLOPT_SSLKEY,tableIndex,objv)) {
1138                 return TCL_ERROR;
1139             }
1140             break;
1141         case 74:
1142             if (SetoptChar(interp,curlHandle,CURLOPT_SSLKEYTYPE,tableIndex,objv)) {
1143                 return TCL_ERROR;
1144             }
1145             break;
1146         case 135:
1147         case 75:
1148             if (SetoptChar(interp,curlHandle,CURLOPT_KEYPASSWD,tableIndex,objv)) {
1149                 return TCL_ERROR;
1150             }
1151             break;
1152         case 76:
1153             if (SetoptChar(interp,curlHandle,CURLOPT_SSLENGINE,tableIndex,objv)) {
1154                 return TCL_ERROR;
1155             }
1156             break;
1157         case 77:
1158             if (SetoptLong(interp,curlHandle,CURLOPT_SSLENGINE_DEFAULT,tableIndex,objv)) {
1159                 return TCL_ERROR;
1160             }
1161             break;
1162         case 78:
1163             if(SetoptsList(interp,&curlData->prequote,objv)) {
1164                 curlErrorSetOpt(interp,configTable,tableIndex,"pretqoute invalid");
1165                 return TCL_ERROR;
1166             }
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;
1171                 return TCL_ERROR;
1172             }
1173             return TCL_OK;
1174             break;
1175         case 79:
1176             curlData->debugProc=curlstrdup(Tcl_GetString(objv));
1177             if (curl_easy_setopt(curlHandle,CURLOPT_DEBUGFUNCTION,
1178                     curlDebugProcInvoke)) {
1179                 return TCL_ERROR;
1180             }
1181             if (curl_easy_setopt(curlHandle,CURLOPT_DEBUGDATA,curlData)) {
1182                 return TCL_ERROR;
1183             }
1184             break;
1185         case 80:
1186             if (SetoptLong(interp,curlHandle,CURLOPT_DNS_CACHE_TIMEOUT,
1187                         tableIndex,objv)) {
1188                 return TCL_ERROR;
1189             }
1190             break;
1191         case 81:
1192             if (SetoptLong(interp,curlHandle,CURLOPT_DNS_USE_GLOBAL_CACHE,
1193                         tableIndex,objv)) {
1194                 return TCL_ERROR;
1195             }
1196             break;
1197         case 82:
1198             if (SetoptLong(interp,curlHandle,CURLOPT_COOKIESESSION,
1199                         tableIndex,objv)) {
1200                 return TCL_ERROR;
1201             }
1202             break;
1203         case 83:
1204             if (SetoptChar(interp,curlHandle,CURLOPT_CAPATH,tableIndex,objv)) {
1205                 return TCL_ERROR;
1206             }
1207             break;
1208         case 84:
1209             if (SetoptLong(interp,curlHandle,CURLOPT_BUFFERSIZE,
1210                         tableIndex,objv)) {
1211                 return TCL_ERROR;
1212             }
1213             break;
1214         case 85:
1215             if (SetoptLong(interp,curlHandle,CURLOPT_NOSIGNAL,
1216                         tableIndex,objv)) {
1217                 return TCL_ERROR;
1218             }
1219             break;
1220         case 86:
1221             if (Tcl_GetIndexFromObj(interp, objv, encodingTable,
1222                 "encoding",TCL_EXACT,&tableIndex)==TCL_ERROR) {
1223                 return TCL_ERROR;
1224             }
1225             if (tableIndex==2) {
1226                 if (curl_easy_setopt(curlHandle,CURLOPT_ENCODING,"")) {
1227                     curlErrorSetOpt(interp,configTable,86,"all");
1228                     return 1;
1229                 }
1230             } else {
1231                 if (SetoptChar(interp,curlHandle,CURLOPT_ENCODING,86,objv)) {
1232                     return TCL_ERROR;
1233                 }
1234             }
1235             break;
1236         case 87:
1237             if (Tcl_GetIndexFromObj(interp, objv, proxyTypeTable,
1238                 "proxy type",TCL_EXACT,&tableIndex)==TCL_ERROR) {
1239                 return TCL_ERROR;
1240             }
1241             switch(tableIndex) {
1242                 case 0:
1243                     curl_easy_setopt(curlHandle,CURLOPT_PROXYTYPE,
1244                             CURLPROXY_HTTP);
1245                 case 1:
1246                     curl_easy_setopt(curlHandle,CURLOPT_PROXYTYPE,
1247                             CURLPROXY_SOCKS4);
1248                 case 2:
1249                     curl_easy_setopt(curlHandle,CURLOPT_PROXYTYPE,
1250                             CURLPROXY_SOCKS4A);
1251                 case 4:
1252                     curl_easy_setopt(curlHandle,CURLOPT_PROXYTYPE,
1253                             CURLPROXY_SOCKS5);
1254                 case 5:
1255                     curl_easy_setopt(curlHandle,CURLOPT_PROXYTYPE,
1256                             CURLPROXY_SOCKS5_HOSTNAME);
1257             }
1258             break;
1259         case 88:
1260             if(SetoptsList(interp,&curlData->http200aliases,objv)) {
1261                 curlErrorSetOpt(interp,configTable,tableIndex,"http200aliases invalid");
1262                 return TCL_ERROR;
1263             }
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;
1268                 return TCL_ERROR;
1269             }
1270             return TCL_OK;
1271             break;
1272         case 89:
1273             if (SetoptInt(interp,curlHandle,CURLOPT_UNRESTRICTED_AUTH
1274                     ,tableIndex,objv)) {
1275                 return TCL_ERROR;
1276             }
1277             break;
1278         case 90:
1279             if (SetoptLong(interp,curlHandle,CURLOPT_FTP_USE_EPRT,
1280                         tableIndex,objv)) {
1281                 return TCL_ERROR;
1282             }
1283             break;
1284         case 91:
1285             Tcl_Free(curlData->command);
1286             curlData->command=curlstrdup(Tcl_GetString(objv));
1287             break;
1288         case 92:
1289             if (Tcl_GetIndexFromObj(interp, objv, httpAuthMethods,
1290                 "authentication method",TCL_EXACT,&intNumber)==TCL_ERROR) {
1291                 return TCL_ERROR;
1292             }
1293             curlData->anyAuthFlag=0;
1294             switch(intNumber) {
1295                 case 0:
1296                     longNumber=CURLAUTH_BASIC;
1297                     break;
1298                 case 1:
1299                     longNumber=CURLAUTH_DIGEST;
1300                     break;
1301                 case 2:
1302                     longNumber=CURLAUTH_DIGEST_IE;
1303                     break;
1304                 case 3:
1305                     longNumber=CURLAUTH_GSSNEGOTIATE;
1306                     break;
1307                 case 4:
1308                     longNumber=CURLAUTH_NTLM;
1309                     break;
1310                 case 5:
1311                     longNumber=CURLAUTH_ANY;
1312                     curlData->anyAuthFlag=1;
1313                     break;
1314                 case 6:
1315                     longNumber=CURLAUTH_ANYSAFE;
1316                     break;
1317             }
1318             tmpObjPtr=Tcl_NewLongObj(longNumber);
1319             if (SetoptLong(interp,curlHandle,CURLOPT_HTTPAUTH
1320                     ,tableIndex,tmpObjPtr)) {
1321                 return TCL_ERROR;
1322             }
1323             break;
1324         case 93:
1325             if (SetoptLong(interp,curlHandle,CURLOPT_FTP_CREATE_MISSING_DIRS,
1326                         tableIndex,objv)) {
1327                 return TCL_ERROR;
1328             }
1329             break;
1330         case 94:
1331             if (Tcl_GetIndexFromObj(interp, objv, httpAuthMethods,
1332                 "authentication method",TCL_EXACT,&intNumber)==TCL_ERROR) {
1333                 return TCL_ERROR;
1334             }
1335             switch(intNumber) {
1336                 case 0:
1337                     longNumber=CURLAUTH_BASIC;
1338                     break;
1339                 case 1:
1340                     longNumber=CURLAUTH_DIGEST;
1341                     break;
1342                 case 2:
1343                     longNumber=CURLAUTH_GSSNEGOTIATE;
1344                     break;
1345                 case 3:
1346                     longNumber=CURLAUTH_NTLM;
1347                     break;
1348                 case 4:
1349                     longNumber=CURLAUTH_ANY;
1350                     break;
1351                 case 5:
1352                     longNumber=CURLAUTH_ANYSAFE;
1353                     break;
1354             }
1355             tmpObjPtr=Tcl_NewLongObj(longNumber);
1356             if (SetoptLong(interp,curlHandle,CURLOPT_PROXYAUTH
1357                     ,tableIndex,tmpObjPtr)) {
1358                 return TCL_ERROR;
1359             }
1360             break;
1361         case 95:
1362             if (SetoptLong(interp,curlHandle,CURLOPT_FTP_RESPONSE_TIMEOUT,
1363                         tableIndex,objv)) {
1364                 return TCL_ERROR;
1365             }
1366             break;
1367         case 96:
1368             if (Tcl_GetIndexFromObj(interp, objv, ipresolve,
1369                 "ip version",TCL_EXACT,&curlTableIndex)==TCL_ERROR) {
1370                 return TCL_ERROR;
1371             }
1372             switch(curlTableIndex) {
1373                 case 0:
1374                     longNumber=CURL_IPRESOLVE_WHATEVER;
1375                     break;
1376                 case 1:
1377                     longNumber=CURL_IPRESOLVE_V4;
1378                     break;
1379                 case 2:
1380                     longNumber=CURL_IPRESOLVE_V6;
1381                     break;
1382             }
1383             tmpObjPtr=Tcl_NewLongObj(longNumber);
1384             if (SetoptLong(interp,curlHandle,CURLOPT_IPRESOLVE
1385                     ,tableIndex,tmpObjPtr)) {
1386                 return TCL_ERROR;
1387             }
1388             break;
1389         case 97:
1390             if (SetoptLong(interp,curlHandle,CURLOPT_MAXFILESIZE,
1391                         tableIndex,objv)) {
1392                 return TCL_ERROR;
1393             }
1394             break;
1395         case 98:
1396             if (SetoptChar(interp,curlHandle,CURLOPT_NETRC_FILE,tableIndex,objv)) {
1397                 return TCL_ERROR;
1398             }
1399             break;
1400         case 99:
1401         case 138:
1402             if (Tcl_GetIndexFromObj(interp, objv, ftpssl,
1403                 "ftps method ",TCL_EXACT,&intNumber)==TCL_ERROR) {
1404                 return TCL_ERROR;
1405             }
1406             switch(intNumber) {
1407                 case 0:
1408                     longNumber=CURLUSESSL_NONE;
1409                     break;
1410                 case 1:
1411                     longNumber=CURLUSESSL_TRY;
1412                     break;
1413                 case 2:
1414                     longNumber=CURLUSESSL_CONTROL;
1415                     break;
1416                 case 3:
1417                     longNumber=CURLUSESSL_ALL;
1418                     break;
1419             }
1420             tmpObjPtr=Tcl_NewLongObj(longNumber);
1421             if (SetoptLong(interp,curlHandle,CURLOPT_USE_SSL,
1422                         tableIndex,tmpObjPtr)) {
1423                 return TCL_ERROR;
1424             }
1425             break;
1426         case 100:
1427             if (SetoptSHandle(interp,curlHandle,CURLOPT_SHARE,
1428                     tableIndex,objv)) {
1429                 return TCL_ERROR;
1430             }
1431             break;
1432         case 101:
1433             if (SetoptLong(interp,curlHandle,CURLOPT_PORT,
1434                         tableIndex,objv)) {
1435                 return TCL_ERROR;
1436             }
1437             break;
1438         case 102:
1439             if (SetoptLong(interp,curlHandle,CURLOPT_TCP_NODELAY,
1440                         tableIndex,objv)) {
1441                 return TCL_ERROR;
1442             }
1443             break;
1444         case 103:
1445             if (SetoptLong(interp,curlHandle,CURLOPT_AUTOREFERER,
1446                         tableIndex,objv)) {
1447                 return TCL_ERROR;
1448             }
1449             break;
1450         case 104:
1451             curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1452             return TCL_ERROR;
1453             break;
1454         case 105:
1455             curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1456             return TCL_ERROR;
1457             break;
1458         case 106:
1459             curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1460             return TCL_ERROR;
1461             break;
1462         case 107:
1463             curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete, check '-ftpport'");
1464             return TCL_ERROR;
1465             break;
1466         case 108:
1467             curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete, check '-ftpport'");
1468             return TCL_ERROR;
1469             break;
1470         case 109:
1471             curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1472             return TCL_ERROR;
1473             break;
1474         case 110:
1475             curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1476             return TCL_ERROR;
1477             break;
1478         case 111:
1479             if (Tcl_GetIndexFromObj(interp, objv, ftpsslauth,
1480                 "ftpsslauth method ",TCL_EXACT,&intNumber)==TCL_ERROR) {
1481                 return TCL_ERROR;
1482             }
1483             switch(intNumber) {
1484                 case 0:
1485                     longNumber=CURLFTPAUTH_DEFAULT;
1486                     break;
1487                 case 1:
1488                     longNumber=CURLFTPAUTH_SSL;
1489                     break;
1490                 case 2:
1491                     longNumber=CURLFTPAUTH_TLS;
1492                     break;
1493             }
1494             tmpObjPtr=Tcl_NewLongObj(longNumber);
1495             if (SetoptLong(interp,curlHandle,CURLOPT_FTPSSLAUTH,
1496                         tableIndex,tmpObjPtr)) {
1497                 return TCL_ERROR;
1498             }
1499             break;
1500         case 112:
1501             curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1502             return TCL_ERROR;
1503             break;
1504         case 113:
1505             curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1506             return TCL_ERROR;
1507             break;
1508         case 114:
1509             if (SetoptChar(interp,curlHandle,CURLOPT_FTP_ACCOUNT,tableIndex,objv)) {
1510                 return TCL_ERROR;
1511             }
1512             break;
1513         case 115:
1514             if (SetoptLong(interp,curlHandle,CURLOPT_IGNORE_CONTENT_LENGTH,
1515                         tableIndex,objv)) {
1516                 return TCL_ERROR;
1517             }
1518             break;
1519         case 116:
1520             if (SetoptChar(interp,curlHandle,CURLOPT_COOKIELIST,tableIndex,objv)) {
1521                 return TCL_ERROR;
1522             }
1523             break;
1524         case 117:
1525             if (SetoptLong(interp,curlHandle,CURLOPT_FTP_SKIP_PASV_IP,
1526                         tableIndex,objv)) {
1527                 return TCL_ERROR;
1528             }
1529             break;
1530         case 118:
1531             if (Tcl_GetIndexFromObj(interp, objv, ftpfilemethod,
1532                 "ftp file method ",TCL_EXACT,&intNumber)==TCL_ERROR) {
1533                 return TCL_ERROR;
1534             }
1535             switch(intNumber) {
1536                 case 0:
1537                 case 1:
1538                     longNumber=1;                /* FTPFILE_MULTICWD  */
1539                     break;
1540                 case 2:
1541                     longNumber=2;                /* FTPFILE_NOCWD     */
1542                     break;
1543                 case 3:
1544                     longNumber=3;                /* FTPFILE_SINGLECWD */
1545                     break;
1546             }
1547             tmpObjPtr=Tcl_NewLongObj(longNumber);
1548             if (SetoptLong(interp,curlHandle,CURLOPT_FTP_FILEMETHOD,
1549                         tableIndex,tmpObjPtr)) {
1550                 return TCL_ERROR;
1551             }
1552             break;
1553         case 119:
1554             if (SetoptLong(interp,curlHandle,CURLOPT_LOCALPORT,
1555                         tableIndex,objv)) {
1556                 return TCL_ERROR;
1557             }
1558             break;
1559         case 120:
1560             if (SetoptLong(interp,curlHandle,CURLOPT_LOCALPORTRANGE,
1561                         tableIndex,objv)) {
1562                 return TCL_ERROR;
1563             }
1564             break;
1565         case 121:
1566             if (SetoptCurlOffT(interp,curlHandle,CURLOPT_MAX_SEND_SPEED_LARGE,
1567                         tableIndex,objv)) {
1568                 return TCL_ERROR;
1569             }
1570             break;
1571          case 122:
1572             if (SetoptCurlOffT(interp,curlHandle,CURLOPT_MAX_RECV_SPEED_LARGE,
1573                         tableIndex,objv)) {
1574                 return TCL_ERROR;
1575             }
1576             break;
1577         case 123:
1578             if (SetoptChar(interp,curlHandle,
1579                     CURLOPT_FTP_ALTERNATIVE_TO_USER,tableIndex,objv)) {
1580                 return TCL_ERROR;
1581             }
1582             break;
1583         case 124:
1584             if (SetoptLong(interp,curlHandle,CURLOPT_SSL_SESSIONID_CACHE,
1585                         tableIndex,objv)) {
1586                 return TCL_ERROR;
1587             }
1588             break;
1589         case 125:
1590             if (Tcl_GetIndexFromObj(interp, objv, sshauthtypes,
1591                 "ssh auth type ",TCL_EXACT,&intNumber)==TCL_ERROR) {
1592                 return TCL_ERROR;
1593             }
1594             switch(intNumber) {
1595                 case 0:
1596                     longNumber=CURLSSH_AUTH_PUBLICKEY;
1597                     break;
1598                 case 1:
1599                     longNumber=CURLSSH_AUTH_PASSWORD;
1600                     break;
1601                 case 2:
1602                     longNumber=CURLSSH_AUTH_HOST;
1603                     break;
1604                 case 3:
1605                     longNumber=CURLSSH_AUTH_KEYBOARD;
1606                     break;
1607                 case 4:
1608                     longNumber=CURLSSH_AUTH_ANY;
1609                     break;
1610             }
1611             tmpObjPtr=Tcl_NewLongObj(longNumber);
1612             if (SetoptLong(interp,curlHandle,CURLOPT_SSH_AUTH_TYPES,
1613                         tableIndex,tmpObjPtr)) {
1614                 return TCL_ERROR;
1615             }
1616             break;
1617         case 126:
1618             if (SetoptChar(interp,curlHandle,CURLOPT_SSH_PUBLIC_KEYFILE,
1619                     tableIndex,objv)) {
1620                 return TCL_ERROR;
1621             }
1622             break;
1623         case 127:
1624             if (SetoptChar(interp,curlHandle,CURLOPT_SSH_PRIVATE_KEYFILE,
1625                     tableIndex,objv)) {
1626                 return TCL_ERROR;
1627             }
1628             break;
1629         case 128:
1630             if (SetoptLong(interp,curlHandle,CURLOPT_TIMEOUT_MS,
1631                         tableIndex,objv)) {
1632                 return TCL_ERROR;
1633             }
1634             break;
1635         case 129:
1636             if (SetoptLong(interp,curlHandle,CURLOPT_CONNECTTIMEOUT_MS,
1637                         tableIndex,objv)) {
1638                 return TCL_ERROR;
1639             }
1640             break;
1641         case 130:
1642             if (SetoptLong(interp,curlHandle,CURLOPT_HTTP_CONTENT_DECODING,
1643                         tableIndex,objv)) {
1644                 return TCL_ERROR;
1645             }
1646             break;
1647         case 131:
1648             if (SetoptLong(interp,curlHandle,CURLOPT_HTTP_TRANSFER_DECODING,
1649                         tableIndex,objv)) {
1650                 return TCL_ERROR;
1651             }
1652             break;
1653         /* 132 is together with case 50 */
1654         case 133:
1655             if (SetoptLong(interp,curlHandle,CURLOPT_NEW_FILE_PERMS,
1656                         tableIndex,objv)) {
1657                 return TCL_ERROR;
1658             }
1659             break;
1660         case 134:
1661             if (SetoptLong(interp,curlHandle,CURLOPT_NEW_DIRECTORY_PERMS,
1662                         tableIndex,objv)) {
1663                 return TCL_ERROR;
1664             }
1665             break;
1666         /* case 135 with 75, case 136 with 19, case 137 with 18 and case 138 with 99 */
1667         case 139:
1668         case 146:
1669             if (Tcl_GetIndexFromObj(interp, objv, postredir,
1670                 "Postredir option ",TCL_EXACT,&intNumber)==TCL_ERROR) {
1671                 return TCL_ERROR;
1672             }
1673             switch(intNumber) {
1674                 case 0:
1675                     longNumber=CURL_REDIR_POST_301;
1676                     break;
1677                 case 1:
1678                     longNumber=CURL_REDIR_POST_302;
1679                     break;
1680                 case 2:
1681                     longNumber=CURL_REDIR_POST_ALL;
1682                     break;
1683             }
1684             tmpObjPtr=Tcl_NewLongObj(longNumber);
1685             if (SetoptLong(interp,curlHandle,CURLOPT_POSTREDIR,
1686                         tableIndex,tmpObjPtr)) {
1687                 return TCL_ERROR;
1688             }
1689             break;
1690         case 140:
1691             if (SetoptChar(interp,curlHandle,CURLOPT_SSH_HOST_PUBLIC_KEY_MD5,
1692                     tableIndex,objv)) {
1693                 return TCL_ERROR;
1694             }
1695             break;
1696         case 141:
1697             if (SetoptLong(interp,curlHandle,CURLOPT_PROXY_TRANSFER_MODE,
1698                         tableIndex,objv)) {
1699                 return TCL_ERROR;
1700             }
1701             break;
1702         case 142:
1703             if (SetoptChar(interp,curlHandle,CURLOPT_CRLFILE,
1704                     tableIndex,objv)) {
1705                 return TCL_ERROR;
1706             }
1707             break;
1708         case 143:
1709             if (SetoptChar(interp,curlHandle,CURLOPT_ISSUERCERT,
1710                     tableIndex,objv)) {
1711                 return TCL_ERROR;
1712             }
1713             break;
1714         case 144:
1715             if (SetoptLong(interp,curlHandle,CURLOPT_ADDRESS_SCOPE,
1716                         tableIndex,objv)) {
1717                 return TCL_ERROR;
1718             }
1719             break;
1720         case 145:
1721             if (SetoptLong(interp,curlHandle,CURLOPT_CERTINFO,
1722                         tableIndex,objv)) {
1723                 return TCL_ERROR;
1724             }
1725             break;
1726         /* case 146 is together with 139*/
1727         case 147:
1728             if (SetoptChar(interp,curlHandle,CURLOPT_USERNAME,
1729                     tableIndex,objv)) {
1730                 return TCL_ERROR;
1731             }
1732             break;
1733         case 148:
1734             if (SetoptChar(interp,curlHandle,CURLOPT_PASSWORD,
1735                     tableIndex,objv)) {
1736                 return TCL_ERROR;
1737             }
1738             break;
1739         case 149:
1740             if (SetoptChar(interp,curlHandle,CURLOPT_PROXYUSERNAME,
1741                     tableIndex,objv)) {
1742                 return TCL_ERROR;
1743             }
1744             break;
1745         case 150:
1746             if (SetoptChar(interp,curlHandle,CURLOPT_PROXYPASSWORD,
1747                     tableIndex,objv)) {
1748                 return TCL_ERROR;
1749             }
1750             break;
1751         case 151:
1752             if (SetoptLong(interp,curlHandle,CURLOPT_TFTP_BLKSIZE,
1753                         tableIndex,objv)) {
1754                 return TCL_ERROR;
1755             }
1756             break;
1757         case 152:
1758             if (SetoptChar(interp,curlHandle,CURLOPT_SOCKS5_GSSAPI_SERVICE,
1759                     tableIndex,objv)) {
1760                 return TCL_ERROR;
1761             }
1762             break;
1763         case 153:
1764             if (SetoptLong(interp,curlHandle,CURLOPT_SOCKS5_GSSAPI_NEC,
1765                         tableIndex,objv)) {
1766                 return TCL_ERROR;
1767             }
1768             break;
1769         case 154:
1770         case 155:
1771             if (Tcl_ListObjGetElements(interp,objv,&j,&protocols)==TCL_ERROR) {
1772                 return 1;
1773             }
1774
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) {
1779                    return TCL_ERROR;
1780                 }
1781                 switch(curlTableIndex) {
1782                     case 0:             /* http     1 */
1783                         protocolMask|=CURLPROTO_HTTP;
1784                         break;
1785                     case 1:             /* https    2 */
1786                         protocolMask|=CURLPROTO_HTTPS;
1787                         break;
1788                     case 2:             /* ftp      4 */
1789                         protocolMask|=CURLPROTO_FTP;
1790                         break;
1791                     case 3:             /* ftps     8 */
1792                         protocolMask|=CURLPROTO_FTPS;
1793                         break;
1794                     case 4:             /* scp     16 */
1795                         protocolMask|=CURLPROTO_SCP;
1796                         break;
1797                     case 5:             /* sftp    32 */
1798                         protocolMask|=CURLPROTO_SFTP;
1799                         break;
1800                     case 6:             /* telnet  64 */
1801                         protocolMask|=CURLPROTO_TELNET;
1802                         break;
1803                     case 7:             /* ldap   128 */
1804                         protocolMask|=CURLPROTO_LDAP;
1805                         break;
1806                     case 8:             /* ldaps  256 */
1807                         protocolMask|=CURLPROTO_LDAPS;
1808                         break;
1809                     case 9:             /* dict   512 */
1810                         protocolMask|=CURLPROTO_DICT;
1811                         break;
1812                     case 10:            /* file  1024 */
1813                         protocolMask|=CURLPROTO_FILE;
1814                         break;
1815                     case 11:            /* tftp  2048 */
1816                         protocolMask|=CURLPROTO_TFTP;
1817                         break;
1818                     case 12:            /* all   FFFF */
1819                         protocolMask|=CURLPROTO_ALL;
1820                 }
1821             }
1822             tmpObjPtr=Tcl_NewLongObj(protocolMask);
1823             if (tableIndex==154) {
1824                 longNumber=CURLOPT_PROTOCOLS;
1825             } else {
1826                 longNumber=CURLOPT_REDIR_PROTOCOLS;
1827             }
1828             if (SetoptLong(interp,curlHandle,longNumber,tableIndex,tmpObjPtr)) {
1829                     return TCL_ERROR;
1830             }
1831             break;
1832         case 156:
1833             if (Tcl_GetIndexFromObj(interp, objv, ftpsslccc,
1834                 "Clear Command Channel option ",TCL_EXACT,&intNumber)==TCL_ERROR) {
1835                 return TCL_ERROR;
1836             }
1837             switch(intNumber) {
1838                 case 0:
1839                     longNumber=CURLFTPSSL_CCC_NONE;
1840                     break;
1841                 case 1:
1842                     longNumber=CURLFTPSSL_CCC_PASSIVE;
1843                     break;
1844                 case 2:
1845                     longNumber=CURLFTPSSL_CCC_ACTIVE;
1846                     break;
1847             }
1848             tmpObjPtr=Tcl_NewLongObj(longNumber);
1849             if (SetoptLong(interp,curlHandle,CURLOPT_FTP_SSL_CCC,
1850                         tableIndex,tmpObjPtr)) {
1851                 return TCL_ERROR;
1852             }
1853             break;
1854         case 157:
1855             if (SetoptChar(interp,curlHandle,CURLOPT_SSH_KNOWNHOSTS,
1856                     tableIndex,objv)) {
1857                 return TCL_ERROR;
1858             }
1859             break;
1860         case 158:
1861             if (curl_easy_setopt(curlHandle,CURLOPT_SSH_KEYFUNCTION,curlsshkeycallback)) {
1862                 return TCL_ERROR;
1863             }
1864             if (curl_easy_setopt(curlHandle,CURLOPT_SSH_KEYDATA,curlData)) {
1865                 return TCL_ERROR;
1866             }
1867             curlData->sshkeycallProc=curlstrdup(Tcl_GetString(objv));
1868             break;
1869     }
1870     return TCL_OK;
1871 }
1872
1873 /*
1874  *----------------------------------------------------------------------
1875  *
1876  * SetoptInt --
1877  *
1878  *   Sets the curl options that require an int
1879  *
1880  *  Parameter:
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.
1885  *
1886  * Results:
1887  *  0 if all went well.
1888  *  1 in case of error.
1889  *----------------------------------------------------------------------
1890  */
1891 int
1892 SetoptInt(Tcl_Interp *interp,CURL *curlHandle,CURLoption opt,
1893         int tableIndex,Tcl_Obj *tclObj) {
1894     int        intNumber;
1895     char       *parPtr;
1896
1897     if (Tcl_GetIntFromObj(interp,tclObj,&intNumber)) {
1898         parPtr=curlstrdup(Tcl_GetString(tclObj));
1899         curlErrorSetOpt(interp,configTable,tableIndex,parPtr);
1900         Tcl_Free(parPtr);
1901         return 1;
1902     }
1903     if (curl_easy_setopt(curlHandle,opt,intNumber)) {
1904         parPtr=curlstrdup(Tcl_GetString(tclObj));
1905         curlErrorSetOpt(interp,configTable,tableIndex,parPtr);
1906         Tcl_Free(parPtr);
1907         return 1;
1908     }
1909     return 0;
1910 }
1911
1912 /*
1913  *----------------------------------------------------------------------
1914  *
1915  * SetoptLong --
1916  *
1917  *  Set the curl options that require a long
1918  *
1919  * Parameter:
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.
1924  *
1925  * Results:
1926  *  0 if all went well.
1927  *  1 in case of error.
1928  *----------------------------------------------------------------------
1929  */
1930 int
1931 SetoptLong(Tcl_Interp *interp,CURL *curlHandle,CURLoption opt,
1932         int tableIndex,Tcl_Obj *tclObj) {
1933     long         longNumber;
1934     char        *parPtr;
1935
1936     if (Tcl_GetLongFromObj(interp,tclObj,&longNumber)) {
1937         parPtr=curlstrdup(Tcl_GetString(tclObj));
1938         curlErrorSetOpt(interp,configTable,tableIndex,parPtr);
1939         Tcl_Free(parPtr);
1940         return 1;
1941     }
1942     if (curl_easy_setopt(curlHandle,opt,longNumber)) {
1943         parPtr=curlstrdup(Tcl_GetString(tclObj));
1944         curlErrorSetOpt(interp,configTable,tableIndex,parPtr);
1945         Tcl_Free(parPtr);
1946         return 1;
1947     }
1948
1949     return 0;
1950 }
1951
1952 /*
1953  *----------------------------------------------------------------------
1954  *
1955  * curlSetoptCurlOffT --
1956  *
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)
1959  *
1960  * Parameter:
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.
1965  *
1966  * Results:
1967  *  0 if all went well.
1968  *  1 in case of error.
1969  *----------------------------------------------------------------------
1970  */
1971 int
1972 SetoptCurlOffT(Tcl_Interp *interp,CURL *curlHandle,CURLoption opt,
1973         int tableIndex,Tcl_Obj *tclObj) {
1974     long        longNumber;
1975     char        *parPtr;
1976
1977     if (Tcl_GetLongFromObj(interp,tclObj,&longNumber)) {
1978         parPtr=curlstrdup(Tcl_GetString(tclObj));
1979         curlErrorSetOpt(interp,configTable,tableIndex,parPtr);
1980         Tcl_Free(parPtr);
1981         return 1;
1982     }
1983
1984     if (curl_easy_setopt(curlHandle,opt,(curl_off_t)longNumber)) {
1985         parPtr=curlstrdup(Tcl_GetString(tclObj));
1986         curlErrorSetOpt(interp,configTable,tableIndex,parPtr);
1987         Tcl_Free(parPtr);
1988         return 1;
1989     }
1990
1991     return 0;
1992 }
1993
1994
1995 /*
1996  *----------------------------------------------------------------------
1997  *
1998  * SetoptChar --
1999  *
2000  *  Set the curl options that require a string
2001  *
2002  * Parameter:
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.
2007  *
2008  * Results:
2009  *  0 if all went well.
2010  *  1 in case of error.
2011  *----------------------------------------------------------------------
2012  */
2013 int
2014 SetoptChar(Tcl_Interp *interp,CURL *curlHandle,
2015         CURLoption opt,int tableIndex,Tcl_Obj *tclObj) {
2016     char    *optionPtr;
2017
2018     optionPtr=curlstrdup(Tcl_GetString(tclObj));
2019     if (curl_easy_setopt(curlHandle,opt,optionPtr)) {
2020         curlErrorSetOpt(interp,configTable,tableIndex,optionPtr);
2021         Tcl_Free(optionPtr);
2022         return 1;
2023     }
2024     Tcl_Free(optionPtr);
2025     return 0;
2026 }
2027
2028 /*
2029  *----------------------------------------------------------------------
2030  *
2031  * SetoptSHandle --
2032  *
2033  *  Set the curl options that require a share handle (there is only
2034  *  one but you never know.
2035  *
2036  * Parameter:
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.
2041  *
2042  * Results:
2043  *  0 if all went well.
2044  *  1 in case of error.
2045  *----------------------------------------------------------------------
2046  */
2047 int
2048 SetoptSHandle(Tcl_Interp *interp,CURL *curlHandle,
2049         CURLoption opt,int tableIndex,Tcl_Obj *tclObj) {
2050
2051     char                    *shandleName;
2052     Tcl_CmdInfo             *infoPtr=(Tcl_CmdInfo *)Tcl_Alloc(sizeof(Tcl_CmdInfo));
2053     struct shcurlObjData    *shandleDataPtr;
2054
2055     shandleName=Tcl_GetString(tclObj);
2056     if (0==Tcl_GetCommandInfo(interp,shandleName,infoPtr)) {
2057         return 1;
2058     }
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);
2063         return 1;
2064     }
2065     return 0;
2066 }
2067
2068 /*
2069  *----------------------------------------------------------------------
2070  *
2071  * SetoptsList --
2072  *
2073  *  Prepares a slist for future use.
2074  *
2075  * Parameter:
2076  *  slistPtr: Pointer to the slist to prepare.
2077  *  objv: Tcl object with a list of the data.
2078  *
2079  * Results:
2080  *  0 if all went well.
2081  *  1 in case of error.
2082  *----------------------------------------------------------------------
2083  */
2084 int
2085 SetoptsList(Tcl_Interp *interp,struct curl_slist **slistPtr,
2086         Tcl_Obj *CONST objv) {
2087     int         i,headerNumber;
2088     Tcl_Obj     **headers;
2089
2090     if (slistPtr!=NULL) {
2091         curl_slist_free_all(*slistPtr);
2092         *slistPtr=NULL;
2093     }
2094
2095     if (Tcl_ListObjGetElements(interp,objv,&headerNumber,&headers)
2096             ==TCL_ERROR) {
2097         return 1;
2098     }
2099
2100     for (i=0;i<headerNumber;i++) {
2101        *slistPtr=curl_slist_append(*slistPtr,Tcl_GetString(headers[i]));
2102         if (slistPtr==NULL) {
2103             return 1;
2104         }
2105     }
2106     return 0;
2107 }
2108
2109 /*
2110  *----------------------------------------------------------------------
2111  *
2112  * curlErrorSetOpt --
2113  *
2114  *  When an error happens when setting an option, this function
2115  *  takes cares of reporting it
2116  *
2117  * Parameter:
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  *----------------------------------------------------------------------
2122  */
2123
2124 void
2125 curlErrorSetOpt(Tcl_Interp *interp,CONST char **configTable, int option,
2126         CONST char *parPtr) {
2127     Tcl_Obj     *resultPtr;
2128     char        errorMsg[500];
2129
2130     snprintf(errorMsg,500,"setting option %s: %s",configTable[option],parPtr);
2131     resultPtr=Tcl_NewStringObj(errorMsg,-1);
2132     Tcl_SetObjResult(interp,resultPtr);
2133 }
2134
2135 /*
2136  *----------------------------------------------------------------------
2137  *
2138  * curlHeaderVar --
2139  *
2140  *  This is the function that will be invoked if the user wants to put
2141  *  the headers into a variable
2142  *
2143  * Parameter:
2144  *  header: string with the header line.
2145  *  size and nmemb: it so happens size * nmemb if the size of the
2146  *  header string.
2147  *  curlData: A pointer to the curlData structure for the transfer.
2148  *
2149  * Returns
2150  *  The number of bytes actually written or -1 in case of error, in
2151  *  which case 'libcurl' will abort the transfer.
2152  *-----------------------------------------------------------------------
2153  */
2154 size_t
2155 curlHeaderReader(void *ptr,size_t size,size_t nmemb,FILE *curlDataPtr) {
2156
2157     char                *header=ptr;
2158     struct curlObjData  *curlData=(struct curlObjData *)curlDataPtr;
2159     Tcl_RegExp           regExp;
2160
2161     CONST char          *startPtr;
2162     CONST char          *endPtr;
2163
2164     char                *headerName;
2165     char                *headerContent;
2166     char                *httpStatus;
2167
2168     int                  match,charLength;
2169
2170     regExp=Tcl_RegExpCompile(curlData->interp,"(.*?)(?::\\s*)(.*?)(\\r*)(\\n)");
2171     match=Tcl_RegExpExec(curlData->interp,regExp,header,header);
2172
2173     if (match) {
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;
2179
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);
2189         } else {
2190             Tcl_SetVar2(curlData->interp,curlData->headerVar,headerName,
2191                     headerContent,0);
2192         }
2193     }
2194     regExp=Tcl_RegExpCompile(curlData->interp,"(^(HTTP|http)[^\r]+)(\r*)(\n)");
2195     match=Tcl_RegExpExec(curlData->interp,regExp,header,header);
2196     if (match) {
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;
2202
2203         Tcl_SetVar2(curlData->interp,curlData->headerVar,"http",
2204                 httpStatus,0);
2205     }
2206     return size*nmemb;
2207 }
2208
2209 /*
2210  *----------------------------------------------------------------------
2211  *
2212  * curlBodyReader --
2213  *
2214  *  This is the function that will be invoked as a callback while
2215  *  transferring the body of a request into a Tcl variable.
2216  *
2217  *  This function has been adapted from an example in libcurl's FAQ.
2218  *
2219  * Parameter:
2220  *  header: string with the header line.
2221  *  size and nmemb: it so happens size * nmemb if the size of the
2222  *  header string.
2223  *  curlData: A pointer to the curlData structure for the transfer.
2224  *
2225  * Returns
2226  *  The number of bytes actually written or -1 in case of error, in
2227  *  which case 'libcurl' will abort the transfer.
2228  *-----------------------------------------------------------------------
2229  */
2230 size_t
2231 curlBodyReader(void *ptr,size_t size,size_t nmemb,FILE *curlDataPtr) {
2232
2233     register int realsize = size * nmemb;
2234     struct MemoryStruct *mem=&(((struct curlObjData *)curlDataPtr)->bodyVar);
2235
2236     mem->memory = (char *)Tcl_Realloc(mem->memory,mem->size + realsize);
2237     if (mem->memory) {
2238         memcpy(&(mem->memory[mem->size]), ptr, realsize);
2239         mem->size += realsize;
2240     }
2241     return realsize;
2242 }
2243
2244 /*
2245  *----------------------------------------------------------------------
2246  *
2247  * curlProgressCallback --
2248  *
2249  *  This is the function that will be invoked as a callback during a
2250  *  transfer.
2251  *
2252  *  This function has been adapted from an example in libcurl's FAQ.
2253  *
2254  * Parameter:
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.
2260  *
2261  * Returns
2262  *  Returning a non-zero value will make 'libcurl' abort the transfer
2263  *  and return 'CURLE_ABORTED_BY_CALLBACK'.
2264  *-----------------------------------------------------------------------
2265  */
2266 int
2267 curlProgressCallback(void *clientData,double dltotal,double dlnow,
2268         double ultotal,double ulnow) {
2269
2270     struct curlObjData    *curlData=(struct curlObjData *)clientData;
2271     Tcl_Obj               *tclProcPtr;
2272     char                   tclCommand[300];
2273
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;
2280             return -1;
2281         }
2282     }
2283     if (Tcl_EvalObjEx(curlData->interp,tclProcPtr,TCL_EVAL_GLOBAL)!=TCL_OK) {
2284         return -1;
2285     }
2286     return 0;
2287 }
2288
2289 /*
2290  *----------------------------------------------------------------------
2291  *
2292  * curlWriteProcInvoke --
2293  *
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.
2296  *
2297  *  This function has been adapted from an example in libcurl's FAQ.
2298  *
2299  * Parameter:
2300  *  ptr: A pointer to the data.
2301  *  size and nmemb: it so happens size * nmemb if the size of the
2302  *  data read.
2303  *  curlData: A pointer to the curlData structure for the transfer.
2304  *
2305  * Returns
2306  *  The number of bytes actually written or -1 in case of error, in
2307  *  which case 'libcurl' will abort the transfer.
2308  *-----------------------------------------------------------------------
2309  */
2310 size_t
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;
2314     Tcl_Obj             *objv[2];
2315
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;
2321             return -1;
2322         }
2323     }
2324     if (Tcl_EvalObjv(curlData->interp,2,objv,TCL_EVAL_GLOBAL)!=TCL_OK) {
2325         return -1;
2326     }
2327
2328     return realsize;
2329 }
2330
2331 /*
2332  *----------------------------------------------------------------------
2333  *
2334  * curlReadProcInvoke --
2335  *
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.
2338  *
2339  * Parameter:
2340  *  header: string with the header line.
2341  *  size and nmemb: it so happens size * nmemb if the size of the
2342  *  header string.
2343  *  curlData: A pointer to the curlData structure for the transfer.
2344  *
2345  * Returns
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  *-----------------------------------------------------------------------
2349  */
2350 size_t
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;
2358     int                  sizeRead;
2359
2360     snprintf(tclCommand,300,"%s %d",curlData->readProc,realsize);
2361     tclProcPtr=Tcl_NewStringObj(tclCommand,-1);
2362
2363     if (curlData->cancelTransVarName) {
2364         if (curlData->cancelTrans) {
2365             curlData->cancelTrans=0;
2366             return CURL_READFUNC_ABORT;
2367         }
2368     }
2369     if (Tcl_EvalObjEx(curlData->interp,tclProcPtr,TCL_EVAL_GLOBAL)!=TCL_OK) {
2370         return CURL_READFUNC_ABORT;
2371     }
2372     readDataPtr=Tcl_GetObjResult(curlData->interp);
2373     readBytes=Tcl_GetByteArrayFromObj(readDataPtr,&sizeRead);
2374     memcpy(ptr,readBytes,sizeRead);
2375
2376     return sizeRead;
2377 }
2378
2379 /*
2380  *----------------------------------------------------------------------
2381  *
2382  * curlshkeyextract --
2383  *
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
2386  *  the key itself.
2387  *
2388  * Parameter:
2389  *  interp: The interp need to deal with the objects.
2390  *  key: a curl_khkey struct with the key.
2391  *
2392  * Returns
2393  *  The object with the list.
2394  *-----------------------------------------------------------------------
2395  */
2396 Tcl_Obj *
2397 curlsshkeyextract(Tcl_Interp *interp,const struct curl_khkey *key) {
2398
2399     Tcl_Obj         *keyObjPtr;
2400
2401     keyObjPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
2402
2403     switch(key->keytype) {
2404         case CURLKHTYPE_RSA1:
2405             Tcl_ListObjAppendElement(interp,keyObjPtr,Tcl_NewStringObj("rsa1",-1));
2406             break;
2407         case CURLKHTYPE_RSA:
2408             Tcl_ListObjAppendElement(interp,keyObjPtr,Tcl_NewStringObj("rsa",-1));
2409             break;
2410         case CURLKHTYPE_DSS:
2411             Tcl_ListObjAppendElement(interp,keyObjPtr,Tcl_NewStringObj("dss",-1));
2412             break;
2413         default:
2414             Tcl_ListObjAppendElement(interp,keyObjPtr,Tcl_NewStringObj("unknnown",-1));
2415             break;
2416     }
2417     Tcl_ListObjAppendElement(interp,keyObjPtr,Tcl_NewStringObj(key->key,-1));
2418
2419     return keyObjPtr;
2420 }
2421
2422 /*
2423  *----------------------------------------------------------------------
2424  *
2425  * curlshkeycallback --
2426  *
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
2429  *
2430  * Parameter:
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.
2437  *
2438  * Returns
2439  *  A libcurl return code so that libcurl knows what to do.
2440  *-----------------------------------------------------------------------
2441  */
2442 size_t
2443 curlsshkeycallback(CURL *curl ,const struct curl_khkey *knownkey,
2444         const struct curl_khkey *foundkey, enum curl_khmatch match,void *curlDataPtr) {
2445
2446     struct curlObjData  *tclcurlDataPtr=(struct curlObjData *)curlDataPtr;
2447     Tcl_Interp          *interp;
2448
2449     Tcl_Obj             *objv[4];
2450     Tcl_Obj             *returnObjPtr;
2451
2452     int                  action;
2453
2454     interp=tclcurlDataPtr->interp;
2455
2456     objv[0]=Tcl_NewStringObj(tclcurlDataPtr->sshkeycallProc,-1);
2457     objv[1]=curlsshkeyextract(interp,knownkey);
2458     objv[2]=curlsshkeyextract(interp,foundkey);
2459
2460     switch(match) {
2461         case CURLKHMATCH_OK:
2462             objv[3]=Tcl_NewStringObj("match",-1);
2463             break;
2464         case CURLKHMATCH_MISMATCH:
2465             objv[3]=Tcl_NewStringObj("mismatch",-1);
2466             break;
2467         case CURLKHMATCH_MISSING:
2468             objv[3]=Tcl_NewStringObj("missing",-1);
2469             break;
2470         case CURLKHMATCH_LAST:
2471             objv[3]=Tcl_NewStringObj("error",-1);
2472     }
2473
2474     if (Tcl_EvalObjv(interp,4,objv,TCL_EVAL_GLOBAL)!=TCL_OK)      {return CURLKHSTAT_REJECT;}
2475
2476     returnObjPtr=Tcl_GetObjResult(interp);
2477
2478     if (Tcl_GetIntFromObj(interp,returnObjPtr,&action)!=TCL_OK)   {return CURLKHSTAT_REJECT;}
2479
2480     switch(action) {
2481         case 0:
2482             return CURLKHSTAT_FINE_ADD_TO_FILE;
2483         case 1:
2484             return CURLKHSTAT_FINE;
2485         case 2:
2486             return CURLKHSTAT_REJECT;
2487         case 3:
2488             return CURLKHSTAT_DEFER;
2489     }
2490     return CURLKHSTAT_REJECT;
2491 }
2492
2493 /*
2494  *----------------------------------------------------------------------
2495  *
2496  * curlDebugProcInvoke --
2497  *
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.
2501  *
2502  *  Parameter:
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.
2507  *
2508  *  Returns
2509  *   The number of bytes actually written or -1 in case of error, in
2510  *   which case 'libcurl' will abort the transfer.
2511  *-----------------------------------------------------------------------
2512  */
2513 int
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;
2518     Tcl_Obj             *objv[3];
2519     char                tclCommand[300];
2520
2521     snprintf(tclCommand,300,"%s %d %d",curlData->debugProc,infoType,size);
2522     tclProcPtr=Tcl_NewStringObj(tclCommand,-1);
2523
2524     objv[0]=Tcl_NewStringObj(curlData->debugProc,-1);
2525     objv[1]=Tcl_NewIntObj(infoType);
2526     objv[2]=Tcl_NewByteArrayObj(dataPtr,size);
2527
2528     if (curlData->cancelTransVarName) {
2529         if (curlData->cancelTrans) {
2530             curlData->cancelTrans=0;
2531             return -1;
2532         }
2533     }
2534
2535     Tcl_EvalObjv(curlData->interp,3,objv,TCL_EVAL_GLOBAL);
2536
2537     return 0;
2538 }
2539
2540 /*
2541  *----------------------------------------------------------------------
2542  *
2543  * curlGetInfo --
2544  *
2545  *  Invokes the 'curl_easy_getinfo' function in libcurl.
2546  *
2547  * Parameter:
2548  *
2549  * Results:
2550  *   0 if all went well.
2551  *   The CURLcode for the error.
2552  *----------------------------------------------------------------------
2553  */
2554 CURLcode
2555 curlGetInfo(Tcl_Interp *interp,CURL *curlHandle,int tableIndex) {
2556     char                    *charPtr;
2557     long                     longNumber;
2558     double                   doubleNumber;
2559     struct curl_slist       *slistPtr;
2560     struct curl_certinfo    *certinfoPtr=NULL;
2561     int                      i;
2562
2563     CURLcode    exitCode;
2564
2565     Tcl_Obj    *resultObjPtr;
2566
2567     switch(tableIndex) {
2568         case 0:
2569             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_EFFECTIVE_URL,&charPtr);
2570             if (exitCode) {
2571                 return exitCode;
2572             }
2573             resultObjPtr=Tcl_NewStringObj(charPtr,-1);
2574             Tcl_SetObjResult(interp,resultObjPtr);
2575             break;
2576         case 1:
2577         case 2:
2578             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_RESPONSE_CODE,&longNumber);
2579             if (exitCode) {
2580                 return exitCode;
2581             }
2582             resultObjPtr=Tcl_NewLongObj(longNumber);
2583             Tcl_SetObjResult(interp,resultObjPtr);
2584             break;
2585         case 3:
2586             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_FILETIME,&longNumber);
2587             if (exitCode) {
2588                 return exitCode;
2589             }
2590             resultObjPtr=Tcl_NewLongObj(longNumber);
2591             Tcl_SetObjResult(interp,resultObjPtr);
2592             break;
2593         case 4:
2594             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_TOTAL_TIME,&doubleNumber);
2595             if (exitCode) {
2596                 return exitCode;
2597             }
2598             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2599             Tcl_SetObjResult(interp,resultObjPtr);
2600             break;
2601         case 5:
2602             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_NAMELOOKUP_TIME,
2603                     &doubleNumber);
2604             if (exitCode) {
2605                 return exitCode;
2606             }
2607             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2608             Tcl_SetObjResult(interp,resultObjPtr);
2609             break;
2610         case 6:
2611             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_CONNECT_TIME,
2612                     &doubleNumber);
2613             if (exitCode) {
2614                 return exitCode;
2615             }
2616             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2617             Tcl_SetObjResult(interp,resultObjPtr);
2618             break;
2619         case 7:
2620             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_PRETRANSFER_TIME,
2621                     &doubleNumber);
2622             if (exitCode) {
2623                 return exitCode;
2624             }
2625             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2626             Tcl_SetObjResult(interp,resultObjPtr);
2627             break;
2628         case 8:
2629             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_SIZE_UPLOAD,
2630                     &doubleNumber);
2631             if (exitCode) {
2632                 return exitCode;
2633             }
2634             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2635             Tcl_SetObjResult(interp,resultObjPtr);
2636             break;
2637         case 9:
2638             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_SIZE_DOWNLOAD,
2639                     &doubleNumber);
2640             if (exitCode) {
2641                 return exitCode;
2642             }
2643             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2644             Tcl_SetObjResult(interp,resultObjPtr);
2645             break;
2646         case 10:
2647             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_SPEED_DOWNLOAD,
2648                     &doubleNumber);
2649             if (exitCode) {
2650                 return exitCode;
2651             }
2652             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2653             Tcl_SetObjResult(interp,resultObjPtr);
2654             break;
2655         case 11:
2656             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_SPEED_UPLOAD,
2657                     &doubleNumber);
2658             if (exitCode) {
2659                 return exitCode;
2660             }
2661             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2662             Tcl_SetObjResult(interp,resultObjPtr);
2663             break;
2664         case 12:
2665             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_HEADER_SIZE,
2666                     &longNumber);
2667             if (exitCode) {
2668                 return exitCode;
2669             }
2670             resultObjPtr=Tcl_NewLongObj(longNumber);
2671             Tcl_SetObjResult(interp,resultObjPtr);
2672             break;
2673         case 13:
2674             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_REQUEST_SIZE,
2675                     &longNumber);
2676             if (exitCode) {
2677                 return exitCode;
2678             }
2679             resultObjPtr=Tcl_NewLongObj(longNumber);
2680             Tcl_SetObjResult(interp,resultObjPtr);
2681             break;
2682         case 14:
2683             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_SSL_VERIFYRESULT,
2684                     &longNumber);
2685             if (exitCode) {
2686                 return exitCode;
2687             }
2688             resultObjPtr=Tcl_NewLongObj(longNumber);
2689             Tcl_SetObjResult(interp,resultObjPtr);
2690             break;
2691         case 15:
2692             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_CONTENT_LENGTH_DOWNLOAD,
2693                     &doubleNumber);
2694             if (exitCode) {
2695                 return exitCode;
2696             }
2697             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2698             Tcl_SetObjResult(interp,resultObjPtr);
2699             break;
2700         case 16:
2701             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_CONTENT_LENGTH_UPLOAD,
2702                     &doubleNumber);
2703             if (exitCode) {
2704                 return exitCode;
2705             }
2706             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2707             Tcl_SetObjResult(interp,resultObjPtr);
2708             break;
2709         case 17:
2710             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_STARTTRANSFER_TIME,&doubleNumber);
2711             if (exitCode) {
2712                 return exitCode;
2713             }
2714             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2715             Tcl_SetObjResult(interp,resultObjPtr);
2716             break;
2717         case 18:
2718             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_CONTENT_TYPE,&charPtr);
2719             if (exitCode) {
2720                 return exitCode;
2721             }
2722             resultObjPtr=Tcl_NewStringObj(charPtr,-1);
2723             Tcl_SetObjResult(interp,resultObjPtr);
2724             break;
2725         case 19:
2726             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_REDIRECT_TIME,&doubleNumber);
2727             if (exitCode) {
2728                 return exitCode;
2729             }
2730             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2731             Tcl_SetObjResult(interp,resultObjPtr);
2732             break;
2733         case 20:
2734             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_REDIRECT_COUNT,&longNumber);
2735             if (exitCode) {
2736                 return exitCode;
2737             }
2738             resultObjPtr=Tcl_NewLongObj(longNumber);
2739             Tcl_SetObjResult(interp,resultObjPtr);
2740             break;
2741         case 21:
2742         case 22:
2743             if (tableIndex==21) {
2744                 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_HTTPAUTH_AVAIL,&longNumber);
2745             } else {
2746                 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_PROXYAUTH_AVAIL,&longNumber);
2747             }
2748             if (exitCode) {
2749                 return exitCode;
2750             }
2751             resultObjPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
2752             if (longNumber&CURLAUTH_BASIC) {
2753                 Tcl_ListObjAppendElement(interp,resultObjPtr
2754                         ,Tcl_NewStringObj("basic",-1));
2755             }
2756             if (longNumber&CURLAUTH_DIGEST) {
2757                 Tcl_ListObjAppendElement(interp,resultObjPtr
2758                         ,Tcl_NewStringObj("digest",-1));
2759             }
2760             if (longNumber&CURLAUTH_GSSNEGOTIATE) {
2761                 Tcl_ListObjAppendElement(interp,resultObjPtr
2762                         ,Tcl_NewStringObj("gssnegotiate",-1));
2763             }
2764             if (longNumber&CURLAUTH_NTLM) {
2765                 Tcl_ListObjAppendElement(interp,resultObjPtr
2766                         ,Tcl_NewStringObj("NTLM",-1));
2767             }
2768             Tcl_SetObjResult(interp,resultObjPtr);
2769             break;
2770         case 23:
2771             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_OS_ERRNO,&longNumber);
2772             if (exitCode) {
2773                 return exitCode;
2774             }
2775             resultObjPtr=Tcl_NewLongObj(longNumber);
2776             Tcl_SetObjResult(interp,resultObjPtr);
2777             break;
2778         case 24:
2779             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_NUM_CONNECTS,&longNumber);
2780             if (exitCode) {
2781                 return exitCode;
2782             }
2783             resultObjPtr=Tcl_NewLongObj(longNumber);
2784             Tcl_SetObjResult(interp,resultObjPtr);
2785             break;
2786         case 25:
2787             exitCode=curl_easy_getinfo                                  \
2788                     (curlHandle,CURLINFO_SSL_ENGINES,&slistPtr);
2789             if (exitCode) {
2790                 return exitCode;
2791             }
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;
2797             }
2798             curl_slist_free_all(slistPtr);
2799             Tcl_SetObjResult(interp,resultObjPtr);
2800             break;
2801         case 26:
2802             exitCode=curl_easy_getinfo                                  \
2803                     (curlHandle,CURLINFO_HTTP_CONNECTCODE,&longNumber);
2804             if (exitCode) {
2805                 return exitCode;
2806             }
2807             resultObjPtr=Tcl_NewLongObj(longNumber);
2808             Tcl_SetObjResult(interp,resultObjPtr);
2809             break;
2810         case 27:
2811             exitCode=curl_easy_getinfo                                  \
2812                     (curlHandle,CURLINFO_COOKIELIST,&slistPtr);
2813             if (exitCode) {
2814                 return exitCode;
2815             }
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;
2821             }
2822             curl_slist_free_all(slistPtr);
2823             Tcl_SetObjResult(interp,resultObjPtr);
2824             break;
2825         case 28:
2826             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_FTP_ENTRY_PATH,&charPtr);
2827             if (exitCode) {
2828                 return exitCode;
2829             }
2830             resultObjPtr=Tcl_NewStringObj(charPtr,-1);
2831             Tcl_SetObjResult(interp,resultObjPtr);
2832             break;
2833         case 29:
2834             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_REDIRECT_URL,&charPtr);
2835             if (exitCode) {
2836                 return exitCode;
2837             }
2838             resultObjPtr=Tcl_NewStringObj(charPtr,-1);
2839             Tcl_SetObjResult(interp,resultObjPtr);
2840             break;
2841         case 30:
2842             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_PRIMARY_IP,&charPtr);
2843             if (exitCode) {
2844                 return exitCode;
2845             }
2846             resultObjPtr=Tcl_NewStringObj(charPtr,-1);
2847             Tcl_SetObjResult(interp,resultObjPtr);
2848             break;
2849         case 31:
2850             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_APPCONNECT_TIME,&doubleNumber);
2851             if (exitCode) {
2852                 return exitCode;
2853             }
2854             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
2855             Tcl_SetObjResult(interp,resultObjPtr);
2856             break;
2857         case 32:
2858             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_CERTINFO,&certinfoPtr);
2859             if (exitCode) {
2860                 return exitCode;
2861             }
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));
2866             Tcl_Free(charPtr);
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));
2870                 }
2871             }
2872             Tcl_SetObjResult(interp,resultObjPtr);
2873             break;
2874         case 33:
2875             exitCode=curl_easy_getinfo                                  \
2876                     (curlHandle,CURLINFO_CONDITION_UNMET,&longNumber);
2877             if (exitCode) {
2878                 return exitCode;
2879             }
2880             resultObjPtr=Tcl_NewLongObj(longNumber);
2881             Tcl_SetObjResult(interp,resultObjPtr);
2882             break;
2883     }
2884     return 0;
2885 }
2886
2887 /*
2888  *----------------------------------------------------------------------
2889  *
2890  * curlFreeSpace --
2891  *
2892  *    Frees the space taken by a curlObjData struct either because we are
2893  *    deleting the handle or reseting it.
2894  *
2895  *  Parameter:
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.
2899  *
2900  * Results:
2901  *    A standard Tcl result.
2902  *----------------------------------------------------------------------
2903  */
2904 void
2905 curlFreeSpace(struct curlObjData *curlData) {
2906
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);
2911
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);
2924     }
2925     Tcl_Free(curlData->progressProc);
2926     if (curlData->cancelTransVarName) {
2927         Tcl_UnlinkVar(curlData->interp,curlData->cancelTransVarName);
2928         Tcl_Free(curlData->cancelTransVarName);
2929     }
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);
2936 }
2937
2938 /*
2939  *----------------------------------------------------------------------
2940  *
2941  * curlDupHandle --
2942  *
2943  *  This function is invoked by the 'duphandle' command, it will
2944  *  create a duplicate of the given handle.
2945  *
2946  * Parameters:
2947  *  The stantard parameters for Tcl commands
2948  *
2949  * Results:
2950  *  A standard Tcl result.
2951  *
2952  * Side effects:
2953  *  See the user documentation.
2954  *
2955  *----------------------------------------------------------------------
2956  */
2957 int
2958 curlDupHandle(Tcl_Interp *interp, struct curlObjData *curlData,
2959         int objc, Tcl_Obj *CONST objv[]) {
2960
2961     CURL                *newCurlHandle;
2962     Tcl_Obj             *result;
2963     struct curlObjData  *newCurlData;
2964     char                *handleName;
2965
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);
2970         return TCL_ERROR;
2971     }
2972
2973     newCurlData=(struct curlObjData *)Tcl_Alloc(sizeof(struct curlObjData));
2974
2975     curlCopyCurlData(curlData,newCurlData);
2976
2977     handleName=curlCreateObjCmd(interp,newCurlData);
2978
2979     newCurlData->curl=newCurlHandle;
2980
2981     result=Tcl_NewStringObj(handleName,-1);
2982     Tcl_SetObjResult(interp,result);
2983     Tcl_Free(handleName);
2984
2985     return TCL_OK;
2986 }
2987
2988
2989 /*
2990  *----------------------------------------------------------------------
2991  *
2992  * curlResetHandle --
2993  *
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.
2996  *
2997  * Parameters:
2998  *  The stantard parameters for Tcl commands
2999  *
3000  * Results:
3001  *  A standard Tcl result.
3002  *
3003  * Side effects:
3004  *      See the user documentation.
3005  *
3006  *----------------------------------------------------------------------
3007  */
3008 int
3009 curlResetHandle(Tcl_Interp *interp, struct curlObjData *curlData)  {
3010     struct curlObjData   *tmpPtr=
3011                     (struct curlObjData *)Tcl_Alloc(sizeof(struct curlObjData));
3012
3013     tmpPtr->curl       = curlData->curl;
3014     tmpPtr->token      = curlData->token;
3015     tmpPtr->shareToken = curlData->shareToken;
3016     tmpPtr->interp     = curlData->interp;
3017
3018     curlFreeSpace(curlData);
3019     memset(curlData, 0, sizeof(struct curlObjData));
3020
3021     curlData->curl       = tmpPtr->curl;
3022     curlData->token      = tmpPtr->token;
3023     curlData->shareToken = tmpPtr->shareToken;
3024     curlData->interp     = tmpPtr->interp;
3025
3026     curl_easy_reset(curlData->curl);
3027
3028     Tcl_Free((char *)tmpPtr);
3029
3030     return TCL_OK;
3031
3032 }
3033
3034 /*
3035  *----------------------------------------------------------------------
3036  *
3037  * curlVersion --
3038  *
3039  *      This procedure is invoked to process the "curl::init" Tcl command.
3040  *      See the user documentation for details on what it does.
3041  *
3042  * Parameters:
3043  *  The stantard parameters for Tcl commands
3044  *
3045  * Results:
3046  *      A standard Tcl result.
3047  *
3048  * Side effects:
3049  *      See the user documentation.
3050  *
3051  *----------------------------------------------------------------------
3052  */
3053 int
3054 curlVersion (ClientData clientData, Tcl_Interp *interp,
3055     int objc,Tcl_Obj *CONST objv[]) {
3056
3057     Tcl_Obj     *versionPtr;
3058     char        tclversion[200];
3059
3060     sprintf(tclversion,"TclCurl Version %s (%s)",TclCurlVersion,
3061                                                  curl_version());
3062     versionPtr=Tcl_NewStringObj(tclversion,-1);
3063     Tcl_SetObjResult(interp,versionPtr);
3064
3065     return TCL_OK;
3066 }
3067
3068 /*
3069  *----------------------------------------------------------------------
3070  *
3071  * curlEscape --
3072  *
3073  *  This function is invoked to process the "curl::escape" Tcl command.
3074  *  See the user documentation for details on what it does.
3075  *
3076  *
3077  * Parameters:
3078  *  The stantard parameters for Tcl commands
3079  *
3080  * Results:
3081  *  A standard Tcl result.
3082  *
3083  * Side effects:
3084  *  See the user documentation.
3085  *
3086  *----------------------------------------------------------------------
3087  */
3088 int
3089 curlEscape(ClientData clientData, Tcl_Interp *interp,
3090     int objc,Tcl_Obj *CONST objv[]) {
3091
3092     Tcl_Obj        *resultObj;
3093     char           *escapedStr;
3094
3095     escapedStr=curl_easy_escape(NULL,Tcl_GetString(objv[1]),0);
3096
3097     if(!escapedStr) {
3098         resultObj=Tcl_NewStringObj("curl::escape bad parameter",-1);
3099         Tcl_SetObjResult(interp,resultObj);
3100         return TCL_ERROR;
3101     }
3102     resultObj=Tcl_NewStringObj(escapedStr,-1);
3103     Tcl_SetObjResult(interp,resultObj);
3104     curl_free(escapedStr);
3105
3106     return TCL_OK;
3107 }
3108
3109 /*
3110  *----------------------------------------------------------------------
3111  *
3112  * curlUnescape --
3113  *
3114  *  This function is invoked to process the "curl::Unescape" Tcl command.
3115  *  See the user documentation for details on what it does.
3116  *
3117  *
3118  * Parameters:
3119  *  The stantard parameters for Tcl commands
3120  *
3121  * Results:
3122  *  A standard Tcl result.
3123  *
3124  * Side effects:
3125  *  See the user documentation.
3126  *
3127  *----------------------------------------------------------------------
3128  */
3129 int
3130 curlUnescape(ClientData clientData, Tcl_Interp *interp,
3131     int objc,Tcl_Obj *CONST objv[]) {
3132
3133     Tcl_Obj        *resultObj;
3134     char           *unescapedStr;
3135
3136     unescapedStr=curl_easy_unescape(NULL,Tcl_GetString(objv[1]),0,NULL);
3137     if(!unescapedStr) {
3138         resultObj=Tcl_NewStringObj("curl::unescape bad parameter",-1);
3139         Tcl_SetObjResult(interp,resultObj);
3140         return TCL_ERROR;
3141     }
3142     resultObj=Tcl_NewStringObj(unescapedStr,-1);
3143     Tcl_SetObjResult(interp,resultObj);
3144     curl_free(unescapedStr);
3145
3146     return TCL_OK;
3147 }
3148
3149 /*
3150  *----------------------------------------------------------------------
3151  *
3152  * curlVersionInfo --
3153  *
3154  *  This function invokes 'curl_version_info' to query how 'libcurl' was
3155  *  compiled.
3156  *
3157  * Parameters:
3158  *  The standard parameters for Tcl commands, but nothing is used.
3159  *
3160  * Results:
3161  *  A standard Tcl result.
3162  *
3163  * Side effects:
3164  *  See the user documentation.
3165  *
3166  *----------------------------------------------------------------------
3167  */
3168 int
3169 curlVersionInfo (ClientData clientData, Tcl_Interp *interp,
3170     int objc,Tcl_Obj *CONST objv[]) {
3171
3172     int                            tableIndex;
3173     int                            i;
3174     curl_version_info_data        *infoPtr;
3175     Tcl_Obj                       *resultObjPtr=NULL;
3176     char                           tmp[7];
3177
3178     if (objc!=2) {
3179         resultObjPtr=Tcl_NewStringObj("usage: curl::versioninfo -option",-1);
3180         Tcl_SetObjResult(interp,resultObjPtr);
3181         return TCL_ERROR;
3182     }
3183
3184     if (Tcl_GetIndexFromObj(interp, objv[1], versionInfoTable, "option",
3185             TCL_EXACT,&tableIndex)==TCL_ERROR) {
3186         return TCL_ERROR;
3187     }
3188
3189     infoPtr=curl_version_info(CURLVERSION_NOW);
3190
3191     switch(tableIndex) {
3192         case 0:
3193             resultObjPtr=Tcl_NewStringObj(infoPtr->version,-1);
3194             break;
3195         case 1:
3196             sprintf(tmp,"%X",infoPtr->version_num);
3197             resultObjPtr=Tcl_NewStringObj(tmp,-1);
3198             break;
3199         case 2:
3200             resultObjPtr=Tcl_NewStringObj(infoPtr->host,-1);
3201             break;
3202         case 3:
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));
3207             }
3208             if (infoPtr->features&CURL_VERSION_KERBEROS4) {
3209                 Tcl_ListObjAppendElement(interp,resultObjPtr
3210                         ,Tcl_NewStringObj("KERBEROS4",-1));
3211             }
3212             if (infoPtr->features&CURL_VERSION_SSL) {
3213                 Tcl_ListObjAppendElement(interp,resultObjPtr
3214                         ,Tcl_NewStringObj("SSL",-1));
3215             }
3216             if (infoPtr->features&CURL_VERSION_LIBZ) {
3217                 Tcl_ListObjAppendElement(interp,resultObjPtr
3218                         ,Tcl_NewStringObj("LIBZ",-1));
3219             }
3220             if (infoPtr->features&CURL_VERSION_NTLM) {
3221                 Tcl_ListObjAppendElement(interp,resultObjPtr
3222                         ,Tcl_NewStringObj("NTLM",-1));
3223             }
3224             if (infoPtr->features&CURL_VERSION_GSSNEGOTIATE) {
3225                 Tcl_ListObjAppendElement(interp,resultObjPtr
3226                         ,Tcl_NewStringObj("GSSNEGOTIATE",-1));
3227             }
3228             if (infoPtr->features&CURL_VERSION_DEBUG) {
3229                 Tcl_ListObjAppendElement(interp,resultObjPtr
3230                         ,Tcl_NewStringObj("DEBUG",-1));
3231             }
3232             if (infoPtr->features&CURL_VERSION_ASYNCHDNS) {
3233                 Tcl_ListObjAppendElement(interp,resultObjPtr
3234                         ,Tcl_NewStringObj("ASYNCHDNS",-1));
3235             }
3236             if (infoPtr->features&CURL_VERSION_SPNEGO) {
3237                 Tcl_ListObjAppendElement(interp,resultObjPtr
3238                         ,Tcl_NewStringObj("SPNEGO",-1));
3239             }
3240             if (infoPtr->features&CURL_VERSION_LARGEFILE) {
3241                 Tcl_ListObjAppendElement(interp,resultObjPtr
3242                         ,Tcl_NewStringObj("LARGEFILE",-1));
3243             }
3244             if (infoPtr->features&CURL_VERSION_IDN) {
3245                 Tcl_ListObjAppendElement(interp,resultObjPtr
3246                         ,Tcl_NewStringObj("IDN",-1));
3247             }
3248             if (infoPtr->features&CURL_VERSION_SSPI) {
3249                 Tcl_ListObjAppendElement(interp,resultObjPtr
3250                         ,Tcl_NewStringObj("SSPI",-1));
3251             }
3252             break;
3253             if (infoPtr->features&CURL_VERSION_CONV) {
3254                 Tcl_ListObjAppendElement(interp,resultObjPtr
3255                         ,Tcl_NewStringObj("CONV",-1));
3256             }
3257         case 4:
3258             resultObjPtr=Tcl_NewStringObj(infoPtr->ssl_version,-1);
3259             break;
3260         case 5:
3261             resultObjPtr=Tcl_NewLongObj(infoPtr->ssl_version_num);
3262             break;
3263         case 6:
3264             resultObjPtr=Tcl_NewStringObj(infoPtr->libz_version,-1);
3265             break;
3266         case 7:
3267             resultObjPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
3268             for(i=0;;i++) {
3269                 if (infoPtr->protocols[i]!=NULL) {
3270                     Tcl_ListObjAppendElement(interp,resultObjPtr
3271                             ,Tcl_NewStringObj(infoPtr->protocols[i],-1));
3272                 } else {
3273                     break;
3274                 }
3275             }
3276     }
3277
3278     Tcl_SetObjResult(interp,resultObjPtr);
3279
3280     return TCL_OK;
3281 }
3282
3283 /*
3284  *----------------------------------------------------------------------
3285  *
3286  * curlCopyCurlData --
3287  *
3288  *  This function copies the contents of a curlData struct into another.
3289  *
3290  * Parameters:
3291  *  curlDataOld: The original one.
3292  *  curlDataNew: The new one
3293  *
3294  * Results:
3295  *  A standard Tcl result.
3296  *
3297  * Side effects:
3298  *  See the user documentation.
3299  *
3300  *----------------------------------------------------------------------
3301  */
3302 int
3303 curlCopyCurlData (struct curlObjData *curlDataOld,
3304                       struct curlObjData *curlDataNew) {
3305
3306     /* This takes care of the int and long values */
3307     memcpy(curlDataNew, curlDataOld, sizeof(struct curlObjData));
3308
3309     /* Some of the data doesn't get copied */
3310
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;
3328
3329     /* The strings need a special treatment. */
3330
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);
3349
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;
3354
3355     return TCL_OK;
3356 }
3357
3358 /*----------------------------------------------------------------------
3359  *
3360  * curlOpenFiles --
3361  *
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.
3365  *
3366  * Parameter:
3367  *  curlData: The pointer to the struct with the transfer data.
3368  *
3369  * Results:
3370  *  '0' all went well, '1' in case of error.
3371  *----------------------------------------------------------------------
3372  */
3373 int
3374 curlOpenFiles(Tcl_Interp *interp,struct curlObjData *curlData) {
3375
3376     if (curlData->outFlag) {
3377         if (curlOpenFile(interp,curlData->outFile,&(curlData->outHandle),1,
3378                 curlData->transferText)) {
3379             return 1;
3380         }
3381         curl_easy_setopt(curlData->curl,CURLOPT_WRITEDATA,curlData->outHandle);
3382     }
3383     if (curlData->inFlag) {
3384         if (curlOpenFile(interp,curlData->inFile,&(curlData->inHandle),0,
3385                 curlData->transferText)) {
3386             return 1;
3387         }
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);
3392         }
3393     }
3394     if (curlData->headerFlag) {
3395         if (curlOpenFile(interp,curlData->headerFile,&(curlData->headerHandle),1,1)) {
3396             return 1;
3397         }
3398         curl_easy_setopt(curlData->curl,CURLOPT_HEADERDATA,curlData->headerHandle);
3399     }
3400     if (curlData->stderrFlag) {
3401         if (curlOpenFile(interp,curlData->stderrFile,&(curlData->stderrHandle),1,1)) {
3402             return 1;
3403         }
3404         curl_easy_setopt(curlData->curl,CURLOPT_STDERR,curlData->stderrHandle);
3405     }
3406     return 0;
3407 }
3408
3409 /*----------------------------------------------------------------------
3410  *
3411  * curlCloseFiles --
3412  *
3413  *  Closes the files opened during a transfer.
3414  *
3415  * Parameter:
3416  *  curlData: The pointer to the struct with the transfer data.
3417  *
3418  *----------------------------------------------------------------------
3419  */
3420 void
3421 curlCloseFiles(struct curlObjData *curlData) {
3422     if (curlData->outHandle!=NULL) {
3423         fclose(curlData->outHandle);
3424         curlData->outHandle=NULL;
3425     }
3426     if (curlData->inHandle!=NULL) {
3427         fclose(curlData->inHandle);
3428         curlData->inHandle=NULL;
3429     }
3430     if (curlData->headerHandle!=NULL) {
3431         fclose(curlData->headerHandle);
3432         curlData->headerHandle=NULL;
3433     }
3434     if (curlData->stderrHandle!=NULL) {
3435         fclose(curlData->stderrHandle);
3436         curlData->stderrHandle=NULL;
3437     }
3438 }
3439
3440 /*----------------------------------------------------------------------
3441  *
3442  * curlOpenFile --
3443  *
3444  *  Opens a file to be used during a transfer.
3445  *
3446  * Parameter:
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.
3451  *
3452  * Results:
3453  *  '0' all went well, '1' in case of error.
3454  *----------------------------------------------------------------------
3455  */
3456 int
3457 curlOpenFile(Tcl_Interp *interp,char *fileName, FILE **handle, int writing, int text) {
3458     Tcl_Obj        *resultObjPtr;
3459     char            errorMsg[300];
3460
3461     if (*handle!=NULL) {
3462         fclose(*handle);
3463     }
3464     if (writing==1) {
3465         if (text==1) {
3466             *handle=fopen(fileName,"w");
3467         } else {
3468             *handle=fopen(fileName,"wb");
3469         }
3470     } else {
3471         if (text==1) {
3472             *handle=fopen(fileName,"r");
3473         } else {
3474             *handle=fopen(fileName,"rb");
3475         }
3476     }
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);
3481         return 1;
3482     }
3483     return 0;
3484 }
3485
3486 /*----------------------------------------------------------------------
3487  *
3488  * curlseek --
3489  *
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.
3493  *
3494  *----------------------------------------------------------------------
3495  */
3496
3497 static curlioerr curlseek(void *instream, curl_off_t offset, int origin)
3498 {
3499     if(-1 == fseek((FILE *)instream, 0, origin)) {
3500           return CURLIOE_FAILRESTART;
3501     }
3502
3503     return CURLIOE_OK;
3504 }
3505
3506 /*----------------------------------------------------------------------
3507  *
3508  * curlSetPostData --
3509  *
3510  *  In case there is going to be a post transfer, this function sets the
3511  *  data that is going to be posted.
3512  *
3513  * Parameter:
3514  *  interp: Tcl interpreter we are using.
3515  *  curlData: A pointer to the struct with the transfer data.
3516  *
3517  * Results:
3518  *  A standard Tcl result.
3519  *----------------------------------------------------------------------
3520  */
3521 int
3522 curlSetPostData(Tcl_Interp *interp,struct curlObjData *curlDataPtr) {
3523     Tcl_Obj        *errorMsgObjPtr;
3524
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);
3530             return TCL_ERROR;
3531         }
3532     }
3533     return TCL_OK;
3534 }
3535
3536 /*----------------------------------------------------------------------
3537  *
3538  * curlResetPostData --
3539  *
3540  *  After performing a transfer, this function is invoked to erease the
3541  *  posr data.
3542  *
3543  * Parameter:
3544  *  curlData: A pointer to the struct with the transfer data.
3545  *----------------------------------------------------------------------
3546  */
3547 void
3548 curlResetPostData(struct curlObjData *curlDataPtr) {
3549     struct formArrayStruct       *tmpPtr;
3550
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);
3556
3557         while(curlDataPtr->formArray!=NULL) {
3558             if (curlDataPtr->formArray->formHeaderList!=NULL) {
3559                 curl_slist_free_all(curlDataPtr->formArray->formHeaderList);
3560                 curlDataPtr->formArray->formHeaderList=NULL;
3561             }
3562             curlResetFormArray(curlDataPtr->formArray->formArray);
3563             tmpPtr=curlDataPtr->formArray->next;
3564             Tcl_Free((char *)curlDataPtr->formArray);
3565             curlDataPtr->formArray=tmpPtr;
3566         }
3567     }
3568 }
3569 /*----------------------------------------------------------------------
3570  *
3571  * curlResetFormArray --
3572  *
3573  *  Cleans the contents of the formArray, it is done after a transfer or
3574  *  if 'curl_formadd' returns an error.
3575  *
3576  * Parameter:
3577  *  formArray: A pointer to the array to clean up.
3578  *----------------------------------------------------------------------
3579  */
3580 void
3581 curlResetFormArray(struct curl_forms *formArray) {
3582     int        i;
3583
3584     for (i=0;formArray[i].option!=CURLFORM_END;i++) {
3585         switch (formArray[i].option) {
3586             case CURLFORM_COPYNAME:
3587             case CURLFORM_COPYCONTENTS:
3588             case CURLFORM_FILE:
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));
3595                 break;
3596             default:
3597                 break;
3598         }
3599     }
3600     Tcl_Free((char *)formArray);
3601 }
3602
3603 /*----------------------------------------------------------------------
3604  *
3605  * curlSetBodyVarName --
3606  *
3607  *  After performing a transfer, this function is invoked to set the
3608  *  body of the recieved transfer into a user defined Tcl variable.
3609  *
3610  * Parameter:
3611  *  interp: The Tcl interpreter we are using.
3612  *  curlData: A pointer to the struct with the transfer data.
3613  *----------------------------------------------------------------------
3614  */
3615 void
3616 curlSetBodyVarName(Tcl_Interp *interp,struct curlObjData *curlDataPtr) {
3617     Tcl_Obj    *bodyVarNameObjPtr, *bodyVarObjPtr;
3618
3619     bodyVarNameObjPtr=Tcl_NewStringObj(curlDataPtr->bodyVarName,-1);
3620     bodyVarObjPtr=Tcl_NewByteArrayObj((unsigned char *)curlDataPtr->bodyVar.memory,
3621             curlDataPtr->bodyVar.size);
3622
3623     Tcl_ObjSetVar2(interp,bodyVarNameObjPtr,(Tcl_Obj *)NULL,bodyVarObjPtr,0);
3624
3625     curlDataPtr->bodyVar.size=0;
3626
3627     Tcl_Free(curlDataPtr->bodyVarName);
3628     curlDataPtr->bodyVarName=NULL;
3629 }
3630
3631 /*----------------------------------------------------------------------
3632  *
3633  * curlstrdup --
3634  *   The same as strdup, but won't seg fault if the string to copy is NULL.
3635  *
3636  * Parameter:
3637  *   old: The original one.
3638  *
3639  * Results:
3640  *   Returns a pointer to the new string.
3641  *----------------------------------------------------------------------
3642  */
3643 char
3644 *curlstrdup (char *old) {
3645     char    *tmpPtr;
3646
3647     if (old==NULL) {
3648         return NULL;
3649     }
3650     tmpPtr=Tcl_Alloc(strlen(old)+1);
3651     strcpy(tmpPtr,old);
3652
3653     return tmpPtr;
3654 }
3655
3656 /*
3657  *----------------------------------------------------------------------
3658  *
3659  * curlShareInitObjCmd --
3660  *
3661  *  Looks for the first free share handle (scurl1, scurl2,...) and
3662  *  creates a Tcl command for it.
3663  *
3664  * Results:
3665  *  A string with the name of the handle, don't forget to free it.
3666  *
3667  * Side effects:
3668  *  See the user documentation.
3669  *
3670  *----------------------------------------------------------------------
3671  */
3672
3673 char *
3674 curlCreateShareObjCmd (Tcl_Interp *interp,struct shcurlObjData  *shcurlData) {
3675     char                *shandleName;
3676     int                 i;
3677     Tcl_CmdInfo         info;
3678     Tcl_Command         cmdToken;
3679
3680     /* We try with scurl1, if it already exists with scurl2...*/
3681     shandleName=(char *)Tcl_Alloc(10);
3682     for (i=1;;i++) {
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);
3688             break;
3689         }
3690     }
3691     shcurlData->token=cmdToken;
3692
3693     return shandleName;
3694 }
3695
3696 /*
3697  *----------------------------------------------------------------------
3698  *
3699  * curlShareInitObjCmd --
3700  *
3701  *  This procedure is invoked to process the "curl::shareinit" Tcl command.
3702  *  See the user documentation for details on what it does.
3703  *
3704  * Results:
3705  *  A standard Tcl result.
3706  *
3707  * Side effects:
3708  *  See the user documentation.
3709  *
3710  *----------------------------------------------------------------------
3711  */
3712
3713 int
3714 curlShareInitObjCmd (ClientData clientData, Tcl_Interp *interp,
3715         int objc,Tcl_Obj *CONST objv[]) {
3716
3717     Tcl_Obj               *resultPtr;
3718     CURL                  *shcurlHandle;
3719     struct shcurlObjData  *shcurlData;
3720     char                  *shandleName;
3721
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);
3726         return TCL_ERROR;
3727     }
3728
3729     memset(shcurlData, 0, sizeof(struct shcurlObjData));
3730
3731     shcurlHandle=curl_share_init();
3732     if (shcurlHandle==NULL) {
3733         resultPtr=Tcl_NewStringObj("Couldn't create share handle",-1);
3734         Tcl_SetObjResult(interp,resultPtr);
3735         return TCL_ERROR;
3736     }
3737
3738     shandleName=curlCreateShareObjCmd(interp,shcurlData);
3739
3740     shcurlData->shandle=shcurlHandle;
3741
3742     resultPtr=Tcl_NewStringObj(shandleName,-1);
3743     Tcl_SetObjResult(interp,resultPtr);
3744     Tcl_Free(shandleName);
3745
3746 #ifdef TCL_THREADS
3747     curl_share_setopt(shcurlHandle, CURLSHOPT_LOCKFUNC, curlShareLockFunc);
3748     curl_share_setopt(shcurlHandle, CURLSHOPT_LOCKFUNC, curlShareUnLockFunc);
3749 #endif
3750
3751     return TCL_OK;
3752 }
3753
3754 #ifdef TCL_THREADS
3755 /*
3756  *----------------------------------------------------------------------
3757  *
3758  * curlShareLockFunc --
3759  *
3760  *  This will be the function invoked by libcurl when it wants to lock
3761  *  some data for the share interface.
3762  *
3763  * Side effects:
3764  *  See the user documentation.
3765  *
3766  *----------------------------------------------------------------------
3767  */
3768
3769 void
3770 curlShareLockFunc (CURL *handle, curl_lock_data data, curl_lock_access access
3771         , void *userptr) {
3772
3773     switch(data) {
3774         CURL_LOCK_DATA_COOKIE:
3775             Tcl_MutexLock(&cookieLock);
3776             break;
3777         CURL_LOCK_DATA_DNS:
3778             Tcl_MutexLock(&dnsLock);
3779             break;
3780         CURL_LOCK_DATA_SSL_SESSION:
3781             Tcl_MutexLock(&sslLock);
3782             break;
3783         CURL_LOCK_DATA_CONNECT:
3784             Tcl_MutexLock(&connectLock);
3785             break;
3786         default:
3787             /* Prevent useless compile warnings */
3788             break;
3789     }
3790 }
3791
3792 /*
3793  *----------------------------------------------------------------------
3794  *
3795  * curlShareUnLockFunc --
3796  *
3797  *  This will be the function invoked by libcurl when it wants to unlock
3798  *  the previously locked data.
3799  *
3800  * Side effects:
3801  *  See the user documentation.
3802  *
3803  *----------------------------------------------------------------------
3804  */
3805 void
3806 curlShareUnLockFunc(CURL *handle, curl_lock_data data, void *userptr) {
3807
3808     switch(data) {
3809         CURL_LOCK_DATA_COOKIE:
3810             Tcl_MutexUnlock(&cookieLock);
3811             break;
3812         CURL_LOCK_DATA_DNS:
3813             Tcl_MutexUnlock(&dnsLock);
3814             break;
3815         CURL_LOCK_DATA_SSL_SESSION:
3816             Tcl_MutexUnlock(&sslLock);
3817             break;
3818         CURL_LOCK_DATA_CONNECT:
3819             Tcl_MutexUnlock(&connectLock);
3820             break;
3821         default:
3822             break;
3823     }
3824 }
3825
3826 #endif
3827
3828 /*
3829  *----------------------------------------------------------------------
3830  *
3831  * curlShareObjCmd --
3832  *
3833  *   This procedure is invoked to process the "share curl" commands.
3834  *   See the user documentation for details on what it does.
3835  *
3836  * Results:
3837  *   A standard Tcl result.
3838  *
3839  * Side effects:
3840  *   See the user documentation.
3841  *
3842  *----------------------------------------------------------------------
3843  */
3844 int
3845 curlShareObjCmd (ClientData clientData, Tcl_Interp *interp,
3846     int objc,Tcl_Obj *CONST objv[]) {
3847
3848     struct shcurlObjData     *shcurlData=(struct shcurlObjData *)clientData;
3849     CURLSH                   *shcurlHandle=shcurlData->shandle;
3850     int                       tableIndex, dataIndex;
3851     int                       dataToLock=0;
3852
3853     if (objc<2) {
3854         Tcl_WrongNumArgs(interp,1,objv,"option arg ?arg?");
3855         return TCL_ERROR;
3856     }
3857
3858     if (Tcl_GetIndexFromObj(interp, objv[1], shareCmd, "option",TCL_EXACT,&tableIndex)==TCL_ERROR) {
3859         return TCL_ERROR;
3860     }
3861
3862     switch(tableIndex) {
3863         case 0:
3864         case 1:
3865             if (Tcl_GetIndexFromObj(interp, objv[2], lockData,
3866                 "data to lock ",TCL_EXACT,&dataIndex)==TCL_ERROR) {
3867                 return TCL_ERROR;
3868             }
3869             switch(dataIndex) {
3870                 case 0:
3871                     dataToLock=CURL_LOCK_DATA_COOKIE;
3872                     break;
3873                 case 1:
3874                     dataToLock=CURL_LOCK_DATA_DNS;
3875                     break;
3876             }
3877             if (tableIndex==0) {
3878                 curl_share_setopt(shcurlHandle, CURLSHOPT_SHARE,   dataToLock);
3879             } else {
3880                 curl_share_setopt(shcurlHandle, CURLSHOPT_UNSHARE, dataToLock);
3881             }
3882             break;
3883         case 2:
3884             Tcl_DeleteCommandFromToken(interp,shcurlData->token);
3885             break;
3886     }
3887     return TCL_OK;
3888 }
3889
3890 /*
3891  *----------------------------------------------------------------------
3892  *
3893  * curlCleanUpShareCmd --
3894  *
3895  *   This procedure is invoked when curl share handle is deleted.
3896  *
3897  * Results:
3898  *   A standard Tcl result.
3899  *
3900  * Side effects:
3901  *   Cleans the curl share handle and frees the memory.
3902  *
3903  *----------------------------------------------------------------------
3904  */
3905 int
3906 curlCleanUpShareCmd(ClientData clientData) {
3907     struct shcurlObjData     *shcurlData=(struct shcurlObjData *)clientData;
3908     CURLSH                   *shcurlHandle=shcurlData->shandle;
3909
3910     curl_share_cleanup(shcurlHandle);
3911     Tcl_Free((char *)shcurlData);
3912
3913     return TCL_OK;
3914 }
3915
3916 /*
3917  *----------------------------------------------------------------------
3918  *
3919  * curlErrorStrings --
3920  *
3921  *  All the commands to return the error string from the error code have
3922  *  this function in common.
3923  *
3924  * Results:
3925  *  '0': All went well.
3926  *  '1': The error code didn't make sense.
3927  *----------------------------------------------------------------------
3928  */
3929 int
3930 curlErrorStrings (Tcl_Interp *interp, Tcl_Obj *CONST objv,int type) {
3931
3932     Tcl_Obj               *resultPtr;
3933     int                    errorCode;
3934     char                   errorMsg[500];
3935
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);
3940         return 1;
3941     }
3942     switch(type) {
3943         case 0:
3944             resultPtr=Tcl_NewStringObj(curl_easy_strerror(errorCode),-1);
3945             break;
3946         case 1:
3947             resultPtr=Tcl_NewStringObj(curl_share_strerror(errorCode),-1);
3948             break;
3949         case 2:
3950             resultPtr=Tcl_NewStringObj(curl_multi_strerror(errorCode),-1);
3951             break;
3952         default:
3953             resultPtr=Tcl_NewStringObj("You're kidding,right?",-1);
3954     }
3955     Tcl_SetObjResult(interp,resultPtr);
3956
3957     return 0;
3958 }
3959
3960 /*
3961  *----------------------------------------------------------------------
3962  *
3963  * curlEasyStringError --
3964  *
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.
3967  *
3968  * Results:
3969  *  A standard Tcl result.
3970  *
3971  * Side effects:
3972  *  The interpreter will contain as a result the string with the error
3973  *  message.
3974  *
3975  *----------------------------------------------------------------------
3976  */
3977 int
3978 curlEasyStringError (ClientData clientData, Tcl_Interp *interp,
3979         int objc,Tcl_Obj *CONST objv[]) {
3980
3981     if (objc<2) {
3982         Tcl_WrongNumArgs(interp,1,objv,"errorCode");
3983         return TCL_ERROR;
3984     }
3985
3986     if (curlErrorStrings(interp,objv[1],0)) {
3987         return TCL_ERROR;
3988     }
3989     return TCL_OK;
3990 }
3991
3992 /*
3993  *----------------------------------------------------------------------
3994  *
3995  * curlShareStringError --
3996  *
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.
3999  *
4000  * Results:
4001  *  A standard Tcl result.
4002  *
4003  * Side effects:
4004  *  The interpreter will contain as a result the string with the error
4005  *  message.
4006  *
4007  *----------------------------------------------------------------------
4008  */
4009 int
4010 curlShareStringError (ClientData clientData, Tcl_Interp *interp,
4011         int objc,Tcl_Obj *CONST objv[]) {
4012
4013     if (objc<2) {
4014         Tcl_WrongNumArgs(interp,1,objv,"errorCode");
4015         return TCL_ERROR;
4016     }
4017
4018     if (curlErrorStrings(interp,objv[1],1)) {
4019         return TCL_ERROR;
4020     }
4021     return TCL_OK;
4022 }
4023
4024 /*
4025  *----------------------------------------------------------------------
4026  *
4027  * curlMultiStringError --
4028  *
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.
4031  *
4032  * Results:
4033  *  A standard Tcl result.
4034  *
4035  * Side effects:
4036  *  The interpreter will contain as a result the string with the error
4037  *  message.
4038  *
4039  *----------------------------------------------------------------------
4040  */
4041 int
4042 curlMultiStringError (ClientData clientData, Tcl_Interp *interp,
4043         int objc,Tcl_Obj *CONST objv[]) {
4044
4045     if (objc<2) {
4046         Tcl_WrongNumArgs(interp,1,objv,"errorCode");
4047         return TCL_ERROR;
4048     }
4049
4050     if (curlErrorStrings(interp,objv[1],2)) {
4051         return TCL_ERROR;
4052     }
4053     return TCL_OK;
4054 }