src/christmastree

   1 #!/usr/bin/perl -w
   2
   3 # Copyright (C) 2007,2008,2009,2010,2011 Ole Tange and Free Software
   4 # Foundation, Inc.
   5 #
   6 # This program is free software; you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation; either version 3 of the License, or
   9 # (at your option) any later version.
  10 #
  11 # This program is distributed in the hope that it will be useful, but
  12 # WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 # General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program; if not, see <http://www.gnu.org/licenses/>
  18 # or write to the Free Software Foundation, Inc., 51 Franklin St,
  19 # Fifth Floor, Boston, MA 02110-1301 USA
  20 #
  21 # SPDX-FileCopyrightText: 2021-2024 Ole Tange, http://ole.tange.dk and Free Software and Foundation, Inc.
  22 # SPDX-License-Identifier: GPL-3.0-or-later
  23
  24 =head1 NAME
  25
  26 christmastree - use memory similar to a christmas tree profile
  27
  28 =head1 SYNOPSIS
  29
  30 B<christmastree> [-s I<per_second>] [-m I<min>] <max>
  31
  32 =head1 DESCRIPTION
  33
  34 GNU B<christmastree> is a test script that increases and decreases its
  35 memory usage. The increase and descrease will happen at random, but
  36 the memory usage will grow on average.
  37
  38 =over 9
  39
  40 =item I<max>
  41
  42 The maximal amount of memory to use before exitting.
  43
  44
  45 =item B<-s> I<per_second>
  46
  47 The amount of memory it should grow per second on average. Default to max/10.
  48
  49
  50 =item B<-m> I<min>
  51
  52 The minimal amount of memory to use before exitting.
  53
  54 =back
  55
  56
  57 =head1 EXAMPLES
  58
  59
  60
  61 =head1 REPORTING BUGS
  62
  63 B<christmastree> is part of GNU B<parallel>. Report bugs to <bug-parallel@gnu.org>.
  64
  65
  66 =head1 AUTHOR
  67
  68 Copyright (C) 2011 Ole Tange, http://ole.tange.dk and Free
  69 Software Foundation, Inc.
  70
  71 =head1 LICENSE
  72
  73 Copyright (C) 2011 Free Software Foundation, Inc.
  74
  75 This program is free software; you can redistribute it and/or modify
  76 it under the terms of the GNU General Public License as published by
  77 the Free Software Foundation; either version 3 of the License, or
  78 at your option any later version.
  79
  80 This program is distributed in the hope that it will be useful,
  81 but WITHOUT ANY WARRANTY; without even the implied warranty of
  82 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  83 GNU General Public License for more details.
  84
  85 You should have received a copy of the GNU General Public License
  86 along with this program.  If not, see <http://www.gnu.org/licenses/>.
  87
  88 =head2 Documentation license I
  89
  90 Permission is granted to copy, distribute and/or modify this documentation
  91 under the terms of the GNU Free Documentation License, Version 1.3 or
  92 any later version published by the Free Software Foundation; with no
  93 Invariant Sections, with no Front-Cover Texts, and with no Back-Cover
  94 Texts.  A copy of the license is included in the file fdl.txt.
  95
  96 =head2 Documentation license II
  97
  98 You are free:
  99
 100 =over 9
 101
 102 =item B<to Share>
 103
 104 to copy, distribute and transmit the work
 105
 106 =item B<to Remix>
 107
 108 to adapt the work
 109
 110 =back
 111
 112 Under the following conditions:
 113
 114 =over 9
 115
 116 =item B<Attribution>
 117
 118 You must attribute the work in the manner specified by the author or
 119 licensor (but not in any way that suggests that they endorse you or
 120 your use of the work).
 121
 122 =item B<Share Alike>
 123
 124 If you alter, transform, or build upon this work, you may distribute
 125 the resulting work only under the same, similar or a compatible
 126 license.
 127
 128 =back
 129
 130 With the understanding that:
 131
 132 =over 9
 133
 134 =item B<Waiver>
 135
 136 Any of the above conditions can be waived if you get permission from
 137 the copyright holder.
 138
 139 =item B<Public Domain>
 140
 141 Where the work or any of its elements is in the public domain under
 142 applicable law, that status is in no way affected by the license.
 143
 144 =item B<Other Rights>
 145
 146 In no way are any of the following rights affected by the license:
 147
 148 =over 9
 149
 150 =item *
 151
 152 Your fair dealing or fair use rights, or other applicable
 153 copyright exceptions and limitations;
 154
 155 =item *
 156
 157 The author's moral rights;
 158
 159 =item *
 160
 161 Rights other persons may have either in the work itself or in
 162 how the work is used, such as publicity or privacy rights.
 163
 164 =back
 165
 166 =item B<Notice>
 167
 168 For any reuse or distribution, you must make clear to others the
 169 license terms of this work.
 170
 171 =back
 172
 173 A copy of the full license is included in the file as cc-by-sa.txt.
 174
 175 =head1 DEPENDENCIES
 176
 177 B<christmastree> uses Perl.
 178
 179
 180 =head1 SEE ALSO
 181
 182 B<parallel>(1)
 183
 184 =cut
 185
 186 use Getopt::Long;
 187
 188 parse_options();
 189 my $start_time = time;
 190 my $max = multiply_binary_prefix(shift);
 191 my $min = (multiply_binary_prefix($::opt_m) or $max);
 192 my $target_max = int(rand($max - $min)) + $min;
 193 my $per_second = (multiply_binary_prefix($::opt_s) or $target_max/10);
 194 my ($memusage,@a,$target,$this_round);
 195
 196 do {
 197    $memusage = my_memory_usage();
 198    $target = (time - $start_time)*int($per_second);
 199    $this_round = $target - my_memory_usage();
 200    if($this_round > 0) {
 201        my $this_size = min(rand($this_round*3), $target_max-$memusage);
 202        my $a = "x"x$this_size;
 203        push @a,$a;
 204    } else {
 205        pop @a;
 206    }
 207    debug("$#a memusage $memusage target $target this_round $this_round target_max $target_max\n");
 208    usleep(500);
 209 } while($memusage < $target_max);
 210
 211
 212 sub min {
 213     # Returns:
 214     #   Minimum value of array
 215     my $min;
 216     for (@_) {
 217         # Skip undefs
 218         defined $_ or next;
 219         defined $min or do { $min = $_; next; }; # Set $_ to the first non-undef
 220         $min = ($min < $_) ? $min : $_;
 221     }
 222     return $min;
 223 }
 224
 225
 226 sub debug {
 227     # Returns: N/A
 228     $Global::debug or return;
 229     @_ = grep { defined $_ ? $_ : "" } @_;
 230     if($Global::original_stdout) {
 231         print $Global::original_stdout @_;
 232     } else {
 233         print @_;
 234     }
 235 }
 236
 237 sub parse_options {
 238     $Global::version = 20110822;
 239     $Global::progname = 'christmastree';
 240
 241     Getopt::Long::Configure ("bundling","require_order");
 242     GetOptions("s=s" => \$::opt_s,
 243                "m=s" => \$::opt_m,
 244                "r=s" => \$::opt_r,
 245                "debug" => \$::opt_debug,
 246                # GNU requirements
 247                "help|h" => \$::opt_help,
 248                "version|V" => \$::opt_version,
 249         ) || die_usage();
 250
 251     if(defined $::opt_r) { srand($::opt_r); }
 252     if(defined $::opt_help) { die_usage(); }
 253     if(defined $::opt_version) { version(); exit(0); }
 254     $Global::debug = $::opt_debug;
 255 }
 256
 257 sub usleep {
 258     # Sleep this many milliseconds.
 259     my $secs = shift;
 260     ::debug("Sleeping ",$secs," millisecs\n");
 261     select(undef, undef, undef, $secs/1000);
 262     if($::opt_timeout) {
 263         ::debug(my_dump($Global::timeoutq));
 264         $Global::timeoutq->process_timeouts();
 265     }
 266 }
 267
 268 sub undef_as_zero {
 269     my $a = shift;
 270     return $a ? $a : 0;
 271 }
 272
 273 sub undef_as_empty {
 274     my $a = shift;
 275     return $a ? $a : "";
 276 }
 277
 278 sub my_memory_usage {
 279     # Returns:
 280     #   memory usage if found
 281     #   0 otherwise
 282     use strict;
 283     use FileHandle;
 284
 285     my $pid = $$;
 286     if(-e "/proc/$pid/stat") {
 287         my $fh = FileHandle->new("</proc/$pid/stat");
 288
 289         my $data = <$fh>;
 290         chomp $data;
 291         $fh->close;
 292
 293         my @procinfo = split(/\s+/,$data);
 294
 295         return undef_as_zero($procinfo[22]);
 296     } else {
 297         return 0;
 298     }
 299 }
 300
 301 sub multiply_binary_prefix {
 302     # Evalualte numbers with binary prefix
 303     # k=10^3, m=10^6, g=10^9, t=10^12, p=10^15, e=10^18, z=10^21, y=10^24
 304     # K=2^10, M=2^20, G=2^30, T=2^40, P=2^50, E=2^70, Z=2^80, Y=2^80
 305     # Ki=2^10, Mi=2^20, Gi=2^30, Ti=2^40, Pi=2^50, Ei=2^70, Zi=2^80, Yi=2^80
 306     # ki=2^10, mi=2^20, gi=2^30, ti=2^40, pi=2^50, ei=2^70, zi=2^80, yi=2^80
 307     # 13G = 13*1024*1024*1024 = 13958643712
 308     my $s = undef_as_empty(shift);
 309     $s =~ s/k/*1000/g;
 310     $s =~ s/M/*1000*1000/g;
 311     $s =~ s/G/*1000*1000*1000/g;
 312     $s =~ s/T/*1000*1000*1000*1000/g;
 313     $s =~ s/P/*1000*1000*1000*1000*1000/g;
 314     $s =~ s/E/*1000*1000*1000*1000*1000*1000/g;
 315     $s =~ s/Z/*1000*1000*1000*1000*1000*1000*1000/g;
 316     $s =~ s/Y/*1000*1000*1000*1000*1000*1000*1000*1000/g;
 317     $s =~ s/X/*1000*1000*1000*1000*1000*1000*1000*1000*1000/g;
 318
 319     $s =~ s/Ki?/*1024/gi;
 320     $s =~ s/Mi?/*1024*1024/gi;
 321     $s =~ s/Gi?/*1024*1024*1024/gi;
 322     $s =~ s/Ti?/*1024*1024*1024*1024/gi;
 323     $s =~ s/Pi?/*1024*1024*1024*1024*1024/gi;
 324     $s =~ s/Ei?/*1024*1024*1024*1024*1024*1024/gi;
 325     $s =~ s/Zi?/*1024*1024*1024*1024*1024*1024*1024/gi;
 326     $s =~ s/Yi?/*1024*1024*1024*1024*1024*1024*1024*1024/gi;
 327     $s =~ s/Xi?/*1024*1024*1024*1024*1024*1024*1024*1024*1024/gi;
 328     $s = eval $s;
 329     return $s;
 330 }
 331