diff --git a/basis/base64/base64.factor b/basis/base64/base64.factor index e5972991e5..a1668e7ce9 100644 --- a/basis/base64/base64.factor +++ b/basis/base64/base64.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: combinators io io.binary io.encodings.binary io.streams.byte-array io.streams.string kernel math namespaces -sequences strings ; +sequences strings io.crlf ; IN: base64 , ; IN: http -: crlf ( -- ) "\r\n" write ; - -: read-crlf ( -- bytes ) - "\r" read-until - [ CHAR: \r assert= read1 CHAR: \n assert= ] when* ; - : (read-header) ( -- alist ) [ read-crlf dup f like ] [ parse-header-line ] [ drop ] produce ; diff --git a/basis/io/crlf/authors.txt b/basis/io/crlf/authors.txt new file mode 100644 index 0000000000..33616a2d6a --- /dev/null +++ b/basis/io/crlf/authors.txt @@ -0,0 +1,2 @@ +Daniel Ehrenberg +Slava Pestov diff --git a/basis/io/crlf/crlf-docs.factor b/basis/io/crlf/crlf-docs.factor new file mode 100644 index 0000000000..ac7c8c324e --- /dev/null +++ b/basis/io/crlf/crlf-docs.factor @@ -0,0 +1,12 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: help.syntax help.markup sequences ; +IN: io.crlf + +HELP: crlf +{ $values } +{ $description "Prints a carriage return and line feed to the current output stream, used to indicate a newline for certain network protocols." } ; + +HELP: read-crlf +{ $values { "seq" sequence } } +{ $description "Reads until the next CRLF (carriage return followed by line feed) from the current input stream, throwing an error if there is not a CRLF remaining, or if CR is present without immediately being followed by LF." } ; diff --git a/basis/io/crlf/crlf.factor b/basis/io/crlf/crlf.factor new file mode 100644 index 0000000000..53dddce199 --- /dev/null +++ b/basis/io/crlf/crlf.factor @@ -0,0 +1,11 @@ +! Copyright (C) 2009 Daniel Ehrenberg, Slava Pestov +! See http://factorcode.org/license.txt for BSD license. +USING: io kernel ; +IN: io.crlf + +: crlf ( -- ) + "\r\n" write ; + +: read-crlf ( -- seq ) + "\r" read-until + [ CHAR: \r assert= read1 CHAR: \n assert= ] when* ; diff --git a/basis/io/crlf/summary.txt b/basis/io/crlf/summary.txt new file mode 100644 index 0000000000..2fa6a6e2c1 --- /dev/null +++ b/basis/io/crlf/summary.txt @@ -0,0 +1 @@ +Writing and reading until \r\n diff --git a/basis/quoted-printable/authors.txt b/basis/quoted-printable/authors.txt new file mode 100644 index 0000000000..f990dd0ed2 --- /dev/null +++ b/basis/quoted-printable/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/basis/quoted-printable/quoted-printable-docs.factor b/basis/quoted-printable/quoted-printable-docs.factor new file mode 100644 index 0000000000..81219a3f84 --- /dev/null +++ b/basis/quoted-printable/quoted-printable-docs.factor @@ -0,0 +1,27 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax strings byte-arrays io.encodings.string ; +IN: quoted-printable + +ABOUT: "quoted-printable" + +ARTICLE: "quoted-printable" "Quoted printable encoding" +"The " { $vocab-link "quoted-printable" } " vocabulary implements RFC 2045 part 6.7, providing words for reading and generating quotable printed text." +{ $subsection >quoted } +{ $subsection >quoted-lines } +{ $subsection quoted> } ; + +HELP: >quoted +{ $values { "byte-array" byte-array } { "string" string } } +{ $description "Encodes a byte array as quoted printable, on a single line." } +{ $warning "To encode a string in quoted printable, first use the " { $link encode } " word." } ; + +HELP: >quoted-lines +{ $values { "byte-array" byte-array } { "string" string } } +{ $description "Encodes a byte array as quoted printable, with soft line breaks inserted so the output lines are no longer than 76 characters." } +{ $warning "To encode a string in quoted printable, first use the " { $link encode } " word with a specific encoding." } ; + +HELP: quoted> +{ $values { "string" string } { "byte-array" byte-array } } +{ $description "Decodes a quoted printable string into an array of the bytes represented." } +{ $warning "When decoding something in quoted printable form and using it as a string, be sure to use the " { $link decode } " word rather than simply converting the byte array to a string." } ; diff --git a/basis/quoted-printable/quoted-printable-tests.factor b/basis/quoted-printable/quoted-printable-tests.factor new file mode 100644 index 0000000000..6f42a48b37 --- /dev/null +++ b/basis/quoted-printable/quoted-printable-tests.factor @@ -0,0 +1,30 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test quoted-printable multiline io.encodings.string +sequences io.encodings.8-bit splitting kernel ; +IN: quoted-printable.tests + +[ <" José was the +person who knew how to write the letters: + ő and ü +and we didn't know hów tö do thât"> ] +[ <" Jos=E9 was the +person who knew how to write the letters: + =F5 and =FC=20 +and w= +e didn't know h=F3w t=F6 do th=E2t"> quoted> latin2 decode ] unit-test + +[ <" Jos=E9 was the=0Aperson who knew how to write the letters:=0A =F5 and =FC=0Aand we didn't know h=F3w t=F6 do th=E2t"> ] +[ <" José was the +person who knew how to write the letters: + ő and ü +and we didn't know hów tö do thât"> latin2 encode >quoted ] unit-test + +: message ( -- str ) + 55 [ "hello" ] replicate concat ; + +[ f ] [ message >quoted "=\r\n" swap subseq? ] unit-test +[ 1 ] [ message >quoted string-lines length ] unit-test +[ t ] [ message >quoted-lines "=\r\n" swap subseq? ] unit-test +[ 4 ] [ message >quoted-lines string-lines length ] unit-test +[ "===o" ] [ message >quoted-lines string-lines [ peek ] "" map-as ] unit-test diff --git a/basis/quoted-printable/quoted-printable.factor b/basis/quoted-printable/quoted-printable.factor new file mode 100644 index 0000000000..83fee523a0 --- /dev/null +++ b/basis/quoted-printable/quoted-printable.factor @@ -0,0 +1,62 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: sequences strings kernel io.encodings.string +math.order ascii math io io.encodings.utf8 io.streams.string +combinators.short-circuit math.parser arrays ; +IN: quoted-printable + +! This implements RFC 2045 section 6.7 + + CHAR: ~ between? ] + [ CHAR: \t = ] + } 1|| ; + +: char>quoted ( ch -- str ) + dup printable? [ 1string ] [ + assure-small >hex >upper + 2 CHAR: 0 pad-left + CHAR: = prefix + ] if ; + +: take-some ( seqs -- seqs seq ) + 0 over [ length + dup 76 >= ] find drop nip + [ 1- cut-slice swap ] [ f swap ] if* concat ; + +: divide-lines ( strings -- strings ) + [ dup ] [ take-some ] [ ] produce nip ; + +PRIVATE> + +: >quoted ( byte-array -- string ) + [ char>quoted ] { } map-as concat "" like ; + +: >quoted-lines ( byte-array -- string ) + [ char>quoted ] { } map-as + divide-lines "=\r\n" join ; + + ] if + ] when ; + +: read-quoted ( -- bytes ) + [ read1 dup ] [ read-char ] [ drop ] B{ } produce-as ; + +PRIVATE> + +: quoted> ( string -- byte-array ) + ! Input should already be normalized to make \r\n into \n + [ read-quoted ] with-string-reader ; diff --git a/basis/quoted-printable/summary.txt b/basis/quoted-printable/summary.txt new file mode 100644 index 0000000000..c32ac1fc80 --- /dev/null +++ b/basis/quoted-printable/summary.txt @@ -0,0 +1 @@ +Quoted printable encoding/decoding diff --git a/basis/quoted-printable/tags.txt b/basis/quoted-printable/tags.txt new file mode 100644 index 0000000000..8fd3eccc9a --- /dev/null +++ b/basis/quoted-printable/tags.txt @@ -0,0 +1,2 @@ +parsing +web diff --git a/basis/smtp/server/server.factor b/basis/smtp/server/server.factor index f986404404..5d7791292b 100644 --- a/basis/smtp/server/server.factor +++ b/basis/smtp/server/server.factor @@ -4,7 +4,7 @@ USING: combinators kernel prettyprint io io.timeouts sequences namespaces io.sockets io.sockets.secure continuations calendar io.encodings.ascii io.streams.duplex destructors locals concurrency.promises threads accessors smtp.private -io.sockets.secure.unix.debug ; +io.sockets.secure.unix.debug io.crlf ; IN: smtp.server ! Mock SMTP server for testing purposes. diff --git a/basis/smtp/smtp.factor b/basis/smtp/smtp.factor index 2ffc2e6db3..03b9d8af11 100644 --- a/basis/smtp/smtp.factor +++ b/basis/smtp/smtp.factor @@ -6,7 +6,7 @@ io.encodings.utf8 io.timeouts io.sockets io.sockets.secure io.encodings.ascii kernel logging sequences combinators splitting assocs strings math.order math.parser random system calendar summary calendar.format accessors sets hashtables -base64 debugger classes prettyprint ; +base64 debugger classes prettyprint io.crlf ; IN: smtp SYMBOL: smtp-domain @@ -50,12 +50,6 @@ TUPLE: email > [ tag? ] find nip ; -! * Accessing part of an XML document -! for tag- words, a start means that it searches all children -! and no star searches only direct children - : tag-named? ( name elem -- ? ) dup tag? [ names-match? ] [ 2drop f ] if ; @@ -36,8 +32,6 @@ IN: xml.utilities tags@ '[ _ swap tag-named? ] deep-filter ; : tag-named ( tag name/string -- matching-tag ) - ! like get-name-tag but only looks at direct children, - ! not all the children down the tree. assure-name swap [ tag-named? ] with find nip ; : tags-named ( tag name/string -- tags-seq ) @@ -58,7 +52,7 @@ IN: xml.utilities : deep-tags-with-attr ( tag attr-value attr-name -- tags-seq ) tags@ '[ _ _ tag-with-attr? ] deep-filter ; -: get-id ( tag id -- elem ) ! elem=tag.getElementById(id) +: get-id ( tag id -- elem ) "id" deep-tag-with-attr ; : deep-tags-named-with-attr ( tag tag-name attr-value attr-name -- tags ) diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index c99c226a0c..e08821bddd 100644 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -557,7 +557,7 @@ HELP: GENERIC: HELP: GENERIC# { $syntax "GENERIC# word n" } -{ $values { "word" "a new word to define" } { "n" "the stack position to dispatch on, either 0, 1 or 2" } } +{ $values { "word" "a new word to define" } { "n" "the stack position to dispatch on" } } { $description "Defines a new generic word which dispatches on the " { $snippet "n" } "th most element from the top of the stack in the current vocabulary. Initially, it contains no methods, and thus will throw a " { $link no-method } " error when called." } { $notes "The following two definitions are equivalent:"