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-2011 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.22.0");
  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
 356     if (Tcl_GetIndexFromObj(interp, objv[2], optionTable, "option",
 357             TCL_EXACT, &tableIndex)==TCL_ERROR) {
 358         return TCL_ERROR;
 359     }
 360
 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     unsigned long int         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_ACCEPT_ENCODING,"")) {
1227                     curlErrorSetOpt(interp,configTable,86,"all");
1228                     return 1;
1229                 }
1230             } else {
1231                 if (SetoptChar(interp,curlHandle,CURLOPT_ACCEPT_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                     break;
1246                 case 1:
1247                     curl_easy_setopt(curlHandle,CURLOPT_PROXYTYPE,
1248                             CURLPROXY_HTTP_1_0);
1249                     break;
1250                 case 2:
1251                     curl_easy_setopt(curlHandle,CURLOPT_PROXYTYPE,
1252                             CURLPROXY_SOCKS4);
1253                     break;
1254                 case 3:
1255                     curl_easy_setopt(curlHandle,CURLOPT_PROXYTYPE,
1256                             CURLPROXY_SOCKS4A);
1257                     break;
1258                 case 4:
1259                     curl_easy_setopt(curlHandle,CURLOPT_PROXYTYPE,
1260                             CURLPROXY_SOCKS5);
1261                     break;
1262                 case 5:
1263                     curl_easy_setopt(curlHandle,CURLOPT_PROXYTYPE,
1264                             CURLPROXY_SOCKS5_HOSTNAME);
1265             }
1266             break;
1267         case 88:
1268             if(SetoptsList(interp,&curlData->http200aliases,objv)) {
1269                 curlErrorSetOpt(interp,configTable,tableIndex,"http200aliases invalid");
1270                 return TCL_ERROR;
1271             }
1272             if (curl_easy_setopt(curlHandle,CURLOPT_HTTP200ALIASES,curlData->http200aliases)) {
1273                 curlErrorSetOpt(interp,configTable,tableIndex,"http200aliases invalid");
1274                 curl_slist_free_all(curlData->http200aliases);
1275                 curlData->http200aliases=NULL;
1276                 return TCL_ERROR;
1277             }
1278             return TCL_OK;
1279             break;
1280         case 89:
1281             if (SetoptInt(interp,curlHandle,CURLOPT_UNRESTRICTED_AUTH
1282                     ,tableIndex,objv)) {
1283                 return TCL_ERROR;
1284             }
1285             break;
1286         case 90:
1287             if (SetoptLong(interp,curlHandle,CURLOPT_FTP_USE_EPRT,
1288                         tableIndex,objv)) {
1289                 return TCL_ERROR;
1290             }
1291             break;
1292         case 91:
1293             Tcl_Free(curlData->command);
1294             curlData->command=curlstrdup(Tcl_GetString(objv));
1295             break;
1296         case 92:
1297             if (Tcl_GetIndexFromObj(interp, objv, httpAuthMethods,
1298                 "authentication method",TCL_EXACT,&intNumber)==TCL_ERROR) {
1299                 return TCL_ERROR;
1300             }
1301             curlData->anyAuthFlag=0;
1302             switch(intNumber) {
1303                 case 0:
1304                     longNumber=CURLAUTH_BASIC;
1305                     break;
1306                 case 1:
1307                     longNumber=CURLAUTH_DIGEST;
1308                     break;
1309                 case 2:
1310                     longNumber=CURLAUTH_DIGEST_IE;
1311                     break;
1312                 case 3:
1313                     longNumber=CURLAUTH_GSSNEGOTIATE;
1314                     break;
1315                 case 4:
1316                     longNumber=CURLAUTH_NTLM;
1317                     break;
1318                 case 5:
1319                     longNumber=CURLAUTH_ANY;
1320                     curlData->anyAuthFlag=1;
1321                     break;
1322                 case 6:
1323                     longNumber=CURLAUTH_ANYSAFE;
1324                     break;
1325                 case 7:
1326                     longNumber=CURLAUTH_NTLM_WB;
1327                     break;
1328             }
1329             tmpObjPtr=Tcl_NewLongObj(longNumber);
1330             if (SetoptLong(interp,curlHandle,CURLOPT_HTTPAUTH
1331                     ,tableIndex,tmpObjPtr)) {
1332                 return TCL_ERROR;
1333             }
1334             break;
1335         case 93:
1336             if (SetoptLong(interp,curlHandle,CURLOPT_FTP_CREATE_MISSING_DIRS,
1337                         tableIndex,objv)) {
1338                 return TCL_ERROR;
1339             }
1340             break;
1341         case 94:
1342             if (Tcl_GetIndexFromObj(interp, objv, httpAuthMethods,
1343                 "authentication method",TCL_EXACT,&intNumber)==TCL_ERROR) {
1344                 return TCL_ERROR;
1345             }
1346             switch(intNumber) {
1347                 case 0:
1348                     longNumber=CURLAUTH_BASIC;
1349                     break;
1350                 case 1:
1351                     longNumber=CURLAUTH_DIGEST;
1352                     break;
1353                 case 2:
1354                     longNumber=CURLAUTH_GSSNEGOTIATE;
1355                     break;
1356                 case 3:
1357                     longNumber=CURLAUTH_NTLM;
1358                     break;
1359                 case 5:
1360                     longNumber=CURLAUTH_ANYSAFE;
1361                     break;
1362                 case 4:
1363                 default:
1364                     longNumber=CURLAUTH_ANY;
1365                     break;
1366             }
1367             tmpObjPtr=Tcl_NewLongObj(longNumber);
1368             if (SetoptLong(interp,curlHandle,CURLOPT_PROXYAUTH
1369                     ,tableIndex,tmpObjPtr)) {
1370                 return TCL_ERROR;
1371             }
1372             break;
1373         case 95:
1374             if (SetoptLong(interp,curlHandle,CURLOPT_FTP_RESPONSE_TIMEOUT,
1375                         tableIndex,objv)) {
1376                 return TCL_ERROR;
1377             }
1378             break;
1379         case 96:
1380             if (Tcl_GetIndexFromObj(interp, objv, ipresolve,
1381                 "ip version",TCL_EXACT,&curlTableIndex)==TCL_ERROR) {
1382                 return TCL_ERROR;
1383             }
1384             switch(curlTableIndex) {
1385                 case 0:
1386                     longNumber=CURL_IPRESOLVE_WHATEVER;
1387                     break;
1388                 case 1:
1389                     longNumber=CURL_IPRESOLVE_V4;
1390                     break;
1391                 case 2:
1392                     longNumber=CURL_IPRESOLVE_V6;
1393                     break;
1394             }
1395             tmpObjPtr=Tcl_NewLongObj(longNumber);
1396             if (SetoptLong(interp,curlHandle,CURLOPT_IPRESOLVE
1397                     ,tableIndex,tmpObjPtr)) {
1398                 return TCL_ERROR;
1399             }
1400             break;
1401         case 97:
1402             if (SetoptLong(interp,curlHandle,CURLOPT_MAXFILESIZE,
1403                         tableIndex,objv)) {
1404                 return TCL_ERROR;
1405             }
1406             break;
1407         case 98:
1408             if (SetoptChar(interp,curlHandle,CURLOPT_NETRC_FILE,tableIndex,objv)) {
1409                 return TCL_ERROR;
1410             }
1411             break;
1412         case 99:
1413         case 138:
1414             if (Tcl_GetIndexFromObj(interp, objv, ftpssl,
1415                 "ftps method ",TCL_EXACT,&intNumber)==TCL_ERROR) {
1416                 return TCL_ERROR;
1417             }
1418             switch(intNumber) {
1419                 case 0:
1420                     longNumber=CURLUSESSL_NONE;
1421                     break;
1422                 case 1:
1423                     longNumber=CURLUSESSL_TRY;
1424                     break;
1425                 case 2:
1426                     longNumber=CURLUSESSL_CONTROL;
1427                     break;
1428                 case 3:
1429                     longNumber=CURLUSESSL_ALL;
1430                     break;
1431             }
1432             tmpObjPtr=Tcl_NewLongObj(longNumber);
1433             if (SetoptLong(interp,curlHandle,CURLOPT_USE_SSL,
1434                         tableIndex,tmpObjPtr)) {
1435                 return TCL_ERROR;
1436             }
1437             break;
1438         case 100:
1439             if (SetoptSHandle(interp,curlHandle,CURLOPT_SHARE,
1440                     tableIndex,objv)) {
1441                 return TCL_ERROR;
1442             }
1443             break;
1444         case 101:
1445             if (SetoptLong(interp,curlHandle,CURLOPT_PORT,
1446                         tableIndex,objv)) {
1447                 return TCL_ERROR;
1448             }
1449             break;
1450         case 102:
1451             if (SetoptLong(interp,curlHandle,CURLOPT_TCP_NODELAY,
1452                         tableIndex,objv)) {
1453                 return TCL_ERROR;
1454             }
1455             break;
1456         case 103:
1457             if (SetoptLong(interp,curlHandle,CURLOPT_AUTOREFERER,
1458                         tableIndex,objv)) {
1459                 return TCL_ERROR;
1460             }
1461             break;
1462         case 104:
1463             curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1464             return TCL_ERROR;
1465             break;
1466         case 105:
1467             curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1468             return TCL_ERROR;
1469             break;
1470         case 106:
1471             curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1472             return TCL_ERROR;
1473             break;
1474         case 107:
1475             curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete, check '-ftpport'");
1476             return TCL_ERROR;
1477             break;
1478         case 108:
1479             curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete, check '-ftpport'");
1480             return TCL_ERROR;
1481             break;
1482         case 109:
1483             curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1484             return TCL_ERROR;
1485             break;
1486         case 110:
1487             curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1488             return TCL_ERROR;
1489             break;
1490         case 111:
1491             if (Tcl_GetIndexFromObj(interp, objv, ftpsslauth,
1492                 "ftpsslauth method ",TCL_EXACT,&intNumber)==TCL_ERROR) {
1493                 return TCL_ERROR;
1494             }
1495             switch(intNumber) {
1496                 case 0:
1497                     longNumber=CURLFTPAUTH_DEFAULT;
1498                     break;
1499                 case 1:
1500                     longNumber=CURLFTPAUTH_SSL;
1501                     break;
1502                 case 2:
1503                     longNumber=CURLFTPAUTH_TLS;
1504                     break;
1505             }
1506             tmpObjPtr=Tcl_NewLongObj(longNumber);
1507             if (SetoptLong(interp,curlHandle,CURLOPT_FTPSSLAUTH,
1508                         tableIndex,tmpObjPtr)) {
1509                 return TCL_ERROR;
1510             }
1511             break;
1512         case 112:
1513             curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1514             return TCL_ERROR;
1515             break;
1516         case 113:
1517             curlErrorSetOpt(interp,configTable,tableIndex,"option is obsolete");
1518             return TCL_ERROR;
1519             break;
1520         case 114:
1521             if (SetoptChar(interp,curlHandle,CURLOPT_FTP_ACCOUNT,tableIndex,objv)) {
1522                 return TCL_ERROR;
1523             }
1524             break;
1525         case 115:
1526             if (SetoptLong(interp,curlHandle,CURLOPT_IGNORE_CONTENT_LENGTH,
1527                         tableIndex,objv)) {
1528                 return TCL_ERROR;
1529             }
1530             break;
1531         case 116:
1532             if (SetoptChar(interp,curlHandle,CURLOPT_COOKIELIST,tableIndex,objv)) {
1533                 return TCL_ERROR;
1534             }
1535             break;
1536         case 117:
1537             if (SetoptLong(interp,curlHandle,CURLOPT_FTP_SKIP_PASV_IP,
1538                         tableIndex,objv)) {
1539                 return TCL_ERROR;
1540             }
1541             break;
1542         case 118:
1543             if (Tcl_GetIndexFromObj(interp, objv, ftpfilemethod,
1544                 "ftp file method ",TCL_EXACT,&intNumber)==TCL_ERROR) {
1545                 return TCL_ERROR;
1546             }
1547             switch(intNumber) {
1548                 case 0:
1549                 case 1:
1550                     longNumber=1;                /* FTPFILE_MULTICWD  */
1551                     break;
1552                 case 2:
1553                     longNumber=2;                /* FTPFILE_NOCWD     */
1554                     break;
1555                 case 3:
1556                     longNumber=3;                /* FTPFILE_SINGLECWD */
1557                     break;
1558             }
1559             tmpObjPtr=Tcl_NewLongObj(longNumber);
1560             if (SetoptLong(interp,curlHandle,CURLOPT_FTP_FILEMETHOD,
1561                         tableIndex,tmpObjPtr)) {
1562                 return TCL_ERROR;
1563             }
1564             break;
1565         case 119:
1566             if (SetoptLong(interp,curlHandle,CURLOPT_LOCALPORT,
1567                         tableIndex,objv)) {
1568                 return TCL_ERROR;
1569             }
1570             break;
1571         case 120:
1572             if (SetoptLong(interp,curlHandle,CURLOPT_LOCALPORTRANGE,
1573                         tableIndex,objv)) {
1574                 return TCL_ERROR;
1575             }
1576             break;
1577         case 121:
1578             if (SetoptCurlOffT(interp,curlHandle,CURLOPT_MAX_SEND_SPEED_LARGE,
1579                         tableIndex,objv)) {
1580                 return TCL_ERROR;
1581             }
1582             break;
1583          case 122:
1584             if (SetoptCurlOffT(interp,curlHandle,CURLOPT_MAX_RECV_SPEED_LARGE,
1585                         tableIndex,objv)) {
1586                 return TCL_ERROR;
1587             }
1588             break;
1589         case 123:
1590             if (SetoptChar(interp,curlHandle,
1591                     CURLOPT_FTP_ALTERNATIVE_TO_USER,tableIndex,objv)) {
1592                 return TCL_ERROR;
1593             }
1594             break;
1595         case 124:
1596             if (SetoptLong(interp,curlHandle,CURLOPT_SSL_SESSIONID_CACHE,
1597                         tableIndex,objv)) {
1598                 return TCL_ERROR;
1599             }
1600             break;
1601         case 125:
1602             if (Tcl_GetIndexFromObj(interp, objv, sshauthtypes,
1603                 "ssh auth type ",TCL_EXACT,&intNumber)==TCL_ERROR) {
1604                 return TCL_ERROR;
1605             }
1606             switch(intNumber) {
1607                 case 0:
1608                     longNumber=CURLSSH_AUTH_PUBLICKEY;
1609                     break;
1610                 case 1:
1611                     longNumber=CURLSSH_AUTH_PASSWORD;
1612                     break;
1613                 case 2:
1614                     longNumber=CURLSSH_AUTH_HOST;
1615                     break;
1616                 case 3:
1617                     longNumber=CURLSSH_AUTH_KEYBOARD;
1618                     break;
1619                 case 4:
1620                     longNumber=CURLSSH_AUTH_ANY;
1621                     break;
1622             }
1623             tmpObjPtr=Tcl_NewLongObj(longNumber);
1624             if (SetoptLong(interp,curlHandle,CURLOPT_SSH_AUTH_TYPES,
1625                         tableIndex,tmpObjPtr)) {
1626                 return TCL_ERROR;
1627             }
1628             break;
1629         case 126:
1630             if (SetoptChar(interp,curlHandle,CURLOPT_SSH_PUBLIC_KEYFILE,
1631                     tableIndex,objv)) {
1632                 return TCL_ERROR;
1633             }
1634             break;
1635         case 127:
1636             if (SetoptChar(interp,curlHandle,CURLOPT_SSH_PRIVATE_KEYFILE,
1637                     tableIndex,objv)) {
1638                 return TCL_ERROR;
1639             }
1640             break;
1641         case 128:
1642             if (SetoptLong(interp,curlHandle,CURLOPT_TIMEOUT_MS,
1643                         tableIndex,objv)) {
1644                 return TCL_ERROR;
1645             }
1646             break;
1647         case 129:
1648             if (SetoptLong(interp,curlHandle,CURLOPT_CONNECTTIMEOUT_MS,
1649                         tableIndex,objv)) {
1650                 return TCL_ERROR;
1651             }
1652             break;
1653         case 130:
1654             if (SetoptLong(interp,curlHandle,CURLOPT_HTTP_CONTENT_DECODING,
1655                         tableIndex,objv)) {
1656                 return TCL_ERROR;
1657             }
1658             break;
1659         case 131:
1660             if (SetoptLong(interp,curlHandle,CURLOPT_HTTP_TRANSFER_DECODING,
1661                         tableIndex,objv)) {
1662                 return TCL_ERROR;
1663             }
1664             break;
1665         /* 132 is together with case 50 */
1666         case 133:
1667             if (SetoptLong(interp,curlHandle,CURLOPT_NEW_FILE_PERMS,
1668                         tableIndex,objv)) {
1669                 return TCL_ERROR;
1670             }
1671             break;
1672         case 134:
1673             if (SetoptLong(interp,curlHandle,CURLOPT_NEW_DIRECTORY_PERMS,
1674                         tableIndex,objv)) {
1675                 return TCL_ERROR;
1676             }
1677             break;
1678         /* case 135 with 75, case 136 with 19, case 137 with 18 and case 138 with 99 */
1679         case 139:
1680         case 146:
1681             if (Tcl_GetIndexFromObj(interp, objv, postredir,
1682                 "Postredir option ",TCL_EXACT,&intNumber)==TCL_ERROR) {
1683                 return TCL_ERROR;
1684             }
1685             switch(intNumber) {
1686                 case 0:
1687                     longNumber=CURL_REDIR_POST_301;
1688                     break;
1689                 case 1:
1690                     longNumber=CURL_REDIR_POST_302;
1691                     break;
1692                 case 2:
1693                     longNumber=CURL_REDIR_POST_ALL;
1694                     break;
1695             }
1696             tmpObjPtr=Tcl_NewLongObj(longNumber);
1697             if (SetoptLong(interp,curlHandle,CURLOPT_POSTREDIR,
1698                         tableIndex,tmpObjPtr)) {
1699                 return TCL_ERROR;
1700             }
1701             break;
1702         case 140:
1703             if (SetoptChar(interp,curlHandle,CURLOPT_SSH_HOST_PUBLIC_KEY_MD5,
1704                     tableIndex,objv)) {
1705                 return TCL_ERROR;
1706             }
1707             break;
1708         case 141:
1709             if (SetoptLong(interp,curlHandle,CURLOPT_PROXY_TRANSFER_MODE,
1710                         tableIndex,objv)) {
1711                 return TCL_ERROR;
1712             }
1713             break;
1714         case 142:
1715             if (SetoptChar(interp,curlHandle,CURLOPT_CRLFILE,
1716                     tableIndex,objv)) {
1717                 return TCL_ERROR;
1718             }
1719             break;
1720         case 143:
1721             if (SetoptChar(interp,curlHandle,CURLOPT_ISSUERCERT,
1722                     tableIndex,objv)) {
1723                 return TCL_ERROR;
1724             }
1725             break;
1726         case 144:
1727             if (SetoptLong(interp,curlHandle,CURLOPT_ADDRESS_SCOPE,
1728                         tableIndex,objv)) {
1729                 return TCL_ERROR;
1730             }
1731             break;
1732         case 145:
1733             if (SetoptLong(interp,curlHandle,CURLOPT_CERTINFO,
1734                         tableIndex,objv)) {
1735                 return TCL_ERROR;
1736             }
1737             break;
1738         /* case 146 is together with 139*/
1739         case 147:
1740             if (SetoptChar(interp,curlHandle,CURLOPT_USERNAME,
1741                     tableIndex,objv)) {
1742                 return TCL_ERROR;
1743             }
1744             break;
1745         case 148:
1746             if (SetoptChar(interp,curlHandle,CURLOPT_PASSWORD,
1747                     tableIndex,objv)) {
1748                 return TCL_ERROR;
1749             }
1750             break;
1751         case 149:
1752             if (SetoptChar(interp,curlHandle,CURLOPT_PROXYUSERNAME,
1753                     tableIndex,objv)) {
1754                 return TCL_ERROR;
1755             }
1756             break;
1757         case 150:
1758             if (SetoptChar(interp,curlHandle,CURLOPT_PROXYPASSWORD,
1759                     tableIndex,objv)) {
1760                 return TCL_ERROR;
1761             }
1762             break;
1763         case 151:
1764             if (SetoptLong(interp,curlHandle,CURLOPT_TFTP_BLKSIZE,
1765                         tableIndex,objv)) {
1766                 return TCL_ERROR;
1767             }
1768             break;
1769         case 152:
1770             if (SetoptChar(interp,curlHandle,CURLOPT_SOCKS5_GSSAPI_SERVICE,
1771                     tableIndex,objv)) {
1772                 return TCL_ERROR;
1773             }
1774             break;
1775         case 153:
1776             if (SetoptLong(interp,curlHandle,CURLOPT_SOCKS5_GSSAPI_NEC,
1777                         tableIndex,objv)) {
1778                 return TCL_ERROR;
1779             }
1780             break;
1781         case 154:
1782         case 155:
1783             if (Tcl_ListObjGetElements(interp,objv,&j,&protocols)==TCL_ERROR) {
1784                 return 1;
1785             }
1786
1787             for (i=0,protocolMask=0;i<j;i++) {
1788                 tmpStr=curlstrdup(Tcl_GetString(protocols[i]));
1789                 if (Tcl_GetIndexFromObj(interp,protocols[i],protocolNames,
1790                        "protocol",TCL_EXACT,&curlTableIndex)==TCL_ERROR) {
1791                    return TCL_ERROR;
1792                 }
1793                 switch(curlTableIndex) {
1794                     case 0:             /* http     1 */
1795                         protocolMask|=CURLPROTO_HTTP;
1796                         break;
1797                     case 1:             /* https    2 */
1798                         protocolMask|=CURLPROTO_HTTPS;
1799                         break;
1800                     case 2:             /* ftp      4 */
1801                         protocolMask|=CURLPROTO_FTP;
1802                         break;
1803                     case 3:             /* ftps     8 */
1804                         protocolMask|=CURLPROTO_FTPS;
1805                         break;
1806                     case 4:             /* scp     16 */
1807                         protocolMask|=CURLPROTO_SCP;
1808                         break;
1809                     case 5:             /* sftp    32 */
1810                         protocolMask|=CURLPROTO_SFTP;
1811                         break;
1812                     case 6:             /* telnet  64 */
1813                         protocolMask|=CURLPROTO_TELNET;
1814                         break;
1815                     case 7:             /* ldap   128 */
1816                         protocolMask|=CURLPROTO_LDAP;
1817                         break;
1818                     case 8:             /* ldaps  256 */
1819                         protocolMask|=CURLPROTO_LDAPS;
1820                         break;
1821                     case 9:             /* dict   512 */
1822                         protocolMask|=CURLPROTO_DICT;
1823                         break;
1824                     case 10:            /* file  1024 */
1825                         protocolMask|=CURLPROTO_FILE;
1826                         break;
1827                     case 11:            /* tftp  2048 */
1828                         protocolMask|=CURLPROTO_TFTP;
1829                         break;
1830                     case 12:            /* imap  4096 */
1831                         protocolMask|=CURLPROTO_IMAP;
1832                         break;
1833                     case 13:            /* imaps */
1834                         protocolMask|=CURLPROTO_IMAPS;
1835                         break;
1836                     case 14:            /* pop3 */
1837                         protocolMask|=CURLPROTO_POP3;
1838                         break;
1839                     case 15:            /* pop3s */
1840                         protocolMask|=CURLPROTO_POP3S;
1841                         break;
1842                     case 16:            /* smtp */
1843                         protocolMask|=CURLPROTO_SMTP;
1844                         break;
1845                     case 17:            /* smtps */
1846                         protocolMask|=CURLPROTO_SMTPS;
1847                         break;
1848                     case 18:            /* rtsp */
1849                         protocolMask|=CURLPROTO_RTSP;
1850                         break;
1851                     case 19:            /* rtmp */
1852                         protocolMask|=CURLPROTO_RTMP;
1853                         break;
1854                     case 20:            /* rtmpt */
1855                         protocolMask|=CURLPROTO_RTMPT;
1856                         break;
1857                     case 21:            /* rtmpe */
1858                         protocolMask|=CURLPROTO_RTMPE;
1859                         break;
1860                     case 22:            /* rtmpte */
1861                         protocolMask|=CURLPROTO_RTMPTE;
1862                         break;
1863                     case 23:            /* rtmps */
1864                         protocolMask|=CURLPROTO_RTMPS;
1865                         break;
1866                     case 24:            /* rtmpts */
1867                         protocolMask|=CURLPROTO_RTMPTS;
1868                         break;
1869                     case 25:            /* gopher */
1870                         protocolMask|=CURLPROTO_GOPHER;
1871                         break;
1872                     case 26:            /* all   FFFF */
1873                         protocolMask|=CURLPROTO_ALL;
1874                 }
1875             }
1876             tmpObjPtr=Tcl_NewLongObj(protocolMask);
1877             if (tableIndex==154) {
1878                 longNumber=CURLOPT_PROTOCOLS;
1879             } else {
1880                 longNumber=CURLOPT_REDIR_PROTOCOLS;
1881             }
1882             if (SetoptLong(interp,curlHandle,longNumber,tableIndex,tmpObjPtr)) {
1883                     return TCL_ERROR;
1884             }
1885             break;
1886         case 156:
1887             if (Tcl_GetIndexFromObj(interp, objv, ftpsslccc,
1888                 "Clear Command Channel option ",TCL_EXACT,&intNumber)==TCL_ERROR) {
1889                 return TCL_ERROR;
1890             }
1891             switch(intNumber) {
1892                 case 0:
1893                     longNumber=CURLFTPSSL_CCC_NONE;
1894                     break;
1895                 case 1:
1896                     longNumber=CURLFTPSSL_CCC_PASSIVE;
1897                     break;
1898                 case 2:
1899                     longNumber=CURLFTPSSL_CCC_ACTIVE;
1900                     break;
1901             }
1902             tmpObjPtr=Tcl_NewLongObj(longNumber);
1903             if (SetoptLong(interp,curlHandle,CURLOPT_FTP_SSL_CCC,
1904                         tableIndex,tmpObjPtr)) {
1905                 return TCL_ERROR;
1906             }
1907             break;
1908         case 157:
1909             if (SetoptChar(interp,curlHandle,CURLOPT_SSH_KNOWNHOSTS,
1910                     tableIndex,objv)) {
1911                 return TCL_ERROR;
1912             }
1913             break;
1914         case 158:
1915             if (curl_easy_setopt(curlHandle,CURLOPT_SSH_KEYFUNCTION,curlsshkeycallback)) {
1916                 return TCL_ERROR;
1917             }
1918             if (curl_easy_setopt(curlHandle,CURLOPT_SSH_KEYDATA,curlData)) {
1919                 return TCL_ERROR;
1920             }
1921             curlData->sshkeycallProc=curlstrdup(Tcl_GetString(objv));
1922             break;
1923         case 159:
1924             if (SetoptChar(interp,curlHandle,CURLOPT_MAIL_FROM,
1925                     tableIndex,objv)) {
1926                 return TCL_ERROR;
1927             }
1928             break;
1929         case 160:
1930             if(SetoptsList(interp,&curlData->mailrcpt,objv)) {
1931                 curlErrorSetOpt(interp,configTable,tableIndex,"mailrcpt invalid");
1932                 return TCL_ERROR;
1933             }
1934             if (curl_easy_setopt(curlHandle,CURLOPT_MAIL_RCPT,curlData->mailrcpt)) {
1935                 curlErrorSetOpt(interp,configTable,tableIndex,"mailrcpt invalid");
1936                 curl_slist_free_all(curlData->mailrcpt);
1937                 curlData->mailrcpt=NULL;
1938                 return TCL_ERROR;
1939             }
1940             return TCL_OK;
1941             break;
1942         case 161:
1943             if (SetoptLong(interp,curlHandle,CURLOPT_FTP_USE_PRET,
1944                         tableIndex,objv)) {
1945                 return TCL_ERROR;
1946             }
1947             break;
1948         case 162:
1949             if (SetoptLong(interp,curlHandle,CURLOPT_WILDCARDMATCH,
1950                         tableIndex,objv)) {
1951                 return TCL_ERROR;
1952             }
1953             break;
1954         case 163:
1955             curlData->chunkBgnProc=curlstrdup(Tcl_GetString(objv));
1956             if (strcmp(curlData->chunkBgnProc,"")) {
1957                 if (curl_easy_setopt(curlHandle,CURLOPT_CHUNK_BGN_FUNCTION,
1958                         curlChunkBgnProcInvoke)) {
1959                     return TCL_ERROR;
1960                 }
1961             } else {
1962                 curl_easy_setopt(curlHandle,CURLOPT_CHUNK_BGN_FUNCTION,NULL);
1963                 return TCL_OK;
1964             }
1965             if (curl_easy_setopt(curlHandle,CURLOPT_CHUNK_DATA,curlData)) {
1966                 return TCL_ERROR;
1967             }
1968             break;
1969         case 164:
1970             curlData->chunkBgnVar=curlstrdup(Tcl_GetString(objv));
1971             if (!strcmp(curlData->chunkBgnVar,"")) {
1972                 curlErrorSetOpt(interp,configTable,tableIndex,"invalid var name");
1973                 return TCL_ERROR;
1974             }
1975             break;
1976         case 165:
1977             curlData->chunkEndProc=curlstrdup(Tcl_GetString(objv));
1978             if (strcmp(curlData->chunkEndProc,"")) {
1979                 if (curl_easy_setopt(curlHandle,CURLOPT_CHUNK_END_FUNCTION,
1980                         curlChunkEndProcInvoke)) {
1981                     return TCL_ERROR;
1982                 }
1983             } else {
1984                 curl_easy_setopt(curlHandle,CURLOPT_CHUNK_END_FUNCTION,NULL);
1985                 return TCL_OK;
1986             }
1987             break;
1988         case 166:
1989             curlData->fnmatchProc=curlstrdup(Tcl_GetString(objv));
1990             if (strcmp(curlData->fnmatchProc,"")) {
1991                 if (curl_easy_setopt(curlHandle,CURLOPT_FNMATCH_FUNCTION,
1992                         curlfnmatchProcInvoke)) {
1993                     return TCL_ERROR;
1994                 }
1995             } else {
1996                 curl_easy_setopt(curlHandle,CURLOPT_FNMATCH_FUNCTION,NULL);
1997                 return TCL_OK;
1998             }
1999             if (curl_easy_setopt(curlHandle,CURLOPT_FNMATCH_DATA,curlData)) {
2000                 return TCL_ERROR;
2001             }
2002             break;
2003         case 167:
2004             if(SetoptsList(interp,&curlData->resolve,objv)) {
2005                 curlErrorSetOpt(interp,configTable,tableIndex,"invalid list");
2006                 return TCL_ERROR;
2007             }
2008             if (curl_easy_setopt(curlHandle,CURLOPT_RESOLVE,curlData->resolve)) {
2009                 curlErrorSetOpt(interp,configTable,tableIndex,"resolve list invalid");
2010                 curl_slist_free_all(curlData->resolve);
2011                 curlData->resolve=NULL;
2012                 return TCL_ERROR;
2013             }
2014             return TCL_OK;
2015             break;
2016         case 168:
2017             if (SetoptChar(interp,curlHandle,CURLOPT_TLSAUTH_USERNAME,
2018                     tableIndex,objv)) {
2019                 return TCL_ERROR;
2020             }
2021             break;
2022         case 169:
2023             if (SetoptChar(interp,curlHandle,CURLOPT_TLSAUTH_PASSWORD,
2024                     tableIndex,objv)) {
2025                 return TCL_ERROR;
2026             }
2027             break;
2028         case 170:
2029             if (Tcl_GetIndexFromObj(interp, objv, tlsauth,
2030                 "TSL auth option ",TCL_EXACT,&intNumber)==TCL_ERROR) {
2031                 return TCL_ERROR;
2032             }
2033             switch(intNumber) {
2034                 case 0:
2035                     longNumber=CURL_TLSAUTH_NONE;
2036                     break;
2037                 case 1:
2038                     longNumber=CURL_TLSAUTH_SRP;
2039             }
2040             tmpObjPtr=Tcl_NewLongObj(longNumber);
2041             if (SetoptLong(interp,curlHandle,CURLOPT_TLSAUTH_TYPE,
2042                         tableIndex,tmpObjPtr)) {
2043                 return TCL_ERROR;
2044             }
2045             break;
2046         case 171:
2047             if (SetoptLong(interp,curlHandle,CURLOPT_TRANSFER_ENCODING,
2048                         tableIndex,objv)) {
2049                 return TCL_ERROR;
2050             }
2051             break;
2052         case 172:
2053             if (Tcl_GetIndexFromObj(interp, objv, gssapidelegation,
2054                 "GSS API delegation option ",TCL_EXACT,&intNumber)==TCL_ERROR) {
2055                 return TCL_ERROR;
2056             }
2057             switch(intNumber) {
2058                 case 0:
2059                     longNumber=CURLGSSAPI_DELEGATION_FLAG;
2060                     break;
2061                 case 1:
2062                     longNumber=CURLGSSAPI_DELEGATION_POLICY_FLAG;
2063             }
2064             tmpObjPtr=Tcl_NewLongObj(longNumber);
2065             if (SetoptLong(interp,curlHandle,CURLOPT_GSSAPI_DELEGATION,
2066                         tableIndex,tmpObjPtr)) {
2067                 return TCL_ERROR;
2068             }
2069             break;
2070         case 173:
2071             if (SetoptChar(interp,curlHandle,CURLOPT_NOPROXY,
2072                     tableIndex,objv)) {
2073                 return TCL_ERROR;
2074             }
2075             break;
2076         case 174:
2077             if(SetoptsList(interp,&curlData->telnetoptions,objv)) {
2078                 curlErrorSetOpt(interp,configTable,tableIndex,"invalid list");
2079                 return TCL_ERROR;
2080             }
2081             if (curl_easy_setopt(curlHandle,CURLOPT_TELNETOPTIONS,curlData->telnetoptions)) {
2082                 curlErrorSetOpt(interp,configTable,tableIndex,"telnetoptions list invalid");
2083                 curl_slist_free_all(curlData->telnetoptions);
2084                 curlData->telnetoptions=NULL;
2085                 return TCL_ERROR;
2086             }
2087             return TCL_OK;
2088             break;
2089     }
2090     return TCL_OK;
2091 }
2092
2093 /*
2094  *----------------------------------------------------------------------
2095  *
2096  * SetoptInt --
2097  *
2098  *   Sets the curl options that require an int
2099  *
2100  *  Parameter:
2101  *   interp: The interpreter we are working with.
2102  *   curlHandle: and the curl handle
2103  *   opt: the option to set
2104  *   tclObj: The Tcl with the value for the option.
2105  *
2106  * Results:
2107  *  0 if all went well.
2108  *  1 in case of error.
2109  *----------------------------------------------------------------------
2110  */
2111 int
2112 SetoptInt(Tcl_Interp *interp,CURL *curlHandle,CURLoption opt,
2113         int tableIndex,Tcl_Obj *tclObj) {
2114     int        intNumber;
2115     char       *parPtr;
2116
2117     if (Tcl_GetIntFromObj(interp,tclObj,&intNumber)) {
2118         parPtr=curlstrdup(Tcl_GetString(tclObj));
2119         curlErrorSetOpt(interp,configTable,tableIndex,parPtr);
2120         Tcl_Free(parPtr);
2121         return 1;
2122     }
2123     if (curl_easy_setopt(curlHandle,opt,intNumber)) {
2124         parPtr=curlstrdup(Tcl_GetString(tclObj));
2125         curlErrorSetOpt(interp,configTable,tableIndex,parPtr);
2126         Tcl_Free(parPtr);
2127         return 1;
2128     }
2129     return 0;
2130 }
2131
2132 /*
2133  *----------------------------------------------------------------------
2134  *
2135  * SetoptLong --
2136  *
2137  *  Set the curl options that require a long
2138  *
2139  * Parameter:
2140  *  interp: The interpreter we are working with.
2141  *  curlHandle: and the curl handle
2142  *  opt: the option to set
2143  *  tclObj: The Tcl with the value for the option.
2144  *
2145  * Results:
2146  *  0 if all went well.
2147  *  1 in case of error.
2148  *----------------------------------------------------------------------
2149  */
2150 int
2151 SetoptLong(Tcl_Interp *interp,CURL *curlHandle,CURLoption opt,
2152         int tableIndex,Tcl_Obj *tclObj) {
2153     long         longNumber;
2154     char        *parPtr;
2155
2156     if (Tcl_GetLongFromObj(interp,tclObj,&longNumber)) {
2157         parPtr=curlstrdup(Tcl_GetString(tclObj));
2158         curlErrorSetOpt(interp,configTable,tableIndex,parPtr);
2159         Tcl_Free(parPtr);
2160         return 1;
2161     }
2162     if (curl_easy_setopt(curlHandle,opt,longNumber)) {
2163         parPtr=curlstrdup(Tcl_GetString(tclObj));
2164         curlErrorSetOpt(interp,configTable,tableIndex,parPtr);
2165         Tcl_Free(parPtr);
2166         return 1;
2167     }
2168
2169     return 0;
2170 }
2171
2172 /*
2173  *----------------------------------------------------------------------
2174  *
2175  * curlSetoptCurlOffT --
2176  *
2177  *  Set the curl options that require a curl_off_t, even if we really
2178  *  use a long to do it. (Cutting and pasting at its worst)
2179  *
2180  * Parameter:
2181  *  interp: The interpreter we are working with.
2182  *  curlHandle: and the curl handle
2183  *  opt: the option to set
2184  *  tclObj: The Tcl with the value for the option.
2185  *
2186  * Results:
2187  *  0 if all went well.
2188  *  1 in case of error.
2189  *----------------------------------------------------------------------
2190  */
2191 int
2192 SetoptCurlOffT(Tcl_Interp *interp,CURL *curlHandle,CURLoption opt,
2193         int tableIndex,Tcl_Obj *tclObj) {
2194     long        longNumber;
2195     char        *parPtr;
2196
2197     if (Tcl_GetLongFromObj(interp,tclObj,&longNumber)) {
2198         parPtr=curlstrdup(Tcl_GetString(tclObj));
2199         curlErrorSetOpt(interp,configTable,tableIndex,parPtr);
2200         Tcl_Free(parPtr);
2201         return 1;
2202     }
2203
2204     if (curl_easy_setopt(curlHandle,opt,(curl_off_t)longNumber)) {
2205         parPtr=curlstrdup(Tcl_GetString(tclObj));
2206         curlErrorSetOpt(interp,configTable,tableIndex,parPtr);
2207         Tcl_Free(parPtr);
2208         return 1;
2209     }
2210
2211     return 0;
2212 }
2213
2214
2215 /*
2216  *----------------------------------------------------------------------
2217  *
2218  * SetoptChar --
2219  *
2220  *  Set the curl options that require a string
2221  *
2222  * Parameter:
2223  *  interp: The interpreter we are working with.
2224  *  curlHandle: and the curl handle
2225  *  opt: the option to set
2226  *  tclObj: The Tcl with the value for the option.
2227  *
2228  * Results:
2229  *  0 if all went well.
2230  *  1 in case of error.
2231  *----------------------------------------------------------------------
2232  */
2233 int
2234 SetoptChar(Tcl_Interp *interp,CURL *curlHandle,
2235         CURLoption opt,int tableIndex,Tcl_Obj *tclObj) {
2236     char    *optionPtr;
2237
2238     optionPtr=curlstrdup(Tcl_GetString(tclObj));
2239     if (curl_easy_setopt(curlHandle,opt,optionPtr)) {
2240         curlErrorSetOpt(interp,configTable,tableIndex,optionPtr);
2241         Tcl_Free(optionPtr);
2242         return 1;
2243     }
2244     Tcl_Free(optionPtr);
2245     return 0;
2246 }
2247
2248 /*
2249  *----------------------------------------------------------------------
2250  *
2251  * SetoptSHandle --
2252  *
2253  *  Set the curl options that require a share handle (there is only
2254  *  one but you never know.
2255  *
2256  * Parameter:
2257  *  interp: The interpreter we are working with.
2258  *  curlHandle: the curl handle
2259  *  opt: the option to set
2260  *  tclObj: The Tcl with the value for the option.
2261  *
2262  * Results:
2263  *  0 if all went well.
2264  *  1 in case of error.
2265  *----------------------------------------------------------------------
2266  */
2267 int
2268 SetoptSHandle(Tcl_Interp *interp,CURL *curlHandle,
2269         CURLoption opt,int tableIndex,Tcl_Obj *tclObj) {
2270
2271     char                    *shandleName;
2272     Tcl_CmdInfo             *infoPtr=(Tcl_CmdInfo *)Tcl_Alloc(sizeof(Tcl_CmdInfo));
2273     struct shcurlObjData    *shandleDataPtr;
2274
2275     shandleName=Tcl_GetString(tclObj);
2276     if (0==Tcl_GetCommandInfo(interp,shandleName,infoPtr)) {
2277         return 1;
2278     }
2279     shandleDataPtr=(struct shcurlObjData *)(infoPtr->objClientData);
2280     Tcl_Free((char *)infoPtr);
2281     if (curl_easy_setopt(curlHandle,opt,shandleDataPtr->shandle)) {
2282         curlErrorSetOpt(interp,configTable,tableIndex,shandleName);
2283         return 1;
2284     }
2285     return 0;
2286 }
2287
2288 /*
2289  *----------------------------------------------------------------------
2290  *
2291  * SetoptsList --
2292  *
2293  *  Prepares a slist for future use.
2294  *
2295  * Parameter:
2296  *  slistPtr: Pointer to the slist to prepare.
2297  *  objv: Tcl object with a list of the data.
2298  *
2299  * Results:
2300  *  0 if all went well.
2301  *  1 in case of error.
2302  *----------------------------------------------------------------------
2303  */
2304 int
2305 SetoptsList(Tcl_Interp *interp,struct curl_slist **slistPtr,
2306         Tcl_Obj *CONST objv) {
2307     int         i,headerNumber;
2308     Tcl_Obj     **headers;
2309
2310     if (slistPtr!=NULL) {
2311         curl_slist_free_all(*slistPtr);
2312         *slistPtr=NULL;
2313     }
2314
2315     if (Tcl_ListObjGetElements(interp,objv,&headerNumber,&headers)
2316             ==TCL_ERROR) {
2317         return 1;
2318     }
2319
2320     for (i=0;i<headerNumber;i++) {
2321        *slistPtr=curl_slist_append(*slistPtr,Tcl_GetString(headers[i]));
2322         if (slistPtr==NULL) {
2323             return 1;
2324         }
2325     }
2326     return 0;
2327 }
2328
2329 /*
2330  *----------------------------------------------------------------------
2331  *
2332  * curlErrorSetOpt --
2333  *
2334  *  When an error happens when setting an option, this function
2335  *  takes cares of reporting it
2336  *
2337  * Parameter:
2338  *  interp: Pointer to the interpreter we are using.
2339  *  option: The index of the option in 'optionTable'
2340  *  parPtr: String with the parameter we wanted to set the option to.
2341  *----------------------------------------------------------------------
2342  */
2343
2344 void
2345 curlErrorSetOpt(Tcl_Interp *interp,CONST char **configTable, int option,
2346         CONST char *parPtr) {
2347     Tcl_Obj     *resultPtr;
2348     char        errorMsg[500];
2349
2350     snprintf(errorMsg,500,"setting option %s: %s",configTable[option],parPtr);
2351     resultPtr=Tcl_NewStringObj(errorMsg,-1);
2352     Tcl_SetObjResult(interp,resultPtr);
2353 }
2354
2355 /*
2356  *----------------------------------------------------------------------
2357  *
2358  * curlHeaderVar --
2359  *
2360  *  This is the function that will be invoked if the user wants to put
2361  *  the headers into a variable
2362  *
2363  * Parameter:
2364  *  header: string with the header line.
2365  *  size and nmemb: it so happens size * nmemb if the size of the
2366  *  header string.
2367  *  curlData: A pointer to the curlData structure for the transfer.
2368  *
2369  * Returns
2370  *  The number of bytes actually written or -1 in case of error, in
2371  *  which case 'libcurl' will abort the transfer.
2372  *-----------------------------------------------------------------------
2373  */
2374 size_t
2375 curlHeaderReader(void *ptr,size_t size,size_t nmemb,FILE *curlDataPtr) {
2376
2377     char                *header=ptr;
2378     struct curlObjData  *curlData=(struct curlObjData *)curlDataPtr;
2379     Tcl_RegExp           regExp;
2380
2381     CONST char          *startPtr;
2382     CONST char          *endPtr;
2383
2384     char                *headerName;
2385     char                *headerContent;
2386     char                *httpStatus;
2387
2388     int                  match,charLength;
2389
2390     regExp=Tcl_RegExpCompile(curlData->interp,"(.*?)(?::\\s*)(.*?)(\\r*)(\\n)");
2391     match=Tcl_RegExpExec(curlData->interp,regExp,header,header);
2392
2393     if (match) {
2394         Tcl_RegExpRange(regExp,1,&startPtr,&endPtr);
2395         charLength=endPtr-startPtr;
2396         headerName=Tcl_Alloc(charLength+1);
2397         strncpy(headerName,startPtr,charLength);
2398         headerName[charLength]=0;
2399
2400         Tcl_RegExpRange(regExp,2,&startPtr,&endPtr);
2401         charLength=endPtr-startPtr;
2402         headerContent=Tcl_Alloc(charLength+1);
2403         strncpy(headerContent,startPtr,charLength);
2404         headerContent[charLength]=0;
2405         /* There may be multiple 'Set-Cookie' headers, so we use a list */
2406         if (Tcl_StringCaseMatch(headerName,"Set-Cookie",1)) {
2407             Tcl_SetVar2(curlData->interp,curlData->headerVar,headerName, \
2408                     headerContent,TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
2409         } else {
2410             Tcl_SetVar2(curlData->interp,curlData->headerVar,headerName,
2411                     headerContent,0);
2412         }
2413     }
2414     regExp=Tcl_RegExpCompile(curlData->interp,"(^(HTTP|http)[^\r]+)(\r*)(\n)");
2415     match=Tcl_RegExpExec(curlData->interp,regExp,header,header);
2416     if (match) {
2417         Tcl_RegExpRange(regExp,1,&startPtr,&endPtr);
2418         charLength=endPtr-startPtr;
2419         httpStatus=Tcl_Alloc(charLength+1);
2420         strncpy(httpStatus,startPtr,charLength);
2421         httpStatus[charLength]=0;
2422
2423         Tcl_SetVar2(curlData->interp,curlData->headerVar,"http",
2424                 httpStatus,0);
2425     }
2426     return size*nmemb;
2427 }
2428
2429 /*
2430  *----------------------------------------------------------------------
2431  *
2432  * curlBodyReader --
2433  *
2434  *  This is the function that will be invoked as a callback while
2435  *  transferring the body of a request into a Tcl variable.
2436  *
2437  *  This function has been adapted from an example in libcurl's FAQ.
2438  *
2439  * Parameter:
2440  *  header: string with the header line.
2441  *  size and nmemb: it so happens size * nmemb if the size of the
2442  *  header string.
2443  *  curlData: A pointer to the curlData structure for the transfer.
2444  *
2445  * Returns
2446  *  The number of bytes actually written or -1 in case of error, in
2447  *  which case 'libcurl' will abort the transfer.
2448  *-----------------------------------------------------------------------
2449  */
2450 size_t
2451 curlBodyReader(void *ptr,size_t size,size_t nmemb,FILE *curlDataPtr) {
2452
2453     register int realsize = size * nmemb;
2454     struct MemoryStruct *mem=&(((struct curlObjData *)curlDataPtr)->bodyVar);
2455
2456     mem->memory = (char *)Tcl_Realloc(mem->memory,mem->size + realsize);
2457     if (mem->memory) {
2458         memcpy(&(mem->memory[mem->size]), ptr, realsize);
2459         mem->size += realsize;
2460     }
2461     return realsize;
2462 }
2463
2464 /*
2465  *----------------------------------------------------------------------
2466  *
2467  * curlProgressCallback --
2468  *
2469  *  This is the function that will be invoked as a callback during a
2470  *  transfer.
2471  *
2472  *  This function has been adapted from an example in libcurl's FAQ.
2473  *
2474  * Parameter:
2475  *  clientData: The curlData struct for the transfer.
2476  *  dltotal: Total amount of bytes to download.
2477  *  dlnow: Bytes downloaded so far.
2478  *  ultotal: Total amount of bytes to upload.
2479  *  ulnow: Bytes uploaded so far.
2480  *
2481  * Returns
2482  *  Returning a non-zero value will make 'libcurl' abort the transfer
2483  *  and return 'CURLE_ABORTED_BY_CALLBACK'.
2484  *-----------------------------------------------------------------------
2485  */
2486 int
2487 curlProgressCallback(void *clientData,double dltotal,double dlnow,
2488         double ultotal,double ulnow) {
2489
2490     struct curlObjData    *curlData=(struct curlObjData *)clientData;
2491     Tcl_Obj               *tclProcPtr;
2492     char                   tclCommand[300];
2493
2494     snprintf(tclCommand,299,"%s %f %f %f %f",curlData->progressProc,dltotal,
2495             dlnow,ultotal,ulnow);
2496     tclProcPtr=Tcl_NewStringObj(tclCommand,-1);
2497     if (curlData->cancelTransVarName) {
2498         if (curlData->cancelTrans) {
2499             curlData->cancelTrans=0;
2500             return -1;
2501         }
2502     }
2503     if (Tcl_EvalObjEx(curlData->interp,tclProcPtr,TCL_EVAL_GLOBAL)!=TCL_OK) {
2504         return -1;
2505     }
2506     return 0;
2507 }
2508
2509 /*
2510  *----------------------------------------------------------------------
2511  *
2512  * curlWriteProcInvoke --
2513  *
2514  *  This is the function that will be invoked as a callback when the user
2515  *  wants to invoke a Tcl procedure to write the recieved data.
2516  *
2517  *  This function has been adapted from an example in libcurl's FAQ.
2518  *
2519  * Parameter:
2520  *  ptr: A pointer to the data.
2521  *  size and nmemb: it so happens size * nmemb if the size of the
2522  *  data read.
2523  *  curlData: A pointer to the curlData structure for the transfer.
2524  *
2525  * Returns
2526  *  The number of bytes actually written or -1 in case of error, in
2527  *  which case 'libcurl' will abort the transfer.
2528  *-----------------------------------------------------------------------
2529  */
2530 size_t
2531 curlWriteProcInvoke(void *ptr,size_t size,size_t nmemb,FILE *curlDataPtr) {
2532     register int realsize = size * nmemb;
2533     struct curlObjData  *curlData=(struct curlObjData *)curlDataPtr;
2534     Tcl_Obj             *objv[2];
2535
2536     objv[0]=Tcl_NewStringObj(curlData->writeProc,-1);
2537     objv[1]=Tcl_NewByteArrayObj(ptr,realsize);
2538     if (curlData->cancelTransVarName) {
2539         if (curlData->cancelTrans) {
2540             curlData->cancelTrans=0;
2541             return -1;
2542         }
2543     }
2544     if (Tcl_EvalObjv(curlData->interp,2,objv,TCL_EVAL_GLOBAL)!=TCL_OK) {
2545         return -1;
2546     }
2547     return realsize;
2548 }
2549
2550 /*
2551  *----------------------------------------------------------------------
2552  *
2553  * curlReadProcInvoke --
2554  *
2555  *  This is the function that will be invoked as a callback when the user
2556  *  wants to invoke a Tcl procedure to read the data to send.
2557  *
2558  * Parameter:
2559  *  header: string with the header line.
2560  *  size and nmemb: it so happens size * nmemb if the size of the
2561  *  header string.
2562  *  curlData: A pointer to the curlData structure for the transfer.
2563  *
2564  * Returns
2565  *  The number of bytes actually read or CURL_READFUNC_ABORT in case
2566  *  of error, in which case 'libcurl' will abort the transfer.
2567  *-----------------------------------------------------------------------
2568  */
2569 size_t
2570 curlReadProcInvoke(void *ptr,size_t size,size_t nmemb,FILE *curlDataPtr) {
2571     register int realsize = size * nmemb;
2572     struct curlObjData  *curlData=(struct curlObjData *)curlDataPtr;
2573     Tcl_Obj             *tclProcPtr;
2574     Tcl_Obj             *readDataPtr;
2575     char                 tclCommand[300];
2576     unsigned char       *readBytes;
2577     int                  sizeRead;
2578
2579     snprintf(tclCommand,300,"%s %d",curlData->readProc,realsize);
2580     tclProcPtr=Tcl_NewStringObj(tclCommand,-1);
2581
2582     if (curlData->cancelTransVarName) {
2583         if (curlData->cancelTrans) {
2584             curlData->cancelTrans=0;
2585             return CURL_READFUNC_ABORT;
2586         }
2587     }
2588     if (Tcl_EvalObjEx(curlData->interp,tclProcPtr,TCL_EVAL_GLOBAL)!=TCL_OK) {
2589         return CURL_READFUNC_ABORT;
2590     }
2591     readDataPtr=Tcl_GetObjResult(curlData->interp);
2592     readBytes=Tcl_GetByteArrayFromObj(readDataPtr,&sizeRead);
2593     memcpy(ptr,readBytes,sizeRead);
2594
2595     return sizeRead;
2596 }
2597
2598 /*
2599  *----------------------------------------------------------------------
2600  *
2601  * curlChunkBgnProcInvoke --
2602  *
2603  *  This is the function that will be invoked as a callback when the user
2604  *  wants to invoke a Tcl procedure to process every wildcard matching file
2605  *  on a ftp transfer.
2606  *
2607  * Parameter:
2608  *  transfer_info: a curl_fileinfo structure about the file.
2609  *  curlData: A pointer to the curlData structure for the transfer.
2610  *  remains: number of chunks remaining.
2611  *-----------------------------------------------------------------------
2612  */
2613 long
2614 curlChunkBgnProcInvoke (const void *transfer_info, void *curlDataPtr, int remains) {
2615     struct curlObjData             *curlData=(struct curlObjData *)curlDataPtr;
2616     Tcl_Obj                        *tclProcPtr;
2617     char                            tclCommand[300];
2618     int                             i;
2619     const struct curl_fileinfo     *fileinfoPtr=(const struct curl_fileinfo *)transfer_info;
2620
2621     tclProcPtr=Tcl_NewStringObj(tclCommand,-1);
2622
2623     if (curlData->chunkBgnVar==NULL) {
2624         curlData->chunkBgnVar=curlstrdup("fileData");
2625     }
2626
2627     Tcl_SetVar2(curlData->interp,curlData->chunkBgnVar,"filename",
2628             fileinfoPtr->filename,0);
2629
2630     switch(fileinfoPtr->filetype) {
2631         case 0:
2632             Tcl_SetVar2(curlData->interp,curlData->chunkBgnVar,"filetype",
2633                     "file",0);
2634             break;
2635         case 1:
2636             Tcl_SetVar2(curlData->interp,curlData->chunkBgnVar,"filetype",
2637                     "directory",0);
2638             break;
2639         case 2:
2640             Tcl_SetVar2(curlData->interp,curlData->chunkBgnVar,"filetype",
2641                     "symlink",0);
2642             break;
2643         case 3:
2644             Tcl_SetVar2(curlData->interp,curlData->chunkBgnVar,"filetype",
2645                     "device block",0);
2646             break;
2647         case 4:
2648             Tcl_SetVar2(curlData->interp,curlData->chunkBgnVar,"filetype",
2649                     "device char",0);
2650             break;
2651         case 5:
2652             Tcl_SetVar2(curlData->interp,curlData->chunkBgnVar,"filetype",
2653                     "named pipe",0);
2654             break;
2655         case 6:
2656             Tcl_SetVar2(curlData->interp,curlData->chunkBgnVar,"filetype",
2657                     "socket",0);
2658             break;
2659         case 7:
2660             Tcl_SetVar2(curlData->interp,curlData->chunkBgnVar,"filetype",
2661                     "door",0);
2662             break;
2663         case 8:
2664             Tcl_SetVar2(curlData->interp,curlData->chunkBgnVar,"filetype",
2665                     "error",0);
2666             break;
2667     }
2668
2669     Tcl_SetVar2Ex(curlData->interp,curlData->chunkBgnVar,"time",
2670             Tcl_NewLongObj(fileinfoPtr->time),0);
2671
2672     Tcl_SetVar2Ex(curlData->interp,curlData->chunkBgnVar,"perm",
2673             Tcl_NewIntObj(fileinfoPtr->perm),0);
2674
2675     Tcl_SetVar2Ex(curlData->interp,curlData->chunkBgnVar,"uid",
2676             Tcl_NewIntObj(fileinfoPtr->uid),0);
2677     Tcl_SetVar2Ex(curlData->interp,curlData->chunkBgnVar,"gid",
2678             Tcl_NewIntObj(fileinfoPtr->gid),0);
2679     Tcl_SetVar2Ex(curlData->interp,curlData->chunkBgnVar,"size",
2680             Tcl_NewLongObj(fileinfoPtr->size),0);
2681     Tcl_SetVar2Ex(curlData->interp,curlData->chunkBgnVar,"hardlinks",
2682             Tcl_NewIntObj(fileinfoPtr->hardlinks),0);
2683     Tcl_SetVar2Ex(curlData->interp,curlData->chunkBgnVar,"flags",
2684             Tcl_NewIntObj(fileinfoPtr->flags),0);
2685
2686     snprintf(tclCommand,300,"%s %d",curlData->chunkBgnProc,remains);
2687     tclProcPtr=Tcl_NewStringObj(tclCommand,-1);
2688
2689     if (Tcl_EvalObjEx(curlData->interp,tclProcPtr,TCL_EVAL_GLOBAL)!=TCL_OK) {
2690         return CURL_CHUNK_BGN_FUNC_FAIL;
2691     }
2692
2693     if (Tcl_GetIntFromObj(curlData->interp,Tcl_GetObjResult(curlData->interp),&i)!=TCL_OK) {
2694         return CURL_CHUNK_BGN_FUNC_FAIL;
2695     }
2696     switch(i) {
2697         case 0:
2698             return CURL_CHUNK_BGN_FUNC_OK;
2699         case 1:
2700             return CURL_CHUNK_BGN_FUNC_SKIP;
2701     }
2702     return CURL_CHUNK_BGN_FUNC_FAIL;
2703 }
2704
2705 /*
2706  *----------------------------------------------------------------------
2707  *
2708  * curlChunkEndProcInvoke --
2709  *
2710  *  This is the function that will be invoked every time a file has
2711  *  been downloaded or skipped, it does little more than called the
2712  *  given proc.
2713  *
2714  * Parameter:
2715  *  curlData: A pointer to the curlData structure for the transfer.
2716  *
2717  * Returns
2718  *-----------------------------------------------------------------------
2719  */
2720 long
2721 curlChunkEndProcInvoke (void *curlDataPtr) {
2722
2723     struct curlObjData      *curlData=(struct curlObjData *)curlDataPtr;
2724     Tcl_Obj                 *tclProcPtr;
2725     char                     tclCommand[300];
2726     int                      i;
2727
2728     snprintf(tclCommand,300,"%s",curlData->chunkEndProc);
2729     tclProcPtr=Tcl_NewStringObj(tclCommand,-1);
2730
2731     if (Tcl_EvalObjEx(curlData->interp,tclProcPtr,TCL_EVAL_GLOBAL)!=TCL_OK) {
2732         return CURL_CHUNK_END_FUNC_FAIL;
2733     }
2734
2735     if (Tcl_GetIntFromObj(curlData->interp,Tcl_GetObjResult(curlData->interp),&i)!=TCL_OK) {
2736         return CURL_CHUNK_END_FUNC_FAIL;
2737     }
2738     if (i==1) {
2739         return CURL_CHUNK_BGN_FUNC_FAIL;
2740     }
2741     return CURL_CHUNK_END_FUNC_OK;
2742 }
2743
2744 /*
2745  *----------------------------------------------------------------------
2746  *
2747  * curlfnmatchProcInvoke --
2748  *
2749  *  This is the function that will be invoked to tell whether a filename
2750  *  matches a pattern when doing a 'wildcard' download. It invokes a Tcl
2751  *  proc to do the actual work.
2752  *
2753  * Parameter:
2754  *  curlData: A pointer to the curlData structure for the transfer.
2755  *  pattern: The pattern to match.
2756  *  filename: The file name to be matched.
2757  *-----------------------------------------------------------------------
2758  */
2759 int curlfnmatchProcInvoke(void *curlDataPtr, const char *pattern, const char *filename) {
2760
2761     struct curlObjData      *curlData=(struct curlObjData *)curlDataPtr;
2762     Tcl_Obj                 *tclProcPtr;
2763     char                     tclCommand[500];
2764     int                      i;
2765
2766     snprintf(tclCommand,500,"%s %s %s",curlData->fnmatchProc,pattern,filename);
2767     tclProcPtr=Tcl_NewStringObj(tclCommand,-1);
2768
2769     if (Tcl_EvalObjEx(curlData->interp,tclProcPtr,TCL_EVAL_GLOBAL)!=TCL_OK) {
2770         return CURL_FNMATCHFUNC_FAIL;
2771     }
2772
2773     if (Tcl_GetIntFromObj(curlData->interp,Tcl_GetObjResult(curlData->interp),&i)!=TCL_OK) {
2774         return CURL_FNMATCHFUNC_FAIL;
2775     }
2776     switch(i) {
2777         case 0:
2778             return CURL_FNMATCHFUNC_MATCH;
2779         case 1:
2780             return CURL_FNMATCHFUNC_NOMATCH;
2781     }
2782     return CURL_FNMATCHFUNC_FAIL;
2783 }
2784
2785 /*
2786  *----------------------------------------------------------------------
2787  *
2788  * curlshkeyextract --
2789  *
2790  *  Out of one of libcurl's ssh key struct, this function will return a
2791  *  Tcl_Obj with a list, the first element is the type ok key, the second
2792  *  the key itself.
2793  *
2794  * Parameter:
2795  *  interp: The interp need to deal with the objects.
2796  *  key: a curl_khkey struct with the key.
2797  *
2798  * Returns
2799  *  The object with the list.
2800  *-----------------------------------------------------------------------
2801  */
2802 Tcl_Obj *
2803 curlsshkeyextract(Tcl_Interp *interp,const struct curl_khkey *key) {
2804
2805     Tcl_Obj         *keyObjPtr;
2806
2807     keyObjPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
2808
2809     switch(key->keytype) {
2810         case CURLKHTYPE_RSA1:
2811             Tcl_ListObjAppendElement(interp,keyObjPtr,Tcl_NewStringObj("rsa1",-1));
2812             break;
2813         case CURLKHTYPE_RSA:
2814             Tcl_ListObjAppendElement(interp,keyObjPtr,Tcl_NewStringObj("rsa",-1));
2815             break;
2816         case CURLKHTYPE_DSS:
2817             Tcl_ListObjAppendElement(interp,keyObjPtr,Tcl_NewStringObj("dss",-1));
2818             break;
2819         default:
2820             Tcl_ListObjAppendElement(interp,keyObjPtr,Tcl_NewStringObj("unknnown",-1));
2821             break;
2822     }
2823     Tcl_ListObjAppendElement(interp,keyObjPtr,Tcl_NewStringObj(key->key,-1));
2824
2825     return keyObjPtr;
2826 }
2827
2828 /*
2829  *----------------------------------------------------------------------
2830  *
2831  * curlshkeycallback --
2832  *
2833  *  This is the function that will be invoked as a callback when the user
2834  *  wants to invoke a Tcl procedure to decide about this new ssh host
2835  *
2836  * Parameter:
2837  *  curl: curl's easy handle for the connection.
2838  *  knownkey:    The key from the hosts_file.
2839  *  foundkey:    The key from the remote site.
2840  *  match:       What libcurl thinks about how they match
2841  *  curlDataPtr: Points to the structure with all the TclCurl data
2842  *               for the connection.
2843  *
2844  * Returns
2845  *  A libcurl return code so that libcurl knows what to do.
2846  *-----------------------------------------------------------------------
2847  */
2848 size_t
2849 curlsshkeycallback(CURL *curl ,const struct curl_khkey *knownkey,
2850         const struct curl_khkey *foundkey, enum curl_khmatch match,void *curlDataPtr) {
2851
2852     struct curlObjData  *tclcurlDataPtr=(struct curlObjData *)curlDataPtr;
2853     Tcl_Interp          *interp;
2854
2855     Tcl_Obj             *objv[4];
2856     Tcl_Obj             *returnObjPtr;
2857
2858     int                  action;
2859
2860     interp=tclcurlDataPtr->interp;
2861
2862     objv[0]=Tcl_NewStringObj(tclcurlDataPtr->sshkeycallProc,-1);
2863     objv[1]=curlsshkeyextract(interp,knownkey);
2864     objv[2]=curlsshkeyextract(interp,foundkey);
2865
2866     switch(match) {
2867         case CURLKHMATCH_OK:
2868             objv[3]=Tcl_NewStringObj("match",-1);
2869             break;
2870         case CURLKHMATCH_MISMATCH:
2871             objv[3]=Tcl_NewStringObj("mismatch",-1);
2872             break;
2873         case CURLKHMATCH_MISSING:
2874             objv[3]=Tcl_NewStringObj("missing",-1);
2875             break;
2876         case CURLKHMATCH_LAST:
2877             objv[3]=Tcl_NewStringObj("error",-1);
2878     }
2879
2880     if (Tcl_EvalObjv(interp,4,objv,TCL_EVAL_GLOBAL)!=TCL_OK)      {return CURLKHSTAT_REJECT;}
2881
2882     returnObjPtr=Tcl_GetObjResult(interp);
2883
2884     if (Tcl_GetIntFromObj(interp,returnObjPtr,&action)!=TCL_OK)   {return CURLKHSTAT_REJECT;}
2885
2886     switch(action) {
2887         case 0:
2888             return CURLKHSTAT_FINE_ADD_TO_FILE;
2889         case 1:
2890             return CURLKHSTAT_FINE;
2891         case 2:
2892             return CURLKHSTAT_REJECT;
2893         case 3:
2894             return CURLKHSTAT_DEFER;
2895     }
2896     return CURLKHSTAT_REJECT;
2897 }
2898
2899 /*
2900  *----------------------------------------------------------------------
2901  *
2902  * curlDebugProcInvoke --
2903  *
2904  *  This is the function that will be invoked as a callback when the user
2905  *  wants to invoke a Tcl procedure to write the debug data produce by
2906  *  the verbose option.
2907  *
2908  *  Parameter:
2909  *   curlHandle: A pointer to the handle for the transfer.
2910  *   infoType: Integer with the type of data.
2911  *   dataPtr: the data passed to the procedure.
2912  *   curlDataPtr: ointer to the curlData structure for the transfer.
2913  *
2914  *  Returns
2915  *   The number of bytes actually written or -1 in case of error, in
2916  *   which case 'libcurl' will abort the transfer.
2917  *-----------------------------------------------------------------------
2918  */
2919 int
2920 curlDebugProcInvoke(CURL *curlHandle, curl_infotype infoType,
2921         char * dataPtr, size_t size, void  *curlDataPtr) {
2922     struct curlObjData  *curlData=(struct curlObjData *)curlDataPtr;
2923     Tcl_Obj             *tclProcPtr;
2924     Tcl_Obj             *objv[3];
2925     char                tclCommand[300];
2926
2927     snprintf(tclCommand,300,"%s %d %d",curlData->debugProc,infoType,size);
2928     tclProcPtr=Tcl_NewStringObj(tclCommand,-1);
2929
2930     objv[0]=Tcl_NewStringObj(curlData->debugProc,-1);
2931     objv[1]=Tcl_NewIntObj(infoType);
2932     objv[2]=Tcl_NewByteArrayObj((CONST unsigned char *)dataPtr,size);
2933
2934     if (curlData->cancelTransVarName) {
2935         if (curlData->cancelTrans) {
2936             curlData->cancelTrans=0;
2937             return -1;
2938         }
2939     }
2940
2941     Tcl_EvalObjv(curlData->interp,3,objv,TCL_EVAL_GLOBAL);
2942
2943     return 0;
2944 }
2945
2946 /*
2947  *----------------------------------------------------------------------
2948  *
2949  * curlGetInfo --
2950  *
2951  *  Invokes the 'curl_easy_getinfo' function in libcurl.
2952  *
2953  * Parameter:
2954  *
2955  * Results:
2956  *   0 if all went well.
2957  *   The CURLcode for the error.
2958  *----------------------------------------------------------------------
2959  */
2960 CURLcode
2961 curlGetInfo(Tcl_Interp *interp,CURL *curlHandle,int tableIndex) {
2962     char                    *charPtr;
2963     long                     longNumber;
2964     double                   doubleNumber;
2965     struct curl_slist       *slistPtr;
2966     struct curl_certinfo    *certinfoPtr=NULL;
2967     int                      i;
2968
2969     CURLcode    exitCode;
2970
2971     Tcl_Obj    *resultObjPtr;
2972
2973     switch(tableIndex) {
2974         case 0:
2975             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_EFFECTIVE_URL,&charPtr);
2976             if (exitCode) {
2977                 return exitCode;
2978             }
2979             resultObjPtr=Tcl_NewStringObj(charPtr,-1);
2980             Tcl_SetObjResult(interp,resultObjPtr);
2981             break;
2982         case 1:
2983         case 2:
2984             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_RESPONSE_CODE,&longNumber);
2985             if (exitCode) {
2986                 return exitCode;
2987             }
2988             resultObjPtr=Tcl_NewLongObj(longNumber);
2989             Tcl_SetObjResult(interp,resultObjPtr);
2990             break;
2991         case 3:
2992             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_FILETIME,&longNumber);
2993             if (exitCode) {
2994                 return exitCode;
2995             }
2996             resultObjPtr=Tcl_NewLongObj(longNumber);
2997             Tcl_SetObjResult(interp,resultObjPtr);
2998             break;
2999         case 4:
3000             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_TOTAL_TIME,&doubleNumber);
3001             if (exitCode) {
3002                 return exitCode;
3003             }
3004             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3005             Tcl_SetObjResult(interp,resultObjPtr);
3006             break;
3007         case 5:
3008             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_NAMELOOKUP_TIME,
3009                     &doubleNumber);
3010             if (exitCode) {
3011                 return exitCode;
3012             }
3013             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3014             Tcl_SetObjResult(interp,resultObjPtr);
3015             break;
3016         case 6:
3017             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_CONNECT_TIME,
3018                     &doubleNumber);
3019             if (exitCode) {
3020                 return exitCode;
3021             }
3022             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3023             Tcl_SetObjResult(interp,resultObjPtr);
3024             break;
3025         case 7:
3026             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_PRETRANSFER_TIME,
3027                     &doubleNumber);
3028             if (exitCode) {
3029                 return exitCode;
3030             }
3031             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3032             Tcl_SetObjResult(interp,resultObjPtr);
3033             break;
3034         case 8:
3035             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_SIZE_UPLOAD,
3036                     &doubleNumber);
3037             if (exitCode) {
3038                 return exitCode;
3039             }
3040             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3041             Tcl_SetObjResult(interp,resultObjPtr);
3042             break;
3043         case 9:
3044             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_SIZE_DOWNLOAD,
3045                     &doubleNumber);
3046             if (exitCode) {
3047                 return exitCode;
3048             }
3049             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3050             Tcl_SetObjResult(interp,resultObjPtr);
3051             break;
3052         case 10:
3053             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_SPEED_DOWNLOAD,
3054                     &doubleNumber);
3055             if (exitCode) {
3056                 return exitCode;
3057             }
3058             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3059             Tcl_SetObjResult(interp,resultObjPtr);
3060             break;
3061         case 11:
3062             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_SPEED_UPLOAD,
3063                     &doubleNumber);
3064             if (exitCode) {
3065                 return exitCode;
3066             }
3067             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3068             Tcl_SetObjResult(interp,resultObjPtr);
3069             break;
3070         case 12:
3071             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_HEADER_SIZE,
3072                     &longNumber);
3073             if (exitCode) {
3074                 return exitCode;
3075             }
3076             resultObjPtr=Tcl_NewLongObj(longNumber);
3077             Tcl_SetObjResult(interp,resultObjPtr);
3078             break;
3079         case 13:
3080             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_REQUEST_SIZE,
3081                     &longNumber);
3082             if (exitCode) {
3083                 return exitCode;
3084             }
3085             resultObjPtr=Tcl_NewLongObj(longNumber);
3086             Tcl_SetObjResult(interp,resultObjPtr);
3087             break;
3088         case 14:
3089             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_SSL_VERIFYRESULT,
3090                     &longNumber);
3091             if (exitCode) {
3092                 return exitCode;
3093             }
3094             resultObjPtr=Tcl_NewLongObj(longNumber);
3095             Tcl_SetObjResult(interp,resultObjPtr);
3096             break;
3097         case 15:
3098             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_CONTENT_LENGTH_DOWNLOAD,
3099                     &doubleNumber);
3100             if (exitCode) {
3101                 return exitCode;
3102             }
3103             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3104             Tcl_SetObjResult(interp,resultObjPtr);
3105             break;
3106         case 16:
3107             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_CONTENT_LENGTH_UPLOAD,
3108                     &doubleNumber);
3109             if (exitCode) {
3110                 return exitCode;
3111             }
3112             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3113             Tcl_SetObjResult(interp,resultObjPtr);
3114             break;
3115         case 17:
3116             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_STARTTRANSFER_TIME,&doubleNumber);
3117             if (exitCode) {
3118                 return exitCode;
3119             }
3120             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3121             Tcl_SetObjResult(interp,resultObjPtr);
3122             break;
3123         case 18:
3124             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_CONTENT_TYPE,&charPtr);
3125             if (exitCode) {
3126                 return exitCode;
3127             }
3128             resultObjPtr=Tcl_NewStringObj(charPtr,-1);
3129             Tcl_SetObjResult(interp,resultObjPtr);
3130             break;
3131         case 19:
3132             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_REDIRECT_TIME,&doubleNumber);
3133             if (exitCode) {
3134                 return exitCode;
3135             }
3136             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3137             Tcl_SetObjResult(interp,resultObjPtr);
3138             break;
3139         case 20:
3140             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_REDIRECT_COUNT,&longNumber);
3141             if (exitCode) {
3142                 return exitCode;
3143             }
3144             resultObjPtr=Tcl_NewLongObj(longNumber);
3145             Tcl_SetObjResult(interp,resultObjPtr);
3146             break;
3147         case 21:
3148         case 22:
3149             if (tableIndex==21) {
3150                 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_HTTPAUTH_AVAIL,&longNumber);
3151             } else {
3152                 exitCode=curl_easy_getinfo(curlHandle,CURLINFO_PROXYAUTH_AVAIL,&longNumber);
3153             }
3154             if (exitCode) {
3155                 return exitCode;
3156             }
3157             resultObjPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
3158             if (longNumber&CURLAUTH_BASIC) {
3159                 Tcl_ListObjAppendElement(interp,resultObjPtr
3160                         ,Tcl_NewStringObj("basic",-1));
3161             }
3162             if (longNumber&CURLAUTH_DIGEST) {
3163                 Tcl_ListObjAppendElement(interp,resultObjPtr
3164                         ,Tcl_NewStringObj("digest",-1));
3165             }
3166             if (longNumber&CURLAUTH_GSSNEGOTIATE) {
3167                 Tcl_ListObjAppendElement(interp,resultObjPtr
3168                         ,Tcl_NewStringObj("gssnegotiate",-1));
3169             }
3170             if (longNumber&CURLAUTH_NTLM) {
3171                 Tcl_ListObjAppendElement(interp,resultObjPtr
3172                         ,Tcl_NewStringObj("NTLM",-1));
3173             }
3174             Tcl_SetObjResult(interp,resultObjPtr);
3175             break;
3176         case 23:
3177             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_OS_ERRNO,&longNumber);
3178             if (exitCode) {
3179                 return exitCode;
3180             }
3181             resultObjPtr=Tcl_NewLongObj(longNumber);
3182             Tcl_SetObjResult(interp,resultObjPtr);
3183             break;
3184         case 24:
3185             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_NUM_CONNECTS,&longNumber);
3186             if (exitCode) {
3187                 return exitCode;
3188             }
3189             resultObjPtr=Tcl_NewLongObj(longNumber);
3190             Tcl_SetObjResult(interp,resultObjPtr);
3191             break;
3192         case 25:
3193             exitCode=curl_easy_getinfo                                  \
3194                     (curlHandle,CURLINFO_SSL_ENGINES,&slistPtr);
3195             if (exitCode) {
3196                 return exitCode;
3197             }
3198             resultObjPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
3199             while(slistPtr!=NULL) {
3200                 Tcl_ListObjAppendElement(interp,resultObjPtr
3201                         ,Tcl_NewStringObj(slistPtr->data,-1));
3202                 slistPtr=slistPtr->next;
3203             }
3204             curl_slist_free_all(slistPtr);
3205             Tcl_SetObjResult(interp,resultObjPtr);
3206             break;
3207         case 26:
3208             exitCode=curl_easy_getinfo                                  \
3209                     (curlHandle,CURLINFO_HTTP_CONNECTCODE,&longNumber);
3210             if (exitCode) {
3211                 return exitCode;
3212             }
3213             resultObjPtr=Tcl_NewLongObj(longNumber);
3214             Tcl_SetObjResult(interp,resultObjPtr);
3215             break;
3216         case 27:
3217             exitCode=curl_easy_getinfo                                  \
3218                     (curlHandle,CURLINFO_COOKIELIST,&slistPtr);
3219             if (exitCode) {
3220                 return exitCode;
3221             }
3222             resultObjPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
3223             while(slistPtr!=NULL) {
3224                 Tcl_ListObjAppendElement(interp,resultObjPtr
3225                         ,Tcl_NewStringObj(slistPtr->data,-1));
3226                 slistPtr=slistPtr->next;
3227             }
3228             curl_slist_free_all(slistPtr);
3229             Tcl_SetObjResult(interp,resultObjPtr);
3230             break;
3231         case 28:
3232             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_FTP_ENTRY_PATH,&charPtr);
3233             if (exitCode) {
3234                 return exitCode;
3235             }
3236             resultObjPtr=Tcl_NewStringObj(charPtr,-1);
3237             Tcl_SetObjResult(interp,resultObjPtr);
3238             break;
3239         case 29:
3240             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_REDIRECT_URL,&charPtr);
3241             if (exitCode) {
3242                 return exitCode;
3243             }
3244             resultObjPtr=Tcl_NewStringObj(charPtr,-1);
3245             Tcl_SetObjResult(interp,resultObjPtr);
3246             break;
3247         case 30:
3248             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_PRIMARY_IP,&charPtr);
3249             if (exitCode) {
3250                 return exitCode;
3251             }
3252             resultObjPtr=Tcl_NewStringObj(charPtr,-1);
3253             Tcl_SetObjResult(interp,resultObjPtr);
3254             break;
3255         case 31:
3256             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_APPCONNECT_TIME,&doubleNumber);
3257             if (exitCode) {
3258                 return exitCode;
3259             }
3260             resultObjPtr=Tcl_NewDoubleObj(doubleNumber);
3261             Tcl_SetObjResult(interp,resultObjPtr);
3262             break;
3263         case 32:
3264             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_CERTINFO,certinfoPtr);
3265             if (exitCode) {
3266                 return exitCode;
3267             }
3268             charPtr=(char *)Tcl_Alloc(3);
3269             sprintf(charPtr,"%d",certinfoPtr->num_of_certs);
3270             resultObjPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
3271             Tcl_ListObjAppendElement(interp,resultObjPtr,Tcl_NewStringObj(charPtr,-1));
3272             Tcl_Free(charPtr);
3273             for(i=0; i < certinfoPtr->num_of_certs; i++) {
3274                 for(slistPtr = certinfoPtr->certinfo[i]; slistPtr; slistPtr=slistPtr->next) {
3275                     Tcl_ListObjAppendElement(interp,resultObjPtr,Tcl_NewStringObj(slistPtr->data,-1));
3276                 }
3277             }
3278             Tcl_SetObjResult(interp,resultObjPtr);
3279             break;
3280         case 33:
3281             exitCode=curl_easy_getinfo                                  \
3282                     (curlHandle,CURLINFO_CONDITION_UNMET,&longNumber);
3283             if (exitCode) {
3284                 return exitCode;
3285             }
3286             resultObjPtr=Tcl_NewLongObj(longNumber);
3287             Tcl_SetObjResult(interp,resultObjPtr);
3288             break;
3289         case 34:
3290             exitCode=curl_easy_getinfo                                  \
3291                     (curlHandle,CURLINFO_PRIMARY_PORT,&longNumber);
3292             if (exitCode) {
3293                 return exitCode;
3294             }
3295             resultObjPtr=Tcl_NewLongObj(longNumber);
3296             Tcl_SetObjResult(interp,resultObjPtr);
3297             break;
3298         case 35:
3299             exitCode=curl_easy_getinfo(curlHandle,CURLINFO_LOCAL_IP,&charPtr);
3300             if (exitCode) {
3301                 return exitCode;
3302             }
3303             resultObjPtr=Tcl_NewStringObj(charPtr,-1);
3304             Tcl_SetObjResult(interp,resultObjPtr);
3305             break;
3306         case 36:
3307             exitCode=curl_easy_getinfo                                  \
3308                     (curlHandle,CURLINFO_LOCAL_PORT,&longNumber);
3309             if (exitCode) {
3310                 return exitCode;
3311             }
3312             resultObjPtr=Tcl_NewLongObj(longNumber);
3313             Tcl_SetObjResult(interp,resultObjPtr);
3314             break;
3315     }
3316     return 0;
3317 }
3318
3319 /*
3320  *----------------------------------------------------------------------
3321  *
3322  * curlFreeSpace --
3323  *
3324  *    Frees the space taken by a curlObjData struct either because we are
3325  *    deleting the handle or reseting it.
3326  *
3327  *  Parameter:
3328  *    interp: Pointer to the interpreter we are using.
3329  *    curlHandle: the curl handle for which the option is set.
3330  *    objc and objv: The usual in Tcl.
3331  *
3332  * Results:
3333  *    A standard Tcl result.
3334  *----------------------------------------------------------------------
3335  */
3336 void
3337 curlFreeSpace(struct curlObjData *curlData) {
3338
3339     curl_slist_free_all(curlData->headerList);
3340     curl_slist_free_all(curlData->quote);
3341     curl_slist_free_all(curlData->prequote);
3342     curl_slist_free_all(curlData->postquote);
3343
3344     Tcl_Free(curlData->outFile);
3345     Tcl_Free(curlData->inFile);
3346     Tcl_Free(curlData->proxy);
3347     Tcl_Free(curlData->errorBuffer);
3348     Tcl_Free(curlData->errorBufferName);
3349     Tcl_Free(curlData->errorBufferKey);
3350     Tcl_Free(curlData->stderrFile);
3351     Tcl_Free(curlData->randomFile);
3352     Tcl_Free(curlData->headerVar);
3353     Tcl_Free(curlData->bodyVarName);
3354     if (curlData->bodyVar.memory) {
3355         Tcl_Free(curlData->bodyVar.memory);
3356     }
3357     Tcl_Free(curlData->progressProc);
3358     if (curlData->cancelTransVarName) {
3359         Tcl_UnlinkVar(curlData->interp,curlData->cancelTransVarName);
3360         Tcl_Free(curlData->cancelTransVarName);
3361     }
3362     Tcl_Free(curlData->writeProc);
3363     Tcl_Free(curlData->readProc);
3364     Tcl_Free(curlData->debugProc);
3365     curl_slist_free_all(curlData->http200aliases);
3366     Tcl_Free(curlData->sshkeycallProc);
3367     curl_slist_free_all(curlData->mailrcpt);
3368     Tcl_Free(curlData->chunkBgnProc);
3369     Tcl_Free(curlData->chunkBgnVar);
3370     Tcl_Free(curlData->chunkEndProc);
3371     Tcl_Free(curlData->fnmatchProc);
3372     curl_slist_free_all(curlData->resolve);
3373     curl_slist_free_all(curlData->telnetoptions);
3374
3375     Tcl_Free(curlData->command);
3376 }
3377
3378 /*
3379  *----------------------------------------------------------------------
3380  *
3381  * curlDupHandle --
3382  *
3383  *  This function is invoked by the 'duphandle' command, it will
3384  *  create a duplicate of the given handle.
3385  *
3386  * Parameters:
3387  *  The stantard parameters for Tcl commands
3388  *
3389  * Results:
3390  *  A standard Tcl result.
3391  *
3392  * Side effects:
3393  *  See the user documentation.
3394  *
3395  *----------------------------------------------------------------------
3396  */
3397 int
3398 curlDupHandle(Tcl_Interp *interp, struct curlObjData *curlData,
3399         int objc, Tcl_Obj *CONST objv[]) {
3400
3401     CURL                *newCurlHandle;
3402     Tcl_Obj             *result;
3403     struct curlObjData  *newCurlData;
3404     char                *handleName;
3405
3406     newCurlHandle=curl_easy_duphandle(curlData->curl);
3407     if (newCurlHandle==NULL) {
3408         result=Tcl_NewStringObj("Couldn't create new handle.",-1);
3409         Tcl_SetObjResult(interp,result);
3410         return TCL_ERROR;
3411     }
3412
3413     newCurlData=(struct curlObjData *)Tcl_Alloc(sizeof(struct curlObjData));
3414
3415     curlCopyCurlData(curlData,newCurlData);
3416
3417     handleName=curlCreateObjCmd(interp,newCurlData);
3418
3419     newCurlData->curl=newCurlHandle;
3420
3421     result=Tcl_NewStringObj(handleName,-1);
3422     Tcl_SetObjResult(interp,result);
3423     Tcl_Free(handleName);
3424
3425     return TCL_OK;
3426 }
3427
3428
3429 /*
3430  *----------------------------------------------------------------------
3431  *
3432  * curlResetHandle --
3433  *
3434  *  This function is invoked by the 'reset' command, it reset all the
3435  *  options in the handle to the state it had when 'init' was invoked.
3436  *
3437  * Parameters:
3438  *  The stantard parameters for Tcl commands
3439  *
3440  * Results:
3441  *  A standard Tcl result.
3442  *
3443  * Side effects:
3444  *      See the user documentation.
3445  *
3446  *----------------------------------------------------------------------
3447  */
3448 int
3449 curlResetHandle(Tcl_Interp *interp, struct curlObjData *curlData)  {
3450     struct curlObjData   *tmpPtr=
3451                     (struct curlObjData *)Tcl_Alloc(sizeof(struct curlObjData));
3452
3453     tmpPtr->curl       = curlData->curl;
3454     tmpPtr->token      = curlData->token;
3455     tmpPtr->shareToken = curlData->shareToken;
3456     tmpPtr->interp     = curlData->interp;
3457
3458     curlFreeSpace(curlData);
3459     memset(curlData, 0, sizeof(struct curlObjData));
3460
3461     curlData->curl       = tmpPtr->curl;
3462     curlData->token      = tmpPtr->token;
3463     curlData->shareToken = tmpPtr->shareToken;
3464     curlData->interp     = tmpPtr->interp;
3465
3466     curl_easy_reset(curlData->curl);
3467
3468     Tcl_Free((char *)tmpPtr);
3469
3470     return TCL_OK;
3471
3472 }
3473
3474 /*
3475  *----------------------------------------------------------------------
3476  *
3477  * curlVersion --
3478  *
3479  *      This procedure is invoked to process the "curl::init" Tcl command.
3480  *      See the user documentation for details on what it does.
3481  *
3482  * Parameters:
3483  *  The stantard parameters for Tcl commands
3484  *
3485  * Results:
3486  *      A standard Tcl result.
3487  *
3488  * Side effects:
3489  *      See the user documentation.
3490  *
3491  *----------------------------------------------------------------------
3492  */
3493 int
3494 curlVersion (ClientData clientData, Tcl_Interp *interp,
3495     int objc,Tcl_Obj *CONST objv[]) {
3496
3497     Tcl_Obj     *versionPtr;
3498     char        tclversion[200];
3499
3500     sprintf(tclversion,"TclCurl Version %s (%s)",TclCurlVersion,
3501                                                  curl_version());
3502     versionPtr=Tcl_NewStringObj(tclversion,-1);
3503     Tcl_SetObjResult(interp,versionPtr);
3504
3505     return TCL_OK;
3506 }
3507
3508 /*
3509  *----------------------------------------------------------------------
3510  *
3511  * curlEscape --
3512  *
3513  *  This function is invoked to process the "curl::escape" Tcl command.
3514  *  See the user documentation for details on what it does.
3515  *
3516  *
3517  * Parameters:
3518  *  The stantard parameters for Tcl commands
3519  *
3520  * Results:
3521  *  A standard Tcl result.
3522  *
3523  * Side effects:
3524  *  See the user documentation.
3525  *
3526  *----------------------------------------------------------------------
3527  */
3528 int
3529 curlEscape(ClientData clientData, Tcl_Interp *interp,
3530     int objc,Tcl_Obj *CONST objv[]) {
3531
3532     Tcl_Obj        *resultObj;
3533     char           *escapedStr;
3534
3535     escapedStr=curl_easy_escape(NULL,Tcl_GetString(objv[1]),0);
3536
3537     if(!escapedStr) {
3538         resultObj=Tcl_NewStringObj("curl::escape bad parameter",-1);
3539         Tcl_SetObjResult(interp,resultObj);
3540         return TCL_ERROR;
3541     }
3542     resultObj=Tcl_NewStringObj(escapedStr,-1);
3543     Tcl_SetObjResult(interp,resultObj);
3544     curl_free(escapedStr);
3545
3546     return TCL_OK;
3547 }
3548
3549 /*
3550  *----------------------------------------------------------------------
3551  *
3552  * curlUnescape --
3553  *
3554  *  This function is invoked to process the "curl::Unescape" Tcl command.
3555  *  See the user documentation for details on what it does.
3556  *
3557  *
3558  * Parameters:
3559  *  The stantard parameters for Tcl commands
3560  *
3561  * Results:
3562  *  A standard Tcl result.
3563  *
3564  * Side effects:
3565  *  See the user documentation.
3566  *
3567  *----------------------------------------------------------------------
3568  */
3569 int
3570 curlUnescape(ClientData clientData, Tcl_Interp *interp,
3571     int objc,Tcl_Obj *CONST objv[]) {
3572
3573     Tcl_Obj        *resultObj;
3574     char           *unescapedStr;
3575
3576     unescapedStr=curl_easy_unescape(NULL,Tcl_GetString(objv[1]),0,NULL);
3577     if(!unescapedStr) {
3578         resultObj=Tcl_NewStringObj("curl::unescape bad parameter",-1);
3579         Tcl_SetObjResult(interp,resultObj);
3580         return TCL_ERROR;
3581     }
3582     resultObj=Tcl_NewStringObj(unescapedStr,-1);
3583     Tcl_SetObjResult(interp,resultObj);
3584     curl_free(unescapedStr);
3585
3586     return TCL_OK;
3587 }
3588
3589 /*
3590  *----------------------------------------------------------------------
3591  *
3592  * curlVersionInfo --
3593  *
3594  *  This function invokes 'curl_version_info' to query how 'libcurl' was
3595  *  compiled.
3596  *
3597  * Parameters:
3598  *  The standard parameters for Tcl commands, but nothing is used.
3599  *
3600  * Results:
3601  *  A standard Tcl result.
3602  *
3603  * Side effects:
3604  *  See the user documentation.
3605  *
3606  *----------------------------------------------------------------------
3607  */
3608 int
3609 curlVersionInfo (ClientData clientData, Tcl_Interp *interp,
3610     int objc,Tcl_Obj *CONST objv[]) {
3611
3612     int                            tableIndex;
3613     int                            i;
3614     curl_version_info_data        *infoPtr;
3615     Tcl_Obj                       *resultObjPtr=NULL;
3616     char                           tmp[7];
3617
3618     if (objc!=2) {
3619         resultObjPtr=Tcl_NewStringObj("usage: curl::versioninfo -option",-1);
3620         Tcl_SetObjResult(interp,resultObjPtr);
3621         return TCL_ERROR;
3622     }
3623
3624     if (Tcl_GetIndexFromObj(interp, objv[1], versionInfoTable, "option",
3625             TCL_EXACT,&tableIndex)==TCL_ERROR) {
3626         return TCL_ERROR;
3627     }
3628
3629     infoPtr=curl_version_info(CURLVERSION_NOW);
3630
3631     switch(tableIndex) {
3632         case 0:
3633             resultObjPtr=Tcl_NewStringObj(infoPtr->version,-1);
3634             break;
3635         case 1:
3636             sprintf(tmp,"%X",infoPtr->version_num);
3637             resultObjPtr=Tcl_NewStringObj(tmp,-1);
3638             break;
3639         case 2:
3640             resultObjPtr=Tcl_NewStringObj(infoPtr->host,-1);
3641             break;
3642         case 3:
3643             resultObjPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
3644             if (infoPtr->features&CURL_VERSION_IPV6) {
3645                 Tcl_ListObjAppendElement(interp,resultObjPtr
3646                         ,Tcl_NewStringObj("IPV6",-1));
3647             }
3648             if (infoPtr->features&CURL_VERSION_KERBEROS4) {
3649                 Tcl_ListObjAppendElement(interp,resultObjPtr
3650                         ,Tcl_NewStringObj("KERBEROS4",-1));
3651             }
3652             if (infoPtr->features&CURL_VERSION_SSL) {
3653                 Tcl_ListObjAppendElement(interp,resultObjPtr
3654                         ,Tcl_NewStringObj("SSL",-1));
3655             }
3656             if (infoPtr->features&CURL_VERSION_LIBZ) {
3657                 Tcl_ListObjAppendElement(interp,resultObjPtr
3658                         ,Tcl_NewStringObj("LIBZ",-1));
3659             }
3660             if (infoPtr->features&CURL_VERSION_NTLM) {
3661                 Tcl_ListObjAppendElement(interp,resultObjPtr
3662                         ,Tcl_NewStringObj("NTLM",-1));
3663             }
3664             if (infoPtr->features&CURL_VERSION_GSSNEGOTIATE) {
3665                 Tcl_ListObjAppendElement(interp,resultObjPtr
3666                         ,Tcl_NewStringObj("GSSNEGOTIATE",-1));
3667             }
3668             if (infoPtr->features&CURL_VERSION_DEBUG) {
3669                 Tcl_ListObjAppendElement(interp,resultObjPtr
3670                         ,Tcl_NewStringObj("DEBUG",-1));
3671             }
3672             if (infoPtr->features&CURL_VERSION_ASYNCHDNS) {
3673                 Tcl_ListObjAppendElement(interp,resultObjPtr
3674                         ,Tcl_NewStringObj("ASYNCHDNS",-1));
3675             }
3676             if (infoPtr->features&CURL_VERSION_SPNEGO) {
3677                 Tcl_ListObjAppendElement(interp,resultObjPtr
3678                         ,Tcl_NewStringObj("SPNEGO",-1));
3679             }
3680             if (infoPtr->features&CURL_VERSION_LARGEFILE) {
3681                 Tcl_ListObjAppendElement(interp,resultObjPtr
3682                         ,Tcl_NewStringObj("LARGEFILE",-1));
3683             }
3684             if (infoPtr->features&CURL_VERSION_IDN) {
3685                 Tcl_ListObjAppendElement(interp,resultObjPtr
3686                         ,Tcl_NewStringObj("IDN",-1));
3687             }
3688             if (infoPtr->features&CURL_VERSION_SSPI) {
3689                 Tcl_ListObjAppendElement(interp,resultObjPtr
3690                         ,Tcl_NewStringObj("SSPI",-1));
3691             }
3692             break;
3693             if (infoPtr->features&CURL_VERSION_CONV) {
3694                 Tcl_ListObjAppendElement(interp,resultObjPtr
3695                         ,Tcl_NewStringObj("CONV",-1));
3696             }
3697         case 4:
3698             resultObjPtr=Tcl_NewStringObj(infoPtr->ssl_version,-1);
3699             break;
3700         case 5:
3701             resultObjPtr=Tcl_NewLongObj(infoPtr->ssl_version_num);
3702             break;
3703         case 6:
3704             resultObjPtr=Tcl_NewStringObj(infoPtr->libz_version,-1);
3705             break;
3706         case 7:
3707             resultObjPtr=Tcl_NewListObj(0,(Tcl_Obj **)NULL);
3708             for(i=0;;i++) {
3709                 if (infoPtr->protocols[i]!=NULL) {
3710                     Tcl_ListObjAppendElement(interp,resultObjPtr
3711                             ,Tcl_NewStringObj(infoPtr->protocols[i],-1));
3712                 } else {
3713                     break;
3714                 }
3715             }
3716     }
3717
3718     Tcl_SetObjResult(interp,resultObjPtr);
3719
3720     return TCL_OK;
3721 }
3722
3723 /*
3724  *----------------------------------------------------------------------
3725  *
3726  * curlCopyCurlData --
3727  *
3728  *  This function copies the contents of a curlData struct into another.
3729  *
3730  * Parameters:
3731  *  curlDataOld: The original one.
3732  *  curlDataNew: The new one
3733  *
3734  * Results:
3735  *  A standard Tcl result.
3736  *
3737  * Side effects:
3738  *  See the user documentation.
3739  *
3740  *----------------------------------------------------------------------
3741  */
3742 int
3743 curlCopyCurlData (struct curlObjData *curlDataOld,
3744                       struct curlObjData *curlDataNew) {
3745
3746     /* This takes care of the int and long values */
3747     memcpy(curlDataNew, curlDataOld, sizeof(struct curlObjData));
3748
3749     /* Some of the data doesn't get copied */
3750
3751     curlDataNew->headerList=NULL;
3752     curlDataNew->quote=NULL;
3753     curlDataNew->prequote=NULL;
3754     curlDataNew->postquote=NULL;
3755     curlDataNew->formArray=NULL;
3756     curlDataNew->postListFirst=NULL;
3757     curlDataNew->postListLast=NULL;
3758     curlDataNew->formArray=NULL;
3759     curlDataNew->outHandle=NULL;
3760     curlDataNew->outFlag=0;
3761     curlDataNew->inHandle=NULL;
3762     curlDataNew->inFlag=0;
3763     curlDataNew->headerHandle=NULL;
3764     curlDataNew->headerFlag=0;
3765     curlDataNew->stderrHandle=NULL;
3766     curlDataNew->stderrFlag=0;
3767     curlDataNew->http200aliases=NULL;
3768     curlDataNew->mailrcpt=NULL;
3769     curlDataNew->resolve=NULL;
3770     curlDataNew->telnetoptions=NULL;
3771
3772     /* The strings need a special treatment. */
3773
3774     curlDataNew->outFile=curlstrdup(curlDataOld->outFile);
3775     curlDataNew->inFile=curlstrdup(curlDataOld->inFile);
3776     curlDataNew->proxy=curlstrdup(curlDataOld->proxy);
3777     curlDataNew->errorBuffer=curlstrdup(curlDataOld->errorBuffer);
3778     curlDataNew->errorBufferName=curlstrdup(curlDataOld->errorBufferName);
3779     curlDataNew->errorBufferKey=curlstrdup(curlDataOld->errorBufferKey);
3780     curlDataNew->headerFile=curlstrdup(curlDataOld->headerFile);
3781     curlDataNew->stderrFile=curlstrdup(curlDataOld->stderrFile);
3782     curlDataNew->randomFile=curlstrdup(curlDataOld->randomFile);
3783     curlDataNew->headerVar=curlstrdup(curlDataOld->headerVar);
3784     curlDataNew->bodyVarName=curlstrdup(curlDataOld->bodyVarName);
3785     curlDataNew->progressProc=curlstrdup(curlDataOld->progressProc);
3786     curlDataNew->cancelTransVarName=curlstrdup(curlDataOld->cancelTransVarName);
3787     curlDataNew->writeProc=curlstrdup(curlDataOld->writeProc);
3788     curlDataNew->readProc=curlstrdup(curlDataOld->readProc);
3789     curlDataNew->debugProc=curlstrdup(curlDataOld->debugProc);
3790     curlDataNew->command=curlstrdup(curlDataOld->command);
3791     curlDataNew->sshkeycallProc=curlstrdup(curlDataOld->sshkeycallProc);
3792     curlDataNew->chunkBgnProc=curlstrdup(curlDataOld->chunkBgnProc);
3793     curlDataNew->chunkBgnVar=curlstrdup(curlDataOld->chunkBgnVar);
3794     curlDataNew->chunkEndProc=curlstrdup(curlDataOld->chunkEndProc);
3795     curlDataNew->fnmatchProc=curlstrdup(curlDataOld->fnmatchProc);
3796
3797     curlDataNew->bodyVar.memory=(char *)Tcl_Alloc(curlDataOld->bodyVar.size);
3798     memcpy(curlDataNew->bodyVar.memory,curlDataOld->bodyVar.memory
3799             ,curlDataOld->bodyVar.size);
3800     curlDataNew->bodyVar.size=curlDataOld->bodyVar.size;
3801
3802     return TCL_OK;
3803 }
3804
3805 /*----------------------------------------------------------------------
3806  *
3807  * curlOpenFiles --
3808  *
3809  *  Before doing a transfer with the easy interface or adding an easy
3810  *  handle to a multi one, this function takes care of opening all
3811  *  necessary files for the transfer.
3812  *
3813  * Parameter:
3814  *  curlData: The pointer to the struct with the transfer data.
3815  *
3816  * Results:
3817  *  '0' all went well, '1' in case of error.
3818  *----------------------------------------------------------------------
3819  */
3820 int
3821 curlOpenFiles(Tcl_Interp *interp,struct curlObjData *curlData) {
3822
3823     if (curlData->outFlag) {
3824         if (curlOpenFile(interp,curlData->outFile,&(curlData->outHandle),1,
3825                 curlData->transferText)) {
3826             return 1;
3827         }
3828         curl_easy_setopt(curlData->curl,CURLOPT_WRITEDATA,curlData->outHandle);
3829     }
3830     if (curlData->inFlag) {
3831         if (curlOpenFile(interp,curlData->inFile,&(curlData->inHandle),0,
3832                 curlData->transferText)) {
3833             return 1;
3834         }
3835         curl_easy_setopt(curlData->curl,CURLOPT_READDATA,curlData->inHandle);
3836         if (curlData->anyAuthFlag) {
3837             curl_easy_setopt(curlData->curl, CURLOPT_SEEKFUNCTION, curlseek);
3838             curl_easy_setopt(curlData->curl, CURLOPT_SEEKDATA, curlData->inHandle);
3839         }
3840     }
3841     if (curlData->headerFlag) {
3842         if (curlOpenFile(interp,curlData->headerFile,&(curlData->headerHandle),1,1)) {
3843             return 1;
3844         }
3845         curl_easy_setopt(curlData->curl,CURLOPT_HEADERDATA,curlData->headerHandle);
3846     }
3847     if (curlData->stderrFlag) {
3848         if (curlOpenFile(interp,curlData->stderrFile,&(curlData->stderrHandle),1,1)) {
3849             return 1;
3850         }
3851         curl_easy_setopt(curlData->curl,CURLOPT_STDERR,curlData->stderrHandle);
3852     }
3853     return 0;
3854 }
3855
3856 /*----------------------------------------------------------------------
3857  *
3858  * curlCloseFiles --
3859  *
3860  *  Closes the files opened during a transfer.
3861  *
3862  * Parameter:
3863  *  curlData: The pointer to the struct with the transfer data.
3864  *
3865  *----------------------------------------------------------------------
3866  */
3867 void
3868 curlCloseFiles(struct curlObjData *curlData) {
3869     if (curlData->outHandle!=NULL) {
3870         fclose(curlData->outHandle);
3871         curlData->outHandle=NULL;
3872     }
3873     if (curlData->inHandle!=NULL) {
3874         fclose(curlData->inHandle);
3875         curlData->inHandle=NULL;
3876     }
3877     if (curlData->headerHandle!=NULL) {
3878         fclose(curlData->headerHandle);
3879         curlData->headerHandle=NULL;
3880     }
3881     if (curlData->stderrHandle!=NULL) {
3882         fclose(curlData->stderrHandle);
3883         curlData->stderrHandle=NULL;
3884     }
3885 }
3886
3887 /*----------------------------------------------------------------------
3888  *
3889  * curlOpenFile --
3890  *
3891  *  Opens a file to be used during a transfer.
3892  *
3893  * Parameter:
3894  *  fileName: name of the file.
3895  *  handle: the handle for the file
3896  *  writing: '0' if reading, '1' if writing.
3897  *  text:    '0' if binary, '1' if text.
3898  *
3899  * Results:
3900  *  '0' all went well, '1' in case of error.
3901  *----------------------------------------------------------------------
3902  */
3903 int
3904 curlOpenFile(Tcl_Interp *interp,char *fileName, FILE **handle, int writing, int text) {
3905     Tcl_Obj        *resultObjPtr;
3906     char            errorMsg[300];
3907
3908     if (*handle!=NULL) {
3909         fclose(*handle);
3910     }
3911     if (writing==1) {
3912         if (text==1) {
3913             *handle=fopen(fileName,"w");
3914         } else {
3915             *handle=fopen(fileName,"wb");
3916         }
3917     } else {
3918         if (text==1) {
3919             *handle=fopen(fileName,"r");
3920         } else {
3921             *handle=fopen(fileName,"rb");
3922         }
3923     }
3924     if (*handle==NULL) {
3925         snprintf(errorMsg,300,"Couldn't open file %s.",fileName);
3926         resultObjPtr=Tcl_NewStringObj(errorMsg,-1);
3927         Tcl_SetObjResult(interp,resultObjPtr);
3928         return 1;
3929     }
3930     return 0;
3931 }
3932
3933 /*----------------------------------------------------------------------
3934  *
3935  * curlseek --
3936  *
3937  *  When the user requests the 'any' auth, libcurl may need
3938  *  to send the PUT/POST data more than once and thus may need to ask
3939  *  the app to "rewind" the read data stream to start.
3940  *
3941  *----------------------------------------------------------------------
3942  */
3943
3944 int
3945 curlseek(void *instream, curl_off_t offset, int origin)
3946 {
3947     if(-1 == fseek((FILE *)instream, 0, origin)) {
3948           return CURLIOE_FAILRESTART;
3949     }
3950     return CURLIOE_OK;
3951 }
3952
3953 /*----------------------------------------------------------------------
3954  *
3955  * curlSetPostData --
3956  *
3957  *  In case there is going to be a post transfer, this function sets the
3958  *  data that is going to be posted.
3959  *
3960  * Parameter:
3961  *  interp: Tcl interpreter we are using.
3962  *  curlData: A pointer to the struct with the transfer data.
3963  *
3964  * Results:
3965  *  A standard Tcl result.
3966  *----------------------------------------------------------------------
3967  */
3968 int
3969 curlSetPostData(Tcl_Interp *interp,struct curlObjData *curlDataPtr) {
3970     Tcl_Obj        *errorMsgObjPtr;
3971
3972     if (curlDataPtr->postListFirst!=NULL) {
3973         if (curl_easy_setopt(curlDataPtr->curl,CURLOPT_HTTPPOST,curlDataPtr->postListFirst)) {
3974             curl_formfree(curlDataPtr->postListFirst);
3975             errorMsgObjPtr=Tcl_NewStringObj("Error setting the data to post",-1);
3976             Tcl_SetObjResult(interp,errorMsgObjPtr);
3977             return TCL_ERROR;
3978         }
3979     }
3980     return TCL_OK;
3981 }
3982
3983 /*----------------------------------------------------------------------
3984  *
3985  * curlResetPostData --
3986  *
3987  *  After performing a transfer, this function is invoked to erease the
3988  *  posr data.
3989  *
3990  * Parameter:
3991  *  curlData: A pointer to the struct with the transfer data.
3992  *----------------------------------------------------------------------
3993  */
3994 void
3995 curlResetPostData(struct curlObjData *curlDataPtr) {
3996     struct formArrayStruct       *tmpPtr;
3997
3998     if (curlDataPtr->postListFirst) {
3999         curl_formfree(curlDataPtr->postListFirst);
4000         curlDataPtr->postListFirst=NULL;
4001         curlDataPtr->postListLast=NULL;
4002         curl_easy_setopt(curlDataPtr->curl,CURLOPT_HTTPPOST,NULL);
4003
4004         while(curlDataPtr->formArray!=NULL) {
4005             if (curlDataPtr->formArray->formHeaderList!=NULL) {
4006                 curl_slist_free_all(curlDataPtr->formArray->formHeaderList);
4007                 curlDataPtr->formArray->formHeaderList=NULL;
4008             }
4009             curlResetFormArray(curlDataPtr->formArray->formArray);
4010             tmpPtr=curlDataPtr->formArray->next;
4011             Tcl_Free((char *)curlDataPtr->formArray);
4012             curlDataPtr->formArray=tmpPtr;
4013         }
4014     }
4015 }
4016 /*----------------------------------------------------------------------
4017  *
4018  * curlResetFormArray --
4019  *
4020  *  Cleans the contents of the formArray, it is done after a transfer or
4021  *  if 'curl_formadd' returns an error.
4022  *
4023  * Parameter:
4024  *  formArray: A pointer to the array to clean up.
4025  *----------------------------------------------------------------------
4026  */
4027 void
4028 curlResetFormArray(struct curl_forms *formArray) {
4029     int        i;
4030
4031     for (i=0;formArray[i].option!=CURLFORM_END;i++) {
4032         switch (formArray[i].option) {
4033             case CURLFORM_COPYNAME:
4034             case CURLFORM_COPYCONTENTS:
4035             case CURLFORM_FILE:
4036             case CURLFORM_CONTENTTYPE:
4037             case CURLFORM_FILENAME:
4038             case CURLFORM_FILECONTENT:
4039             case CURLFORM_BUFFER:
4040             case CURLFORM_BUFFERPTR:
4041                 Tcl_Free((char *)(formArray[i].value));
4042                 break;
4043             default:
4044                 break;
4045         }
4046     }
4047     Tcl_Free((char *)formArray);
4048 }
4049
4050 /*----------------------------------------------------------------------
4051  *
4052  * curlSetBodyVarName --
4053  *
4054  *  After performing a transfer, this function is invoked to set the
4055  *  body of the recieved transfer into a user defined Tcl variable.
4056  *
4057  * Parameter:
4058  *  interp: The Tcl interpreter we are using.
4059  *  curlData: A pointer to the struct with the transfer data.
4060  *----------------------------------------------------------------------
4061  */
4062 void
4063 curlSetBodyVarName(Tcl_Interp *interp,struct curlObjData *curlDataPtr) {
4064     Tcl_Obj    *bodyVarNameObjPtr, *bodyVarObjPtr;
4065
4066     bodyVarNameObjPtr=Tcl_NewStringObj(curlDataPtr->bodyVarName,-1);
4067     bodyVarObjPtr=Tcl_NewByteArrayObj((unsigned char *)curlDataPtr->bodyVar.memory,
4068             curlDataPtr->bodyVar.size);
4069
4070     Tcl_ObjSetVar2(interp,bodyVarNameObjPtr,(Tcl_Obj *)NULL,bodyVarObjPtr,0);
4071
4072     Tcl_Free(curlDataPtr->bodyVar.memory);
4073     curlDataPtr->bodyVar.memory=NULL;
4074     curlDataPtr->bodyVar.size=0;
4075 }
4076
4077 /*----------------------------------------------------------------------
4078  *
4079  * curlstrdup --
4080  *   The same as strdup, but won't seg fault if the string to copy is NULL.
4081  *
4082  * Parameter:
4083  *   old: The original one.
4084  *
4085  * Results:
4086  *   Returns a pointer to the new string.
4087  *----------------------------------------------------------------------
4088  */
4089 char
4090 *curlstrdup (char *old) {
4091     char    *tmpPtr;
4092
4093     if (old==NULL) {
4094         return NULL;
4095     }
4096     tmpPtr=Tcl_Alloc(strlen(old)+1);
4097     strcpy(tmpPtr,old);
4098
4099     return tmpPtr;
4100 }
4101
4102 /*
4103  *----------------------------------------------------------------------
4104  *
4105  * curlShareInitObjCmd --
4106  *
4107  *  Looks for the first free share handle (scurl1, scurl2,...) and
4108  *  creates a Tcl command for it.
4109  *
4110  * Results:
4111  *  A string with the name of the handle, don't forget to free it.
4112  *
4113  * Side effects:
4114  *  See the user documentation.
4115  *
4116  *----------------------------------------------------------------------
4117  */
4118
4119 char *
4120 curlCreateShareObjCmd (Tcl_Interp *interp,struct shcurlObjData  *shcurlData) {
4121     char                *shandleName;
4122     int                 i;
4123     Tcl_CmdInfo         info;
4124     Tcl_Command         cmdToken;
4125
4126     /* We try with scurl1, if it already exists with scurl2...*/
4127     shandleName=(char *)Tcl_Alloc(10);
4128     for (i=1;;i++) {
4129         sprintf(shandleName,"scurl%d",i);
4130         if (!Tcl_GetCommandInfo(interp,shandleName,&info)) {
4131             cmdToken=Tcl_CreateObjCommand(interp,shandleName,curlShareObjCmd,
4132                                 (ClientData)shcurlData,
4133                                 (Tcl_CmdDeleteProc *)curlCleanUpShareCmd);
4134             break;
4135         }
4136     }
4137     shcurlData->token=cmdToken;
4138
4139     return shandleName;
4140 }
4141
4142 /*
4143  *----------------------------------------------------------------------
4144  *
4145  * curlShareInitObjCmd --
4146  *
4147  *  This procedure is invoked to process the "curl::shareinit" Tcl command.
4148  *  See the user documentation for details on what it does.
4149  *
4150  * Results:
4151  *  A standard Tcl result.
4152  *
4153  * Side effects:
4154  *  See the user documentation.
4155  *
4156  *----------------------------------------------------------------------
4157  */
4158
4159 int
4160 curlShareInitObjCmd (ClientData clientData, Tcl_Interp *interp,
4161         int objc,Tcl_Obj *CONST objv[]) {
4162
4163     Tcl_Obj               *resultPtr;
4164     CURL                  *shcurlHandle;
4165     struct shcurlObjData  *shcurlData;
4166     char                  *shandleName;
4167
4168     shcurlData=(struct shcurlObjData *)Tcl_Alloc(sizeof(struct shcurlObjData));
4169     if (shcurlData==NULL) {
4170         resultPtr=Tcl_NewStringObj("Couldn't allocate memory",-1);
4171         Tcl_SetObjResult(interp,resultPtr);
4172         return TCL_ERROR;
4173     }
4174
4175     memset(shcurlData, 0, sizeof(struct shcurlObjData));
4176
4177     shcurlHandle=curl_share_init();
4178     if (shcurlHandle==NULL) {
4179         resultPtr=Tcl_NewStringObj("Couldn't create share handle",-1);
4180         Tcl_SetObjResult(interp,resultPtr);
4181         return TCL_ERROR;
4182     }
4183
4184     shandleName=curlCreateShareObjCmd(interp,shcurlData);
4185
4186     shcurlData->shandle=shcurlHandle;
4187
4188     resultPtr=Tcl_NewStringObj(shandleName,-1);
4189     Tcl_SetObjResult(interp,resultPtr);
4190     Tcl_Free(shandleName);
4191
4192 #ifdef TCL_THREADS
4193     curl_share_setopt(shcurlHandle, CURLSHOPT_LOCKFUNC, curlShareLockFunc);
4194     curl_share_setopt(shcurlHandle, CURLSHOPT_LOCKFUNC, curlShareUnLockFunc);
4195 #endif
4196
4197     return TCL_OK;
4198 }
4199
4200 #ifdef TCL_THREADS
4201 /*
4202  *----------------------------------------------------------------------
4203  *
4204  * curlShareLockFunc --
4205  *
4206  *  This will be the function invoked by libcurl when it wants to lock
4207  *  some data for the share interface.
4208  *
4209  * Side effects:
4210  *  See the user documentation.
4211  *
4212  *----------------------------------------------------------------------
4213  */
4214
4215 void
4216 curlShareLockFunc (CURL *handle, curl_lock_data data, curl_lock_access access
4217         , void *userptr) {
4218
4219     switch(data) {
4220         CURL_LOCK_DATA_COOKIE:
4221             Tcl_MutexLock(&cookieLock);
4222             break;
4223         CURL_LOCK_DATA_DNS:
4224             Tcl_MutexLock(&dnsLock);
4225             break;
4226         CURL_LOCK_DATA_SSL_SESSION:
4227             Tcl_MutexLock(&sslLock);
4228             break;
4229         CURL_LOCK_DATA_CONNECT:
4230             Tcl_MutexLock(&connectLock);
4231             break;
4232         default:
4233             /* Prevent useless compile warnings */
4234             break;
4235     }
4236 }
4237
4238 /*
4239  *----------------------------------------------------------------------
4240  *
4241  * curlShareUnLockFunc --
4242  *
4243  *  This will be the function invoked by libcurl when it wants to unlock
4244  *  the previously locked data.
4245  *
4246  * Side effects:
4247  *  See the user documentation.
4248  *
4249  *----------------------------------------------------------------------
4250  */
4251 void
4252 curlShareUnLockFunc(CURL *handle, curl_lock_data data, void *userptr) {
4253
4254     switch(data) {
4255         CURL_LOCK_DATA_COOKIE:
4256             Tcl_MutexUnlock(&cookieLock);
4257             break;
4258         CURL_LOCK_DATA_DNS:
4259             Tcl_MutexUnlock(&dnsLock);
4260             break;
4261         CURL_LOCK_DATA_SSL_SESSION:
4262             Tcl_MutexUnlock(&sslLock);
4263             break;
4264         CURL_LOCK_DATA_CONNECT:
4265             Tcl_MutexUnlock(&connectLock);
4266             break;
4267         default:
4268             break;
4269     }
4270 }
4271
4272 #endif
4273
4274 /*
4275  *----------------------------------------------------------------------
4276  *
4277  * curlShareObjCmd --
4278  *
4279  *   This procedure is invoked to process the "share curl" commands.
4280  *   See the user documentation for details on what it does.
4281  *
4282  * Results:
4283  *   A standard Tcl result.
4284  *
4285  * Side effects:
4286  *   See the user documentation.
4287  *
4288  *----------------------------------------------------------------------
4289  */
4290 int
4291 curlShareObjCmd (ClientData clientData, Tcl_Interp *interp,
4292     int objc,Tcl_Obj *CONST objv[]) {
4293
4294     struct shcurlObjData     *shcurlData=(struct shcurlObjData *)clientData;
4295     CURLSH                   *shcurlHandle=shcurlData->shandle;
4296     int                       tableIndex, dataIndex;
4297     int                       dataToLock=0;
4298
4299     if (objc<2) {
4300         Tcl_WrongNumArgs(interp,1,objv,"option arg ?arg?");
4301         return TCL_ERROR;
4302     }
4303
4304     if (Tcl_GetIndexFromObj(interp, objv[1], shareCmd, "option",TCL_EXACT,&tableIndex)==TCL_ERROR) {
4305         return TCL_ERROR;
4306     }
4307
4308     switch(tableIndex) {
4309         case 0:
4310         case 1:
4311             if (Tcl_GetIndexFromObj(interp, objv[2], lockData,
4312                 "data to lock ",TCL_EXACT,&dataIndex)==TCL_ERROR) {
4313                 return TCL_ERROR;
4314             }
4315             switch(dataIndex) {
4316                 case 0:
4317                     dataToLock=CURL_LOCK_DATA_COOKIE;
4318                     break;
4319                 case 1:
4320                     dataToLock=CURL_LOCK_DATA_DNS;
4321                     break;
4322             }
4323             if (tableIndex==0) {
4324                 curl_share_setopt(shcurlHandle, CURLSHOPT_SHARE,   dataToLock);
4325             } else {
4326                 curl_share_setopt(shcurlHandle, CURLSHOPT_UNSHARE, dataToLock);
4327             }
4328             break;
4329         case 2:
4330             Tcl_DeleteCommandFromToken(interp,shcurlData->token);
4331             break;
4332     }
4333     return TCL_OK;
4334 }
4335
4336 /*
4337  *----------------------------------------------------------------------
4338  *
4339  * curlCleanUpShareCmd --
4340  *
4341  *   This procedure is invoked when curl share handle is deleted.
4342  *
4343  * Results:
4344  *   A standard Tcl result.
4345  *
4346  * Side effects:
4347  *   Cleans the curl share handle and frees the memory.
4348  *
4349  *----------------------------------------------------------------------
4350  */
4351 int
4352 curlCleanUpShareCmd(ClientData clientData) {
4353     struct shcurlObjData     *shcurlData=(struct shcurlObjData *)clientData;
4354     CURLSH                   *shcurlHandle=shcurlData->shandle;
4355
4356     curl_share_cleanup(shcurlHandle);
4357     Tcl_Free((char *)shcurlData);
4358
4359     return TCL_OK;
4360 }
4361
4362 /*
4363  *----------------------------------------------------------------------
4364  *
4365  * curlErrorStrings --
4366  *
4367  *  All the commands to return the error string from the error code have
4368  *  this function in common.
4369  *
4370  * Results:
4371  *  '0': All went well.
4372  *  '1': The error code didn't make sense.
4373  *----------------------------------------------------------------------
4374  */
4375 int
4376 curlErrorStrings (Tcl_Interp *interp, Tcl_Obj *CONST objv,int type) {
4377
4378     Tcl_Obj               *resultPtr;
4379     int                    errorCode;
4380     char                   errorMsg[500];
4381
4382     if (Tcl_GetIntFromObj(interp,objv,&errorCode)) {
4383         snprintf(errorMsg,500,"Invalid error code: %s",Tcl_GetString(objv));
4384         resultPtr=Tcl_NewStringObj(errorMsg,-1);
4385         Tcl_SetObjResult(interp,resultPtr);
4386         return 1;
4387     }
4388     switch(type) {
4389         case 0:
4390             resultPtr=Tcl_NewStringObj(curl_easy_strerror(errorCode),-1);
4391             break;
4392         case 1:
4393             resultPtr=Tcl_NewStringObj(curl_share_strerror(errorCode),-1);
4394             break;
4395         case 2:
4396             resultPtr=Tcl_NewStringObj(curl_multi_strerror(errorCode),-1);
4397             break;
4398         default:
4399             resultPtr=Tcl_NewStringObj("You're kidding,right?",-1);
4400     }
4401     Tcl_SetObjResult(interp,resultPtr);
4402
4403     return 0;
4404 }
4405
4406 /*
4407  *----------------------------------------------------------------------
4408  *
4409  * curlEasyStringError --
4410  *
4411  *  This function is invoked to process the "curl::easystrerror" Tcl command.
4412  *  It will return a string with an explanation of the error code given.
4413  *
4414  * Results:
4415  *  A standard Tcl result.
4416  *
4417  * Side effects:
4418  *  The interpreter will contain as a result the string with the error
4419  *  message.
4420  *
4421  *----------------------------------------------------------------------
4422  */
4423 int
4424 curlEasyStringError (ClientData clientData, Tcl_Interp *interp,
4425         int objc,Tcl_Obj *CONST objv[]) {
4426
4427     if (objc<2) {
4428         Tcl_WrongNumArgs(interp,1,objv,"errorCode");
4429         return TCL_ERROR;
4430     }
4431
4432     if (curlErrorStrings(interp,objv[1],0)) {
4433         return TCL_ERROR;
4434     }
4435     return TCL_OK;
4436 }
4437
4438 /*
4439  *----------------------------------------------------------------------
4440  *
4441  * curlShareStringError --
4442  *
4443  *  This function is invoked to process the "curl::sharestrerror" Tcl command.
4444  *  It will return a string with an explanation of the error code given.
4445  *
4446  * Results:
4447  *  A standard Tcl result.
4448  *
4449  * Side effects:
4450  *  The interpreter will contain as a result the string with the error
4451  *  message.
4452  *
4453  *----------------------------------------------------------------------
4454  */
4455 int
4456 curlShareStringError (ClientData clientData, Tcl_Interp *interp,
4457         int objc,Tcl_Obj *CONST objv[]) {
4458
4459     if (objc<2) {
4460         Tcl_WrongNumArgs(interp,1,objv,"errorCode");
4461         return TCL_ERROR;
4462     }
4463
4464     if (curlErrorStrings(interp,objv[1],1)) {
4465         return TCL_ERROR;
4466     }
4467     return TCL_OK;
4468 }
4469
4470 /*
4471  *----------------------------------------------------------------------
4472  *
4473  * curlMultiStringError --
4474  *
4475  *  This function is invoked to process the "curl::multirerror" Tcl command.
4476  *  It will return a string with an explanation of the error code given.
4477  *
4478  * Results:
4479  *  A standard Tcl result.
4480  *
4481  * Side effects:
4482  *  The interpreter will contain as a result the string with the error
4483  *  message.
4484  *
4485  *----------------------------------------------------------------------
4486  */
4487 int
4488 curlMultiStringError (ClientData clientData, Tcl_Interp *interp,
4489         int objc,Tcl_Obj *CONST objv[]) {
4490
4491     if (objc<2) {
4492         Tcl_WrongNumArgs(interp,1,objv,"errorCode");
4493         return TCL_ERROR;
4494     }
4495
4496     if (curlErrorStrings(interp,objv[1],2)) {
4497         return TCL_ERROR;
4498     }
4499     return TCL_OK;
4500 }