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