1\
2\ CDDL HEADER START
3\
4\ The contents of this file are subject to the terms of the
5\ Common Development and Distribution License (the "License").
6\ You may not use this file except in compliance with the License.
7\
8\ You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
9\ or http://www.opensolaris.org/os/licensing.
10\ See the License for the specific language governing permissions
11\ and limitations under the License.
12\
13\ When distributing Covered Code, include this CDDL HEADER in each
14\ file and include the License file at usr/src/OPENSOLARIS.LICENSE.
15\ If applicable, add the following below this CDDL HEADER, with the
16\ fields enclosed by brackets "[]" replaced with your own identifying
17\ information: Portions Copyright [yyyy] [name of copyright owner]
18\
19\ CDDL HEADER END
20\
21\
22\
23\ Copyright 2009 Sun Microsystems, Inc.  All rights reserved.
24\ Use is subject to license terms.
25\
26
27purpose: HSFS file system support package for NewBoot
28copyright: Copyright 2009 Sun Microsystems, Inc. All Rights Reserved
29
30\ High Sierra, Rock Ridge (CD-ROM) file system reader and boot block
31
32headers
33" /packages" get-package  push-package
34
35new-device
36   fs-pkg$  device-name  diag-cr?
37
38   \
39   \	HSFS variables
40   \
41   0 instance value dev-ih
42   0 instance value vol-desc
43   0 instance value dir-buf
44   0 instance value sua-buf
45   0 instance value ce-buf
46
47   \
48   \	HSFS volume descriptor routines
49   \
50
51   \ unaligned load of 2-byte item
52   : xw@  ( adr -- n )
53      dup c@ swap char+   ( c0 adr+1 )
54      c@                  ( c0 c1 )
55      bwjoin
56   ;
57
58   \ unaligned store of 2-byte item
59   : xw!  ( n adr -- )
60      swap wbsplit swap 2 pick c! swap char+ c!
61   ;
62
63   \ unaligned load of 4-byte item
64   : xl@  ( adr -- n )
65      dup xw@ swap wa1+   ( w0 adr+2 )
66      xw@                 ( w0 w1 )
67      wljoin
68   ;
69   \ unaligned store of 4-byte item
70   : xl!  ( n adr -- )
71      swap lwsplit swap 2 pick xw! swap wa1+ xw!
72   ;
73
74   d# 2048 constant /sector
75   d# 16 constant vol-desc-sector#  ( -- n )
76
77   : +vd  ( index -- adr )
78      vol-desc 0= if
79         ." invalid access of +vd" cr abort
80      then
81      vol-desc +
82   ;
83
84   : root-dir  ( -- n )  d# 156 +vd  ;
85   : /block    ( -- n )  d# 128 +vd xw@  ;
86   : byte>blkoff  ( byte-off -- block-off )  /block mod  ;
87
88   : get-vol-desc  ( -- )
89      vol-desc  /sector  vol-desc-sector# /sector *  dev-ih  read-disk
90   ;
91
92   : read-fs-blocks  ( adr len fs-blk# -- )  /block *  dev-ih  read-disk  ;
93
94   \
95   \	HSFS directory routines
96   \
97
98   \ Current directory variables.
99   instance variable cdir-blk		\ Current directory device block ptr.
100   instance variable cdir-blk0          \ Current directory block0.
101   instance variable cdir-offset	\ Current directory logical offset.
102   instance variable cdir-size		\ Current directory logical size.
103   instance variable cdir-ptr		\ Current directory entry pointer.
104   false instance value cdir-rescan     \ Rescan current directory for symlink.
105
106   \ Access of current directory entry.
107   : +dr  ( n -- adr )  cdir-ptr @ +  ;
108
109   : dir-entrylen    ( -- n )    d# 0  +dr c@  ;
110   : dir-block0      ( -- n )    d# 2  +dr xl@  ;
111   : dir-filesize    ( -- n )    d# 10 +dr xl@  ;
112   : dir-flags       ( -- n )    d# 25 +dr c@  ;
113   : dir-filenamelen ( -- n )    d# 32 +dr c@  ;
114   : dir-filename    ( -- adr )  d# 33 +dr  ;
115
116   : dir-isdir?      ( -- flag )  dir-flags  h# 02  and  0<>  ;
117   : dir-file$       ( -- adr len )  dir-filename  dir-filenamelen  ;
118   : dir-sualen      ( -- len )  dir-entrylen  d# 33 -  dir-filenamelen -  ;
119
120   \ ISO name, including dot & dot-dot check
121   : dir-iso$        ( -- adr len )
122      dir-filenamelen 1  =  if
123         dir-filename c@             ( name[0] )
124         dup 0=  if
125            drop " ."  exit          ( dot )
126         then
127         1 =  if                     (  )
128            " .."  exit              ( dot-dot )
129         then
130      then
131      dir-file$                      ( name$ )
132   ;
133
134   false instance value symlink?
135
136   : get-dirblk  ( -- )
137      dir-buf /block  cdir-blk @  read-fs-blocks
138      1 cdir-blk +!
139   ;
140
141   : froot  ( -- )  root-dir cdir-ptr !  ;
142
143   \
144   \ SUAs - System Use Area in directory entry (Rock Ridge
145   \  Extensions to High Sierra/ISO 9660 Format).
146   \  Immediately follows directory entry name rounded up to
147   \  a half-word boundary.
148   \
149   0 instance value sua-ptr
150   0 instance value sua-len
151
152   : +suf           ( n -- adr )    sua-ptr +  ;
153   : suf-sig        ( -- adr len )  sua-ptr 2  ;
154   : suf-len        ( -- len )      2 +suf c@  ;
155   : suf-dat        ( -- data )     5 +suf  ;
156   : suf-ce-lbn     ( -- lbn )      4 +suf xl@ ;
157   : suf-ce-offset  ( -- offset )   d# 12 +suf xl@ ;
158   : suf-ce-len     ( -- len )      d# 20 +suf xl@ ;
159
160   : init-sua     ( -- )
161      dir-file$ +  /w roundup  to sua-ptr
162      dir-sualen               to sua-len
163   ;
164
165   : next-suf  ( -- )
166      sua-len suf-len -  to sua-len
167      suf-len +suf       to sua-ptr
168   ;
169
170   : end-sua  ( -- end? )
171      sua-len 4 <
172   ;
173
174   : suf-nm$  ( -- adr len )  suf-dat  suf-len 5 -  ;
175
176   \ Continuation suffix handling.  When a 'CE' suffix is seen,
177   \ record the CE parameters (logical block#, offset and length
178   \ of continuation).  We process the CE continuation only after
179   \ we've finished processing the current SUA area.
180   instance variable ce-lbn
181   instance variable ce-offset
182   instance variable ce-len
183   : suf-ce-set  ( -- )
184      suf-ce-lbn ce-lbn !
185      suf-ce-offset ce-offset !
186      suf-ce-len ce-len !
187   ;
188
189   : suf-ce-process  ( -- error? )
190      ce-lbn @ 0= if
191         true
192      else
193         sua-buf ce-len @ ce-lbn @  read-fs-blocks
194         sua-buf   to sua-ptr
195         ce-len @  to sua-len
196         0 ce-len ! 0 ce-lbn ! 0 ce-offset !
197         false
198      then
199   ;
200
201   /buf-len  instance buffer: suf-sl-buf
202   false     instance value   symlink-need-sep
203
204   \ Format of Rock Ridge symlinks needs to be munged to unix-style
205   \ name.  Format is:  <flag><nbytes>file-name<flag><nbytes>filename...
206   \ where \ <flag> is flag byte (0=filename, 2=current dir, 4=parent
207   \ dir, 8=root dir) and <nbytes> is one-byte byte count (zero for
208   \ !filename).
209   : suf-copy-to-symlinkbuf  ( name$  -- )
210       false to symlink-need-sep
211       suf-sl-buf -rot bounds do           ( dst )
212          symlink-need-sep if
213             ascii / over c! char+
214          then
215          true to symlink-need-sep
216          i c@ dup 2 = if                   ( dst 2 )
217             \ CURRENT (".")
218             drop ascii . over c! char+ 2   ( dst' inc )
219          else  dup 4 =  if                 ( dst 4 )
220             \ PARENT ("..")
221             drop " .." 2 pick swap move    ( dst )
222             wa1+ 2                         ( dst' inc )
223          else  dup 8 =  if                 ( dst 8 )
224             \ ROOT ("/")
225             drop ascii / over c! char+ 2   ( dst' inc )
226             false to symlink-need-sep
227          else  dup 0<> if
228             ." unknown SL flag: " .x cr abort
229          else                              ( dst c )
230             drop                           ( dst )
231             i char+ dup c@ >r              ( dst src+1  R:nbytes )
232             char+ over r@ move             ( dst R:nbytes )
233             r@ +                           ( dst' R:nbytes )
234             r> wa1+                        ( dst' inc )
235          then then then then
236       +loop                                ( dst )
237       0 swap c!
238    ;
239
240   \ Saved 'NM' prefix buffer.
241   /buf-len  instance buffer: suf-nm-buf
242   0 instance value suf-nm-size
243
244   \ Return the Rock Ridge file name associated with the current
245   \ dirent ('NM' suffix).  Otherwise returns standard iso filename.
246   \ Marks whether returned filename is a symbolic link ('SL' suffix)
247   \ and also processes continuations ('CE' suffix).
248   : rr-file$ ( -- adr len )
249      false to symlink?
250      0 to suf-nm-size
251
252      \ select start of sua, record sua offset
253      init-sua
254      begin
255         end-sua  if
256            suf-ce-process if
257               suf-nm-size if
258                  suf-nm-buf suf-nm-size       ( NM$ )
259               else
260                  dir-iso$                     ( iso$ )
261               then                            ( file$ )
262               exit
263            then
264         then
265         suf-sig                               ( sig-adr sig-len )
266         2dup " NM"  $=  if
267            suf-nm$ to suf-nm-size             ( sig-adr sig-len suf-nm-adr )
268            suf-nm-buf suf-nm-size move
269         then                                  ( sig-adr sig-len )
270         2dup " SL"  $=  if
271            true to symlink?
272            suf-nm$ suf-copy-to-symlinkbuf
273         then
274         2dup " CE"  $=  if
275            suf-ce-set
276         then                                  ( sig-adr sig-len )
277         2drop  next-suf                       (  )
278      again
279   ;
280
281   \
282   \	HSFS high-level routines
283   \
284
285   \ Used for rescanning current directory for symbolic links.
286
287   \ Initializes current directory settings from current directory
288   \ entry pointer or for rescan.  If it's not a rescan, we have
289   \ access to the actual directory entry, so we can check whether
290   \ it's a directory or not here.
291   : init-dent  ( -- error? )
292      cdir-rescan if
293         false to cdir-rescan
294         cdir-blk0 @ cdir-blk !
295      else
296         dir-isdir? 0= if
297            true exit
298         then
299         dir-block0 dup cdir-blk ! cdir-blk0 !
300         dir-filesize cdir-size !
301      then                                    ( blk0 size )
302      0 cdir-offset !
303      false
304   ;
305
306   : get-dent ( -- error? )
307      begin
308         \ Check for end of directory, return true if we're past the EOF.
309         cdir-offset @  cdir-size @  >=  if
310            true  exit
311         then
312
313         \ If we're at a block boundary, get the next block.  Otherwise
314         \ increment the directory pointer.
315         cdir-offset @ byte>blkoff  0=  if
316            get-dirblk
317            dir-buf cdir-ptr !
318         else
319            dir-entrylen cdir-ptr +!
320         then
321
322         \ If dir-entrylen is not zero, increment the current directory
323         \ file offset.  Otherwise, a dir-entrylen of zero indicates
324         \ the end of a dir block, so round up cdir-offset to fetch the
325         \ next one
326         dir-entrylen ?dup if
327            cdir-offset +!  true
328         else
329            cdir-offset @  /block  roundup  cdir-offset !
330            false
331         then
332      until  false
333   ;
334
335   \ Look through current directory for file name 'file$'.
336   \ Will leave current directory entry (cdir-ptr) pointing
337   \ to matched entry on success.
338   : dirlook  ( file$ -- error? )
339      init-dent if
340         true exit
341      then
342      begin  get-dent 0=  while      ( file$ )
343         2dup rr-file$ $=  if        ( file$ )
344            2drop false  exit        ( succeeded )
345         then                        ( file$ )
346      repeat 2drop true              ( failed )
347   ;
348
349   /buf-len  instance buffer: symlink-buf
350   : symlink-buf$  ( -- path$ )  symlink-buf cscount  ;
351
352   : follow-symlink  ( tail$ -- tail$' )
353
354      \ copy symlink value (plus null) to buf
355      suf-sl-buf cscount 1+  symlink-buf swap  move
356      false to symlink?
357
358      \ append to current path
359      ?dup  if                                              ( tail$ )
360	 " /" symlink-buf$  $append                         ( tail$ )
361	 symlink-buf$  $append                              (  )
362      else  drop  then                                      (  )
363      symlink-buf$                                          ( path$ )
364      over c@  ascii /  =  if                               ( path$ )
365	 froot  str++                                       ( path$' )
366      else
367         true to cdir-rescan
368      then                                                  ( path$ )
369   ;
370
371   : lookup  ( path$ -- error? )
372      over c@  ascii /  =  if
373	 froot  str++                            ( path$' )
374      then                                       ( path$ )
375      begin                                      ( path$ )
376         ascii / left-parse-string               ( path$ file$ )
377      dup  while                                 ( path$ file$ )
378         dirlook  if
379            2drop true  exit                     ( failed )
380         then                                    ( path$ )
381         symlink?  if
382            follow-symlink                       ( path$' )
383         then                                    ( path$ )
384      repeat                                     ( path$ file$ )
385      2drop 2drop  false                         ( succeeded )
386   ;
387
388
389   \
390   \	HSFS installation routines
391   \
392
393   \ Allocate memory for necessary data structures.  Need to
394   \ read volume desriptor sector in order to get /block value.
395   : initialize  ( -- error? )
396      /sector  mem-alloc to vol-desc
397      get-vol-desc
398      /block   mem-alloc to dir-buf
399      /block   mem-alloc to sua-buf
400      /block   mem-alloc to ce-buf
401   ;
402
403   : release-buffers  ( -- )
404      ce-buf      /block  mem-free
405      sua-buf	  /block  mem-free
406      dir-buf     /block  mem-free
407      vol-desc    /sector mem-free
408      0 to vol-desc
409   ;
410
411
412   \ HSFS file interface
413   struct
414      /x     field >filesize
415      /x     field >offset
416      /x     field >block0
417   constant /file-record
418
419   d# 10                  constant #opens
420   #opens /file-record *  constant /file-records
421
422   /file-records  instance buffer: file-records
423
424   -1 instance value current-fd
425
426   : fd>record  ( fd -- record )  /file-record *  file-records +  ;
427
428   : set-fd  ( fd -- error? )
429      dup 0 #opens 1 - between 0= if
430         drop true exit
431      then
432      dup fd>record  >block0 x@ 0= if
433         drop true exit
434      then
435      to current-fd false
436   ;
437
438   : file-offset@  ( -- off )
439      current-fd fd>record >offset x@
440   ;
441
442   : file-offset!  ( off -- )
443      current-fd fd>record >offset x!
444   ;
445
446   : file-size@  ( -- size )
447      current-fd fd>record >filesize x@
448   ;
449
450   : file-size!  ( size -- )
451      current-fd fd>record >filesize x!
452   ;
453
454   : file-block0@  ( -- block0 )
455      current-fd fd>record >block0 x@
456   ;
457
458   : file-block0!  ( block0 -- )
459      current-fd fd>record >block0 x!
460   ;
461
462   : get-slot  ( -- fd false | true )
463      #opens 0  do
464         i fd>record >block0 x@  0=  if
465            i false  unloop exit
466         then
467      loop  true
468   ;
469
470   : free-slot  ( fd -- )
471      set-fd 0= if
472         0 file-offset!
473         0 file-size!
474         0 file-block0!
475      then
476   ;
477
478   \ initializes the open structure with information from
479   \ the inode (on UFS) or directory entry (from HSFS).
480   : init-fd  ( fd -- )
481      to current-fd
482      dir-block0 file-block0!
483      dir-filesize file-size!
484      0 file-offset!
485   ;
486
487   external
488
489   : open ( -- okay? )
490      my-args dev-open  dup 0=  if       ( 0 )
491         exit                            ( failed )
492      then  to dev-ih
493
494      initialize  froot
495      file-records /file-records  erase
496      true                               ( succeeded )
497   ;
498
499   : close  ( -- )
500      dev-ih dev-close
501      release-buffers
502   ;
503
504   : open-file  ( path$ -- fd true | false )
505      get-slot  if
506	 2drop false  exit            ( failed )
507      then  -rot                      ( fd path$ )
508
509      lookup  if                      ( fd )
510	 drop false  exit             ( failed )
511      then
512
513      dup init-fd true                ( fd success )
514   ;
515
516   : close-file  ( fd -- )
517      free-slot   (  )
518   ;
519
520   : read-file   ( adr len fd -- #read )
521
522      \ Check if fd is valid, if it is set current-fd.
523      set-fd if
524         2drop 0 exit
525      then                                   ( adr len )
526
527      \ Adjust len if less than len bytes remain.
528      file-size@ file-offset@ - min          ( adr len' )
529
530      \ Check for invalid length read.
531      dup 0<=  if  2drop 0 exit  then
532
533      \ Compute physical device byte offset.
534      tuck                                   ( len adr len )
535      file-block0@ /block * file-offset@ +   ( len adr len off )
536      dev-ih read-disk                       ( #read )
537      dup file-offset@ +  file-offset!
538   ;
539
540   : seek-file  ( off fd -- error? )
541      set-fd  if                ( off )
542         drop false  exit       ( failed )
543      then                      ( off )
544
545      dup file-size@ >  if      ( off )
546         drop false  exit       ( failed )
547      then                      ( off )
548      dup  file-offset!  true   ( off succeeded )
549   ;
550
551   : size-file  ( fd -- size )
552      set-fd if
553         0
554      else
555         file-size@
556      then
557   ;
558
559   \ we don't support compression (yet)
560   : cinfo-file  ( fd -- bsize fsize comp? )
561      set-fd  if  0 0 0  else  /block file-size@ 0  then
562   ;
563
564   \ read ramdisk fcode at rd-offset
565   : get-rd   ( adr len -- )
566      rd-offset dev-ih  read-disk
567   ;
568
569   \ no additional props needed for hsfs
570   : bootprop  ( -- )  false  ;
571
572   \ debug words
573   : chdir  ( path$ -- )
574      2dup lookup if
575         type ."  Not found" cr
576      else
577         dir-isdir? 0= if
578            type ."  Not a directory" cr
579         else
580            type
581	    ."  blk0 "
582            cdir-blk0 @ .x
583            ."  size "
584            cdir-size @ .x
585            cr
586         then
587      then
588   ;
589
590   : dir  ( -- )
591      init-dent
592      begin  get-dent 0=  while
593         rr-file$ type
594         ."  flags " dir-flags .x
595         ." blk0 " dir-block0 .x
596         ." size " dir-filesize .x
597         cr
598      repeat
599      true to cdir-rescan
600   ;
601
602
603finish-device
604pop-package
605
606