From 2741b3739d9e3b797fb1b66e3ca10c42606728d7 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 29 Apr 2009 08:22:35 -0500 Subject: [PATCH 1/5] plug some holes in wav parser --- extra/audio/wav/wav.factor | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/extra/audio/wav/wav.factor b/extra/audio/wav/wav.factor index 6f8ee49395..3f40516abf 100644 --- a/extra/audio/wav/wav.factor +++ b/extra/audio/wav/wav.factor @@ -1,6 +1,6 @@ USING: alien.c-types alien.syntax audio combinators combinators.short-circuit io io.binary io.encodings.binary -io.files io.streams.memory kernel locals sequences ; +io.files io.streams.byte-array kernel locals sequences ; IN: audio.wav CONSTANT: RIFF-MAGIC "RIFF" @@ -16,7 +16,6 @@ C-STRUCT: riff-chunk-header C-STRUCT: riff-chunk { "riff-chunk-header" "header" } { "char[4]" "format" } - { "uchar[0]" "body" } ; C-STRUCT: wav-fmt-chunk @@ -34,8 +33,17 @@ C-STRUCT: wav-data-chunk { "uchar[0]" "body" } ; +ERROR: invalid-wav-file ; + +: ensured-read ( count -- output/f ) + [ read ] keep over length = [ drop f ] unless ; +: ensured-read* ( count -- output ) + ensured-read [ invalid-wav-file ] unless* ; + : read-chunk ( -- byte-array/f ) - 4 read [ 4 read le> [ ] [ read ] bi 3append ] [ f ] if* ; + 4 ensured-read [ 4 ensured-read* dup le> ensured-read* 3append ] [ f ] if* ; +: read-riff-chunk ( -- byte-array/f ) + "riff-chunk" heap-size ensured-read* ; : id= ( chunk id -- ? ) [ 4 memory>byte-array ] dip sequence= ; @@ -49,8 +57,6 @@ C-STRUCT: wav-data-chunk } cond ] while drop fmt data ; -ERROR: invalid-wav-file ; - : verify-wav ( chunk -- ) { [ RIFF-MAGIC id= ] [ riff-chunk-format WAVE-MAGIC id= ] } 1&& [ invalid-wav-file ] unless ; @@ -68,7 +74,5 @@ ERROR: invalid-wav-file ; : read-wav ( filename -- audio ) binary [ - read-chunk - [ verify-wav ] - [ riff-chunk-body [ (read-wav) ] with-input-stream* ] bi + read-riff-chunk verify-wav (read-wav) ] with-file-reader ; From aa3025ce235815c58c2e4aa675921613db6d9c94 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 29 Apr 2009 08:38:01 -0500 Subject: [PATCH 2/5] ensure wav chunks are as big as they ought to be --- extra/audio/wav/wav.factor | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/extra/audio/wav/wav.factor b/extra/audio/wav/wav.factor index 3f40516abf..998752eb3a 100644 --- a/extra/audio/wav/wav.factor +++ b/extra/audio/wav/wav.factor @@ -1,6 +1,7 @@ USING: alien.c-types alien.syntax audio combinators combinators.short-circuit io io.binary io.encodings.binary -io.files io.streams.byte-array kernel locals sequences ; +io.files io.streams.byte-array kernel locals math +sequences ; IN: audio.wav CONSTANT: RIFF-MAGIC "RIFF" @@ -46,19 +47,25 @@ ERROR: invalid-wav-file ; "riff-chunk" heap-size ensured-read* ; : id= ( chunk id -- ? ) - [ 4 memory>byte-array ] dip sequence= ; + [ 4 head ] dip sequence= ; + +: check-chunk ( chunk id min-size -- ? ) + [ id= ] [ [ length ] dip >= ] bi-curry* bi and ; :: read-wav-chunks ( -- fmt data ) f :> fmt! f :> data! [ { [ fmt data and not ] [ read-chunk ] } 0&& dup ] [ { - { [ dup FMT-MAGIC id= ] [ fmt! ] } - { [ dup DATA-MAGIC id= ] [ data! ] } + { [ dup FMT-MAGIC "wav-fmt-chunk" heap-size check-chunk ] [ fmt! ] } + { [ dup DATA-MAGIC "wav-data-chunk" heap-size check-chunk ] [ data! ] } } cond ] while drop fmt data ; : verify-wav ( chunk -- ) - { [ RIFF-MAGIC id= ] [ riff-chunk-format WAVE-MAGIC id= ] } 1&& + { + [ RIFF-MAGIC id= ] + [ riff-chunk-format 4 memory>byte-array WAVE-MAGIC id= ] + } 1&& [ invalid-wav-file ] unless ; : (read-wav) ( -- audio ) From 4038d30e7ef799bb82259ada93526a3082dc306c Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 29 Apr 2009 08:40:31 -0500 Subject: [PATCH 3/5] die if wav fmt or data chunk is missing --- extra/audio/wav/wav.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/audio/wav/wav.factor b/extra/audio/wav/wav.factor index 998752eb3a..6b76e98f3a 100644 --- a/extra/audio/wav/wav.factor +++ b/extra/audio/wav/wav.factor @@ -59,7 +59,7 @@ ERROR: invalid-wav-file ; { [ dup FMT-MAGIC "wav-fmt-chunk" heap-size check-chunk ] [ fmt! ] } { [ dup DATA-MAGIC "wav-data-chunk" heap-size check-chunk ] [ data! ] } } cond ] while drop - fmt data ; + fmt data 2dup and [ invalid-wav-file ] unless ; : verify-wav ( chunk -- ) { @@ -69,7 +69,7 @@ ERROR: invalid-wav-file ; [ invalid-wav-file ] unless ; : (read-wav) ( -- audio ) - read-wav-chunks + read-wav-chunks [ [ wav-fmt-chunk-num-channels 2 memory>byte-array le> ] [ wav-fmt-chunk-bits-per-sample 2 memory>byte-array le> ] From 939c2fa64e19fc403bed0fd08db096cbc15f3f56 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 29 Apr 2009 18:22:54 -0500 Subject: [PATCH 4/5] scaffold-emacs should use application-data directory on windows --- basis/tools/scaffold/scaffold.factor | 12 +++++++++--- basis/tools/scaffold/windows/authors.txt | 1 + basis/tools/scaffold/windows/windows.factor | 7 +++++++ 3 files changed, 17 insertions(+), 3 deletions(-) create mode 100755 basis/tools/scaffold/windows/authors.txt create mode 100755 basis/tools/scaffold/windows/windows.factor diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index f35da24266..5034207c98 100755 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -298,9 +298,12 @@ SYMBOL: examples-flag "}" print ] with-variable ; +: touch. ( path -- ) + [ touch-file ] + [ "Click to edit: " write . ] bi ; + : scaffold-rc ( path -- ) - [ home ] dip append-path - [ touch-file ] [ "Click to edit: " write . ] bi ; + [ home ] dip append-path touch. ; : scaffold-factor-boot-rc ( -- ) os windows? "factor-boot-rc" ".factor-boot-rc" ? scaffold-rc ; @@ -308,4 +311,7 @@ SYMBOL: examples-flag : scaffold-factor-rc ( -- ) os windows? "factor-rc" ".factor-rc" ? scaffold-rc ; -: scaffold-emacs ( -- ) ".emacs" scaffold-rc ; + +HOOK: scaffold-emacs os ( -- ) + +M: unix scaffold-emacs ( -- ) ".emacs" scaffold-rc ; diff --git a/basis/tools/scaffold/windows/authors.txt b/basis/tools/scaffold/windows/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/tools/scaffold/windows/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/tools/scaffold/windows/windows.factor b/basis/tools/scaffold/windows/windows.factor new file mode 100755 index 0000000000..fef6121717 --- /dev/null +++ b/basis/tools/scaffold/windows/windows.factor @@ -0,0 +1,7 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: io.pathnames system tools.scaffold windows.shell32 ; +IN: tools.scaffold.windows + +M: windows scaffold-emacs ( -- ) + application-data ".emacs" append-path touch. ; From 7fe22b14f86178d57e583bc19bd4fbf94f60aa5f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 29 Apr 2009 19:06:06 -0500 Subject: [PATCH 5/5] don't scaffold an authors file if the developer-name is not set --- basis/tools/scaffold/scaffold.factor | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index 5034207c98..63dc951d60 100755 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -6,7 +6,7 @@ vocabs.loader io combinators calendar accessors math.parser io.streams.string ui.tools.operations quotations strings arrays prettyprint words vocabs sorting sets classes math alien urls splitting ascii combinators.short-circuit alarms words.symbol -system ; +system summary ; IN: tools.scaffold SYMBOL: developer-name @@ -16,6 +16,10 @@ ERROR: not-a-vocab-root string ; ERROR: vocab-name-contains-separator path ; ERROR: vocab-name-contains-dot path ; ERROR: no-vocab vocab ; +ERROR: bad-developer-name name ; + +M: bad-developer-name summary + drop "Developer name must be a string." ; path scaffolding? [ - [ developer-name get ] dip utf8 set-file-contents + developer-name get [ + dup string? [ bad-developer-name ] unless + "authors.txt" vocab-root/vocab/file>path scaffolding? [ + utf8 set-file-contents + ] [ + 2drop + ] if ] [ - drop - ] if ; + 2drop + ] if* ; : lookup-type ( string -- object/string ? ) "new" ?head drop [ { [ CHAR: ' = ] [ digit? ] } 1|| ] trim-tail