Moved the delete-after support into generator.c.
[rsync/rsync.git] / flist.c
diff --git a/flist.c b/flist.c
index 1bfe2df..e19b06a 100644 (file)
--- a/flist.c
+++ b/flist.c
 extern struct stats stats;
 
 extern int verbose;
-extern int do_progress;
+extern int dry_run;
+extern int list_only;
 extern int am_root;
 extern int am_server;
 extern int am_daemon;
 extern int am_sender;
+extern int do_progress;
 extern int always_checksum;
 extern int module_id;
 extern int ignore_errors;
 extern int numeric_ids;
-
 extern int recurse;
 extern int xfer_dirs;
-extern char curr_dir[MAXPATHLEN];
-extern unsigned int curr_dir_len;
-extern char *backup_dir;
-extern char *backup_suffix;
 extern int filesfrom_fd;
-
 extern int one_file_system;
 extern int keep_dirlinks;
 extern int preserve_links;
@@ -58,15 +54,20 @@ extern int preserve_uid;
 extern int preserve_gid;
 extern int relative_paths;
 extern int implied_dirs;
-extern int make_backups;
-extern int backup_suffix_len;
 extern int copy_links;
 extern int copy_unsafe_links;
 extern int protocol_version;
 extern int sanitize_paths;
 extern int max_delete;
+extern int force_delete;
 extern int orig_umask;
-extern int list_only;
+extern int make_backups;
+extern unsigned int curr_dir_len;
+extern char *backup_dir;
+extern char *backup_suffix;
+extern int backup_suffix_len;
+
+extern char curr_dir[MAXPATHLEN];
 
 extern struct filter_list_struct filter_list;
 extern struct filter_list_struct server_filter_list;
@@ -75,9 +76,8 @@ int io_error;
 
 static char empty_sum[MD4_SUM_LENGTH];
 static unsigned int file_struct_len;
-static struct file_list *received_flist;
+static struct file_list *received_flist, *sorting_flist;
 static dev_t filesystem_dev; /* used to implement -x */
-static int deletion_count = 0; /* used to implement --max-delete */
 
 static void clean_flist(struct file_list *flist, int strip_root, int no_dups);
 static void output_flist(struct file_list *flist, const char *whose_list);
@@ -145,7 +145,7 @@ static void list_file_entry(struct file_struct *f)
 
        permstring(perms, f->mode);
 
