Version 15 of Simple ftp uploader

Updated 2008-08-22 08:23:07 by tonytraductor

WJG 23/11/05. Having made a photoalbum, PhotoAlbum -A Web Gallery Creation Tool it's time to upload the files to the remote server using ftp.


 package require Tk

 catch { console show }

 # load necessary packages
 package require ftp 
 package require ftp::geturl

 #---------------
 # set appropriate values...
 #---------------
 set host *******
 set user *******
 set pass *******
 set directory /

 #---------------
 # transfer files to server
 #---------------

 proc upload {host user pass dir fileList} {

  set handle [::ftp::Open $host $user $pass]

  # some counters for our feedback string
  set j 1
  set k [llength $fileList]


  foreach i $fileList {
    upload:status "uploading ($j/$k) $i"
    ::ftp::Put $handle $i
    incr j
  }

  ::ftp::Close $handle
 }

 #---------------
 # feedback
 #---------------
 proc upload:status {msg} {
  puts $msg
 }

 #--------------- 
 # create filelist
 #---------------
 set files ""
 foreach i {jpg html css} {
  upload $host $user $pass $directory [glob -nocomplain *.$i]
 }

RLH 2006-Apr-05: Is there a reason Tk is required for this?


Pierre Coueffin 2006-Apr-12: Why does it need the variable "files"?

I'd be tempted to replace:

 if 0 {
  #--------------- 
  # create filelist
  #---------------
  set files ""
  foreach i {jpg html css} {
   upload $host $user $pass $directory [glob -nocomplain *.$i]
  }
 }

with

 if 0 {
  #--------------- 
  # create filelist
  #---------------
  upload $host $user $pass $directory [glob -nocomplain *.jpg *.html *.css]
 }

Unless I'm missing something subtle about how glob works.


thgr 2008-Mar-08: I needed to transfer whole directories:

ftpUpload $myHost $myUser $myPasswd $localDirctory $hostDirectory

 # ftpUpload --
 #
 #       Open ftp session - transfer $local recursively to ftp server - close
 #       ftp session.
 #
 # Arguments:
 #       host     name of ftp server.
 #       user     ftp user name.
 #       passwd   ftp password.
 #       local    name of file or dir.
 #       hostDir  (optional) name of target directory on ftp server.
 #
 # Results:
 #       If $local is a file name the file will be uploaded. If $local is the
 #       name of a local directory, all subdirs and files will be uploaded. 

 proc ftpUpload {host user passwd local {hostDir ""}} {
     set handle [::ftp::Open $host $user $passwd]
     if {$handle < 0} {
         error "Connection refused!"
         return
     }
     ftpGoToDir $handle $hostDir
     foreach l $local {
         recursiveUpload $handle $l $hostDir
     }
     ::ftp::Close $handle
     return
 }

 proc setFtpType {handle fileName} {
     switch -exact -- [file extension $fileName] \
       .txt - .html - .css {::ftp::Type $handle ascii} \
       default {::ftp::Type $handle binary}
 }

 # recursiveUpload --
 #
 #       Recursively transfer directories to ftp server.
 #
 # Arguments:
 #       handle   ftp session handle.
 #       local    name of local file or directory.
 #       hostDir  name of directory on ftp server.
 #
 # Results:
 #       If $local is a file name the file will be uploaded. If $local is the
 #       name of a local directory, all subdirs and files will be uploaded. 

 proc recursiveUpload {handle local hostDir} {
     if {[file isfile $local]} {
         #just a file -> upload
         set fileName [file tail $local]
         setFtpType $handle $fileName
         ::ftp::Put $handle $local [file join $hostDir $fileName]
         return
     } ;# else file is directory -> recursion

     if {![file isdirectory $local]} {return}
     set targetDir [file join $hostDir [file tail $local]]
     ftpGoToDir $handle $targetDir
     # upload regular files of directory
     foreach f [glob -nocomplain -directory $local -type f *] {
         setFtpType $handle [file tail $f]
         ::ftp::Put $handle $f
     }
     # recursion for subdirectories
     foreach d [glob -nocomplain -directory $local -type d *] {
         recursiveUpload $handle $d $targetDir
     }
 }

 # ftpGoToDir --
 #
 #       Change directory on ftp server to given path.
 #
 # Arguments:
 #       handle   ftp session handle.
 #       path     path on ftp server.
 #
 # Results:
 #       Goes to the given path on ftp server. If directories don't exist, they
 #       will be created.

 proc ftpGoToDir {handle path} {
     ::ftp::Cd $handle /
     foreach dir [file split $path] {
         if {![::ftp::Cd $handle $dir]} {
             ::ftp::MkDir $handle $dir
             ::ftp::Cd $handle $dir
         }
     }
 }

