1 (* HCoop
Domtool (http
://hcoop
.sourceforge
.net
/)
2 * Copyright (c
) 2006, Adam Chlipala
4 * This program is free software
; you can redistribute it
and/or
5 * modify it under the terms
of the GNU General Public License
6 * as published by the Free Software Foundation
; either version
2
7 * of the License
, or (at your option
) any later version
.
9 * This program is distributed
in the hope that it will be useful
,
10 * but WITHOUT ANY WARRANTY
; without even the implied warranty
of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE
. See the
12 * GNU General Public License for more details
.
14 * You should have received a copy
of the GNU General Public License
15 * along
with this program
; if not
, write to the Free Software
16 * Foundation
, Inc
., 51 Franklin Street
, Fifth Floor
, Boston
, MA
02110-1301, USA
.
19 (* Domain
-related primitive actions
*)
21 structure Domain
:> DOMAIN
= struct
23 fun isIdent ch
= Char.isLower ch
orelse Char.isDigit ch
26 size s
> 0 andalso size s
< 20
27 andalso CharVector
.all (fn ch
=> isIdent ch
orelse ch
= #
"-") s
30 size s
> 0 andalso size s
< 100
31 andalso List.all
validHost (String.fields (fn ch
=> ch
= #
".") s
)
33 val _
= Env
.type_one
"host"
37 val _
= Env
.type_one
"domain"
43 val befores
= ref (fn (_
: string) => ())
44 val afters
= ref (fn (_
: string) => ())
46 fun registerBefore f
=
50 befores
:= (fn x
=> (old x
; f x
))
57 afters
:= (fn x
=> (old x
; f x
))
61 val currentPath
= ref
""
65 fun currentDomain () = !current
67 fun domainFile name
= TextIO.openOut (!currentPath ^ name
)
71 val toks
= String.fields (fn ch
=> ch
= #
".") domain
73 val elems
= foldr (fn (piece
, elems
) =>
75 val elems
= piece
:: elems
76 val path
= String.concatWith
"/" (Config
.resultRoot
:: rev elems
)
77 val tmpPath
= String.concatWith
"/" (Config
.tmpDir
:: rev elems
)
79 (if Posix
.FileSys
.ST
.isDir
80 (Posix
.FileSys
.stat path
) then
83 (OS
.FileSys
.remove path
;
84 OS
.FileSys
.mkDir path
))
85 handle OS
.SysErr _
=> OS
.FileSys
.mkDir path
;
87 (if Posix
.FileSys
.ST
.isDir
88 (Posix
.FileSys
.stat tmpPath
) then
91 (OS
.FileSys
.remove tmpPath
;
92 OS
.FileSys
.mkDir tmpPath
))
93 handle OS
.SysErr _
=> OS
.FileSys
.mkDir tmpPath
;
98 fn root
=> String.concatWith
"/" (root
:: rev ("" :: elems
))
101 datatype file_action
' =
102 Add
' of {src
: string, dst
: string}
104 | Modify
' of {src
: string, dst
: string}
106 fun shell ss
= OS
.Process
.isSuccess (OS
.Process
.system (String.concat ss
))
108 fun shellF (ss
, msg
) =
110 val s
= String.concat ss
112 if OS
.Process
.isSuccess (OS
.Process
.system s
) then
115 ErrorMsg
.error
NONE (msg s
)
120 val realPath
= getPath dom Config
.resultRoot
121 val tmpPath
= !currentPath
123 val dir
= Posix
.FileSys
.opendir realPath
126 case Posix
.FileSys
.readdir dir
of
127 NONE
=> (Posix
.FileSys
.closedir dir
;
131 val real = OS
.Path
.joinDirFile
{dir
= realPath
,
133 val tmp
= OS
.Path
.joinDirFile
{dir
= tmpPath
,
136 if Posix
.FileSys
.ST
.isDir (Posix
.FileSys
.stat
real) then
138 else if Posix
.FileSys
.access (tmp
, []) then
139 if shell
[Config
.diff
, " ", real, " ", tmp
] then
142 loopReal (Modify
' {src
= tmp
, dst
= real} :: acts
)
144 loopReal (Delete
' real :: acts
)
147 val acts
= loopReal
[]
149 val dir
= Posix
.FileSys
.opendir realPath
152 case Posix
.FileSys
.readdir dir
of
153 NONE
=> (Posix
.FileSys
.closedir dir
;
157 val real = OS
.Path
.joinDirFile
{dir
= realPath
,
159 val tmp
= OS
.Path
.joinDirFile
{dir
= tmpPath
,
162 if Posix
.FileSys
.ST
.isDir (Posix
.FileSys
.stat tmp
) then
164 else if Posix
.FileSys
.access (real, []) then
167 loopTmp (Add
' {src
= tmp
, dst
= real} :: acts
)
170 val acts
= loopTmp acts
175 val _
= Env
.container_one
"domain"
176 ("domain", Env
.string)
179 val path
= getPath dom Config
.tmpDir
190 val diffs
= findDiffs dom
192 val diffs
= map (fn Add
' {src
, dst
} =>
193 (shellF ([Config
.cp
, " ", src
, " ", dst
],
194 fn cl
=> "Copy failed: " ^ cl
);
199 (OS
.FileSys
.remove dst
200 handle OS
.SysErr _
=>
201 ErrorMsg
.error
NONE ("Delete failed for " ^ dst
);
202 {action
= Slave
.Delete
,
205 | Modify
' {src
, dst
} =>
206 (shellF ([Config
.cp
, " ", src
, " ", dst
],
207 fn cl
=> "Copy failed: " ^ cl
);
208 {action
= Slave
.Modify
,
212 if !ErrorMsg
.anyErrors
then
215 Slave
.handleChanges diffs
;
216 ignore (shellF ([Config
.rm
, " -rf ", Config
.tmpDir
, "/*"],
217 fn cl
=> "Temp file cleanup failed: " ^ cl
))