Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Source file env.ml
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482openImportmoduleWorking_dir_spec=structtypet=|Inherit|Pathofstring|Physicalof{path:string;fd:Unix.file_descr}endmoduleWorking_dir=struct(* Physical working directories are ref-counted so that the file descriptor can be
closed as soon as it is not needed anymore. This allow to optimize a [chdir] in tail
position. *)modulePhysical=structtypet=|Win32(* Physical path is not supported on Windows *)|Unixof{fd:Unix.file_descr;mutableusers:int;mutex:Mutex.t}letcreate_unixfd=Unix{fd;users=1;mutex=Mutex.create()}letaddref=function|Win32->()|Unixu->Mutex.locku.mutex;letusers=u.users+1inu.users<-users;Mutex.unlocku.mutex;(* One must not try to reference a physical path that has been released *)assert(users>=2)letderef=function|Win32->()|Unixu->Mutex.locku.mutex;letusers=u.users-1inu.users<-users;Mutex.unlocku.mutex;assert(users>=0);ifusers=0thentryUnix.closeu.fdwith_->()letmap_unixt~f=matchtwith|Win32->Win32|Unixu->create_unix(fu.fd)endtypet={logical:string;physical:Physical.t}letcreate(spec:Working_dir_spec.t)=letlogical,physical=matchspecwith|Inherit->(Sys.getcwd(),None)|Pathp->(p,None)|Physical{path;fd}->(path,Somefd)inletphysical:Physical.t=matchphysical,Sys.win32with|Some_,true->invalid_arg"Shexp_exec.Std.Env.create: cannot use a physical \
working directory on Windows";|Somefd,false->Physical.create_unixfd|None,true->Win32|None,false->Physical.create_unix(Unix.openfilelogical[O_CLOEXEC;O_RDONLY]0)in{logical;physical}letsplit_relative_dirdir=letrecloopdiracc=letacc=Filename.basenamedir::accinletdir=Filename.dirnamedirinifdir=Filename.current_dir_namethenaccelseloopdiraccinloopdir[]letchdir_logicaldirrelative_dir=letrecloopdircomponents~symlinks_followed=matchcomponentswith|[]->dir|component::rest->ifcomponent=Filename.current_dir_namethenloopdirrest~symlinks_followedelseifcomponent=Filename.parent_dir_namethenmatchUnix.readlinkdirwith|exception(Unix.Unix_error(EINVAL,_,_))->loop(Filename.dirnamedir)rest~symlinks_followed|target->letsymlinks_followed=symlinks_followed+1inifsymlinks_followed=1000thenraiseExit;(* The current dir is a symlink, we need to resolve it before we can interpret
the ".." *)ifFilename.is_relativetargetthenloopdir(split_relative_dirtarget@components)~symlinks_followedelselooptargetcomponents~symlinks_followedelseloop(dir^/component)rest~symlinks_followedinletcomponents=split_relative_dirrelative_dirintryloopdircomponents~symlinks_followed:0withExit->raise(Unix.Unix_error(ELOOP,"chdir",dir^/relative_dir))letchdirtdir=ifdir=Filename.current_dir_namethentelseletlogical=ifFilename.is_relativedirthenchdir_logicalt.logicaldirelsedirinletphysical=Physical.map_unixt.physical~f:(funfd->Posixat.openat~dir:fd~flags:[O_RDONLY]~path:dir~perm:0)in{logical;physical}letaddreft=Physical.addreft.physicalletdereft=Physical.dereft.physicalendmoduleUenv=structtypet={entries:stringSMap.t;(* The [PATH] variable pre-splitted *)path:stringlist}letgettvar=SMap.lookupvart.entriesletsplit_pathstr=letlen=String.lengthstrinletis_sepc=c=':'inletrecloopij=ifj=lenthen[String.substr~pos:i~len:(j-i)]elseifis_sepstr.[j]thenString.substr~pos:i~len:(j-i)::loop(j+1)(j+1)elseloopi(j+1)inloop00letsettvarvalue=letentries=SMap.addt.entries~key:var~data:valueinifvar="PATH"then{entries;path=split_pathvalue}else{twithentries}letunsettvar=letentries=SMap.removevart.entriesinifvar="PATH"then{entries;path=[]}else{twithentries}letcreateinitial~pwd=letentries=matchinitialwith|Somel->List.fold_leftl~init:SMap.empty~f:(funacc(key,data)->SMap.addacc~key~data)|None->Array.fold_left(Unix.environment())~init:SMap.empty~f:(funaccs->leti=String.indexs'='inletkey=String.subs~pos:0~len:iinletdata=String.subs~pos:(i+1)~len:(String.lengths-i-1)inSMap.addacc~key~data)inletentries=SMap.addentries~key:"PWD"~data:pwdinletpath=matchSMap.find"PATH"entrieswith|exceptionNot_found->[]|s->split_pathsin{entries;path}endtypet={stdin:Unix.file_descr;stdout:Unix.file_descr;stderr:Unix.file_descr;cwd:Working_dir.t;unix_env:Uenv.t}letcreate?(stdin=Unix.stdin)?(stdout=Unix.stdout)?(stderr=Unix.stderr)?(cwd=Working_dir_spec.Inherit)?unix_env()=letcwd=Working_dir.createcwdinletunix_env=Uenv.createunix_env~pwd:cwd.logicalin{stdin;stdout;stderr;cwd;unix_env}letadd_cwd_reft=Working_dir.addreft.cwdletderef_cwdt=Working_dir.dereft.cwdletget_envtvar=Uenv.gett.unix_envvarletset_envtvarvalue={twithunix_env=Uenv.sett.unix_envvarvalue}letunset_envtvar={twithunix_env=Uenv.unsett.unix_envvar}letset_env_manytbindings=letunix_env=List.fold_leftbindings~init:t.unix_env~f:(funuenv(var,value)->Uenv.setuenvvarvalue)in{twithunix_env}letunset_env_manytbindings=letunix_env=List.fold_leftbindings~init:t.unix_env~f:Uenv.unsetin{twithunix_env}letstdint=t.stdinletstdoutt=t.stdoutletstderrt=t.stderrletset_stdintfd={twithstdin=fd}letset_stdouttfd={twithstdout=fd}letset_stderrtfd={twithstderr=fd}letset_outputstfd={twithstdout=fd;stderr=fd}letset_stdiost~stdin~stdout~stderr={twithstdin;stdout;stderr}letget_stdiot(which:Std_io.t)=matchwhichwith|Stdin->t.stdin|Stdout->t.stdout|Stderr->t.stderrletset_stdiot(which:Std_io.t)x=matchwhichwith|Stdin->set_stdintx|Stdout->set_stdouttx|Stderr->set_stderrtxletcwd_logicalt=t.cwd.logicalletchdirtdir=letcwd=Working_dir.chdirt.cwddirinletunix_env=Uenv.sett.unix_env"PWD"cwd.logicalin{twithcwd;unix_env}letfind_executabletexe=letrecloop=function|[]->None|path::rest->letfn=path^/exeinifSys.file_existsfnthenSomefnelselooprestinifnot(Filename.is_relativeexe)thenSomeexeelseifFilename.basenameexe<>exethenSomeexeelseloopt.unix_env.pathtyperun_error=|Command_not_foundletspawnt~prog~args=matchfind_executabletprogwith|None->ErrorCommand_not_found|Somereal_prog->letenv=SMap.foldt.unix_env.entries~init:[]~f:(fun~key~dataacc->sprintf"%s=%s"keydata::acc)|>Spawn.Env.of_listinletcwd:Spawn.Working_dir.t=matcht.cwd.physicalwith|Win32->Patht.cwd.logical|Unixu->Fdu.fdinletpid=Spawn.spawn()~env~cwd~prog:real_prog~argv:(prog::args)~stdin:t.stdin~stdout:t.stdout~stderr:t.stderrinOkpidtypefull_path=|Pathofstring|In_dirofUnix.file_descr*stringletmk_logical_pathtpath=ifFilename.is_relativepaththent.cwd.logical^/pathelsepathletfull_pathtpath=matcht.cwd.physicalwith|Win32->Path(mk_logical_pathtpath)|Unixu->In_dir(u.fd,path)typefull_path2=|Pathofstring*string|In_dirofUnix.file_descr*string*stringletfull_path2tpath1path2=matcht.cwd.physicalwith|Win32->Path(mk_logical_pathtpath1,mk_logical_pathtpath2)|Unixu->In_dir(u.fd,path1,path2)letopen_filet?(perm=0)~flagspath=matchfull_pathtpathwith|Pathpath->Unix.openfilepath(O_CLOEXEC::List.map~f:Posixat.Open_flag.to_unix_open_flag_exnflags)perm|In_dir(dir,path)->Posixat.openat~dir~path~perm~flags:(O_CLOEXEC::flags)letclose_noerrt=tryUnix.closetwith_->()letwith_filet?perm~flagspath~f=letfd=open_filetpath~flags?perminmatchffdwith|x->Unix.closefd;x|exceptione->close_noerrfd;raiseeletmkdir_onet~permpath=matchfull_pathtpathwith|Pathpath->Unix.mkdirpathperm|In_dir(dir,path)->Posixat.mkdirat~dir~path~permletrecmkdirt?(perm=0o777)?(p=false)path=ifnotpthenmkdir_onetpath~permelsetrymkdir_onetpath~permwith|Unix.Unix_error((EEXIST|EISDIR),_,_)->()|Unix.Unix_error(ENOENT,_,_)whenFilename.basenamepath<>path->mkdirt(Filename.dirnamepath)~perm~p;mkdir_onetpath~permletchmodtpath~perm=matchfull_pathtpathwith|Pathpath->Unix.chmodpathperm|In_dir(dir,path)->Posixat.fchmodat~dir~path~perm~flags:[]letchowntpath~uid~gid=matchfull_pathtpathwith|Pathpath->Unix.chownpathuidgid|In_dir(dir,path)->Posixat.fchownat~dir~path~uid~gid~flags:[]letrmtpath=matchfull_pathtpathwith|Pathpath->Unix.unlinkpath|In_dir(dir,path)->Posixat.unlinkat~dir~path~flags:[]letrmdirtpath=matchfull_pathtpathwith|Pathpath->Unix.rmdirpath|In_dir(dir,path)->Posixat.unlinkat~dir~path~flags:[AT_REMOVEDIR]letmkfifot?(perm=0o666)path=matchfull_pathtpathwith|Pathpath->Unix.mkfifopathperm|In_dir(dir,path)->Posixat.mkfifoat~dir~path~permletlinktoldpathnewpath=matchfull_path2toldpathnewpathwith|Path(oldpath,newpath)->Unix.linkoldpathnewpath|In_dir(dir,oldpath,newpath)->Posixat.linkat~olddir:dir~newdir:dir~oldpath~newpath~flags:[]letsymlinktoldpathnewpath=matchfull_path2toldpathnewpathwith|Path(oldpath,newpath)->Unix.symlinkoldpathnewpath|In_dir(dir,oldpath,newpath)->Posixat.symlinkat~newdir:dir~oldpath~newpathletrenametoldpathnewpath=matchfull_path2toldpathnewpathwith|Path(oldpath,newpath)->Unix.renameoldpathnewpath|In_dir(dir,oldpath,newpath)->Posixat.renameat~olddir:dir~newdir:dir~oldpath~newpathletstattpath=matchfull_pathtpathwith|Pathpath->Unix.statpath|In_dir(dir,path)->Posixat.fstatat~dir~path~flags:[]letlstattpath=matchfull_pathtpathwith|Pathpath->Unix.lstatpath|In_dir(dir,path)->Posixat.fstatat~dir~path~flags:[AT_SYMLINK_NOFOLLOW]letreadlinktpath=matchfull_pathtpathwith|Pathpath->Unix.readlinkpath|In_dir(dir,path)->Posixat.readlinkat~dir~pathletaccesstpathmode=matchfull_pathtpathwith|Pathpath->Unix.accesspathmode|In_dir(dir,path)->Posixat.faccessat~dir~path~mode~flags:[]letreaddirtpath=matchfull_pathtpathwith|Pathpath->Sys.readdirpath|>Array.to_list|In_dir(dir,path)->letfd=Posixat.openat~dir~path~flags:[O_RDONLY]~perm:0inmatchPosixat.fdopendirfdwith|exceptione->close_noerrfd;raisee|dh->letrecloopdhacc=matchUnix.readdirdhwith|"."|".."->loopdhacc|fname->loopdh(fname::acc)|exceptionEnd_of_file->Unix.closedirdh;List.revacc|exceptione->Unix.closedirdh;raiseeinloopdh[]