abstract
[Files handling (listing, copying, ...)] ; eol
# Copyright Hubert Tonneau hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License version 2
# as published by the Free Software Foundation.
#
# 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. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# version 2 along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
submodule "/pliant/language/stream/filebase1.pli"
submodule "/pliant/language/stream/filebase2.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/stream/filesystembase.pli"
module "/pliant/language/os.pli"
constant trace false
constant advanced_tmp false
if os_api="linux" or os_api="posix"
if advanced_tmp
gvar Sem temp_sem ; gvar Str temp_path ; gvar Int temp_counter
function file_configure filename options command -> status
arg Str filename options command ; arg ExtendedStatus status
status := pliant_default_file_system configure filename options command
function file_configure filename command -> status
arg Str filename command ; arg ExtendedStatus status
status := file_configure filename "" command
export file_configure
#----------------------------------------------------------------------
function file_tree_create filename -> status
arg Str filename ; arg Status status
var Str path := filename 0 (filename search_last "/" -1)+1
if (file_query path standard+directories)=defined
status := success
eif path<>""
status := shunt (file_tree_create (path 0 path:len-1))=success and (file_configure path "mkdir")=success success failure
else
status := failure
#--------------------------------------------------------------------------
function file_delete filename -> status
arg Str filename ; arg ExtendedStatus status
if filename:len>0 and (filename filename:len-1)="/"
status := file_configure (filename 0 filename:len-1) "delete"
if status=failure
status := file_configure filename "rmdir"
else
status := file_configure filename "delete"
if os_api="linux" or os_api="posix"
if advanced_tmp
temp_sem request
if temp_path:len<>0 and (filename 0 temp_path:len)=temp_path
if (os_rmdir (temp_path 5 temp_path:len))=0
temp_path := ""
temp_sem release
function file_link src dest force -> status
arg Str src dest ; arg CBool force ; arg ExtendedStatus status
var Str target := (file_query src extended):options option "os_name" Str
if target<>""
status := file_configure dest "link "+string:target+(shunt force " force" "")
eif (target search "/" -1)=(-1)
status := file_configure dest "link "+string:src+(shunt force " force" "")
else
status := failure
function file_link src dest -> status
arg Str src dest ; arg Status status
status := file_link src dest false
function file_clone src dest force -> status
arg Str src dest ; arg CBool force ; arg ExtendedStatus status
var Str target := (file_query dest extended):options option "os_name" Str
if target<>""
status := file_configure src "clone "+string:target+(shunt force " force" "")
else
status := failure
function file_clone src dest -> status
arg Str src dest ; arg ExtendedStatus status
status := file_clone src dest false
module "/pliant/language/stream/listmode.pli"
module "/pliant/language/compiler.pli"
|
constant use_sendfile false # os_api="linux"
if use_sendfile
function os_sendfile64 out_fd in_fd offset count -> copied
arg Int out_fd in_fd ; arg_rw Int64 offset ; arg Int count copied
kernel_function 239
|
function file_copy src dest flags -> status
arg FileInfo src dest ; arg Int flags ; arg ExtendedStatus status
check (flags .and. recursive)=0
check (flags .and. delete)=0 or (flags .and. bidirectional)=0
check src:datetime=defined or dest:datetime=defined or (flags .and. (lazy .or. newer .or. bidirectional))=0
if (flags .and. bidirectional)<>0
if dest=defined and (src=undefined or (src:datetime=defined and dest:datetime=defined and dest:datetime>src:datetime))
return (file_copy dest src flags)
if (flags .and. (newer .or. bidirectional))<>0
if src:datetime=defined and dest:datetime=defined and dest:datetime>=src:datetime
return success
if (flags .and. lazy)<>0
if dest:datetime=src:datetime and dest:size=src:size
return success
var Str cmd
if (flags .and. level_flags)>=standard and src:datetime=defined
src:datetime split (var Int year) (var Int month) (var Int day) (var Int hour) (var Int minute) (var Int second) (var Float fraction)
cmd := "datetime "+string:year+"/"+string:month+"/"+string:day+" "+string:hour+":"+string:minute+":"+string:second
else
cmd := ""
cmd += (shunt cmd<>"" " " "")+"file_size "+(string src:size)
if (flags .and. level_flags)>=extended and src:options<>""
cmd += (shunt cmd<>"" " " "")+src:options
if src:is_link and (flags .and. linktransparent)=0
if ((dest:options option "link" Str)=(src:options option "link" Str))
return success
if (file_configure dest:name "link "+string:(src:options option "link" Str)+" force")=success
return success
file_tree_create dest:name
return (file_configure dest:name "link "+string:(src:options option "link" Str))
|
eif src:is_directory
|
eif src:is_directory and (flags .and. forcefile)=0
|
if dest=defined and dest:is_directory
status := success
else
status := file_tree_create dest:name
else
var Stream s ; s open src:name in+safe+bigcache
if s=failure
return failure
var Stream d ; d open dest:name cmd out+mkdir+safe+bigcache
if d=failure
return failure
var Intn total := 0
|
while { var Int step := raw_copy s d 1 2^30 ; step>0 }
total += step
|
if use_sendfile and s:stream_handle<>undefined and d:stream_handle<>undefined
while { var Int step := os_sendfile64 d:stream_handle s:stream_handle (null map Int64) 2^16 ; step>0 }
total += step
if not use_sendfile or total=0
while { var Int step := raw_copy s d 1 2^30 ; step>0 }
total += step
|
if (flags .and. level_flags)<standard
status := success
eif (s safe_query "encoding")<>"" or (d safe_query "encoding")<>""
status := success
else
status := shunt total=src:size success failure
if d:close=failure # let's close the destination first as a workaround Linux stalled connections on close when using NAT
status := failure
if s:close=failure
status := failure
if cmd<>""
file_configure dest:name cmd
if trace
console src:name+" -> "+dest:name+(shunt status=success " success" " failure")+"[lf]"
function file_copy src dest flags -> status
arg Str src dest ; arg Int flags ; arg ExtendedStatus status
status := file_copy (file_query src extended) (file_query dest extended) flags
(the_function file_copy FileInfo FileInfo Int -> ExtendedStatus) extra_module :> the_module "/pliant/language/stream/listmode.pli"
(the_function file_copy Str Str Int -> ExtendedStatus) extra_module :> the_module "/pliant/language/stream/listmode.pli"
function file_copy src dest -> status
arg Str src dest ; arg ExtendedStatus status
status := file_copy src dest extended
function file_move oldfilename newfilename -> status
arg Str oldfilename newfilename ; arg ExtendedStatus status
if newfilename=oldfilename
return success
var Str target := (file_query newfilename extended):options option "os_name" Str
if target<>""
if (file_configure oldfilename "move "+string:target)=success
return success
status := file_copy oldfilename newfilename
if status=success and newfilename<>oldfilename
file_delete oldfilename
function mode u g o -> m
arg Int u g o m
m := u*8^2+g*8+o
function file_rights info owner group on off
arg FileInfo info ; arg Int owner group on off
var Int m := info:options option "mode" Int
var Int m2 := (m .and. .not. off) .or. on
if (shunt owner=defined (info:options option "uid" Int)<>owner false) or (shunt group=defined (info:options option "gid" Int)<>group false) or m2<>m
file_configure info:name (shunt owner=defined "uid "+string:owner "")+" "+(shunt group=defined "gid "+string:group "")+" "+(shunt m2<>m "mode "+string:m2 "")
# console "setting access rights for " info:name eol
function file_rights filename owner group on off
arg Str filename ; arg Int owner group on off
file_rights (file_query filename extended) owner group on off
function file_directory_flush filename -> status
arg Str filename ; arg ExtendedStatus status
var Str path := filename 0 (filename search_last "/" -1)
status := file_configure path "flush"
#----------------------------------------------------------------------
function file_tree_delete path -> status
arg Str path ; arg ExtendedStatus status
var Array:FileInfo subs := file_list path extended+directories+deadlinks
for (var Int i) 0 subs:size-1
if subs:i:is_directory and not subs:i:is_link
file_tree_delete subs:i:name
else
file_delete subs:i:name
status := file_delete path
function file_name_concat path subpath -> fullpath
arg Str path subpath fullpath
if path:len>0 and path:0="[dq]" and (path parse (var Str strippedpath) any:(var Str options))
fullpath := (string strippedpath+subpath)+(shunt options<>"" " " "")+options
else
fullpath := path+subpath
function file_tree_copy src dest flags -> status
arg Str src dest ; arg Int flags ; arg ExtendedStatus status
check (flags .and. delete)=0 or (flags .and. bidirectional)=0
check src<>"" and (src src:len-1)="/" and dest<>"" and (dest dest:len-1)="/"
status := success
var Array:FileInfo src_files := file_list src extended+recursive+relative
for (var Int i) 0 src_files:size-1
var FileInfo srci := src_files i ; srci name := file_name_concat src srci:name
var FileInfo desti := file_query (file_name_concat dest src_files:i:name) extended
if (file_copy srci desti flags)=failure
status := failure
if (flags .and. (bidirectional .or. delete))<>0
var Array:FileInfo dest_files := file_list dest extended+recursive+relative
for (var Int i) 0 dest_files:size-1
var FileInfo desti := dest_files i ; desti name := file_name_concat dest desti:name
var FileInfo srci := file_query (file_name_concat src dest_files:i:name) extended
if srci=undefined
if (flags .and. bidirectional)<>0
if (file_copy desti srci flags)=failure
status := failure
else
check (flags .and. delete)<>0
if (file_delete desti:name)=failure
status := failure
(the_function file_tree_copy Str Str Int -> ExtendedStatus) extra_module :> the_module "/pliant/language/stream/listmode.pli"
function file_tree_copy src dest -> status
arg Str src dest ; arg ExtendedStatus status
status := file_tree_copy src dest extended
function file_tree_rights path owner group files_on files_off dirs_on dirs_off
arg Str path ; arg Int owner group files_on files_off dirs_on dirs_off
var Array:FileInfo files := file_list path extended+recursive+directories
for (var Int i) 0 files:size-1
if files:i:is_directory
file_rights files:i owner group dirs_on dirs_off
else
file_rights files:i owner group files_on files_off
file_rights path owner group dirs_on dirs_off
function file_tree_cleanup path
arg Str path
check path<>"" and (path path:len-1)="/"
var Array:FileInfo subs := file_list path extended+directories
for (var Int i) 0 subs:size-1
if subs:i:is_directory and not subs:i:is_link
file_tree_cleanup subs:i:name
file_delete path
#--------------------------------------------------------------------------
if os_api="linux" or os_api="posix"
if advanced_tmp
function file_temporary -> name
arg Str name
temp_sem request
var Int try_count := 0
while temp_path=""
temp_path := "file:/tmp/pliant"+string:os_getpid+"_"+string:try_count+"/"
temp_counter := 0
if (os_mkdir (temp_path 5 temp_path:len) 7*8^2)<>0
temp_path := "" ; try_count += 1
temp_counter += 1
name := temp_path+string:temp_counter+".tmp"
temp_sem release
function file_temporary_cleanup
if (file_query "file:/proc/" standard)=defined
var Array:FileInfo files := file_list "file:/tmp/" standard+directories
(var Relation processes) flags := 0
var Array:FileInfo proc := file_list "file:/proc/" standard
for (var Int i) 0 proc:size-1
if (proc:i:name parse "file:/proc/" (var Int pid) "/")
processes define (cast pid Address) null (cast -1 Address)
for (var Int i) 0 files:size-1
if (files:i:name parse "file:/tmp/pliant" (var Int pid) "_" any "/")
if (processes query (cast pid Address) null)=null
file_tree_delete files:i:name
function reset_temporary parameter filehandle
arg Address parameter ; arg Int filehandle
temp_path := ""
gvar DelayedAction da
da function :> the_function reset_temporary Address Int
pliant_restore_actions append addressof:da
else
gvar Sem temp_sem
gvar Int temp_counter := 0
function file_temporary -> name
arg Str name
part generate_name
temp_sem request
temp_counter += 1
name := "file:/tmp/pliant_"+string:os_getpid+"_"+string:temp_counter+".tmp"
temp_sem release
if (file_query name standard)=defined
file_delete name
restart generate_name
function file_temporary_cleanup
void
eif os_api="win32"
gvar Sem temp_sem
gvar Int temp_counter := 0
function file_temporary -> name
arg Str name
temp_sem request
var Str tmp := os_environment_variable "TMP"
if tmp:len=0
tmp := os_environment_variable "TEMP"
if tmp:len=0
tmp := "c:\temp"
temp_counter += 1
name := "file:"+(replace tmp "\" "/")+"/pliant_"+string:os_getpid+"_"+string:temp_counter+".tmp"
temp_sem release
function file_temporary_cleanup
void
eif os_api="os2"
gvar Sem temp_sem
gvar Int temp_counter := 0
function file_temporary -> name
arg Str name
temp_sem request
temp_counter += 1
name := "file:c:/tmp/pliant_"+string:os_getpid+"_"+string:temp_counter+".tmp"
temp_sem release
function file_temporary_cleanup
void
function file_temporary filename options -> temp
arg Str filename options temp
if (options option "notmp")
return filename
var Str temp0
if (temp eparse (var Str base) any:(var Str opt))
temp0 := string:(file_temporary base options)+opt
else
temp0 := filename+".tmp"
var Int counter := 0
part checkit
temp := temp0+(shunt counter=0 "" string:counter)
if (file_query temp standard)=defined
counter += 1
restart checkit
function file_os_name filename -> osname
arg Str filename osname
osname := (file_query filename extended):options option "os_name" Str
function file_hook filename
arg Str filename
plugin hook
#--------------------------------------------------------------------------
export file_delete file_link file_clone file_copy file_move file_rights file_directory_flush
export file_tree_create file_tree_delete file_tree_copy file_tree_rights file_tree_cleanup
export file_temporary file_temporary_cleanup file_os_name file_hook
|