Factor : FTP でファイルをアップロードする

以前やった、Common Lisp FTP でファイルをアップロードする を Factor でやってみました。
FTP のモジュールはなさそうだったので、ソケットモジュールを使って実装しました。
ftp-put のあたりぐちゃぐちゃですがなんとか動きました。

#! /usr/bin/env factor

USING: arrays assocs kernel math math.parser namespaces sequences
io io.sockets io.streams.string io.streams.lines io.files strings splitting
continuations system
prettyprint
;
IN: ftp.client


: ftp-check-res* ( line-stream code -- line-stream line )
    over stream-readln
    dup print                   ! for debug
    swap over
    start 0 = [ "error" throw ] unless ;

: ftp-check-res ( line-stream code -- line-stream )
    ftp-check-res*
    drop ;

: ftp-crlf ( line-stream -- line-stream )
    dup "\r\n" swap stream-write
    dup stream-flush ;

: ftp-snd0 ( line-stream cmd -- line-stream )
    over stream-write
    ftp-crlf ;

: ftp-snd1 ( line-stream arg1 cmd -- line-stream )
    pick stream-write
    over stream-write
    ftp-crlf ;

: ftp-connect ( host -- stream )
    21 <inet> <client> <line-reader>
    "220" ftp-check-res ;

: ftp-user ( line-stream user -- line-stream )
    "USER " ftp-snd1
    "331" ftp-check-res ;

: ftp-pass ( line-stream pass -- line-stream )
    "PASS " ftp-snd1
    "230" ftp-check-res ;

: ftp-quit ( line-stream -- line-stream )
    "QUIT" ftp-snd0
    "221" ftp-check-res
    stream-close ;

: ftp-cwd ( line-stream dir -- line-stream )
    "CWD " ftp-snd1
    "250" ftp-check-res ;

: ftp-type ( line-stream type -- line-stream )
    "TYPE " ftp-snd1
    "200" ftp-check-res ;

: ftp-ascii ( line-stream -- line-stream )
    "A" ftp-type ;

: ftp-binary ( line-stream -- line-stream )
    "I" ftp-type ;

: ftp-pasv-parse ( str -- ip port )
    "()," split
    dup 5 swap nth 10 string>integer
    256 *
    over 6 swap nth 10 string>integer
    +
    swap 1 5 rot subseq
    "." join
    swap
    ;

: ftp-pasv ( line-stream -- line-stream inet )
    "PASV" ftp-snd0
    "227" ftp-check-res*
    ftp-pasv-parse
    <inet>
    ;

: ftp-stor ( line-stream file -- line-stream )
    "STOR " ftp-snd1 ;

: ftp-put ( line-stream file -- line-stream )
    swap ftp-pasv               ! file line-stream inet
    -rot over ftp-stor          ! inet file line-stream
    swap <file-reader>          ! inet line-stream file-reader
    rot <client>                ! line-stream file-reader client
    rot "150" ftp-check-res -rot ! line-stream file-reader client
    stream-copy                 ! line-stream
    "226" ftp-check-res         ! line-stream
    ;


cwd cd
"ftp.example.com" ftp-connect
"user" ftp-user
"password" ftp-pass
ftp-binary
"/public_html/factor" ftp-cwd
"cookbook.html" ftp-put
"cookbook.css" ftp-put
ftp-quit

0 exit

あとシェルから起動するために次ようなファイルを factor というファイル名でパスのとおったところに置いておきます。

#!/bin/sh

~/letter/factor/factor/factor -i=$HOME/letter/factor/factor/factor.image $*

これで ./upload.factor でファイルのアップロードができました。