basis/ftp/server/server-tests.factor

   1 USING: calendar ftp.server io.encodings.ascii io.files
   2 io.files.unique namespaces threads tools.test kernel
   3 io.servers.connection ftp.client accessors urls
   4 io.pathnames io.directories sequences fry ;
   5 FROM: ftp.client => ftp-get ;
   6 IN: ftp.server.tests
   7
   8 : test-file-contents ( -- string )
   9     "Files are so boring anymore." ;
  10
  11 : create-test-file ( -- path )
  12     test-file-contents
  13     "ftp.server" "test" make-unique-file
  14     [ ascii set-file-contents ] keep canonicalize-path ;
  15
  16 : test-ftp-server ( quot -- )
  17     '[
  18         current-temporary-directory get 0
  19         <ftp-server>
  20         [ start-server* ]
  21         [
  22             sockets>> first addr>> port>>
  23             <url>
  24                 swap >>port
  25                 "ftp" >>protocol
  26                 "localhost" >>host
  27                 create-test-file >>path
  28                 _ call
  29         ]
  30         [ stop-server ] tri
  31     ] with-unique-directory drop ; inline
  32
  33 [ t ]
  34 [
  35
  36     [
  37         unique-directory [
  38             [ ftp-get ] [ path>> file-name ascii file-contents ] bi
  39         ] with-directory
  40     ] test-ftp-server test-file-contents =
  41 ] unit-test
  42
  43 [
  44
  45     [
  46         "/" >>path
  47         unique-directory [
  48             [ ftp-get ] [ path>> file-name ascii file-contents ] bi
  49         ] with-directory
  50     ] test-ftp-server test-file-contents =
  51 ] must-fail