[tor-browser-build/master] Bug 40221: Add tools/prune-old-builds - tbb-commits

1 Feb 2021

commit 52ba09265002299e7fcba1f181c1656c372dbbc1
Author: Nicolas Vigier boklm@torproject.org
Date:   Sun Jan 31 22:57:20 2021 +0100
Bug 40221: Add tools/prune-old-builds
This script was already present in the directory
    tools/ansible/roles/tbb-nightly-build/files, however this directory will
    soon be removed as part of #40196.
---
 tools/prune-old-builds | 136 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 136 insertions(+)

diff --git a/tools/prune-old-builds b/tools/prune-old-builds
new file mode 100755
index 0000000..852a9da
--- /dev/null
+++ b/tools/prune-old-builds
@@ -0,0 +1,136 @@
+#!/usr/bin/perl -w
+
+# Copyright (c) 2019, The Tor Project, Inc.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions are
+# met:
+#
+#     * Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+#
+#     * Redistributions in binary form must reproduce the above
+# copyright notice, this list of conditions and the following disclaimer
+# in the documentation and/or other materials provided with the
+# distribution.
+#
+#     * Neither the names of the copyright owners nor the names of its
+# contributors may be used to endorse or promote products derived from
+# this software without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+# OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+# 'prune-old-builds' is a script to prune old builds.
+#
+#
+# Usage:
+#  $ ./prune-old-builds [options] <directory>
+#
+#
+# Available options:
+#
+# --dry-run
+#         Don't delete anything, but say what would be deleted.
+#
+# --prefix <prefix>
+#         Prefix of the directories to be removed. Default is 'tbb-nightly.'.
+#
+# --separator <c>
+#         Separator character to separate the year, month, day in the directory
+#         names. Default is '.'.
+#
+# --days <n>
+#         Number of days that we should keep. Default is 6.
+#
+# --weeks <n>
+#         Number of monday builds that we should keep. Default is 3.
+#
+# --months <n>
+#         Number of 1st day of the month builds that we should keep.
+#         Default is 3.
+
+use strict;
+use Getopt::Long;
+use DateTime;
+use DateTime::Duration;
+use File::Path qw(remove_tree);
+
+my %options = (
+    days   => 6,
+    weeks  => 3,
+    months => 3,
+    prefix => 'tbb-nightly.',
+    separator => '.',
+);
+
+sub keep_builds {
+    my %res;
+
+    my $day = DateTime::Duration->new(days => 1);
+    my $week = DateTime::Duration->new(weeks => 1);
+    my $month = DateTime::Duration->new(months => 1);
+
+    my $n = $options{days};
+    my $dt = DateTime->now;
+    while ($n) {
+        $res{ $options{prefix} . $dt->ymd($options{separator}) } = 1;
+        $dt = $dt - $day;
+        $n--;
+    }
+
+    my $w = $options{weeks};
+    while ($dt->day_of_week != 1) {
+        $dt = $dt - $day;
+    }
+    while ($w) {
+        $res{ $options{prefix} . $dt->ymd($options{separator}) } = 1;
+        $dt = $dt - $week;
+        $w--;
+    }
+
+    my $m = $options{months};
+    $dt = DateTime->now;
+    while ($dt->day != 1) {
+        $dt = $dt - $day;
+    }
+    while ($m) {
+        $res{ $options{prefix} . $dt->ymd($options{separator}) } = 1;
+        $dt = $dt - $month;
+        $m--;
+    }
+
+    return %res;
+}
+
+sub clean_directory {
+    my ($directory) = @_;
+    my $k = keep_builds;
+    chdir $directory || die "Error entering $directory";
+    foreach my $file (glob "$options{prefix}*") {
+        next unless $file =~ m/^$options{prefix}\d{4}$options{separator}\d{2}$options{separator}\d{2}$/;
+        next if $k->{$file};
+        if ($options{'dry-run'}) {
+            print "Would remove $file\n";
+        } else {
+            remove_tree($file);
+        }
+    }
+}
+
+my @opts = qw(days=i weeks=i months=i prefix=s dry-run!);
+Getopt::Long::GetOptions(%options, @opts);
+die "Missing argument: directory to clean" unless @ARGV;
+foreach my $dir (@ARGV) {
+    clean_directory($dir);
+}

    