1
2(********************************************************************)
3(*                                                                  *)
4(*  sydir7.sd7    Utility to synchronize directory trees            *)
5(*  Copyright (C) 2009 - 2019  Thomas Mertes                        *)
6(*                                                                  *)
7(*  This program is free software; you can redistribute it and/or   *)
8(*  modify it under the terms of the GNU General Public License as  *)
9(*  published by the Free Software Foundation; either version 2 of  *)
10(*  the License, or (at your option) any later version.             *)
11(*                                                                  *)
12(*  This program is distributed in the hope that it will be useful, *)
13(*  but WITHOUT ANY WARRANTY; without even the implied warranty of  *)
14(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   *)
15(*  GNU General Public License for more details.                    *)
16(*                                                                  *)
17(*  You should have received a copy of the GNU General Public       *)
18(*  License along with this program; if not, write to the           *)
19(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
20(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
21(*                                                                  *)
22(********************************************************************)
23
24
25$ include "seed7_05.s7i";
26  include "stdio.s7i";
27  include "osfiles.s7i";
28  include "time.s7i";
29  include "duration.s7i";
30
31const type: syncFlags is new struct
32    var boolean: removeFilesAtDest is FALSE;
33    var boolean: overwriteNewerDestFiles is FALSE;
34    var boolean: doChanges is TRUE;
35  end struct;
36
37
38const proc: syncFile (in string: sourcePath, in string: destPath,
39    in syncFlags: flags) is forward;
40
41
42const proc: syncDir (in string: sourcePath, in string: destPath,
43    in syncFlags: flags) is func
44  local
45    var array string: sourceContent is 0 times "";
46    var array string: destContent is 0 times "";
47    var boolean: updateMtime is FALSE;
48    var integer: sourceIndex is 1;
49    var integer: destIndex is 1;
50    var string: sourceName is "";
51    var string: destName is "";
52  begin
53    if getMTime(sourcePath) + 1 . SECONDS >= getMTime(destPath) then
54      updateMtime := TRUE;
55    end if;
56    sourceContent := readDir(sourcePath);
57    destContent := readDir(destPath);
58    # writeln("syncDir " <& literal(sourcePath) <& " " <& literal(destPath));
59    while sourceIndex <= length(sourceContent) and
60        destIndex <= length(destContent) do
61      sourceName := sourceContent[sourceIndex];
62      destName := destContent[destIndex];
63      if sourceName = destName then
64        # writeln("syncFile = " <& literal(sourceName) <& " " <& literal(destName));
65        syncFile(sourcePath & "/" & sourceName,
66                 destPath & "/" & destName, flags);
67        incr(sourceIndex);
68        incr(destIndex);
69      elsif sourceName < destName then
70        # writeln("syncFile < " <& literal(sourceName) <& " " <& literal(destName));
71        syncFile(sourcePath & "/" & sourceName,
72                 destPath & "/" & sourceName, flags);
73        incr(sourceIndex);
74      else # sourceName > destName then
75        # writeln("syncFile > " <& literal(sourceName) <& " " <& literal(destName));
76        syncFile(sourcePath & "/" & destName,
77                 destPath & "/" & destName, flags);
78        incr(destIndex);
79      end if;
80    end while;
81    while sourceIndex <= length(sourceContent) do
82      sourceName := sourceContent[sourceIndex];
83      # writeln("syncFile S " <& literal(sourceName));
84      syncFile(sourcePath & "/" & sourceName,
85               destPath & "/" & sourceName, flags);
86      incr(sourceIndex);
87    end while;
88    while destIndex <= length(destContent) do
89      destName := destContent[destIndex];
90      # writeln("syncFile D " <& literal(destName));
91      syncFile(sourcePath & "/" & destName,
92               destPath & "/" & destName, flags);
93      incr(destIndex);
94    end while;
95    if updateMtime then
96      # writeln("update mtime " <& literal(sourcePath) <& " to " <& literal(destPath));
97      if flags.doChanges then
98        setMTime(destPath, getMTime(sourcePath));
99      end if;
100    end if;
101  end func;
102
103
104const func boolean: equalFileContent (in string: sourcePath, in string: destPath) is func
105  result
106    var boolean: equal is FALSE;
107  local
108    var file: sourceFile is STD_NULL;
109    var file: destFile is STD_NULL;
110    var string: sourceBlock is "";
111    var string: destBlock is "";
112  begin
113    sourceFile := open(sourcePath, "r");
114    if sourceFile <> STD_NULL then
115      destFile := open(destPath, "r");
116      if destFile <> STD_NULL then
117        equal := TRUE;
118        while equal and not eof(sourceFile) and not eof(destFile) do
119          sourceBlock := gets(sourceFile, 67108864);
120          destBlock := gets(destFile, 67108864);
121          equal := sourceBlock = destBlock;
122        end while;
123        if not eof(sourceFile) or not eof(destFile) then
124          equal := FALSE;
125        end if;
126        close(destFile);
127      end if;
128      close(sourceFile);
129    end if;
130  end func;
131
132
133const proc: syncFile (in string: sourcePath, in string: destPath,
134    in syncFlags: flags) is func
135  local
136    var fileType: sourceType is FILE_ABSENT;
137    var fileType: destType is FILE_ABSENT;
138    var time: sourceTime is time.value;
139    var time: destTime is time.value;
140    var array string: dirContent is 0 times "";
141    var string: fileName is "";
142  begin
143    sourceType := fileTypeSL(sourcePath);
144    destType := fileTypeSL(destPath);
145    if sourceType = FILE_ABSENT then
146      if destType <> FILE_ABSENT then
147        if flags.removeFilesAtDest then
148          writeln("remove file " <& literal(destPath));
149          if flags.doChanges then
150            removeTree(destPath);
151          end if;
152        end if;
153      end if;
154    elsif sourceType = FILE_SYMLINK then
155      if destType = FILE_ABSENT then
156        block
157          if flags.doChanges then
158            cloneFile(sourcePath, destPath);
159          end if;
160          writeln("copy symlink " <& literal(sourcePath) <& " to " <& literal(destPath));
161        exception
162          catch FILE_ERROR:
163            writeln(" *** Cannot copy symlink " <& literal(sourcePath) <& " to " <& literal(destPath));
164        end block;
165      elsif destType = FILE_SYMLINK then
166        if readLink(sourcePath) <> readLink(destPath) then
167          writeln("Source link " <& literal(sourcePath) <&
168                  " and destination link " <& literal(destPath) <&
169                  " point to different paths");
170        end if;
171      else
172        writeln(" *** Destination " <& literal(destPath) <& " is not a symbolic link");
173      end if;
174    elsif sourceType = FILE_DIR then
175      if destType = FILE_ABSENT then
176        writeln("copy directory " <& literal(sourcePath) <& " to " <& literal(destPath));
177        if flags.doChanges then
178          mkdir(destPath);
179          syncDir(sourcePath, destPath, flags);
180          setMTime(destPath, getMTime(sourcePath));
181        end if;
182      elsif destType = FILE_DIR then
183        syncDir(sourcePath, destPath, flags);
184      else
185        writeln(" *** Destination " <& literal(destPath) <& " is not a directory");
186      end if;
187    elsif sourceType = FILE_REGULAR then
188      if destType = FILE_ABSENT then
189        block
190          if flags.doChanges then
191            cloneFile(sourcePath, destPath);
192          end if;
193          writeln("copy file " <& literal(sourcePath) <& " to " <& literal(destPath));
194        exception
195          catch FILE_ERROR:
196            writeln(" *** Cannot copy file " <& literal(sourcePath) <& " to " <& literal(destPath));
197        end block;
198      elsif destType = FILE_REGULAR then
199        sourceTime := getMTime(sourcePath);
200        destTime := getMTime(destPath);
201        # writeln(sourceTime);
202        # writeln(destTime);
203        if sourceTime > destTime + 1 . SECONDS then
204          if fileSize(sourcePath) = fileSize(destPath) and equalFileContent(sourcePath, destPath) then
205            writeln("Correct time of identical files " <& literal(sourcePath) <& " - " <& literal(destPath));
206            if flags.doChanges then
207              setMTime(destPath, sourceTime);
208            end if;
209          else
210            writeln("update file " <& literal(sourcePath) <& " to " <& literal(destPath));
211            if flags.doChanges then
212              removeFile(destPath);
213              cloneFile(sourcePath, destPath);
214            end if;
215          end if;
216        elsif sourceTime < destTime - 1 . SECONDS then
217          if fileSize(sourcePath) = fileSize(destPath) and equalFileContent(sourcePath, destPath) then
218            writeln("Correct time of identical files " <& literal(sourcePath) <& " - " <& literal(destPath));
219            if flags.doChanges then
220              setMTime(destPath, sourceTime);
221            end if;
222          elsif flags.overwriteNewerDestFiles then
223            writeln("replace newer dest file " <& literal(sourcePath) <& " to " <& literal(destPath));
224            if flags.doChanges then
225              removeFile(destPath);
226              cloneFile(sourcePath, destPath);
227            end if;
228          else
229            writeln(" *** Destination newer " <& literal(sourcePath) <& " - " <& literal(destPath));
230            # writeln(sourceTime <& "   " <& destTime <& "   " <& destTime - 1 . SECONDS);
231          end if;
232        elsif fileSize(sourcePath) <> fileSize(destPath) then
233          writeln("Correct file " <& literal(sourcePath) <& " to " <& literal(destPath));
234          if flags.doChanges then
235            removeFile(destPath);
236            cloneFile(sourcePath, destPath);
237          end if;
238        end if;
239      else
240        writeln(" *** Destination " <& literal(destPath) <& " is not a regular file");
241      end if;
242    else
243      writeln(" *** Source " <& literal(sourcePath) <& " has file type " <& sourceType);
244    end if;
245  end func;
246
247
248const proc: main is func
249  local
250    var integer: numOfFileNames is 0;
251    var string: parameter is "";
252    var string: fromName is "";
253    var string: toName is "";
254    var boolean: error is FALSE;
255    var syncFlags: flags is syncFlags.value;
256  begin
257    if length(argv(PROGRAM)) < 2 then
258      writeln("Sydir7 Version 1.0 - Utility to synchronize directory trees");
259      writeln("Copyright (C) 2009 - 2019 Thomas Mertes");
260      writeln("This is free software; see the source for copying conditions.  There is NO");
261      writeln("warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.");
262      writeln("Sydir7 is written in the Seed7 programming language");
263      writeln("Homepage: http://seed7.sourceforge.net");
264      writeln;
265      writeln("usage: sydir7 {-c|-n} source destination");
266      writeln;
267      writeln("Options:");
268      writeln("  -c Copy files. Remove destination files, if they are missing in source.");
269      writeln("     Overwrite newer destination files with older source files.");
270      writeln("  -n No change. Write, what should be done to sync, but do not change");
271      writeln("     anything.");
272      writeln;
273    else
274      for parameter range argv(PROGRAM) do
275        if startsWith(parameter, "-") then
276          if parameter = "-c" then
277            flags.removeFilesAtDest := TRUE;
278            flags.overwriteNewerDestFiles := TRUE;
279          elsif parameter = "-n" then
280            flags.doChanges := FALSE;
281          else
282            writeln(" *** Unknown option: " <& parameter);
283            error := TRUE;
284          end if;
285        else
286          incr(numOfFileNames);
287          case numOfFileNames of
288            when {1}: fromName := convDosPath(parameter);
289            when {2}: toName := convDosPath(parameter);
290          end case;
291        end if;
292      end for;
293      if numOfFileNames <> 2 then
294        writeln(" *** Wrong number of parameters.");
295        error := TRUE;
296      end if;
297      if not error then
298        syncFile(fromName, toName, flags);
299      end if;
300    end if;
301  end func;
302