tclcurl 7.22.0-1 / usr / lib / tcltk / TclCurl7.22.0 / tclcurl.tcl

This file is indexed.

/usr/lib/tcltk/TclCurl7.22.0/tclcurl.tcl is in tclcurl 7.22.0-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below. 

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
################################################################################
################################################################################
####                                  tclcurl.tcl
################################################################################
################################################################################
## Includes the tcl part of TclCurl
################################################################################
################################################################################
## (c) 2001-2011 Andres Garcia Garcia. fandom@telefonica.net
## See the file "license.terms" for information on usage and redistribution
## of this file and for a DISCLAIMER OF ALL WARRANTIES.
################################################################################
################################################################################

package provide TclCurl 7.22.0

namespace eval curl {

################################################################################
# configure
#    Invokes the 'curl-config' script to be able to know what features have
#    been compiled in the installed version of libcurl.
#    Possible options are '-prefix', '-feature' and 'vernum'
################################################################################
proc ::curl::curlConfig {option} {

    if {$::tcl_platform(platform)=="windows"} {
        error "This command is not available in Windows"
    }

    switch -exact -- $option {
        -prefix {
            return [exec curl-config --prefix]
        }
        -feature {
            set featureList [exec curl-config --feature]
            regsub -all {\\n} $featureList { } featureList
            return $featureList
        }
        -vernum {
            return [exec curl-config --vernum]
        }
        -ca {
            return [exec curl-config --ca]
        }
        default {
            error "bad option '$option': must be '-prefix', '-feature', '-vernum' or '-ca'"
        }
    }
    return
}

################################################################################
# transfer
#    The transfer command is used for simple transfers in which you don't
#    want to request more than one file.
#
# Parameters:
#    Use the same parameters you would use in the 'configure' command to
#    configure the download and the same as in 'getinfo' with a 'info'
#    prefix to get info about the transfer.
################################################################################
proc ::curl::transfer {args} {
    variable getInfo
    variable curlBodyVar

    set i 0
    set newArgs ""
    catch {unset getInfo}

    if {[llength $args]==0} {
        puts "No transfer configured"
        return
    }

    foreach {option value} $args {
        set noPassOption 0
        set block        1
        switch -regexp -- $option {
            -info.* {
                set noPassOption 1
                regsub -- {-info} $option {} option
                set getInfo($option) $value
            }
            -block {
                set noPassOption 1
                set block $value
            }
            -bodyvar {
                upvar $value curlBodyVar
                set    value curlBodyVar
            }
            -headervar {
                upvar $value curlHeaderVar
                set    value curlHeaderVar
            }
            -errorbuffer {
                upvar $value curlErrorVar
                set    value curlErrorVar
            }
        }
        if {$noPassOption==0} {
            lappend newArgs $option $value
        }
    }

    if {[catch {::curl::init} curlHandle]} {
        error "Could not init a curl session: $curlHandle"
    }

    if {[catch {eval $curlHandle configure $newArgs} result]} {
        $curlHandle  cleanup
        error $result
    }

    if {$block==1} {
        if {[catch {$curlHandle perform} result]} {
           $curlHandle cleanup
           error $result
        }
        if {[info exists getInfo]} {
            foreach {option var} [array get getInfo] {
                upvar $var info
                set info [eval $curlHandle getinfo $option]
            }
        }
        if {[catch {$curlHandle cleanup} result]} {
            error $result
        }
    } else {
        # We create a multiHandle
        set multiHandle [curl::multiinit]

        # We add the easy handle to the multi handle.
        $multiHandle addhandle $curlHandle

        # So now we create the event source passing the multiHandle as a parameter.
        curl::createEventSource $multiHandle

        # And we return, it is non blocking after all.
    }
    return 0
}

}

APT Browse - Built by Thomas Orozco.