-#if SUPPORT_LINKS
+#ifdef SUPPORT_LINKS
        if (preserve_links && S_ISLNK(f->mode)) {
                rprintf(FINFO, "%s %11.0f %s %s -> %s\n",
                        perms,
@@ -178,7 +178,7 @@ static void list_file_entry(struct file_struct *f)
  **/
 static int readlink_stat(const char *path, STRUCT_STAT *buffer, char *linkbuf)
 {
-#if SUPPORT_LINKS
+#ifdef SUPPORT_LINKS
        if (copy_links)
                return do_stat(path, buffer);
        if (link_stat(path, buffer, 0) < 0)
@@ -204,7 +204,7 @@ static int readlink_stat(const char *path, STRUCT_STAT *buffer, char *linkbuf)
 
 int link_stat(const char *path, STRUCT_STAT *buffer, int follow_dirlinks)
 {
-#if SUPPORT_LINKS
+#ifdef SUPPORT_LINKS
        if (copy_links)
                return do_stat(path, buffer);
        if (do_lstat(path, buffer) < 0)
@@ -253,7 +253,7 @@ static int is_excluded(char *fname, int is_dir, int filter_level)
 
 static int to_wire_mode(mode_t mode)
 {
-#if SUPPORT_LINKS
+#ifdef SUPPORT_LINKS
        if (S_ISLNK(mode) && (_S_IFLNK != 0120000))
                return (mode & ~(_S_IFMT)) | 0120000;
 #endif
@@ -330,7 +330,7 @@ void send_file_entry(struct file_struct *file, int f, unsigned short base_flags)
        char fname[MAXPATHLEN];
        int l1, l2;
 
-       if (f == -1)
+       if (f < 0)
                return;
 
        if (!file) {
@@ -385,7 +385,7 @@ void send_file_entry(struct file_struct *file, int f, unsigned short base_flags)
        else
                modtime = file->modtime;
 
-#if SUPPORT_HARD_LINKS
+#ifdef SUPPORT_HARD_LINKS
        if (file->link_u.idev) {
                if (file->F_DEV == dev) {
                        if (protocol_version >= 28)
@@ -463,7 +463,7 @@ void send_file_entry(struct file_struct *file, int f, unsigned short base_flags)
                }
        }
 
-#if SUPPORT_LINKS
+#ifdef SUPPORT_LINKS
        if (preserve_links && S_ISLNK(mode)) {
                int len = strlen(file->u.link);
                write_int(f, len);
@@ -471,7 +471,7 @@ void send_file_entry(struct file_struct *file, int f, unsigned short base_flags)
        }
 #endif
 
-#if SUPPORT_HARD_LINKS
+#ifdef SUPPORT_HARD_LINKS
        if (flags & XMIT_HAS_IDEV_DATA) {
                if (protocol_version < 26) {
                        /* 32-bit dev_t and ino_t */
@@ -611,7 +611,7 @@ static struct file_struct *receive_file_entry(struct file_list *flist,
                }
        }
 
-#if SUPPORT_LINKS
+#ifdef SUPPORT_LINKS
        if (preserve_links && S_ISLNK(mode)) {
                linkname_len = read_int(f) + 1; /* count the '\0' */
                if (linkname_len <= 0 || linkname_len > MAXPATHLEN) {
@@ -679,7 +679,7 @@ static struct file_struct *receive_file_entry(struct file_list *flist,
        if (preserve_devices && IS_DEVICE(mode))
                file->u.rdev = rdev;
 
-#if SUPPORT_LINKS
+#ifdef SUPPORT_LINKS
        if (linkname_len) {
                file->u.link = bp;
                read_sbuf(f, bp, linkname_len - 1);
@@ -689,7 +689,7 @@ static struct file_struct *receive_file_entry(struct file_list *flist,
        }
 #endif
 
-#if SUPPORT_HARD_LINKS
+#ifdef SUPPORT_HARD_LINKS
        if (preserve_hard_links && protocol_version < 28 && S_ISREG(mode))
                flags |= XMIT_HAS_IDEV_DATA;
        if (flags & XMIT_HAS_IDEV_DATA) {
@@ -788,7 +788,7 @@ struct file_struct *make_file(char *fname, struct file_list *flist,
                    && is_excluded(thisname, 0, filter_level))
                        return NULL;
                if (save_errno == ENOENT) {
-#if SUPPORT_LINKS
+#ifdef SUPPORT_LINKS
                        /* Avoid "vanished" error if symlink points nowhere. */
                        if (copy_links && do_lstat(thisname, &st) == 0
                            && S_ISLNK(st.st_mode)) {
@@ -832,7 +832,7 @@ struct file_struct *make_file(char *fname, struct file_list *flist,
                return NULL;
 
        if (lp_ignore_nonreadable(module_id)) {
-#if SUPPORT_LINKS
+#ifdef SUPPORT_LINKS
                if (!S_ISLNK(st.st_mode))
 #endif
                        if (access(thisname, R_OK) != 0)
@@ -861,7 +861,7 @@ skip_filters:
        }
        basename_len = strlen(basename) + 1; /* count the '\0' */
 
-#if SUPPORT_LINKS
+#ifdef SUPPORT_LINKS
        linkname_len = S_ISLNK(st.st_mode) ? strlen(linkname) + 1 : 0;
 #else
        linkname_len = 0;
@@ -890,7 +890,7 @@ skip_filters:
        file->uid = st.st_uid;
        file->gid = st.st_gid;
 
-#if SUPPORT_HARD_LINKS
+#ifdef SUPPORT_HARD_LINKS
        if (flist && flist->hlink_pool) {
                if (protocol_version < 28) {
                        if (S_ISREG(st.st_mode))
@@ -923,12 +923,12 @@ skip_filters:
        memcpy(bp, basename, basename_len);
        bp += basename_len;
 
-#if HAVE_STRUCT_STAT_ST_RDEV
+#ifdef HAVE_STRUCT_STAT_ST_RDEV
        if (preserve_devices && IS_DEVICE(st.st_mode))
                file->u.rdev = st.st_rdev;
 #endif
 
-#if SUPPORT_LINKS
+#ifdef SUPPORT_LINKS
        if (linkname_len) {
                file->u.link = bp;
                memcpy(bp, linkname, linkname_len);
@@ -962,7 +962,7 @@ skip_filters:
                        file->mode = save_mode;
        }
 
-       if (!S_ISDIR(st.st_mode))
+       if (S_ISREG(st.st_mode) || S_ISLNK(st.st_mode))
                stats.total_size += st.st_size;
 
        return file;
@@ -975,7 +975,8 @@ void send_file_name(int f, struct file_list *flist, char *fname,
        struct file_struct *file;
        char fbuf[MAXPATHLEN];
 
-       if (!(file = make_file(fname, flist, ALL_FILTERS)))
+       file = make_file(fname, flist, f == -2 ? SERVER_FILTERS : ALL_FILTERS);
+       if (!file)
                return;
 
        maybe_emit_filelist_progress(flist);
@@ -1010,7 +1011,9 @@ void send_file_name(int f, struct file_list *flist, char *fname,
  * or a number >= 0 indicating how many levels of recursion we will allow.
  * This function is normally called by the sender, but the receiving side
  * also calls it from delete_in_dir() with f set to -1 so that we just
- * construct the file list in memory without sending it over the wire. */
+ * construct the file list in memory without sending it over the wire.  Also,
+ * get_dirlist() calls this with f set to -2, which indicates that local
+ * filter rules should be ignored. */
 static void send_directory(int f, struct file_list *flist,
                           char *fbuf, unsigned int len)
 {
@@ -1315,7 +1318,7 @@ struct file_list *recv_file_list(int f)
 
        clean_flist(flist, relative_paths, 1);
 
-       if (f != -1) {
+       if (f >= 0) {
                /* Now send the uid/gid list. This was introduced in
                 * protocol version 15 */
                recv_uid_list(f, flist);
@@ -1415,7 +1418,7 @@ struct file_list *flist_new(int with_hlink, char *msg)
            out_of_memory, POOL_INTERN)))
                out_of_memory(msg);
 
-#if SUPPORT_HARD_LINKS
+#ifdef SUPPORT_HARD_LINKS
        if (with_hlink && preserve_hard_links) {
                if (!(flist->hlink_pool = pool_create(HLINK_EXTENT,
                    sizeof (struct idev), out_of_memory, POOL_INTERN)))
@@ -1449,8 +1452,10 @@ static void clean_flist(struct file_list *flist, int strip_root, int no_dups)
        if (!flist || flist->count == 0)
                return;
 
+       sorting_flist = flist;
        qsort(flist->files, flist->count,
            sizeof flist->files[0], (int (*)())file_compare);
+       sorting_flist = NULL;
 
        for (i = no_dups? 0 : flist->count; i < flist->count; i++) {
                if (flist->files[i]->basename) {
@@ -1460,33 +1465,57 @@ static void clean_flist(struct file_list *flist, int strip_root, int no_dups)
        }
        flist->low = prev_i;
        while (++i < flist->count) {
-               int is_dup;
+               int j;
                struct file_struct *file = flist->files[i];
 
                if (!file->basename)
                        continue;
-               is_dup = f_name_cmp(file, flist->files[prev_i]) == 0;
-               if (!is_dup && protocol_version >= 29 && S_ISDIR(file->mode)) {
+               if (f_name_cmp(file, flist->files[prev_i]) == 0)
+                       j = prev_i;
+               else if (protocol_version >= 29 && S_ISDIR(file->mode)) {
                        int save_mode = file->mode;
                        /* Make sure that this directory doesn't duplicate a
                         * non-directory earlier in the list. */
-                       file->mode = S_IFREG;
                        flist->high = prev_i;
-                       is_dup = flist_find(flist, file) >= 0;
+                       file->mode = S_IFREG;
+                       j = flist_find(flist, file);
                        file->mode = save_mode;
-               }
-               if (is_dup) {
+               } else
+                       j = -1;
+               if (j >= 0) {
+                       struct file_struct *fp = flist->files[j];
+                       int keep, drop;
+                       /* If one is a dir and the other is not, we want to
+                        * keep the dir because it might have contents in the
+                        * list. */
+                       if (S_ISDIR(file->mode) != S_ISDIR(fp->mode)) {
+                               if (S_ISDIR(file->mode))
+                                       keep = i, drop = j;
+                               else
+                                       keep = j, drop = i;
+                       } else
+                               keep = j, drop = i;
                        if (verbose > 1 && !am_server) {
                                rprintf(FINFO,
-                                       "removing duplicate name %s from file list %d\n",
-                                       safe_fname(f_name(file)), i);
+                                       "removing duplicate name %s from file list (%d)\n",
+                                       safe_fname(f_name(file)), drop);
                        }
                        /* Make sure that if we unduplicate '.', that we don't
                         * lose track of a user-specified top directory. */
-                       if (file->flags & FLAG_TOP_DIR)
-                               flist->files[prev_i]->flags |= FLAG_TOP_DIR;
+                       if (flist->files[drop]->flags & FLAG_TOP_DIR)
+                               flist->files[keep]->flags |= FLAG_TOP_DIR;
 
-                       clear_file(i, flist);
+                       clear_file(drop, flist);
+
+                       if (keep == i) {
+                               if (flist->low == drop) {
+                                       for (j = drop + 1;
+                                            j < i && !flist->files[j]->basename;
+                                            j++) {}
+                                       flist->low = j;
+                               }
+                               prev_i = i;
+                       }
                } else
                        prev_i = i;
        }
@@ -1647,6 +1676,18 @@ int f_name_cmp(struct file_struct *f1, struct file_struct *f2)
                if (!*c2) {
                        switch (state2) {
                        case s_DIR:
+                               if (state1 == s_SLASH && sorting_flist) {
+                                       int j;
+                                       /* Optimize for future comparisons. */
+                                       for (j = 0;
+                                            j < sorting_flist->count;
+                                            j++) {
+                                               struct file_struct *fp
+                                                   = sorting_flist->files[j];
+                                               if (fp->dirname == f2->dirname)
+                                                       fp->dirname = f1->dirname;
+                                       }
+                               }
                                state2 = s_SLASH;
                                c2 = (uchar*)"/";
                                break;
@@ -1709,6 +1750,30 @@ char *f_name(struct file_struct *f)
 }
 
 
+struct file_list *get_dirlist(const char *dirname, int ignore_filter_rules)
+{
+       struct file_list *dirlist;
+       char dirbuf[MAXPATHLEN];
+       int dlen;
+       int save_recurse = recurse;
+
+       dlen = strlcpy(dirbuf, dirname, MAXPATHLEN);
+       if (dlen >= MAXPATHLEN)
+               return NULL;
+
+       dirlist = flist_new(WITHOUT_HLINK, "get_dirlist");
+       recurse = 0;
+       send_directory(ignore_filter_rules ? -2 : -1, dirlist, dirbuf, dlen);
+       recurse = save_recurse;
+
+       clean_flist(dirlist, 0, 0);
+
+       return dirlist;
+}
+
+
+static int deletion_count = 0; /* used to implement --max-delete */
+
 static int is_backup_file(char *fn)
 {
        int k = strlen(fn) - backup_suffix_len;
@@ -1716,6 +1781,121 @@ static int is_backup_file(char *fn)
 }
 
 
+/* Delete a file or directory.  If DEL_FORCE_RECURSE is set in the flags, or if
+ * force_delete is set, this will delete recursively as long as DEL_NO_RECURSE
+ * is not set in the flags. */
+int delete_file(char *fname, int mode, int flags)
+{
+       struct file_list *dirlist;
+       char buf[MAXPATHLEN];
+       int j, zap_dir, ok;
+       void *save_filters;
+
+       if (max_delete && deletion_count >= max_delete)
+               return -1;
+
+       if (!S_ISDIR(mode)) {
+               if (make_backups && (backup_dir || !is_backup_file(fname)))
+                       ok = make_backup(fname);
+               else
+                       ok = robust_unlink(fname) == 0;
+               if (ok) {
+                       if (!(flags & DEL_TERSE))
+                               log_delete(fname, mode);
+                       deletion_count++;
+                       return 0;
+               }
+               if (errno == ENOENT)
+                       return 0;
+               rsyserr(FERROR, errno, "delete_file: unlink %s failed",
+                       full_fname(fname));
+               return -1;
+       }
+
+       zap_dir = (flags & DEL_FORCE_RECURSE || (force_delete && recurse))
+               && !(flags & DEL_NO_RECURSE);
+       if (dry_run && zap_dir) {
+               ok = 0;
+               errno = ENOTEMPTY;
+       } else if (make_backups && !backup_dir && !is_backup_file(fname)
+           && !(flags & DEL_FORCE_RECURSE))
+               ok = make_backup(fname);
+       else
+               ok = do_rmdir(fname) == 0;
+       if (ok) {
+               if (!(flags & DEL_TERSE))
+                       log_delete(fname, mode);
+               deletion_count++;
+               return 0;
+       }
+       if (errno == ENOENT)
+               return 0;
+       if (!zap_dir || (errno != ENOTEMPTY && errno != EEXIST)) {
+               rsyserr(FERROR, errno, "delete_file: rmdir %s failed",
+                       full_fname(fname));
+               return -1;
+       }
+       flags |= DEL_FORCE_RECURSE;
+
+       save_filters = push_local_filters(fname, strlen(fname));
+
+       dirlist = get_dirlist(fname, 0);
+       for (j = dirlist->count; j--; ) {
+               struct file_struct *fp = dirlist->files[j];
+               f_name_to(fp, buf);
+               if (delete_file(buf, fp->mode, flags & ~DEL_TERSE) != 0) {
+                       flist_free(dirlist);
+                       return -1;
+               }
+       }
+       flist_free(dirlist);
+
+       pop_local_filters(save_filters);
+
+       if (max_delete && deletion_count >= max_delete)
+               return -1;
+
+       if (do_rmdir(fname) == 0) {
+               if (!(flags & DEL_TERSE))
+                       log_delete(fname, mode);
+               deletion_count++;
+       } else if (errno != ENOTEMPTY && errno != ENOENT) {
+               rsyserr(FERROR, errno, "delete_file: rmdir %s failed",
+                       full_fname(fname));
+               return -1;
+       }
+
+       return 0;
+}
+
+
+/* If an item in dir_list is not found in full_list, delete it from the
+ * filesystem. */
+static void delete_missing(struct file_list *full_list,
+                          struct file_list *dir_list, const char *dirname)
+{
+       char fbuf[MAXPATHLEN];
+       int i;
+
+       if (max_delete && deletion_count >= max_delete)
+               return;
+
+       if (verbose > 2)
+               rprintf(FINFO, "delete_missing(%s)\n", safe_fname(dirname));
+
+       for (i = dir_list->count; i--; ) {
+               if (!dir_list->files[i]->basename)
+                       continue;
+               if (flist_find(full_list, dir_list->files[i]) < 0) {
+                       char *fn = f_name_to(dir_list->files[i], fbuf);
+                       int mode = dir_list->files[i]->mode;
+                       if (delete_file(fn, mode, DEL_FORCE_RECURSE) < 0)
+                               break;
+               }
+       }
+}
+
+
 /* This function is used to implement per-directory deletion, and
  * is used by all the --delete-WHEN options.  Note that the fbuf
  * pointer must point to a MAXPATHLEN buffer with the name of the
@@ -1771,6 +1951,8 @@ void delete_in_dir(struct file_list *flist, char *fbuf,
        recurse = -1;
        fbuf[dlen] = '\0';
 
+       clean_flist(dir_list, 0, 0);
+
        if (verbose > 3)
                output_flist(dir_list, "delete");
 
@@ -1778,41 +1960,3 @@ void delete_in_dir(struct file_list *flist, char *fbuf,
 
        flist_free(dir_list);
 }
-
-
-/* If an item in dir_list is not found in full_list, delete it from the
- * filesystem. */
-void delete_missing(struct file_list *full_list, struct file_list *dir_list,
-                   const char *dirname)
-{
-       int i, mode;
-
-       if (max_delete && deletion_count >= max_delete)
-               return;
-
-       if (verbose > 2)
-               rprintf(FINFO, "delete_missing(%s)\n", safe_fname(dirname));
-
-       for (i = dir_list->count; i--; ) {
-               if (!dir_list->files[i]->basename)
-                       continue;
-               mode = dir_list->files[i]->mode;
-               if (flist_find(full_list, dir_list->files[i]) < 0) {
-                       char *f = f_name(dir_list->files[i]);
-                       if (make_backups && (backup_dir || !is_backup_file(f))
-                         && !S_ISDIR(mode)) {
-                               make_backup(f);
-                               if (verbose) {
-                                       rprintf(FINFO, "deleting %s\n",
-                                               safe_fname(f));
-                               }
-                       } else if (S_ISDIR(mode))
-                               delete_file(f, DEL_DIR | DEL_FORCE_RECURSE);
-                       else
-                               delete_file(f, 0);
-                       deletion_count++;
-                       if (max_delete && deletion_count >= max_delete)
-                               break;
-               }
-       }
-}