tonytraductor - Likely this is extremely inefficient, and there are better ways to do it, but, I wrote one that uploads, and downloads. I don't like my method of listing and finding a remote file to download, but, with my very n00bish skills, it was what I could figure out to make it work. Also, this one will offer the user to open an uploaded file in the browser of their choice (provided it is a file a browser can open, such as .txt, .html, .jpg, etc.), and tells the user where the url is for an uploaded file, and the location of a downloaded file. It was fun...I'll keep learning { #!/usr/bin/env wish8.5

# tclscreen copyright tony baldwin - [email protected]

  # load necessary packages
  package require ftp
  package require Img

#global vars...I'm always getting hollered at for these, but, they're working for me.

global filename global rfile global fname global host global path global username global password global url global dlay global file_types global list global dldir

# File types I most frequently up/download from my server, anyway

set file_types {
{"All Files" * }
{"Text Files" { .txt .TXT}}
{"LaTex" {.tex}}
{"PDF" {.pdf}}
{"Xml" {.xml}}
{"Html" {.html}}
{"CSS" {.css}}
{"Image" {.jpg .jpeg .gif .png}}
{"Zipped" {.gz .zip .rar}}
{"Music" {.ogg .mp3 .wav .wma}}
{"Video" {.mpg .mov .avi .wmv}}
}

wm title . "TickleUP"

# gui

frame .notes

grid ttk::label .notes.lab -text "Server information:"

pack .notes -in . -fill x

frame .fields

grid ttk::label .fields.hq -text "Host:"\ ttk::entry .fields.host -textvariable host\ ttk::label .fields.pathq -text "Directory: "\ ttk::entry .fields.path -textvariable path

grid ttk::label .fields.unam -text "Username: "\ ttk::entry .fields.uname -textvariable username\ ttk::label .fields.pwrd -text "Password: "\ ttk::entry .pswrd -show * -textvariable password

pack .fields -in . -fill x

frame .ubtns

grid ttk::label .ubtns.lbl -text "Uploads:"

grid ttk::button .ubtns.filename -text "Local file" -command grabfile\ ttk::button .ubtns.send -text "Upload" -command {upload} pack .ubtns -in . -fill x

frame .dbtns

grid ttk::label .dbtns.lbl -text "Downloads:"

grid ttk::button .dbtns.dlfilen -text "List" -command {dlist}\ ttk::entry .dbtns.file -textvariable rfile\ ttk::button .dbtns.ddn -text "Download" -command {down}

pack .dbtns -in . -fill x

frame .btns

grid ttk::button .btns.out -text "QUIT" -command {exit}

pack .btns -in . -fill x

# procs

# My really lame, n00bish means of listing the files on the remote server

proc dlist {} {

    set handle [::ftp::Open $::host $::username $::password]
    set list [::ftp::NList $handle $::path]

toplevel .list wm title .list "Remote File List" text .list.l -width 80 -height 40 -wrap word .list.l insert end "$list" .list.l insert end "\n \n Copy the file name you wish to download and paste to the entry field.\n Then click \'download\' and choose the directory where to save it."

pack .list.l -in .list -fill x

}

# dls the file, tells you where it is

proc down {} {

    global dldir
    set dldir [tk_chooseDirectory]
    set handle [::ftp::Open $::host $::username $::password]
    ::ftp::Cd $handle $::path
    ::ftp::Get $handle $::rfile $::dldir/$::rfile
    ::ftp::Close $handle

    toplevel .down
    wm title .down "Success!"
    tk::message .down.loaded -text "Your file has been downloaded to $::dldir/$::rfile"
    tk::button .down.out -text "Okay" -command {destroy .down}
    pack .down.loaded -in .down -side top
    pack .down.out -in .down -side top

}

# uploads the file, tells you where it is, offers to open it in a browser for verification

proc upload {} {

    global fname
   set fname [file tail $::filename]

   set handle [::ftp::Open $::host $::username $::password]

   ::ftp::Cd $handle $::path

   ::ftp::Put $handle $::filename $::fname

   ::ftp::Close $handle

toplevel .url

grid ttk::label .url.lbl -text "Your image is at\n http:://www.$::host/$::path/$::fname" grid ttk::button .url.btn -text "open in browser" -command {browse}\ ttk::button .url.not -text "close" -command {destroy .url}

}

# grabs the local file to upload
# I wish I could use a tk_getOpenFile to grab the remote file
# like this, but, I couldn't get a tk_getOpenFile to open at
# the remote server location, which I tried with
# set $odir ::ftp::Cd $handle $::path
# set filename tk_getOpenFile -filetypes $::file_types -initialdir $odir
# but that didn't work...

proc grabfile {} {

        global filename
        set filename [tk_getOpenFile -filetypes $::file_types]
        wm title . "Now Tickling: $::filename"        

}

#proc to view an uploaded remote file with a browser
# whoopee

proc browse {} {

        set filetypes " "
        tk_messageBox -message "Choose your browser" -type ok -title "Set browser"
        set brow [tk_getOpenFile -filetypes $filetypes]

# I just end up typing in /usr/bin/konqueror or something rather than surf the file system for it

        exec $brow www.$::host/$::path/$::fname &

}

# This program was written by tony baldwin - [email protected]
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

}


Category Internet