Author: wmb
Date: 2009-09-24 12:22:16 +0200 (Thu, 24 Sep 2009)
New Revision: 1377
Modified:
ofw/fs/cifs/netbios.fth
ofw/fs/cifs/smb.fth
Log:
CIFS - implemented next-file-info for dir command.
Modified: ofw/fs/cifs/netbios.fth
===================================================================
--- ofw/fs/cifs/netbios.fth 2009-09-24 06:14:06 UTC (rev 1376)
+++ ofw/fs/cifs/netbios.fth 2009-09-24 10:22:16 UTC (rev 1377)
@@ -1,3 +1,5 @@
+\ See license at end of file
+purpose: Netbios session layer of CIFS file system code
d# 4096 constant max-data
d# 4356 constant my-max-buf
@@ -213,3 +215,27 @@
2drop false ( false )
then ( error? )
;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2009 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
Modified: ofw/fs/cifs/smb.fth
===================================================================
--- ofw/fs/cifs/smb.fth 2009-09-24 06:14:06 UTC (rev 1376)
+++ ofw/fs/cifs/smb.fth 2009-09-24 10:22:16 UTC (rev 1377)
@@ -1,3 +1,15 @@
+\ See license at end of file
+purpose: Server Message Block layer of CIFS file system code
+
+\ This lets you access Windows shares from OFW
+
+\ TODO:
+\ fix opening dir when \ missing from end of URL
+\ next-file-info needs to merge pathname$ into search string
+\ test with other servers
+\ get password and username from config variables if they exist and not specified in URL
+
+
char \ constant delim
0. instance 2value share$
@@ -3,4 +15,6 @@
0. instance 2value server$
0. instance 2value password$
+0. instance 2value pathname$
+0. instance 2value tail$
0. instance 2value account$
@@ -46,70 +60,23 @@
over c@ delim = if ( filename$ tail$ )
\ We found a \\ ( filename$ tail$ )
2swap 2 pick - 1- ( rem$ filename$' ) \ Remove tail
+ to pathname$ ( rem$ )
exit
then ( filename$ tail$ )
then ( filename$ tail$ )
repeat ( filename$ tail$ )
- 2swap ( null-rem$ filename$ )
+ 2swap to pathname$ ( null-rem$ )
;
: parse-share ( share+path$ -- /path$ )
delim split-string 2swap to share$ ( /path$ )
;
-\ If the filename itself contains "//", split it around that, returning
-\ filename$' as the portion preceding the "//" and "rem$" as the trailing
-\ portion beginning with the second "/" of the pair.
-\ For example, "/foo/bar//oof/rab" parses to "/oof/rab" "/foo/bar"
-: parse-filename ( filename$ -- rem$ filename$' )
- 2dup ( filename$ test$ )
- begin dup while ( filename$ test$ )
- delim split-string ( filename$ head$ tail$ )
- 2swap 2drop ( filename$ tail$ )
- dup if 1 /string then ( filename$ tail$' ) \ Remove first "/"
- dup if ( filename$ tail$ )
- over c@ delim = if ( filename$ tail$ )
- \ We found a // ( filename$ tail$ )
- 2swap 2 pick - 1- ( rem$ filename$' ) \ Remove tail
- exit
- then ( filename$ tail$ )
- then ( filename$ tail$ )
- repeat ( filename$ tail$ )
- 2swap ( null-rem$ filename$ )
-;
-
headers
: set-server ( server$ -- )
dup if " $set-host" $call-parent else 2drop then
;
-: old-parse-server ( server+share$ -- server$ )
- \ If the string is shorter than 2 characters, the server portion is null
- dup 2 < if " " exit then ( ss$ )
- \ If the string doesn't start with \\, the server portion is null
- over " \\" comp if " " exit then ( ss$ )
-
- 2 /string ( server\share$ )
- delim split-string ( server$ share$ )
- 2drop ( server$ )
-;
-
-: old-parse-share ( url$ -- rem$ server+share$ )
- \ If the string is shorter than 2 characters, the server portion is null
- dup 2 < if " " exit then ( url$ )
-
- \ If the string doesn't start with \\, the server portion is null
- over " \\" comp if " " exit then ( url$ )
-
- 2dup 2 /string ( url$ $1 ) \ $1 omits the leading \\
- delim left-parse-string ( url$ share+path$ server$ )
- 2drop ( url$ share+path$ )
- delim split-string ( url$ share$ path$ )
- 2nip ( url$ path$ )
- 2swap ( path$ url$ )
- third - ( path$ server+share$ )
-;
-
8 instance buffer: signature
h# c001 constant smb-flags
h# c05c constant my-capabilities \ LargeRd, LargeWr, NTStat, NT SMBs, Large files, Unicode
@@ -117,6 +84,7 @@
0 instance value tid
0 instance value uid
0 instance value mid
+0 instance value sid \ Search ID
0 instance value msg#
0 instance value last-command
@@ -488,6 +456,13 @@
}smb empty-response ( error? )
;
+: $getattr ( path$ -- true | attr false )
+ 8 smb{ +path}smb if true exit then
+ d# 10 expect-wcnt ( rem$' )
+ -xw ( rem$' attr )
+ nip nip false
+;
+
: flush ( -- error? )
5 smb{ fid +xw --bytes-- }smb empty-response
;
@@ -580,7 +555,195 @@
2drop
;
+\ template
0 [if]
+: transact ( timeout oneway #setup #retdata #retparm #data #param -- )
+ h# 32 smb{
+ #param +xw
+ #data +xw
+ #retparm +xw
+ #retdata +xw
+ #setupdata +xb
+ 0 +xb \ Reserved
+ oneway +xw
+ timeout +xl
+ 0 +xw \ Reserved
+ parmcnt +xw
+ parmoffset +xw
+ datacnt +xw
+ dataoffset +xw
+ setupcnt +xb
+ 0 +xb \ Reserved
+ [ setupcnt * +xw ]
+ --bytes--
+ " " +unicode$ \ Name (NULL for TRANSACTION2)
+ pad +xb \ Pad to short or long
+ [ parmcnt * +xb ]
+ pad +xb \ Pad to short or long
+ [ datacnt * +xb ]
+ }smb
+;
+
+[then]
+
+: continue-search ( resumekey -- true | rem$ false )
+ 1- ( resumekey' ) \ We bias it by 1 because 0 is special to OFW
+ h# 32 smb{
+ d# 14 +xw \ #param
+ 0 +xw \ #data
+ d# 10 +xw \ #retparm
+ max-data +xw \ #retdata
+ 0 +xb \ #setupdata
+ 0 +xb \ Reserved
+ 0 +xw \ flags - two way, no disconnect
+ 0 +xl \ timeout - return immediately
+ 0 +xw \ Reserved
+ d# 14 +xw \ parmcnt
+ d# 66 +xw \ parmoffset
+ 0 +xw \ datacnt
+ 0 +xw \ dataoffset
+ 1 +xb \ setupcnt
+ 0 +xb \ Reserved
+
+ 2 +xw \ Setup[0] = Subcommand FIND_NEXT2
+ --bytes--
+ 0 +xb \ Pad to align
+ sid +xw \ Search ID
+ d# 1 +xw \ Search count
+ \ h# 101 +xw \ This value returns a 64-bit date in 100 nS unit since the Gregorian epoch
+ h# 001 +xw \ Get info in DOS format for now, so we can decode the time
+ ( resumekey )
+ +xl
+ h# e +xw \ Search flags - pick up where left off 8, return resume keys 4, close on end 2
+ " " +unicode$ \ Search pattern
+ }smb
+;
+
+: start-search ( -- true | rem$ false )
+ h# 32 smb{
+ d# 18 +xw \ #param
+ 0 +xw \ #data
+ d# 10 +xw \ #retparm
+ max-data +xw \ #retdata
+ 0 +xb \ #setupdata
+ 0 +xb \ Reserved
+ 0 +xw \ flags - two way, no disconnect
+ 0 +xl \ timeout - return immediately
+ 0 +xw \ Reserved
+ d# 18 +xw \ parmcnt \ Actually d# 12 plus pattern length (unicode, null terminated)
+ d# 66 +xw \ parmoffset
+ 0 +xw \ datacnt
+ 0 +xw \ dataoffset
+ 1 +xb \ setupcnt
+ 0 +xb \ Reserved
+
+ 1 +xw \ Setup[0] = Subcommand FIND_FIRST2
+ --bytes--
+ 0 +xb \ Pad to align
+ h# 17 +xw \ Search attributes - include dir 10, system 4, hidden 2, RO 1
+ d# 1 +xw \ Search count
+ 6 +xw \ Search flags - return resume keys 4, close on end 2
+ \ h# 101 +xw \ This value returns a 64-bit date in 100 nS unit since the Gregorian epoch
+ h# 001 +xw \ Get info in DOS format for now, so we can decode the time
+ 0 +xl \ Storage type
+ " \*" +unicode$ \ Search pattern
+ }smb
+;
+
+: >hms ( dos-packed-time -- secs mins hours )
+ dup h# 1f and 2* swap ( secs packed )
+ dup h# 07e0 and 5 >> swap ( secs mins packed )
+ h# f800 and d# 11 >> ( secs mins hours )
+;
+: >dmy ( dos-packed-date -- day month year )
+ dup h# 1f and swap ( day packed )
+ dup h# 01e0 and 5 >> swap ( day month packed )
+ h# fe00 and 9 >> d# 1980 + ( day month year )
+;
+\ Convert DOS file attributes to the firmware encoding
+\ see showdir.fth for a description of the firmware encoding
+: >canonical-attrs ( dos-attrs -- canon-attrs )
+ >r
+ \ Access permissions
+ r@ 1 and if o# 666 else o# 777 then \ rwxrwxrwx
+
+ \ Bits that are independent of one another
+ r@ 2 and if h# 10000 or then \ hidden
+ r@ 4 and if h# 20000 or then \ system
+ r@ h# 20 and if h# 40000 or then \ archive
+
+ \ Mutually-exclusive file types
+ r@ 8 and if h# 3000 or then \ Volume label
+ r> h# 10 and if h# 4000 or then \ Subdirectory
+ dup h# f000 and 0= if h# 8000 or then \ Ordinary file
+;
+
+: unicode>ascii ( adr -- adr len )
+ dup dup ( adr aadr uadr )
+ begin ( adr aadr uadr )
+ dup le-w@ ( adr aadr uadr uchar )
+ rot 2dup c! ( adr uadr uchar aadr )
+ ca1+ -rot ( adr aadr uadr uchar )
+ swap wa1+ swap ( adr aadr uadr uchar )
+ 0= until ( adr aadr uadr )
+ drop ( adr aadr )
+ over - 1- ( adr len )
+;
+
+0 instance value parm-cnt
+0 instance value smb-base
+0 instance value parm-base
+0 instance value data-base
+: parse-search ( rem$ -- false | file info .. true )
+ over d# 32 - to smb-base
+ d# 10 expect-wcnt
+ drop-w \ Total parameter count
+ drop-w \ Total data count
+ drop-w \ reserved
+ -xw to parm-cnt
+ -xw smb-base + to parm-base
+ drop-w \ Parameter displacement
+ drop-w \ # of data bytes
+ -xw smb-base + to data-base
+ 2drop
+ \ At this point we stop deserializing and just go straight to the info
+ \ id s m h d m y len attr name$ true
+ parm-cnt d# 10 = if
+ parm-base le-w@ to sid
+ 2 ( search-count-offset )
+ else ( )
+ 0 ( search-count-offset )
+ then ( search-count-offset )
+ parm-base + le-w@ 0= if false exit then
+
+ data-base le-l@ 1+ ( id' )
+ data-base d# 14 + le-w@ >hms ( id s m h )
+ data-base d# 12 + le-w@ >dmy ( id s m h d m y )
+ data-base d# 16 + le-l@ ( id s m h d m y len )
+ data-base d# 24 + le-w@ >canonical-attrs ( id s m h d m y len attr )
+ data-base d# 28 + unicode>ascii ( id s m h d m y len attr name$ )
+ true
+;
+
+: next-file-info ( id -- false | id' s m h d m y len attributes name$ true )
+ dup -1 = if drop false exit then ( id )
+ ?dup if continue-search else start-search then ( true | adr len false )
+ if false exit then ( rem$ )
+ parse-search
+;
+
+: free-bytes ( -- d.#bytes )
+ h# 80 smb{ --bytes-- }smb if 0. exit then
+ -wcnt ( rem$ )
+ drop-w ( rem$ )
+ -xw >r \ Blocks/unit ( rem$ )
+ -xw >r \ bytes/block ( rem$ )
+ -xw >r \ free-unit ( rem$ )
+ 2drop ( )
+ r> r> u* r> um* ( d.#bytes )
+;
+
+0 [if]
: send-create-andx ( path$ access flags -- )
h# a2 smb{
words{
@@ -615,30 +778,49 @@
my-args dup 0= if 2drop true exit then ( arg$ )
allocate-buffers ( arg$ )
- parse-server parse-share ( rem$ )
- server$ set-server ( rem$ )
- d# 139 " connect" $call-parent 0= if 2drop false exit then
- " OFW" " *SMBSERVER " start-session if 2drop false exit then
- negotiate if free-buffers 4drop false exit then ( rem$ )
- password$ set-password compute-password ( rem$ )
- session-setup if free-buffers 4drop false exit then ( rem$ )
- share$ server$ " \\\\%s\\%s" sprintf ( rem$ server+share$ )
- tree-connect if free-buffers 2drop false exit then ( rem$ )
+ parse-server parse-share parse-pathname to tail$
+ server$ set-server
+ d# 139 " connect" $call-parent 0= if false exit then
+ " OFW " " *SMBSERVER " start-session if false exit then
+ negotiate if free-buffers false exit then ( )
+ password$ set-password compute-password ( )
+ session-setup if free-buffers false exit then ( )
+ share$ server$ " \\\\%s\\%s" sprintf ( server+share$ )
+ tree-connect if free-buffers false exit then ( )
- parse-filename 2 open-file if ( rem$ )
- free-buffers 2drop false exit
- then ( rem$ )
+ \ If we just opened the share without a path, return success now
+ pathname$ nip 0= if ( )
+ " \" to pathname$ ( )
+ true exit
+ then ( )
+ \ Otherwise determine if the path refers to a directory or a file
+ pathname$ $getattr if ( )
+ ." Bad CIFS pathname" cr ( )
+ free-buffers false exit
+ then ( attr )
+
+ \ If the 10 bit is set it's a directory, so we just return success
+ h# 10 and if true exit then ( )
+
+ \ It's a file, so open it - first try to open read/write.
+ pathname$ 2 open-file if ( )
+ \ Failing that, try to open read-only
+ pathname$ 0 open-file if ( )
+ free-buffers false exit
+ then ( )
+ then ( )
+
\ If any arguments remain, assume we are dealing with a ZIP
\ archive and interpose the ZIP handler
- dup if ( rem$ )
- " zip-file-system" $interpose ( okay? )
- else ( rem$ )
- 2drop true ( okay? )
- then ( okay? )
+ tail$ dup if ( tail$ )
+ " zip-file-system" $interpose ( okay? )
+ else ( tail$ )
+ 2drop true ( okay? )
+ then ( okay? )
;
: close ( -- )
- close-file drop
+ fid if close-file drop then
tree-disconnect drop
free-buffers
;
@@ -647,3 +829,27 @@
: dma-free ( adr #bytes -- ) free-mem ;
: load ( adr -- len ) size drop read ;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2009 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
