1# ftp.tcl - Copyright (C) 2001 Pat Thoyts <patthoyts@users.sourceforge.net>
2#
3# Provide an FTP based transport for the SOAP package.
4#
5# This is somewhat less complete that the HTTP and SMTP transports.
6#
7# e.g.:
8#   SOAP::create purchase \
9#          -proxy ftp://me:passwd@localhost/soapstore/transactions
10#          -action urn:tclsoap:Purchase
11#          -uri urn:tclsoap:Purchase
12#          -params {code string auth string}
13#
14# -------------------------------------------------------------------------
15# This software is distributed in the hope that it will be useful, but
16# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
17# or FITNESS FOR A PARTICULAR PURPOSE.  See the accompanying file `LICENSE'
18# for more details.
19# -------------------------------------------------------------------------
20
21package require SOAP
22package require ftp;                    # tcllib
23
24namespace eval ::SOAP::Transport::ftp {
25    variable version 1.0
26    variable rcsid {$Id: ftp.tcl,v 1.4 2008/02/28 22:05:55 andreas_kupries Exp $}
27    variable options
28
29    ::SOAP::register ftp [namespace current]
30
31    # Initialize the transport options.
32    if {![info exists options]} {
33        array set options {}
34    }
35
36    # Declare the additional SOAP method options provided by this transport.
37    variable method:options [list \
38        username \
39        password \
40    ]
41
42    #proc ::ftp::DisplayMsg {handle msg state} {
43    #    # log
44    #}
45}
46
47# -------------------------------------------------------------------------
48
49# Description:
50#  Implement the additional SOAP method configuration options provide
51#  for this transport.
52# Notes:
53#  username - username to login on (can also be part of the URL)
54#  password - password for server (can also be part of the URL)
55#
56proc ::SOAP::Transport::ftp::method:configure {procVarName opt value} {
57    upvar $procVarName procvar
58    switch -glob -- $opt {
59        -user* {
60            set procvar(username) $value
61        }
62        -pass* {
63            set procvar(password) $value
64        }
65        default {
66            # not reached.
67            return -code error "unknown option \"$opt\""
68        }
69    }
70}
71# -------------------------------------------------------------------------
72
73# Description:
74#   Permit configuration of the FTP transport.
75#
76proc ::SOAP::Transport::ftp::configure {args} {
77    variable options
78
79    if {[llength $args] == 0} {
80        set r {}
81        foreach {opt value} [array get options] {
82            lappend r "-$opt" $value
83        }
84        return $r
85    }
86
87    foreach {opt value} $args {
88        switch -- $opt {
89            default {
90                return -code error "invalid option \"$opt\":\
91                    no transport configuration options"
92            }
93        }
94    }
95    return {}
96}
97
98# -------------------------------------------------------------------------
99
100# Description:
101#   Perform a remote procedure call using FTP as the transport protocol.
102#   This uses the tcllib ftp package to do the work. FTP transports will
103#   be asynchronous in that no answer is available.
104#
105#   We should deal with FTP proxies some time soon. Can the FTP package
106#   handle this?
107#
108# Parameters:
109#   procVarName - the name of the SOAP config array for this method.
110#   url         - the SOAP endpoint URL
111#   request     - the XML data making up the SOAP request
112# Result:
113#   The data payload is uploaded to the server using FTP. No
114#   response is available.
115#
116proc ::SOAP::Transport::ftp::xfer {procVarName url soap} {
117    variable options
118    upvar $procVarName procvar
119
120    set username {} ; set password {}
121
122    if {[info exists procvar(username)]} {
123        set username $procvar(username)
124    }
125    if {[info exists procvar(password)]} {
126        set password $procvar(password)
127    }
128
129    array set URL [uri::split $url]
130
131    if {$URL(user) != {}} { set username $URL(user) }
132    if {$URL(pwd)  != {}} { set password $URL(pwd) }
133
134    set tok [ftp::Open $URL(host) $username $password]
135    set r [ftp::Append $tok -data $soap $URL(path)]
136    ftp::Close $tok
137
138    if {! $r} {
139        return -code error "SOAP transport error: $r"
140    }
141
142    return {}
143}
144
145# -------------------------------------------------------------------------
146
147# Description:
148#  Called to release any retained resources from a SOAP method.
149# Parameters:
150#  methodVarName - the name of the SOAP method configuration array
151#
152#proc ::SOAP::Transport::ftp::method:destroy {methodVarName} {
153#    upvar $methodVarName procvar
154#}
155
156# -------------------------------------------------------------------------
157
158#proc ::SOAP::Transport::ftp::dump {methodName type} {
159#}
160
161# -------------------------------------------------------------------------
162
163package provide SOAP::ftp $::SOAP::Transport::ftp::version
164
165# -------------------------------------------------------------------------
166# Local variables:
167#    mode: tcl
168#    indent-tabs-mode: nil
169# End:
170