{ $subsection <file-reader> }
{ $subsection <file-writer> }
{ $subsection <file-appender> }
+ "Utility combinators:"
{ $subsection with-file-reader }
{ $subsection with-file-writer }
-{ $subsection with-file-appender } ;
+{ $subsection with-file-appender }
+{ $subsection file-contents }
- { $subsection file-lines }
++{ $subsection file-lines } ;
+
+ ARTICLE: "pathnames" "Pathname manipulation"
"Pathname manipulation:"
{ $subsection parent-directory }
{ $subsection file-name }
{ $subsection directory? }
{ $subsection file-length }
{ $subsection file-modified }
- { $subsection stat }
- "Directory listing:"
- { $subsection directory }
- "File management:"
+ { $subsection stat } ;
+
+ ARTICLE: "delete-move-copy" "Deleting, moving, copying files"
+ "Operations for deleting and copying files come in two forms:"
+ { $list
+ { "Words named " { $snippet { $emphasis "operation" } "-file" } " which work on regular files only." }
+ { "Words named " { $snippet { $emphasis "operation" } "-tree" } " works on directory trees recursively, and also accepts regular files." }
+ }
+ "The operations for moving and copying files come in three flavors:"
+ { $list
+ { "A word named " { $snippet { $emphasis "operation" } } " which takes a source and destination path." }
+ { "A word named " { $snippet { $emphasis "operation" } "-to" } " which takes a source path and destination directory. The destination file will be stored in the destination directory and will have the same file name as the source path." }
+ { "A word named " { $snippet { $emphasis "operation" } "s-to" } " which takes a sequence of source paths and destination directory." }
+ }
+ "Since both of the above lists apply to copying files, that this means that there are a total of six variations on copying a file."
+ $nl
+ "Deleting files:"
{ $subsection delete-file }
- { $subsection make-directory }
{ $subsection delete-directory }
- "Current and home directories:"
- { $subsection home }
- { $subsection cwd }
- { $subsection cd }
- "Pathnames relative to the Factor install directory:"
- { $subsection resource-path }
- { $subsection ?resource-path }
- "Pathname presentations:"
- { $subsection pathname }
- { $subsection <pathname> }
+ { $subsection delete-tree }
+ "Moving files:"
+ { $subsection move-file }
+ { $subsection move-file-to }
+ { $subsection move-files-to }
+ "Copying files:"
+ { $subsection copy-file }
+ { $subsection copy-file-to }
+ { $subsection copy-files-to }
+ "Copying directory trees recursively:"
+ { $subsection copy-tree }
+ { $subsection copy-tree-to }
+ { $subsection copy-trees-to }
+ "On most operating systems, files can only be moved within the same file system. To move files between file systems, use " { $link copy-file } " followed by " { $link delete-file } " on the old name." ;
+
+ ARTICLE: "io.files" "Basic file operations"
+ "The " { $vocab-link "io.files" } " vocabulary provides basic support for working with files."
+ { $subsection "pathnames" }
+ { $subsection "file-streams" }
+ { $subsection "fs-meta" }
+ { $subsection "directories" }
+ { $subsection "delete-move-copy" }
+ { $subsection "unique" }
{ $see-also "os" } ;
- ABOUT: "file-streams"
+ ABOUT: "io.files"
+
+ HELP: path-separator?
+ { $values { "ch" "a code point" } { "?" "a boolean" } }
+ { $description "Tests if the code point is a platform-specific path separator." }
+ { $examples
+ "On Unix:"
+ { $example "USING: io.files prettyprint ;" "CHAR: / path-separator? ." "t" }
+ } ;
+
+ HELP: parent-directory
+ { $values { "path" "a pathname string" } { "parent" "a pathname string" } }
+ { $description "Strips the last component off a pathname." }
+ { $examples { $example "USE: io.files" "\"/etc/passwd\" parent-directory print" "/etc/" } } ;
+
+ HELP: file-name
+ { $values { "path" "a pathname string" } { "string" string } }
+ { $description "Outputs the last component of a pathname string." }
+ { $examples
+ { "\"/usr/bin/gcc\" file-name ." "\"gcc\"" }
+ { "\"/usr/libexec/awk/\" file-name ." "\"awk\"" }
+ } ;
HELP: <file-reader>
-{ $values { "path" "a pathname string" } { "stream" "an input stream" } }
-{ $description "Outputs an input stream for reading from the specified pathname." }
+{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptors" }
+ { "stream" "an input stream" } }
+{ $description "Outputs an input stream for reading from the specified pathname using the given encoding." }
{ $errors "Throws an error if the file is unreadable." } ;
HELP: <file-writer>
[ "awk" ] [ "/usr/libexec/awk///" file-name ] unit-test
[ ] [
- "test-foo.txt" resource-path ascii [
- "test-foo.txt" temp-file [
++ "test-foo.txt" temp-file ascii [
"Hello world." print
] with-file-writer
] unit-test
[ ] [
- "test-foo.txt" resource-path ascii [
- "test-foo.txt" temp-file <file-appender> [
++ "test-foo.txt" temp-file ascii [
"Hello appender." print
- ] with-stream
+ ] with-file-appender
] unit-test
[ ] [
- "test-bar.txt" resource-path ascii [
- "test-bar.txt" temp-file <file-appender> [
++ "test-bar.txt" temp-file ascii [
"Hello appender." print
- ] with-stream
+ ] with-file-appender
] unit-test
[ "Hello world.\nHello appender.\n" ] [
- "test-foo.txt" resource-path ascii file-contents
- "test-foo.txt" temp-file file-contents
++ "test-foo.txt" temp-file ascii file-contents
] unit-test
[ "Hello appender.\n" ] [
- "test-bar.txt" resource-path ascii file-contents
- "test-bar.txt" temp-file file-contents
++ "test-bar.txt" temp-file ascii file-contents
] unit-test
- [ ] [ "test-foo.txt" resource-path delete-file ] unit-test
+ [ ] [ "test-foo.txt" temp-file delete-file ] unit-test
- [ ] [ "test-bar.txt" resource-path delete-file ] unit-test
+ [ ] [ "test-bar.txt" temp-file delete-file ] unit-test
- [ f ] [ "test-foo.txt" resource-path exists? ] unit-test
+ [ f ] [ "test-foo.txt" temp-file exists? ] unit-test
- [ f ] [ "test-bar.txt" resource-path exists? ] unit-test
+ [ f ] [ "test-bar.txt" temp-file exists? ] unit-test
- [ ] [ "test-blah" resource-path make-directory ] unit-test
+ [ ] [ "test-blah" temp-file make-directory ] unit-test
[ ] [
- "test-blah/fooz" resource-path ascii <file-writer> dispose
- "test-blah/fooz" temp-file <file-writer> dispose
++ "test-blah/fooz" temp-file ascii <file-writer> dispose
] unit-test
[ t ] [
- "test-blah/fooz" resource-path exists?
+ "test-blah/fooz" temp-file exists?
] unit-test
- [ ] [ "test-blah/fooz" resource-path delete-file ] unit-test
+ [ ] [ "test-blah/fooz" temp-file delete-file ] unit-test
- [ ] [ "test-blah" resource-path delete-directory ] unit-test
+ [ ] [ "test-blah" temp-file delete-directory ] unit-test
- [ f ] [ "test-blah" resource-path exists? ] unit-test
+ [ f ] [ "test-blah" temp-file exists? ] unit-test
- [ ] [ "test-quux.txt" resource-path ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
-[ ] [ "test-quux.txt" temp-file [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
++[ ] [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
- [ ] [ "test-quux.txt" resource-path delete-file ] unit-test
+ [ ] [ "test-quux.txt" temp-file delete-file ] unit-test
- [ ] [ "test-quux.txt" resource-path ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
-[ ] [ "test-quux.txt" temp-file [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
++[ ] [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
- [ ] [ "test-quux.txt" "quux-test.txt" [ resource-path ] 2apply rename-file ] unit-test
- [ t ] [ "quux-test.txt" resource-path exists? ] unit-test
+ [ ] [ "test-quux.txt" "quux-test.txt" [ temp-file ] 2apply move-file ] unit-test
+ [ t ] [ "quux-test.txt" temp-file exists? ] unit-test
- [ ] [ "quux-test.txt" resource-path delete-file ] unit-test
+ [ ] [ "quux-test.txt" temp-file delete-file ] unit-test
+ [ ] [ "delete-tree-test/a/b/c" temp-file make-directories ] unit-test
+
+ [ ] [
+ "delete-tree-test/a/b/c/d" temp-file
+ [ "Hi" print ] with-file-writer
+ ] unit-test
+
+ [ ] [
+ "delete-tree-test" temp-file delete-tree
+ ] unit-test
+
+ [ ] [
+ "copy-tree-test/a/b/c" temp-file make-directories
+ ] unit-test
+
+ [ ] [
+ "copy-tree-test/a/b/c/d" temp-file
+ [ "Foobar" write ] with-file-writer
+ ] unit-test
+
+ [ ] [
+ "copy-tree-test" temp-file
+ "copy-destination" temp-file copy-tree
+ ] unit-test
+
+ [ "Foobar" ] [
+ "copy-destination/a/b/c/d" temp-file file-contents
+ ] unit-test
+
+ [ ] [
+ "copy-destination" temp-file delete-tree
+ ] unit-test
+
+ [ ] [
+ "copy-tree-test" temp-file
+ "copy-destination" temp-file copy-tree-to
+ ] unit-test
+
+ [ "Foobar" ] [
+ "copy-destination/copy-tree-test/a/b/c/d" temp-file file-contents
+ ] unit-test
+
+ [ ] [
+ "copy-destination/copy-tree-test/a/b/c/d" temp-file "" temp-file copy-file-to
+ ] unit-test
+
+ [ "Foobar" ] [
+ "d" temp-file file-contents
+ ] unit-test
+
+ [ ] [ "d" temp-file delete-file ] unit-test
+
+ [ ] [ "copy-destination" temp-file delete-tree ] unit-test
+
+ [ ] [ "copy-tree-test" temp-file delete-tree ] unit-test
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2008 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
- IN: io.files
USING: io.backend io.files.private io hashtables kernel math
memory namespaces sequences strings assocs arrays definitions
-system combinators splitting sbufs continuations ;
-
+system combinators splitting sbufs continuations io.encodings
+io.encodings.binary ;
+ IN: io.files
+HOOK: cd io-backend ( path -- )
+
+HOOK: cwd io-backend ( -- path )
+
+HOOK: (file-reader) io-backend ( path -- stream )
+
+HOOK: (file-writer) io-backend ( path -- stream )
+
+HOOK: (file-appender) io-backend ( path -- stream )
+
+: <file-reader> ( path encoding -- stream )
+ swap (file-reader) swap <decoder> ;
+
+: <file-writer> ( path encoding -- stream )
+ swap (file-writer) swap <encoder> ;
+
+: <file-appender> ( path encoding -- stream )
+ swap (file-appender) swap <encoder> ;
+
+HOOK: delete-file io-backend ( path -- )
+
+HOOK: rename-file io-backend ( from to -- )
+
+HOOK: make-directory io-backend ( path -- )
+
+HOOK: delete-directory io-backend ( path -- )
+
+ ! Pathnames
: path-separator? ( ch -- ? ) windows? "/\\" "/" ? member? ;
- HOOK: root-directory? io-backend ( path -- ? )
-
- M: object root-directory? ( path -- ? ) path-separator? ;
-
: right-trim-separators ( str -- newstr )
[ path-separator? ] right-trim ;
] }
} cond drop ;
+ ! Directory listings
+ : fixup-directory ( path seq -- newseq )
+ [
+ dup string?
+ [ tuck path+ directory? 2array ] [ nip ] if
+ ] with map
+ [ first special-directory? not ] subset ;
+
+ : directory ( path -- seq )
+ normalize-directory dup (directory) fixup-directory ;
+
+ : directory* ( path -- seq )
+ dup directory [ first2 >r path+ r> 2array ] with map ;
+
+ ! Touching files
+ HOOK: touch-file io-backend ( path -- )
+
+ ! Deleting files
+ HOOK: delete-file io-backend ( path -- )
+
+ HOOK: delete-directory io-backend ( path -- )
+
+ : (delete-tree) ( path dir? -- )
+ [
+ dup directory* [ (delete-tree) ] assoc-each
+ delete-directory
+ ] [ delete-file ] if ;
+
+ : delete-tree ( path -- )
+ dup directory? (delete-tree) ;
+
+ : to-directory over file-name path+ ;
+
+ ! Moving and renaming files
+ HOOK: move-file io-backend ( from to -- )
+
+ : move-file-to ( from to -- )
+ to-directory move-file ;
+
+ : move-files-to ( files to -- )
+ [ move-file-to ] curry each ;
+
+ ! Copying files
HOOK: copy-file io-backend ( from to -- )
- : copy-directory ( from to -- )
- dup make-directories
- >r dup directory swap r> [
- >r >r first r> over path+ r> rot path+ copy-file
- ] 2curry each ;
+M: object copy-file
+ dup parent-directory make-directories
+ binary <file-writer> [
+ swap binary <file-reader> [
+ swap stream-copy
+ ] with-disposal
+ ] with-disposal ;
+
+ : copy-file-to ( from to -- )
+ to-directory copy-file ;
- : home ( -- dir )
- {
- { [ winnt? ] [ "USERPROFILE" os-env ] }
- { [ wince? ] [ "" resource-path ] }
- { [ unix? ] [ "HOME" os-env ] }
- } cond ;
+ : copy-files-to ( files to -- )
+ [ copy-file-to ] curry each ;
+
+ DEFER: copy-tree-to
+
+ : copy-tree ( from to -- )
+ over directory? [
+ >r dup directory swap r> [
+ >r swap first path+ r> copy-tree-to
+ ] 2curry each
+ ] [
+ copy-file
+ ] if ;
+ : copy-tree-to ( from to -- )
+ to-directory copy-tree ;
+
+ : copy-trees-to ( files to -- )
+ [ copy-tree-to ] curry each ;
+
+ ! Special paths
+ : resource-path ( path -- newpath )
+ \ resource-path get [ image parent-directory ] unless*
+ swap path+ ;
+
+ : ?resource-path ( path -- newpath )
+ "resource:" ?head [ resource-path ] when ;
+
+ : resource-exists? ( path -- ? )
+ ?resource-path exists? ;
+
+ : temp-directory ( -- path )
+ "temp" resource-path
+ dup exists? not
+ [ dup make-directory ]
+ when ;
+
+ : temp-file ( name -- path ) temp-directory swap path+ ;
+
+ ! Pathname presentations
TUPLE: pathname string ;
C: <pathname> pathname
: with-file-writer ( path quot -- )
>r <file-writer> r> with-stream ; inline
-: with-file-appender ( path quot -- )
+: with-file-appender ( path encoding quot -- )
>r <file-appender> r> with-stream ; inline
- } cond ;
+: temp-directory ( -- path )
+ "temp" resource-path
+ dup exists? not
+ [ dup make-directory ]
+ when ;
+
+: temp-file ( name -- path ) temp-directory swap path+ ;
++
+ ! Home directory
+ : home ( -- dir )
+ {
+ { [ winnt? ] [ "USERPROFILE" os-env ] }
+ { [ wince? ] [ "" resource-path ] }
+ { [ unix? ] [ "HOME" os-env ] }
++ } cond ;
- USING: io io.files math math.parser kernel prettyprint io.encodings.ascii ;
+ USING: io io.files math math.parser kernel prettyprint
-benchmark.random ;
++benchmark.random io.encodings.ascii ;
IN: benchmark.sum-file
: sum-file-loop ( n -- n' )
readln [ string>number + sum-file-loop ] when* ;
: sum-file ( file -- )
- [ 0 sum-file-loop ] with-file-reader . ;
+ ascii [ 0 sum-file-loop ] with-file-reader . ;
: sum-file-main ( -- )
- home "sum-file-in.txt" path+ sum-file ;
+ random-numbers-path sum-file ;
MAIN: sum-file-main
: boot-image-names images [ boot-image-name ] map ;
: compute-checksums ( -- )
- "checksums.txt" ascii [
- checksums [
++ checksums ascii [
boot-image-names [ dup write bl file>md5str print ] each
] with-file-writer ;
}
"Read 1024 bytes from a file:"
{ $code
- "\"data.bin\" [ 1024 read ] with-file-reader"
+ "\"data.bin\" binary [ 1024 read ] with-file-reader"
}
- "Convert a file of 4-byte cells from little to big endian or vice versa, by directly mapping it into memory:"
+ "Convert a file of 4-byte cells from little to big endian or vice versa, by directly mapping it into memory and operating on it with sequence words:"
{ $code
"\"mydata.dat\" dup file-length ["
" 4 <sliced-groups> [ reverse-here ] change-each"
"quiet" on
parser-notes off
templating-vocab use+
- dup source-file file set ! so that reload works properly
- [
- ?resource-path utf8 file-contents
- [ eval-template ] [ html-error. drop ] recover
- ] keep
+ ! so that reload works properly
+ dup source-file file set
- dup ?resource-path file-contents
++ dup ?resource-path utf8 file-contents
+ [ eval-template ] [ html-error. drop ] recover
] with-file-vocabs
] assert-depth drop ;
append-flags file-mode open dup io-error
[ dup 0 SEEK_END lseek io-error ] [ ] [ close ] cleanup ;
-M: unix-io <file-appender> ( path -- stream )
+M: unix-io (file-appender) ( path -- stream )
open-append <writer> ;
- M: unix-io rename-file ( from to -- )
+ : touch-mode
+ { O_WRONLY O_APPEND O_CREAT O_EXCL } flags ; foldable
+
+ M: unix-io touch-file ( path -- )
+ touch-mode file-mode open
+ dup 0 < [ err_no EEXIST = [ err_no io-error ] unless ] when
+ close ;
+
+ M: unix-io move-file ( from to -- )
rename io-error ;
M: unix-io delete-file ( path -- )
[ FileArgs-lpNumberOfBytesRet ] keep
FileArgs-lpOverlapped ;
-M: windows-io <file-reader> ( path -- stream )
+M: windows-io (file-reader) ( path -- stream )
open-read <win32-file> <reader> ;
-M: windows-io <file-writer> ( path -- stream )
+M: windows-io (file-writer) ( path -- stream )
open-write <win32-file> <writer> ;
-M: windows-io <file-appender> ( path -- stream )
+M: windows-io (file-appender) ( path -- stream )
open-append <win32-file> <writer> ;
- M: windows-io rename-file ( from to -- )
+ M: windows-io move-file ( from to -- )
[ normalize-pathname ] 2apply MoveFile win32-error=0/f ;
M: windows-io delete-file ( path -- )
++<<<<<<< HEAD:extra/logging/server/server.factor
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: namespaces kernel io calendar sequences io.files
+io.sockets continuations prettyprint assocs math.parser
+words debugger math combinators concurrency.messaging
+threads arrays init math.ranges strings io.encodings.utf8 ;
+IN: logging.server
+
+: log-root ( -- string )
+ \ log-root get "logs" resource-path or ;
+
+: log-path ( service -- path )
+ log-root swap path+ ;
+
+: log# ( path n -- path' )
+ number>string ".log" append path+ ;
+
+SYMBOL: log-files
+
+: open-log-stream ( service -- stream )
+ log-path
+ dup make-directories
+ 1 log# utf8 <file-appender> ;
+
+: log-stream ( service -- stream )
+ log-files get [ open-log-stream ] cache ;
+
+: multiline-header 20 CHAR: - <string> ; foldable
+
+: (write-message) ( msg word-name level multi? -- )
+ [
+ "[" write multiline-header write "] " write
+ ] [
+ "[" write now (timestamp>rfc3339) "] " write
+ ] if
+ write bl write ": " write print ;
+
+: write-message ( msg word-name level -- )
+ rot [ empty? not ] subset {
+ { [ dup empty? ] [ 3drop ] }
+ { [ dup length 1 = ] [ first -rot f (write-message) ] }
+ { [ t ] [
+ [ first -rot f (write-message) ] 3keep
+ 1 tail -rot [ t (write-message) ] 2curry each
+ ] }
+ } cond ;
+
+: (log-message) ( msg -- )
+ #! msg: { msg word-name level service }
+ first4 log-stream [ write-message flush ] with-stream* ;
+
+: try-dispose ( stream -- )
+ [ dispose ] curry [ error. ] recover ;
+
+: close-log ( service -- )
+ log-files get delete-at*
+ [ try-dispose ] [ drop ] if ;
+
+: (close-logs) ( -- )
+ log-files get
+ dup values [ try-dispose ] each
+ clear-assoc ;
+
+: keep-logs 10 ;
+
+: ?delete-file ( path -- )
+ dup exists? [ delete-file ] [ drop ] if ;
+
+: delete-oldest keep-logs log# ?delete-file ;
+
+: ?rename-file ( old new -- )
+ over exists? [ rename-file ] [ 2drop ] if ;
+
+: advance-log ( path n -- )
+ [ 1- log# ] 2keep log# ?rename-file ;
+
+: rotate-log ( service -- )
+ dup close-log
+ log-path
+ dup delete-oldest
+ keep-logs 1 [a,b] [ advance-log ] with each ;
+
+: (rotate-logs) ( -- )
+ (close-logs)
+ log-root directory [ drop rotate-log ] assoc-each ;
+
+: log-server-loop ( -- )
+ receive unclip {
+ { "log-message" [ (log-message) ] }
+ { "rotate-logs" [ drop (rotate-logs) ] }
+ { "close-logs" [ drop (close-logs) ] }
+ } case log-server-loop ;
+
+: log-server ( -- )
+ [ [ log-server-loop ] [ error. (close-logs) ] recover t ]
+ "Log server" spawn-server
+ "log-server" set-global ;
+
+[
+ H{ } clone log-files set-global
+ log-server
+] "logging" add-init-hook
++
++USE: multiline
++! Need to resolve this merge conflict
++<"
+ ! Copyright (C) 2008 Slava Pestov.\r
+ ! See http://factorcode.org/license.txt for BSD license.\r
+ USING: namespaces kernel io calendar sequences io.files\r
+ io.sockets continuations prettyprint assocs math.parser\r
+ words debugger math combinators concurrency.messaging\r
+ threads arrays init math.ranges strings calendar.format ;\r
+ IN: logging.server\r
+ \r
+ : log-root ( -- string )\r
+ \ log-root get "logs" resource-path or ;\r
+ \r
+ : log-path ( service -- path )\r
+ log-root swap path+ ;\r
+ \r
+ : log# ( path n -- path' )\r
+ number>string ".log" append path+ ;\r
+ \r
+ SYMBOL: log-files\r
+ \r
+ : open-log-stream ( service -- stream )\r
+ log-path\r
+ dup make-directories\r
+ 1 log# <file-appender> ;\r
+ \r
+ : log-stream ( service -- stream )\r
+ log-files get [ open-log-stream ] cache ;\r
+ \r
+ : multiline-header 20 CHAR: - <string> ; foldable\r
+ \r
+ : (write-message) ( msg word-name level multi? -- )\r
+ [\r
+ "[" write multiline-header write "] " write\r
+ ] [\r
+ "[" write now (timestamp>rfc3339) "] " write\r
+ ] if\r
+ write bl write ": " write print ;\r
+ \r
+ : write-message ( msg word-name level -- )\r
+ rot [ empty? not ] subset {\r
+ { [ dup empty? ] [ 3drop ] }\r
+ { [ dup length 1 = ] [ first -rot f (write-message) ] }\r
+ { [ t ] [\r
+ [ first -rot f (write-message) ] 3keep\r
+ 1 tail -rot [ t (write-message) ] 2curry each\r
+ ] }\r
+ } cond ;\r
+ \r
+ : (log-message) ( msg -- )\r
+ #! msg: { msg word-name level service }\r
+ first4 log-stream [ write-message flush ] with-stream* ;\r
+ \r
+ : try-dispose ( stream -- )\r
+ [ dispose ] curry [ error. ] recover ;\r
+ \r
+ : close-log ( service -- )\r
+ log-files get delete-at*\r
+ [ try-dispose ] [ drop ] if ;\r
+ \r
+ : (close-logs) ( -- )\r
+ log-files get\r
+ dup values [ try-dispose ] each\r
+ clear-assoc ;\r
+ \r
+ : keep-logs 10 ;\r
+ \r
+ : ?delete-file ( path -- )\r
+ dup exists? [ delete-file ] [ drop ] if ;\r
+ \r
+ : delete-oldest keep-logs log# ?delete-file ;\r
+ \r
+ : ?move-file ( old new -- )\r
+ over exists? [ move-file ] [ 2drop ] if ;\r
+ \r
+ : advance-log ( path n -- )\r
+ [ 1- log# ] 2keep log# ?move-file ;\r
+ \r
+ : rotate-log ( service -- )\r
+ dup close-log\r
+ log-path\r
+ dup delete-oldest\r
+ keep-logs 1 [a,b] [ advance-log ] with each ;\r
+ \r
+ : (rotate-logs) ( -- )\r
+ (close-logs)\r
+ log-root directory [ drop rotate-log ] assoc-each ;\r
+ \r
+ : log-server-loop ( -- )\r
+ receive unclip {\r
+ { "log-message" [ (log-message) ] }\r
+ { "rotate-logs" [ drop (rotate-logs) ] }\r
+ { "close-logs" [ drop (close-logs) ] }\r
+ } case log-server-loop ;\r
+ \r
+ : log-server ( -- )\r
+ [ [ log-server-loop ] [ error. (close-logs) ] recover t ]\r
+ "Log server" spawn-server\r
+ "log-server" set-global ;\r
+ \r
+ [\r
+ H{ } clone log-files set-global\r
+ log-server\r
+ ] "logging" add-init-hook\r
++"> drop
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces io io.timeouts kernel logging io.sockets
sequences combinators sequences.lib splitting assocs strings
- math.parser random system calendar io.encodings.ascii ;
-math.parser random system calendar calendar.format ;
++math.parser random system calendar io.encodings.ascii calendar.format ;
IN: smtp
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
- USING: io io.files io.launcher kernel namespaces sequences
-USING: io io.files kernel namespaces sequences system
-tools.deploy.backend tools.deploy.config assocs hashtables
-prettyprint cocoa cocoa.application cocoa.classes cocoa.plists ;
++USING: io io.files kernel namespaces sequences
+system tools.deploy.backend tools.deploy.config assocs
+hashtables prettyprint io.unix.backend cocoa io.encodings.utf8
+cocoa.application cocoa.classes cocoa.plists qualified ;
- QUALIFIED: unix
IN: tools.deploy.macosx
- : touch ( path -- )
- { "touch" } swap add try-process ;
-
- : rm ( path -- )
- { "rm" "-rf" } swap add try-process ;
-
: bundle-dir ( -- dir )
vm parent-directory parent-directory ;
! See http://factorcode.org/license.txt for BSD license.
USING: io.files io words alien kernel math.parser alien.syntax
io.launcher system assocs arrays sequences namespaces qualified
-system math generator.fixup ;
+system math generator.fixup io.encodings.ascii ;
IN: tools.disassembler
- : in-file "gdb-in.txt" resource-path ;
+ : in-file "gdb-in.txt" temp-file ;
- : out-file "gdb-out.txt" resource-path ;
+ : out-file "gdb-out.txt" temp-file ;
GENERIC: make-disassemble-cmd ( obj -- )
+closed+ +stdin+ set
out-file +stdout+ set
[ "gdb" , "-x" , in-file , "-batch" , ] { } make +arguments+ set
- ] { } make-assoc run-process drop
+ ] { } make-assoc try-process
- out-file file-lines ;
+ out-file ascii file-lines ;
: tabs>spaces ( str -- str' )
{ { CHAR: \t CHAR: \s } } substitute ;
USING: calendar html io io.files kernel math math.parser
http.server.responders http.server.templating namespaces parser
sequences strings assocs hashtables debugger http.mime sorting
- html.elements logging io.encodings.binary ;
-html.elements logging calendar.format ;
++html.elements logging calendar.format io.encodings.binary ;
IN: webapps.file
SYMBOL: doc-root
--- /dev/null
- :: ioc | inout group num len |
+! Copyright (C) 2007 Elie Chaftari, Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types alien.syntax destructors hexdump io
+io.buffers io.nonblocking io.sockets
+io.unix.backend io.unix.files kernel libc locals math qualified
+sequences io.sniffer.backend ;
+QUALIFIED: unix
+IN: io.sniffer.bsd
+
+M: unix-io destruct-handle ( obj -- ) unix:close drop ;
+
+C-UNION: ifreq_props "sockaddr-in" "short" "int" "caddr_t" ;
+C-STRUCT: ifreq { { "char" 16 } "name" } { "ifreq_props" "props" } ;
+
+TUPLE: sniffer-spec path ifname ;
+
+C: <sniffer-spec> sniffer-spec
+
+: IOCPARM_MASK HEX: 1fff ; inline
+: IOCPARM_MAX IOCPARM_MASK 1+ ; inline
+: IOC_VOID HEX: 20000000 ; inline
+: IOC_OUT HEX: 40000000 ; inline
+: IOC_IN HEX: 80000000 ; inline
+: IOC_INOUT IOC_IN IOC_OUT bitor ; inline
+: IOC_DIRMASK HEX: e0000000 ; inline
+
++:: ioc ( inout group num len -- n )
+ group first 8 shift num bitor
+ len IOCPARM_MASK bitand 16 shift bitor
+ inout bitor ;
+
+: io-len ( type -- n )
+ dup zero? [ heap-size ] unless ;
+
+: io ( group num -- n )
+ IOC_VOID -rot 0 io-len ioc ;
+
+: ior ( group num type -- n )
+ IOC_OUT -roll io-len ioc ;
+
+: iow ( group num type -- n )
+ IOC_IN -roll io-len ioc ;
+
+: iowr ( group num type -- n )
+ IOC_INOUT -roll io-len ioc ;
+
+: BIOCGBLEN ( -- n ) "B" 102 "uint" ior ; inline
+: BIOCSETIF ( -- n ) "B" 108 "ifreq" iow ; inline
+: BIOCPROMISC ( -- n ) "B" 105 io ; inline
+: BIOCIMMEDIATE ( -- n ) "B" 112 "uint" iow ; inline
+
+: make-ifreq-props ( ifname -- ifreq )
+ "ifreq" <c-object>
+ 12 <short> 16 0 pad-right over set-ifreq-props
+ swap malloc-char-string dup free-always
+ over set-ifreq-name ;
+
+: make-ioctl-buffer ( fd -- buffer )
+ BIOCGBLEN "char*" <c-object>
+ [ unix:ioctl io-error ] keep
+ *int <buffer> ;
+
+: ioctl-BIOSETIF ( fd ifreq -- )
+ >r BIOCSETIF r> unix:ioctl io-error ;
+
+: ioctl-BIOPROMISC ( fd -- )
+ BIOCPROMISC f unix:ioctl io-error ;
+
+: ioctl-BIOCIMMEDIATE
+ BIOCIMMEDIATE 1 <int> unix:ioctl io-error ;
+
+: ioctl-sniffer-fd ( fd ifname -- )
+ dupd make-ifreq-props ioctl-BIOSETIF
+ dup ioctl-BIOPROMISC
+ ioctl-BIOCIMMEDIATE ;
+
+M: unix-io <sniffer> ( obj -- sniffer )
+ [
+ [
+ sniffer-spec-path
+ open-read
+ dup close-later
+ ] keep
+ dupd sniffer-spec-ifname ioctl-sniffer-fd
+ dup make-ioctl-buffer
+ input-port <port> <line-reader>
+ \ sniffer construct-delegate
+ ] with-destructors ;
+
projects / factor.git / commitdiff