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