[MLton-user] OS.FileSys.realPath bug

[Stephen Weeks]

> The following program:
> 
> val _ = print (OS.FileSys.fullPath "/usr/src/linux/drivers" ^ "\n")
> 
> prints "/usr/src/kernel-source-2.4.19" on my system, when it should  
> print "/usr/src/kernel-source-2.4.19/drivers".
> 
> (As /usr/src/linux is a soft link to kernel-source-2.4.19.)

Thanks for the bug report.  I have checked in a fix to the MLton
sources that will go out with the next release.  In the meantime, you
can get the corrected version of fullPath by prefixing the following
to your program.

--------------------------------------------------------------------------------

structure OS: OS =
   struct
      open OS
	 
      structure FileSys =
	 struct
	    open FileSys

	    val maxLinks = 64
	       
	    structure P = Path

	    fun fullPath p =
	       let
		  val oldCWD = getDir()
		  fun mkPath pathFromRoot =
		     P.toString {arcs = List.rev pathFromRoot,
				 isAbs = true,
				 vol = ""}
		  fun walkPath (n, pathFromRoot, arcs) =
		     if n = 0
			then raise SysErr ("too many links", NONE)
		     else
			case arcs of
			   [] => mkPath pathFromRoot
			 | arc :: al =>
			      if arc = "" orelse arc = "."
				 then walkPath (n, pathFromRoot, al)
			      else if arc = ".."
				      then
					 case pathFromRoot of
					    [] => walkPath (n, [], al)
					  | _ :: r =>
					       (chDir ".."; walkPath (n, r, al))
				   else
				      if isLink arc
					 then expandLink (n, pathFromRoot, arc,
							  al)
				      else
					 case al of
					    [] => mkPath (arc :: pathFromRoot)
					  | _ =>
					       (chDir arc
						; walkPath (n, arc :: pathFromRoot, al))
		  and expandLink (n, pathFromRoot, link, rest) =
		     let
			val {isAbs, arcs, ...} = P.fromString (readLink link)
			val arcs = List.@ (arcs, rest)
		     in 
			if isAbs
			   then gotoRoot (n-1, arcs)
			else walkPath (n-1, pathFromRoot, arcs)
		     end
		  and gotoRoot (n, arcs) =
		     (chDir "/"; walkPath (n, [], arcs))
		  fun computeFullPath arcs =
		     (gotoRoot (maxLinks, arcs) before chDir oldCWD)
		     handle ex => (chDir oldCWD; raise ex)
		  val {arcs, isAbs, ...} = P.fromString p
	       in
		  if isAbs
		     then computeFullPath arcs
		  else
		     let
			val {arcs = arcs', ...} = P.fromString oldCWD
		     in
			computeFullPath (List.@ (arcs', arcs))
		     end
	       end
	 end
   end