{ This file is part of the Free Pascal run time library. Main OS dependant body of the system unit, loosely modelled after POSIX. *BSD version (Linux version is near identical) See the file COPYING.FPC, included in this distribution, for details about the copyright. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} {***************************************************************************** Directory Handling *****************************************************************************} procedure Do_MkDir(s: rawbytestring); var fd: __wasi_fd_t; pr: RawByteString; res: __wasi_errno_t; begin InOutRes:=ConvertToFdRelativePath(s,fd,pr); if InOutRes<>0 then exit; res:=__wasi_path_create_directory(fd,PChar(pr),Length(pr)); if res<>__WASI_ERRNO_SUCCESS then InOutRes:=Errno2InoutRes(res); end; procedure Do_RmDir(s: rawbytestring); var fd: __wasi_fd_t; pr: RawByteString; res: __wasi_errno_t; begin InOutRes:=ConvertToFdRelativePath(s,fd,pr); if InOutRes<>0 then exit; res:=__wasi_path_remove_directory(fd,PChar(pr),Length(pr)); if res<>__WASI_ERRNO_SUCCESS then InOutRes:=Errno2InoutRes(res); end; procedure do_ChDir_internal(s: rawbytestring; SymLinkFollowCount: longint); function GetNextPart: RawByteString; var slashpos,backslashpos: longint; begin slashpos:=Pos('/',s); backslashpos:=Pos('\',s); if (slashpos<>0) and ((slashpos0 then begin result:=Copy(s,1,backslashpos-1); delete(s,1,backslashpos); end else begin result:=s; s:=''; end; while (s<>'') and (s[1] in AllowDirectorySeparators) do delete(s,1,1); end; var new_drive_nr: longint; new_dir,new_dir_save,next_dir_part: RawByteString; fd: __wasi_fd_t; pr: RawByteString; st: __wasi_filestat_t; res: __wasi_errno_t; symlink: RawByteString; begin if SymLinkFollowCount<0 then begin InOutRes:=40; exit; end; if HasDriveLetter(s) then begin new_drive_nr:=Ord(UpCase(s[1]))-(Ord('A')-1); delete(s,1,2); end else new_drive_nr:=current_drive; if (new_drive_nr>=drives_count) or (current_dirs[new_drive_nr].dir_name='') then begin InoutRes:=15; exit; end; new_dir:=current_dirs[new_drive_nr].dir_name; if s<>'' then begin if s[1] in AllowDirectorySeparators then begin delete(s,1,1); new_dir:=DirectorySeparator; end; while s<>'' do begin next_dir_part:=GetNextPart; if next_dir_part='.' then {nothing to do} else if next_dir_part='..' then begin if (new_dir<>'') and not (new_dir[Length(new_dir)] in AllowDirectorySeparators) then begin while (new_dir<>'') and not (new_dir[Length(new_dir)] in AllowDirectorySeparators) do delete(new_dir,Length(new_dir),1); while (new_dir<>'') and (new_dir[Length(new_dir)] in AllowDirectorySeparators) do delete(new_dir,Length(new_dir),1); if (Pos('/',new_dir)=0) and (Pos('\',new_dir)=0) then new_dir:=new_dir+DirectorySeparator; end; end else begin new_dir_save:=new_dir; if (new_dir<>'') and (new_dir[Length(new_dir)] in AllowDirectorySeparators) then new_dir:=new_dir+next_dir_part else new_dir:=new_dir+DirectorySeparator+next_dir_part; if ConvertToFdRelativePath(current_dirs[new_drive_nr].drive_str+new_dir,fd,pr)<>0 then begin {...} InOutRes:=3; exit; end; res:=__wasi_path_filestat_get(fd,0,PChar(pr),Length(pr),@st); if res<>__WASI_ERRNO_SUCCESS then begin if res=__WASI_ERRNO_NOENT then InOutRes:=3 else InOutRes:=Errno2InoutRes(res); exit; end; if st.filetype=__WASI_FILETYPE_SYMBOLIC_LINK then begin res:=fpc_wasi_path_readlink_ansistring(fd,PChar(pr),Length(pr),symlink); if res<>__WASI_ERRNO_SUCCESS then begin InOutRes:=Errno2InoutRes(res); exit; end; if (symlink<>'') and (symlink[1] in AllowDirectorySeparators) then do_ChDir_internal(symlink,SymLinkFollowCount-1) else if (new_dir_save<>'') and (new_dir_save[length(new_dir_save)] in AllowDirectorySeparators) then do_ChDir_internal(current_dirs[new_drive_nr].drive_str+new_dir_save+symlink,SymLinkFollowCount-1) else do_ChDir_internal(current_dirs[new_drive_nr].drive_str+new_dir_save+DirectorySeparator+symlink,SymLinkFollowCount-1); exit; end else if st.filetype<>__WASI_FILETYPE_DIRECTORY then begin InOutRes:=5; exit; end; end; end; end; current_drive:=new_drive_nr; current_dirs[new_drive_nr].dir_name:=new_dir; InOutRes:=0; end; procedure do_ChDir(s: rawbytestring); begin do_ChDir_internal(s, 40); end; procedure do_getdir(drivenr : byte;var dir : rawbytestring); begin if drivenr=0 then drivenr:=current_drive; if (drivenr'') then begin dir:=current_dirs[drivenr].drive_str+current_dirs[drivenr].dir_name; InOutRes:=0; end else InoutRes:=15; end;