[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [Bacula-devel] [Bacula-users] Minor SD Feature Request


11.05.2008 11:37, Kern Sibbald wrote:

OK, thanks. You have confirmed what I suspected. In effect, this is really a support problem - I suspect you not fully understanding how Bacula works and its limitations (explained below).

Well, this is something that we discussed on the -users list, and as far as I can tell, Blake pretty well understands the way Bacula works and has implemented procedures to do things right, but the autochanger itself is causing the trouble. (By loading imported volumes to whatever slots are available automatically).

First, without some additional design and coding, it is not possible for Bacula to snoop around on the autochanger for an available slot in which to unload a volume.

Well, with the discussed slots status query by the SD a good part of the design would already exist.

The autochanger may have hundreds of slots, with only a few available for Bacula, and currently there is no way to tell Bacula that it "owns" slots n-m (this could be a future enhancement). As a consequence, with the current design, Bacula must always unload a volume into the slot from which it came.

I disagree... note that I'm not talking about shared autochangers (which would best be shared by partitioning a big library, i.e. relying on the library hardware to keep track of which slots belong to which logical autochanger). So I assume Bacula has the autochanger it sees all for itself.

In this case it would be possible to list the slots, look for unused ones, and unload the current tape to one of these, updating that catalog accordingly (the mtx-changer script also supports this, by the way).

Second, from the above you should have gathered that if you manually load a volume into a slot where Bacula has loaded a volume from that slot into a drive, at some point everything is going to fail as you are seeing.

Yup, though the term "manually" is misleading in this scenario...

When you change something in the autochanger the preferred way of doing so is:

-- first unmount all drives that Bacula has mounted
-- change the autochanger volumes
-- do an update slots
-- finally remount the drives with Bacula.

I think Blake knows that.

It is possible to rearrange the volumes in the autochanger without unloading all the drives providing that Bacula doesn't want to load/unload any volume while you are changing things in in the autochanger. I strongly recommend against doing this, but it is possible in a situation where Bacula is running a job. Doing so is not without risks though.

If you don't follow these simple rules, Bacula will sooner or later fail, and probably the worst case is if you load a volume into a slot where there is a volume in one of the drives.

I do believe that we could improve how Bacula handles Volumes found in Slots where they are not expected, and I will look at that, but for the moment, having Bacula unload a volume into a different slot than from where it came is a much bigger project that if well designed and accepted would be a feature after the next major release (3.0.0).

Well, I won't argue here, but I believe the design work needed is not that complex.

- I cannot accept your Feature Request as formulated without additional design work so that it won't break shared autochangers.

- You can resolve your problems by implementing improved sysadmin procedures.

Perhaps... ok, attached is a starting point. This is a script I use to help managing autoloaders, especially unloading full volumes and loading new ones.

I recommend that you very carefully test it - it's more a hack that grew into a rather large program (at least for my coding skills...) and I'm quite sure it can be improved a lot.

If I had the time I know that I could rework much of it to become more generally useabl and better structured.

This script is know to work in production environments, but still - no warranties, you are all on your own, and so on.




PS: When unmounting, you do specify an Autochanger, but since autochangers may have multiple drives, you must specify which drive of the autochanger. If you have only one drive, entering a return at the question is all that is necessary to do the right thing.

On Saturday 10 May 2008 19:22:47 Blake Dunlap wrote:
Hello Blake,

One part of Bacula that I would like to improve just a bit (not too much
coding for the moment) for the next release is the information returned
Autochangers.  Currently, it seems to me that the sysadmin has very
little information about the actual state of the autochanger via the
console interface.  Although your suggestion seems to be a bit more than
simple reporting of the status, I am interested in it.  The problem is
that I don't
understand what you are asking for well enough to possibly implement

Could you be much more explicit with what you want, perhaps giving an
example of what happens now and what you would like to see happen.  Don't
forget that at the current time, Bacula has no concept of changing the
slot -- for example, when a Volume is loaded by Bacula from Slot 2 into
drive, it *must* be returned to the same Slot.  Changing this behavior is
project that would require significant design and thought and is probably
something we would want to implement in the near future.

On the other hand, I think there is a lot of need and possibility for
Bacula much smarter at automatically recognizing that a Volume is in a
different Slot from what is written in the database.  Currently such
are marked in error (if I remember right), but we could consider simply
correcting the info in the database.

Best regards,

It is the last paragraph that I am mostly looking at dealing with. Let me
give our situation in depth and I think that will explain what I am looking

We have a 2 drive auto-changer and run 4 pools of backups (Incremental,
OnSiteFull, OffsiteFull, and OnsiteMonthly). We run two sets of backups for
clients, an offsite backup that runs every Friday night (due to the lack of
copy pools etc), and the OnSite backups which occur every night
incremental, except Saturday night which is a full (the pool is overridden
to Monthly the first sat of a month). Anyway we rotate the Offsite tapes
every Tuesday, and supposedly there is an update slots run with all drives
released at the conclusion of the procedure which should update the
database as to the current state of the auto-changer.

Now that the back story is established, what has been extremely frustrating
is that a decent percentage of the time, something occurs which places the
tapes out of sync, and come Saturday night (the first night a drive would
have to swap) the auto-changer fails to load a new tape it is looking for
in the OnsiteFull pool, due to the tape that was in the drive failing to
unload due to a slot full condition. Bacula now requests user intervention
loading the tape, and the drive is marked unloaded (because the error
didn't occur during an unload event, but a load event, which makes it a
pain to determine what tape is actually loaded in the drive currently). To
fix this, one must run an update slots, then look back in the logs to
figure out what tape failed to unload, then "load" that tape into the
drive, and Bacula will then realize the drive is usable again, and then
proceed as normal. Of course due to the times we run backups, this has to
occur in the middle of the night, or pot entially the next day which
impacts backups, and the general network.

I believe this is an error condition that could reasonably be dealt with
programmatically instead of requiring user intervention (An automatic slot
refresh before unloading tapes / loading tapes (with an assumed lifetime
validity of say 10 minutes to reduce occurrences) would be one solution).

Let me know if I need to add anything further, as I tried to be as detailed
as possible in this response, as compared to the quick summary of the
actual feature request. From a user prospective, I do agree that
auto-changer support feels more tacked on than anything (for example, the
requiring to specify a drive instead of an auto-changer when doing an
update slots command) and would love to see improvements in that regard.


This SF.net email is sponsored by the 2008 JavaOne(SM) Conference
Don't miss this year's exciting event. There's still time to save $100.
Use priority code J8TL2D2.
one _______________________________________________
Bacula-devel mailing list

This SF.net email is sponsored by the 2008 JavaOne(SM) Conference Don't miss this year's exciting event. There's still time to save $100. Use priority code J8TL2D2. http://ad.doubleclick.net/clk;198757673;13503038;p?http://java.sun.com/javaone
Bacula-users mailing list

Arno Lehmann
IT-Service Lehmann
#!/usr/bin/perl -w

# $Id: bac_vol_mgmt.pl 3 2007-11-07 23:27:01Z  $

# Version information
# 0.3.1   Fix problems when Backups of intermediate levels don't exist
#         Fix typo
# 0.3     Automatic loading into the first slots of an autochanger
#         (currently only for autoloaders supporting transfer)
#         Adapt to 2.0 (enabling / disabling of volumes)
#         Functions missing:
#           Volume location tracking
#           Volume comments
#           Automatic reordering on mount with non-transfer capable autoloaders
#           More testing
# 0.2.99  Skip pools given on commandline
# 0.2.1   Fixed minor omission in selection of volumes to
#             request (InChanger=0)
# 0.2     Test / evaluation for customer
# 0.1     Unpublished, trial runs
# 0       Development, not fully functional

# Basic volume management for Bacula.
# The following tasks are executed:
# - Determine which tapes can be removed from autochangers
#   and brought off-site
# - Mark these volumes as "Used"
# - Print a report naming these volumes, ordered by storage
#   device and slot number
# - if possible, move volumes so that a minimum number of
#   magazines has to be handled
# - Determine which volumes that are not loaded can be used next
# - Print a report naming these volumes, ordered by pool they
#   belong to 
# - Unmount the storage devices we're working with
# - On command, scan the storage devices we're working with and
#   mount them

# Currently known limitations:
# - Autochangers with more than one drive are probably not supported
#   At least no testing of one has been done, and I'm pretty sure
#   that there are some lines of codes that will break with such a
#   setup.
# - MySQL is the only catalog database backend that is known to work.
#   As this script contains some date / time arithmetic it's quite
#   probable that other SQL backends won't work correctly.
# - This should have a better documentation.

# This script is copyright (C) 2006,2007 IT-Service Arno Lehmann
#                              Arno Lehmann
# This program is provided as-is, without any implicit or expressed
# warranty.
# As this programs requires access to your Bacula catalog database
# and your backup hardware, you are strongly advised to not trust it
# but, by reading and understanding the source, to make sure it really
# doesn't do any harm.
# There is no support included with this script.
# You may modify and use this program as you like, but I ask you to not
# distribute it or modified versions of it. I will not enforce this
# request, though - this is merely a question of courtesy.
# Note that the copyright (or, where applicable, the German Urheberrecht)
# is by Arno Lehmann.

use strict;
use DBI;
use Getopt::Long;
use Class::Date qw(date -DateParse);
use IPC::Open2;

my $version="0.3.1";
$0 =~ /.*\/([^\/]*)$/;
my $ME = $1;
my $COPY = '(C) 2006,2007 IT-Service Lehmann, Arno Lehmann';
my (undef, $min, $hour, $mday, $mon, $year) = localtime();
my $DATE = sprintf('%4i-%02i-%02i %02i:%02i', $year+1900, $mon+1, $mday, $hour, $min);

my %msgs = ('help'=>" This is $ME $version
This program is distributed under the GNU public license Version 2.
For more information, see the source code or http://www.gnu.org/licenses/
Bacula is a Trademark and (C) 2000-2007 by Kern Sibbald. Please see
http://www.bacula.org for more information.

This script is used to help in managing Bacula volumes.

For a more detailed explanation, see \'perldoc $ME\'.

This script understands the following options. Options can be abbreviated
to uniqueness. Negating --option is done like --nooption.     Defaults:
  --help          -h  print this help
  --host          -H  database host for catalog                empty
  --user          -U  database user                            bacula
  --database      -D  database name of the catalog database    bacula
  --password      -P  database password                        empty
  --database-type -T  database interface to use                mysql
  --changer           changer definitions                      empty
                      Try \"--changer help=\" for more information!
  --bconsole      -b  bconsole prog.  bconsole -c /etc/bacula/bconsole.conf
  --var-file      -f  File to store information between program runs
  --skip-pools    -s  do not consider volumes from given pools
                      Pools are a comma-separated list         empty
  --expunge       -x  look for volumes usable at time          current time
  --no-updates    -n  don't update volume status
  --new-vols      -i  number of volumes per pools to import    8
  --new-bypool    -p  print volumes to load ordered by pool    no
  --mount         -m  mount unmounted devices again and update
                      the slots
	    'changerhelp' => 'How to define changer devices.

The --changer options takes a parameter of the following form:


Usually, when setting this through a shell, you will want to qoute the pipe
characters to prevent them being interpreted as program execution pipes. See 
the example below.

The NAME is the name of the changer device you configure, it must match the
storage name inside Baculas configuration. The parts after the equal sign all
define separate aspects of this device. Each part can be left blank in which
case a default applies. Flags are case-insensitive, so eject is the same as

The fields have the following meaning and defaults:

Field       meaning                                                    default
mtxprog    The program to use to control this device. This could  /usr/bin/mtx
           be something like "mtx" or some wrapper around, for
           example, FreeBSDs chio. The script builds a mtx
           command using all the options you supply, so the
           command you specify here MUST accept the mtx command
           syntax and print similar output.

mtprog     The mt program to control the tape drive. This is      /usr/bin/mt
           usually "mt" or some wrapper which supports at least
           the rewoffl function of mt.

device     This is the tape drive device to control. Currently,   [none]
           only one tape drive is used per storage device. As
           the tape drive is used only to transfer tapes, this
           should not be a problem.

control    The changer control device, given to mtx. Usually you  [none]
           will use something like "/dev/sg0" here

offline    Wether the tape drive needs an offline before the      yes
           tape can be unloaded.
           You can use the following to indicate that offline
           must be issued prior to unloading:
           1 or yes or offline
           To turn offlining off prior to unloading the tape:
           0 or no or nooffline

slots      Here, you set up which slots in the autochanger to     0-0
           use for exporting tapes. Usually, you will use slots
           all in one magazine or the mailslots. The format to
           use is <slot number>-<slot number>, e.g. "1-8". To
           only use one slot, give that slots number twice, as
           in "1-1".
           Note that there is no way to guarantee that all tapes
           that should be removed can be put into that slot range.

scan       Set up wether Bacula should actually load the tapes    no
           and read their labels after the tape exchange, or if
           it can rely on the report from mtx. This corresponds
           to the option scan in Baculas "update slots" command.
           When not setting up to scan, an "mtx inventory" might
           be necessary before Bacula gets control of the device
           again. This is not yet implemented, though.
           To turn on loading and reading, use:
           1 or yes or scan
           To turn it of, you set
           0 or no or noscan

transfer   This is used to tell Bacula if the autochanger can     no
           move tapes from slot to slot directly (i.e. if the mtx
           command "transfer" can be used), or if tapes always
           have to be moved through the tape drive.
           Note that in the latter case, tape resorting is only
           possible when at least one slot is empty.
           To turn on the transfer capability, you can use these
           1 or yes or transfer
           To turn this function off, you use
           0 or no or load

eject      Set up ejecting of the autochanger after tape          no
           reordering. Depending on the hardware you use, this
           can, for example, result in ejecting a magazine or
           opening the mail slots.
           To turn on this feature, use
           1 or yes or eject
           To turn it off, you can use one of the following:
           0 or no or noeject or keeploaded

Example: --changer HPDAT="mtx|/dev/st0|/dev/sg0|nooffline|4-6|scan||yes"
will set up a changer resource HPDAT to use "mtx -f /dev/sg0" for changer
control, "mt -f /dev/st0" for tape drive control, not issue an offline
command prior to unloading a tape, prefer slots 4 to 6 for tape exchange,
and Bacula will get an "update slots scan storage=HPDAT" command prior
to re-mounting this device. The autochanger will not be controlled with
"transfer" commands, but rather each tape that needs to be moved will be
loaded and unloaded again, to the new slot. The magazine of this device
will not be ejected after the work is done.

	    'header' => "This report was created $DATE\nby $ME $version $COPY\n\n",
	    'report_rmv_head' => "The following tapes should be removed\nfrom their storage devices and stored safely:\n",
	    'newsto_pre' => "\n==== ",
	    'newsto_post' => " ====\n\n",
	    'slot' => "  Slot ",
	    'norem' => "--- No volumes need to be unloaded ---\n",
	    'noimp' => "*" x 73 . "
There are no volumes that can be (re)used. The next Backups will probably
have trouble!

" . '*' x 72 . "\n\n",
	    'noupdate' => "  > Volume not Disabled\n",
	    'load_from' => 'You should load these volumes for pool ',
	    'load_none' => 'No volumes to load. This might mean trouble when the next jobs run!',
	    'load_all' => "The following volumes should be loaded:\n",
	    'changers' => 'Autochangers defined:',
	    'changer_err' => 'changer definition error:',
	    'changer_ign' => ' device ignored',
	    'nosuchdev' => 'Device not found: ',
	    'devbusy' => 'Device is busy and thus media will not be re-ordered: ',
	    'slotsprob' => 'No reordering due to problem with usable slots: ',
	    'slotsnoav' => 'No reordering due to no available slots in changer: ',


my $showhelp = 0;
my $db_host = "";
my $db_user = "bacula";
my $db_database = "bacula";
my $db_password = "";
my $db_type = "mysql";
my $skip_pools = "";
my $expunge_at = '';
my $dont_update = '';
my $new_vols = 8;
my $new_bypool = '';
my $debug = 0;
my %all_devices = ();
my $bconsole = 'bconsole -c /etc/bacula/bconsole.conf';
my $varfile = '/var/bacula/working/bac_vol_mgmt.state';
my $mount = '';


if ($debug >= 1000) {
    my $dbtr = sprintf("%i", $debug / 1000);
    $debug %= 1000;
    debug_out(0, "Database tracing set to $dbtr");

"All Options:
showhelp:	$showhelp
debug:		$debug
host:		$db_host
user:		$db_user
database:	$db_database
password:	$db_password
database-type:	$db_type
bconsole:       $bconsole
skip-pools:     $skip_pools
expunge-at:     $expunge_at
var-file:       $varfile
mount:          $mount

if ($debug >= 10) {
    debug_out(10, $msgs{'changers'});
    for $a (sort(keys(%all_devices))) {
		debug_out(10, '  ' . $a);
		for $b (sort(keys(%{$all_devices{$a}}))) {
			debug_out(10, '    ' . $b . ' = ' . $all_devices{$a}->{$b});

if ($showhelp) {
    exit 0;

if ($mount) {
    exit 0;

if ("" ne $expunge_at) {
    $expunge_at = Class::Date->new($expunge_at);
} else {
    $expunge_at = Class::Date->now;
debug_out(10, "expunge-at after parsing: $expunge_at\n");

my $dbconn = "dbi:" . $db_type. ":database=" . $db_database;
$dbconn .= ";host=" . $db_host if $db_host;
debug_out(40, "DBI connect with $dbconn");

my $h_db = DBI->connect($dbconn,
                        $db_user, $db_password,
                        { PrintError => 0,
                          AutoCommit => 1 }
                        ) || die DBI::errstr;
debug_out(10, "Have database connection $h_db");

my @skip_pool_list = ();
my $skip_pool_sql = "";
if ($skip_pools ne "") {
	debug_out(10, "Prepare pool skiplist");
	@skip_pool_list = split(/ *, */, $skip_pools);
	debug_out(10, "Got " . join(':', @skip_pool_list));
	my $h_q = $h_db->prepare('SELECT PoolId FROM Pool WHERE Name IN ("' . join('","', @skip_pool_list) . '");');
	if ($h_q->execute()) {
		debug_out(15, "Query for PoolIds ok");
		my $db_res;
		while ($db_res = $h_q->fetchrow_hashref()) {
			$skip_pool_sql .= ',' if ($skip_pool_sql ne "");
			$skip_pool_sql .= $db_res->{PoolId};
		$skip_pool_sql = ' AND Pool.PoolId NOT IN (' . $skip_pool_sql . ') ';
		debug_out(15, "PoolId SQL fragment is \"$skip_pool_sql\".");
	} else {
		debug_out(0, "Couldn\'t get PoolIds: DBI::errstr: " .
				  ((DBI::errstr) ? DBI::errstr : '*none*'));

my $h_q = $h_db->prepare('SELECT ClientId,FileSetId FROM Job WHERE Type="B" AND JobStatus="T" GROUP BY ClientId,FileSetId;');

my $db_res;
my @pairs;
while ($db_res=$h_q->fetchrow_hashref()) {
    my %coll = ('Client'=>$db_res->{ClientId}, 'FileSet'=>$db_res->{FileSetId});
# Now we've got a list of all Client / FileSet pairs in the catalog
    push @pairs, \%coll;

# using the list created above, we search for the jobs we need to consider
# we take the latest Full backup, the latest Differential one, and all
# incrementals after the most recent Full or Diff.

my ($i, $j, $catres);
my @jobs = ();
for $i (0 .. $#pairs) {
    debug_out(20, "Unique Job $i before processing:");
    for $j (keys %{$pairs[$i]}) {
	debug_out(20, "  $j: $pairs[$i]{$j}");
    $catres = $h_db->selectrow_hashref('SELECT JobId,StartTime FROM Job WHERE Type="B" AND JobStatus="T" AND StartTime>"0-0-0 0:0:0" AND Level="F" AND ClientId=' .
				       $pairs[$i]{'Client'} . ' AND FileSetId=' . $pairs[$i]{'FileSet'} .
				       ' ORDER BY StartTime DESC LIMIT 1');
    if ($catres) {
      debug_out(20, "  Full JobId: $catres->{'JobId'}\n  StartTime: $catres->{'StartTime'}");
      push @jobs, $catres->{'JobId'};
    } else {
      debug_out(20, "  No Full Job!");
    if ($catres) {
# now we've got the most current Full backup. Based on this, we search
# for Differentual ones.
      $catres = $h_db->selectrow_hashref('SELECT JobId,StartTime FROM Job WHERE ' .
  				         'Type="B" AND JobStatus="T" AND StartTime>"' . $pairs[$i]->{'After'} . 
				         '" AND Level="D" AND ClientId=' .
				         $pairs[$i]{'Client'} . ' AND FileSetId=' . $pairs[$i]{'FileSet'} .
				         ' ORDER BY StartTime DESC LIMIT 1');
      if ($catres) {
  	  debug_out(20, "  Diff JobId: $catres->{'JobId'}\n  StartTime: $catres->{'StartTime'}");
	  push @jobs, $catres->{'JobId'};
      } else {
	  debug_out(10, "No Differential Backups found. DBI::errstr: " .
		    ((DBI::errstr) ? DBI::errstr : '*none*'));
# now we've got the most current Full and Diff backups. Based on this, we search
# for Incremental ones.
    if ($catres) {
        $catres = $h_db->selectall_hashref('SELECT JobId FROM Job WHERE ' .
				           'Type="B" AND JobStatus="T" AND StartTime>"' . $pairs[$i]->{'After'} .
				           '" AND Level="I" AND ClientId=' .
				           $pairs[$i]{'Client'} . ' AND FileSetId=' . $pairs[$i]{'FileSet'} . ';',
        if ($catres) {
    	    debug_out(20, "  Incr JobIds:");
	    my $a;
	    for $a (keys %{$catres}) {
	        debug_out(20, "    JobId $a");
	        push @jobs, $a;
        } else {
	    debug_out(10, "No Incremental Backups found. DBI::errstr: " .
		      ((DBI::errstr) ? DBI::errstr : '*none*'));
    debug_out(10, "Unique Job $i after processing:");
    for $j (keys %{$pairs[$i]}) {
	debug_out(10,, "  $j: $pairs[$i]{$j}");
    debug_out(10, "");

# Now we have a list of all jobs worth storing.

debug_out(10, "The following Jobs need to be handled:");
debug_out(10, @jobs);

my $all_jobs = join(',', @jobs);
my @volumes = ();

# the following query gives us the information we need to report.

$catres = $h_db->selectall_hashref('SELECT DISTINCT Media.MediaId,VolumeName,Pool.Name AS Pool,Storage.Name AS Storage,Slot ' .
								   'FROM Media,JobMedia,Pool,Storage WHERE JobId in (' . $all_jobs .
								   ') AND Media.MediaId=JobMedia.MediaId ' .
								   $skip_pool_sql .
								   'AND Media.StorageId=Storage.StorageId ' .
								   'AND Media.PoolId=Pool.PoolId ' .
								   'AND Media.InChanger=1 AND Media.Slot>0;',
if ($catres) {
    debug_out(10, "Media to handle:");
    my $a;
    for $a (sort(keys %{$catres})) {
# all the media in one hash - should be ok because we don't expect
# thousands of volumes here...
	debug_out(10, "  Volume $a\n    $catres->{$a}->{'Storage'}\n    $catres->{$a}->{'Slot'}\n    $catres->{$a}->{'Pool'}");
	push @volumes, $catres->{$a};
} else {
    debug_out(10, "No Media: DBI::errstr: " .
	      ((DBI::errstr) ? DBI::errstr : '*none*'));

print $msgs{'header'};

# next, we've got to check if we need to shuffle the media...

# We try to re-order tapes one device at a time...
for $a (keys(%all_devices)) {
    reorder($a, $all_devices{$a}, \@volumes);

if ($#volumes >= 0) {

# we've got the volumes that should be stored.
# First, we sort by Storage device and Slot number to produce 
# equally sorted reports.

    @volumes = sort {
	debug_out(30, "Comparing $a->{'VolumeName'} with $b->{'VolumeName'}");
	$a->{'Storage'} cmp $b->{'Storage'} || $a->{'Slot'} <=> $b->{'Slot'}
    } @volumes;

# The report itself is printed now.
# The work is done in between which is a mess...

	my $wf = open(FH, ">>$varfile");
	debug_out(0, "Can\'t open $varfile for appending. Trying to continue...\n") if (!$wf);
    print $msgs{'report_rmv_head'};
    $j = '';
    $h_q = $h_db->prepare('UPDATE Media SET Enabled=0 WHERE MediaId=?;');
    debug_out(10, 'Prepared statement to update volumes: ' . $h_q->{'Statement'} .
	      ' Result code: ' . ($h_db->errstr() ? $h_db->errstr() : "Ok"));
    for $i (0 .. $#volumes) {
		debug_out(20, "===\nVolume $volumes[$i]{'VolumeName'} from pool $volumes[$i]{'Pool'}
  Storage $volumes[$i]{'Storage'}
  Slot $volumes[$i]{'Slot'}");
		if ($j ne $volumes[$i]{'Storage'}) {
			print $msgs{'newsto_pre'} . $volumes[$i]{'Storage'} . $msgs{'newsto_post'};
			$j = $volumes[$i]{'Storage'};
		printf $msgs{'slot'} . '%4d - ' . $volumes[$i]{'VolumeName'} . ' (' .
			$volumes[$i]{'Pool'} . ")\n", $volumes[$i]{'Slot'};
		if ($dont_update) {
			print $msgs{'noupdate'};
		} else {
			debug_out(20, $h_q->{'Statement'});
			if (!$h_q->execute(($volumes[$i]{'MediaId'}))) {
				print 'Could not update Volume ' . $volumes[$i]{'VolumeName'} .
					' because of ' . $h_db->errstr();
			} else {
				print FH "update volume=$volumes[$i]{'VolumeName'} enabled=yes\n";
	close(FH) if ($wf);
} else {
    print $msgs{'norem'};

# now that we're done with the used media handling it's time
# to look for usable volumes...


$catres = $h_db->selectall_hashref('SELECT MediaId,VolumeName,Pool.Name AS Pool,' .
								   'FROM_UNIXTIME(UNIX_TIMESTAMP(Media.LastWritten)+' .
								   'Media.VolRetention) '.
								   'AS Expunges ' .
								   'FROM Media,Pool ' .
								   'WHERE ' .
								   'InChanger=0 ' .
								   $skip_pool_sql .
								   ' AND Pool.PoolId=Media.PoolId AND VolStatus IN ' .
								   '("Used","Append","Full","Recycle","Purged") ' .
								   'HAVING Expunges<="' .
								   $expunge_at . '";', 'VolumeName');
debug_out(20, 'SELECT MediaId,VolumeName,Pool.Name AS Pool,' .
	  'Media.VolRetention) '.
	  'AS Expunges ' .
	  'FROM Media,Pool ' .
	  'WHERE ' .
      'InChanger=0 ' .
	  $skip_pool_sql .
	  ' AND Pool.PoolId=Media.PoolId AND VolStatus IN ' .
	  '("Used","Append","Full","Recycle","Purged") ' .
	  'HAVING Expunges<="' .
	  $expunge_at . '";');

if ($catres) {
    debug_out(10, "\nMedia that can be loaded:");
    my $a;
    for $a (sort(keys %{$catres})) {
# all the media in one hash - see above...
		debug_out(10, "  Volume $a\n    $catres->{$a}->{'Expunges'}\n    $catres->{$a}->{'Pool'}");
		push @volumes, $catres->{$a};
} else {
    debug_out(10, "No Media: DBI::errstr: " .
	      ((DBI::errstr) ? DBI::errstr : '*none*'));

if ($#volumes >= 0) {
# we've got the volumes that can be loaded again.
# We sort them by expiration time.

    @volumes = sort {
		debug_out(30, "Comparing $a->{'VolumeName'} with $b->{'VolumeName'}");
		Class::Date->new($a->{'Expunges'}) <=> Class::Date->new($b->{'Expunges'})
		} @volumes;
# and produce a nice report:
# Wee need only the first few volumes of each pool

    my %pools;

    for $i (0 .. $#volumes) {
		debug_out(10, "===\nVolume $volumes[$i]{'VolumeName'} from pool $volumes[$i]{'Pool'}
  Expunges $volumes[$i]{'Expunges'}");
		if (defined($pools{$volumes[$i]{'Pool'}})) {
			if (!defined($pools{$volumes[$i]{'Pool'} . '--CONT'})) {
				$pools{$volumes[$i]{'Pool'} . '--CONT'} = ();
			push(@{$pools{$volumes[$i]{'Pool'} . '--CONT'}}, $volumes[$i]{'VolumeName'});
		} else {
			$pools{$volumes[$i]{'Pool'}} = 1;
			$pools{$volumes[$i]{'Pool'} . '--CONT'}->[0] = ($volumes[$i]{'VolumeName'});
    if ($debug >= 10) {
		for $a (sort(keys %pools)) {
			if ($a !~ /.*--CONT$/) {
				debug_out(10, "Pool $a - $pools{$a}\nContents:");
				debug_out(10, @{$pools{$a . '--CONT'}});
    if ($new_bypool) {
		for $a (sort(keys %pools)) {
			if ($a !~ /.*--CONT$/) {
				print "\n" . $msgs{'load_from'} . $a . ":\n";
				for($i=0; ($i < $new_vols) && ($i < $pools{$a}); $i++) {
					print '  ' . $pools{$a . '--CONT'}[$i] . "\n";
				if (0 == $i) {
					print $msgs{'load_none'};
    } else {
		for $a (sort(keys %pools)) {
			if ($a !~ /.*--CONT$/) {
				for($i=0; ($i < $new_vols) && ($i < $pools{$a}); $i++) {
					push(@volumes, $pools{$a . '--CONT'}[$i]);
		if ($#volumes) {
			@volumes = sort(@volumes);
			print "\n " . $msgs{'load_all'} . '  ' . join("\n  ", @volumes) . "\n";
		} else {
			print $msgs{'load_none'}
} else {
    print $msgs{'noimp'};

sub do_mount {

# We read the varfile, and for each unique storage device we
# - make sure volumes are loaded into the first slots
# - execute the update command and mount the device.

    if ((-f $varfile) and (-r $varfile) and (-w $varfile)) {
		debug_out(5, "Using $varfile for updating...");
		if (open(VF, $varfile)) {
			my %st;
			while (<VF>) {
				debug_out(10, "Got line: $_");
				if (/^update volume=(.+) +.*/){
					debug_out(15, "Match for volume=$1");
					debug_out(20, "Issuing $_...");
					my $po = get_prog_output($bconsole, $_);
					debug_out(20, "Command got:\n$po");
					debug_out(0, "Problem updating volume $1:" . 
							  "\n$po\n********\nTrying to continue.")
						if ($po !~ /^New Enabled is: .*/ms);
				} elsif (/^# mtx_load ([^ ]+) ([^ ]+) ([a-z]+)$/) {
						 debug_out(20, "Loading volumes in $1 if necessary");
						 my $po = get_prog_output($2 . ' -f ' . $1 . ' status');
						 debug_out(20, "Command got:\n$po");
						 my $vols = 0;
						 my @full = ();
						 my @empty = ();
						 my $trn = $3;
						 while ($po =~ /^ +Storage Element ([0-9]+)( IMPORT\/EXPORT)?:Full .*$/gm) {
							 debug_out(25, "Match Full: Slot $1");
							 push @full, $1;
						 debug_out(20, 'Volumes: ' . $vols);
						 while ($po =~ /^ +Storage Element ([0-9]+)( IMPORT\/EXPORT)?:Empty:.*/gm) {
							 debug_out(25, "Match Empty: Slot $1");
							 push @empty, $1;
						 debug_out(25, "Slots Full: @full Slots Empty: @empty");
						 debug_out(25, "Highest used slot: $full[$#full-1]");
						 my ($from, $to);
						 while (($from = pop @full) && ($to = shift @empty) && ($to < $from)) {
							 debug_out(25, "Move from $from to $to");
							 if ('transfer' eq $trn) {
								 debug_out(30, 'Doing transfer');
								 $po = get_prog_output($2 . ' -f ' . $1 . ' transfer ' . $from . ' ' . $to);
								 debug_out(30, "Got $po");
								 if (0 < length($po)) {
									 debug_out(0, "Moving tape had an error:\n$po\nTrying to continue...\n");
							 } else {
								 debug_out(0, "Please move the newly loaded volume from slot $from to $to manually!");
				} elsif (/^update .* storage=(.+)$/){
					debug_out(15, "Match for storage=$1");
					my $st = $1;
					if (defined($st{$1})) {
						debug_out(20, "Storage $1 ignored - this is no. $st{$1}");
					} else {
						debug_out(20, "Issuing $_...");
						$st{$1} = 1;
						my $po = get_prog_output($bconsole, $_);
						debug_out(20, "Command got:\n$po");
						debug_out(0, 'Problem updating:' . 
								  "\n$po\n********\nTrying to continue.")
							if ($po !~ /^330\d .*$/ms);
						$po = get_prog_output($bconsole, "mount $st");
						debug_out(15, "Mount command got:\n$po");
						debug_out(0, 'Problem mounting:' . 
								  "\n$po\n********\nTrying to continue.")
							if ($po !~ /^(3905 .*|3901 .*ERR=No medium found|3001 Device .*)$/ms);
		} else {
			debug_out(0, "$varfile could not be opened: $!");
    } else {
		debug_out(0, "$varfile doesn\'t exist, or is not read- and writeable.");

sub reorder {

# This function takes three arguments: A device name, a reference to a
# device-describing hash (see process_changer for details) and a
# reference to the global list is volumes to remove.  It tries to
# shuffle volumes in the given storage so that they can be easily
# removed.

    if ((!defined($_[0]) or (ref($_[1] ne 'HASH')) or (ref($_[2]) ne 'ARRAY'))) {
		debug_out(0, 'Not called with a name, a hash and an array!');
		return 1;
    my $device = $_[0];
    my %caps = %{$_[1]};
    my $volumes = $_[2];
    debug_out(45, "Shuffling in $device...");
    my $out = get_prog_output($bconsole, ".storage");
    debug_out(45, "Got storage defaults $out");
    if ($out =~ /^1000 OK.*^$device$/ms) {
		$out = get_prog_output($bconsole, '.defaults storage=' . $device);
		if ($out =~ /^storage=$device.*device=(.*)(You have messages\.)?$/ms) {
			my $subdev = $1;
			$out = get_prog_output($bconsole, 'status storage=' . $device);
			debug_out(50, "status storage got:\n$out");
			if ($out =~ /^Autochanger \"$subdev\" with devices: *\n *\"([^\n]+)\" \(/ms) {
				$subdev = $1;
			} else {
				debug_out(0, "Couldn't find a drive for device $device / $subdev.");
			debug_out(45, "Sub-device is $subdev");
			$out =~ /^Running Jobs:(.*)\n====\n\nJobs.*/ms;
			$out = $1;
			debug_out(50, "Running jobs:\n$out");
			if ($out !~ /^ +pool=.*device=\"\"$subdev\"/ms) {
				debug_out(45, "$device ($subdev) is not busy.");
				$out = get_prog_output($bconsole, 'unmount ' . $device);
				store_remount($device, $caps{'scn'}, $caps{'ctr'}, $caps{'mtx'}, $caps{'trn'});
				debug_out(45, "Unmounting:\n$out");
				debug_out(0, "Problem unmounting $device ($subdev). trying to continue...")
					if ($out !~ /^3\d{3} Device \"$subdev\" .*unmounted.$/ms);
				my $mtx_s = $caps{'mtx'} . ' -f ' . $caps{'ctr'} . ' status';
				$out = get_prog_output($mtx_s);
				debug_out(45, "First mtx status got:\n$out");
				my $in_drive = undef;
				my $slots_max = 0;
				if ($out =~ /Storage Changer .*Drives, (\d+) Slots/ms) {
					$slots_max = $1;
				if ($out =~ /Data Transfer Element 0:Full \(Storage Element (\d+) Loaded\)/ms) {
					$in_drive = $1;
				debug_out(45, "Slots: $slots_max Loaded: " .
						  (defined($in_drive) ? $in_drive : '*none*'));
				$caps{'slo'} = $slots_max if ($caps{'slo'} > $slots_max);
				$caps{'shi'} = $slots_max if ($caps{'shi'} > $slots_max);
				$caps{'slo'} = 1 if ($caps{'slo'} < 1);
				$caps{'shi'} = -1 if ($caps{'shi'} < 1);
				if (0 < $slots_max) {
					my @slots = ();
					my %dummyvolume = ('VolumeName' => 'Dummy',
									   'Storage' => $device,
									   'Slot' => 999);
					while ($out =~ m/Storage Element (\d+):(Full|Empty)/gms) {
						debug_out(45, "Slot $1 is loaded");
						my $vol = find_media($volumes, $device, $1);
						if (defined($vol)) {
							debug_out(45, "Found volume $vol->{'VolumeName'}");
							if ($vol->{'Slot'} == $1) {
								debug_out(50, "Volume $vol->{'VolumeName'} is in slot $1");
								$slots[$1] = $vol;
							} else {
								debug_out(0, "Slot $1 not correctly loaded. Not sorting.");
								return undef;
						} elsif ('Empty' ne $2) {
							$slots[$1] = \%dummyvolume;
						} elsif ('Empty' eq $2) {
							$slots[$1] = undef;
						} else {
							debug_out(0, "Seriously unexpected internal problem: Slot $1, Status $2, Volume is $vol. Not re-ordering.");
							return undef;
# array @slots is finally initialized with the volumes to re-order and dummies.
					if ($debug >= 45) {
						for my $s (1 .. $#slots) {
							debug_out(45, "Slot $s: " .
									  (defined($slots[$s]->{'VolumeName'}) ?
									   $slots[$s]->{'VolumeName'} : '*empty*'));
					my $keepslots = $slots_max - ($caps{'shi'}-$caps{'slo'}) - 1;
					debug_out(45, "Slots left for storage: $keepslots");
					my $emptyslots = 0;
					foreach my $s (@slots[1 .. $slots_max]) {
						$emptyslots++ if (!defined($s->{'VolumeName'}));
					debug_out(45, "Slots empty: $emptyslots");
					my $workslot = $emptyslots;
					$workslot-- if (defined($in_drive));
					$workslot++ if (1 == $caps{'trn'});
					if ($workslot < 1) {
						print $msgs{'slotsnoav'} . $device . "\n";
						return undef;
					debug_out(45, "Slots available for re-ordering: $workslot");
					debug_out(45, "Limits: $caps{'shi'} $caps{'slo'}");
					for(my $s = 1; $s<= $slots_max; $s++) {
						debug_out(50, "Iter $s: " . defined($slots[$s]->{'VolumeName'}) .
								  ' Hi: ' . ($s > $caps{'shi'}) .
								  ' Lo: ' . ($s < $caps{'slo'}));
						if ((!defined($slots[$s]->{'VolumeName'})) and
							(($s > $caps{'shi'}) or ($s < $caps{'slo'}))) {
							$workslot = $s;
							last SRCH;
					debug_out(50, 'Hmm. Workslot not set.') if (!defined($workslot));
					$workslot = 1 if ((!defined($workslot)) and ($caps{'slo'} > 1));
					$workslot = $slots_max if ((!defined($workslot)) and
											   ($caps{'shi'} < $slots_max));
					if (!defined($workslot)) {
						debug_out(0, 'Couldn\'t find a slot for work. This should never happen.');
						return undef;
					debug_out(45, "Working slot is $workslot");
					my @moves = ();
					my @temp = @slots;
					for(my $s = $caps{'slo'}; $s <= $caps{'shi'}; $s++) {
						if (!defined($temp[$s]->{'VolumeName'}) or
							(('Dummy' eq $temp[$s]->{'VolumeName'}) and
							 (999 == $temp[$s]->{'Slot'}))) {
							debug_out(45, "Volume $s should be replaced with" .
									  ' a volume to export.');
							for (my $t = 1; $t <= $slots_max; $t++) {
								if ((($t < $caps{'slo'}) or ($t > $caps{'shi'})) and ($t != $workslot) and (defined($temp[$t]->{'VolumeName'}) and (('Dummy' ne $temp[$t]->{'VolumeName'}) and (999 != $temp[$t]->{'Slot'})))) {
									debug_out(45, "Move from slot $t to slot $s");
									my $swp = $temp[$t];
									$temp[$t] = $temp[$s];
									$temp[$s] = $swp;
									my %onemove = ('From'=>$t, 'To'=>$s);
									push @moves, \%onemove;
					if ($debug >= 40) {
						debug_out(40, 'Effective Tape moves:');
						for my $a (@moves) {
							debug_out(40, "From: $a->{'From'} To: $a->{'To'}");
# Finally, we have a list of all the tape moves we've got to do in effect.
# With a stupid autochanger without transfer abilities, we handle this as follows:
# First, load the To: slot and unload it to the workslot.
# Then, the From: slot is loaded and unloaded to the To: slot.
# Finally, for bookkeeping, workslot becomes the From: slot.
# Loop until done
# With autoloaders that can transfer, we do it a little different.
# Instead of loading / unloading, we use the transfer command
# Whenever a To: slot is occupied, the tape is moved to the workslot and
# the From: slot becomes the workslot.
# If initially loaded, the drive is unloaded to the workslot.
					my $po = '';
					my $marker;
					if (($caps{'trn'}) and (defined($slots[$workslot]->{'VolumeName'}))) {
						debug_out(40, "Will use transfers but have to free slot $workslot first...");
						$po = get_prog_output($caps{'mtx'} . " -f $caps{'ctr'} load $workslot");
						$marker = 1;
						$in_drive = $workslot;
						$slots[$workslot] = undef;
						if (length($po) > 0) {
							debug_out(0, "Error: \n$po\n********\nCan\'t continue reordering");
							return undef;
					} elsif (!$caps{'trn'} and (defined($slots[$workslot]->{'VolumeName'}))) {
						debug_out(0, "Can\'t use transfers but workslot is not free. No reordering possible.");
						return undef;
					} elsif ((!$caps{'trn'}) and ($in_drive)) {
						my $workslot2;
						for(my $s = 1; $s<= $slots_max; $s++) {
							debug_out(50, "Iter $s: " . defined($slots[$s]->{'VolumeName'}) .
									  ' Hi: ' . ($s > $caps{'shi'}) .
									  ' Lo: ' . ($s < $caps{'slo'}));
							if ((!defined($slots[$s]->{'VolumeName'})) and
								(($s > $caps{'shi'}) or ($s < $caps{'slo'})) and
								($s != $workslot)) {
								$workslot2 = $s;
								last SRCH;
						if (!defined($workslot2)) {
							debug_out(0, "No slot to empty drive. No re-ordering.");
							return undef;
						if ($caps{'off'}) {
							$po = get_prog_output("$caps{'mt'} -f $caps{'dev'} rewoffl");
							if (length($po) > 0) {
								debug_out(0, "Problem offlining drive:\n$po");
								return undef;
						my $po = get_prog_output("$caps{'mtx'} -f $caps{'ctr'} unload $workslot2");
						if (length($po) > 0) {
							debug_out(0, "Problem unloading drive:\n$po");
							return undef;
						debug_out(50, "Drive free and workslot available. Ok.");
					for my $m (@moves) {
						$po = '';
						if ($caps{'trn'}) {
							if (defined($slots[$m->{'To'}]->{'VolumeName'})) {
								debug_out(50, "$caps{'mtx'} -f $caps{'ctr'} transfer $m->{'To'} $workslot");
								$po = get_prog_output("$caps{'mtx'} -f $caps{'ctr'} transfer $m->{'To'} $workslot");
								$workslot = $m->{'From'};
							debug_out(50, "$caps{'mtx'} -f $caps{'ctr'} transfer $m->{'From'} $m->{'To'}");
							$po = get_prog_output("$caps{'mtx'} -f $caps{'ctr'} transfer $m->{'From'} $m->{'To'}");
							if (length($po) > 0) {
								debug_out(0, "Problem moving tape from slot $m->{'From'} to slot $m->{'To'}:\n$po\n********\nCan\'t continue.");
								return undef;
							my $swap = $slots[$m->{'From'}];
							my $gv = find_media($volumes, $device, $m->{'To'});
							$gv->{'Slot'} = $workslot if ($gv);
							$gv = find_media($volumes, $device, $m->{'From'});
							$gv->{'Slot'} = $m->{'To'} if ($gv);
							$slots[$m->{'From'}] = $slots[$m->{'To'}];
							$slots[$m->{'To'}] = $swap;
						} else {
# here we handle autoloaders without tranfer capability
							debug_out(45, "Transfers in non-tranfering devices not supported.");
							if (defined($slots[$m->{'To'}]->{'VolumeName'})) {
								$po = get_prog_output("$caps{'mtx'} -f $caps{'ctr'} load $m->{'To'}");
								if (length($po) > 0) {
									debug_out(0, "Problem loading from slot $m->{'To'}:\n$po\n********\nCan\'t continue reordering.");
									return undef;
								if ($caps{'off'}) {
									$po = get_prog_output("$caps{'mt'} -f $caps{'dev'} rewoffl");
									if (length($po) > 0) {
										debug_out(0, "Problem offlining $device - trying to continue");
								$po = get_prog_output("$caps{'mtx'} -f $caps{'ctr'} unload $workslot");
								if ($po !~ /^Unloading Data Transfer Element into Storage Element ($workslot)...done$/) {
									debug_out(0, "Problem unloading to slot $workslot:\n$po\n********\nCan\'t continue reordering.");
									return undef;
								$workslot = $m->{'To'}
							$po = get_prog_output("$caps{'mtx'} -f $caps{'ctr'} load $m->{'From'}");
							if (length($po) > 0) {
								debug_out(0, "Problem loading from slot $m->{'From'}:\n$po\n********\nCan\'t continue reordering.");
								return undef;
							$po = get_prog_output("$caps{'mtx'} -f $caps{'ctr'} unload $m->{'To'}");
							if ($po !~ /^Unloading Data Transfer Element into Storage Element ($m->{'To'})...done$/) {
								debug_out(0, "Problem unloading to slot $m->{'To'}:\n$po\n********\nCan\'t continue reordering.");
								return undef;
							my $swap = $slots[$m->{'From'}];
							my $gv = find_media($volumes, $device, $m->{'To'});
							$gv->{'Slot'} = $workslot if ($gv);
							$gv = find_media($volumes, $device, $m->{'From'});
							$gv->{'Slot'} = $m->{'To'} if ($gv);
							$slots[$m->{'From'}] = $slots[$m->{'To'}];
							$slots[$m->{'To'}] = $swap;
					if ($caps{'trn'} and $marker) {
						if ($caps{'off'}) {
							$po = get_prog_output("$caps{'mt'} -f $caps{'dev'} rewoffl");
							debug_out(0, "Problem offlining drive:\n$po") if (length($po) > 0);
						$po = get_prog_output("$caps{'mtx'} -f $caps{'ctr'} unload $workslot");
						debug_out(0, "Problem unloading drive:\n$po") if (length($po) > 0);
					if ($caps{'eje'}) {
						$po = get_prog_output("$caps{'mtx'} -f $caps{'ctr'} eject");
						debug_out(0, "Problem unloading drive:\n$po") if (length($po) > 0);
				} else {
					print $msgs{'slotsprob'} .
						"Max: $slots_max Lo: $caps{'slo'} Hi: $caps{'shi'}\n";
			} else {
				print $msgs{'devbusy'} . "$device ($subdev)\n";
		} else {
			print $msgs{'nosuchdev'} . $device . " (sub)\n";
	} else {
		print $msgs{'nosuchdev'} . $device . "\n";

sub find_media {

# this function takes three arguments: a reference to the volumes
# array, a storage name and a slot.  It returns a reference to the
# volume in the volumes array, or undef if the volume specified wasn't
# found.

    if ('ARRAY' eq ref($_[0])) {
		if ((defined($_[1])) and (defined($_[2]))) {
			my $vols = $_[0];
			my $stor = $_[1];
			my $slot = $_[2];
			debug_out(50, "Search for slot $slot in $stor");
			foreach my $a (@$vols) {
				debug_out(50, "Check $a->{'VolumeName'}");
				return $a if (($slot == $a->{'Slot'}) and ($stor eq $a->{'Storage'}));
			return undef;
		} else {
			debug_out(0, 'Problem in find_media: storage or slot not specified.');
			return undef;
    } else {
		debug_out(0, 'Problem in find_media: volumes-array not supplied');
		return undef;

sub get_prog_output {
    if (defined($_[0]) and (defined($_[1]))) {
		my $prog = shift;
		my $params = join("\n", @_) . "\n";
		debug_out(45, "Calling $prog and feed it $params");
		my ($rdfh, $wrfh);
		my $pid = open2($rdfh, $wrfh, $prog);
		debug_out(45, "PID: $pid FHs: $wrfh $rdfh");
		my $ret = '';
		if ($pid) {
			debug_out(45, "Now printing to FH...");
			print $wrfh $params;
			debug_out(45, "Closed FH");
			while (<$rdfh>) {
				debug_out(45, "Reading...");
				$ret .= $_;
				if (length($ret) > 2*1024*1024) { # 2 MB of output should definitely be enough...
					debug_out(0, "Output from $prog got too long. Truncated.");
					return $ret;
			debug_out(45, "Read $ret");
			return $ret;
		} else {
			debug_out(45, "Can't start $prog bcause of $!");
			return '';
    elsif (defined($_[0])) {
		my $f = $_[0] . ' 2>&1 |';
		debug_out(45, "File to open: $f");
		my $ret = '';
		if (open(my $p, $f)) {
			while (<$p>) {
				$ret .= $_;
				if (length($ret) > 2*1024*1024) { # 2 MB of output should definitely be enough...
					debug_out(0, "Output from $_[0] got too long. Truncated.");
					return $ret;
			return $ret;
		} else {
			debug_out(0, "Error opening $f: $!");
			return "\n\n\n**** ERROR $! ****\n\n\n";
    } else {
		debug_out(0, "get_prog_output called without program. This doesn't work...");
		return '';

sub process_changer {
# this function is called for the option --changer, once per occurence.
# it should return with die upon error because Getopt::Long handles this
# correctly as an option processing error.
# This is used as follows:
#  --changer HPDAT=/usr/bin/mtx|/usr/bin/mt|/dev/nst0|/dev/sg0|offl|4-6|transfer|eject
# This is called with three arguments:
#  literal "changer"
#  changer name, like "HPDAT"
#  changer options, like /usr/bin/mtx|/dev/nst0|/dev/sg0|offl|4-6|scan|transfer|eject

    debug_out(45, "process_changer called with @_");
    if ('changer' eq $_[0]) {
	my $device = $_[1];
	if ('help' eq $device) {
	    exit 1;
	my ($mtx, $mt, $dev, $ctr, $offline, $slots, $scan, $transfer, $eject) =
	    split(/\|/, $_[2]);
# the following line produces warnings when not all options are given.
	debug_out(55, "Got $mtx $dev $ctr $offline $slots $scan $transfer $eject");
	my $err = $msgs{'changer_err'};
	my $fault = 0;
	my ($slotlo, $slothi) = (0, 0);
	if (defined($eject)) {
	    if ($eject =~ /^(1|yes|eject)$/i) {
			$eject = 1;
	    } elsif ($eject =~ /^(0|no|noeject|keeploaded|)$/i) {
			$eject = 0;
	    } else {
			$err .= ' eject';
			$fault = 1;
			$eject = 0;
	} else {
	    $eject = 0;
	if (defined($transfer)) {
	    if ($transfer =~ /^(0|no|load|)$/i) {
			$transfer = 0;
	    } elsif ($transfer =~ /^(1|yes|transfer)$/i) {
			$transfer = 1;
	    } else {
			$err .= ' transfer';
			$fault = 1;
			$transfer = 0;
	} else {
	    $transfer = 0;
	if (defined($scan)) {
	    if ($scan =~ /^(0|no|noscan|)$/i) {
			$scan = 0;
	    } elsif ($scan =~ /^(1|yes|scan)$/i) {
			$scan = 1;
	    } else {
			$err .= ' scan';
			$fault = 1;
			$scan = 0;
	} else {
	    $scan = 0;
	if (defined($slots) && ($slots =~ /^(\d+)-(\d+)$/)) {
	    $slotlo = $1;
	    $slothi = $2;
	} elsif ((defined($slots)) && ('' ne $slots)) {
	    $err .= ' slots';
	    $fault = 1;
	if (defined($offline)) {
	    if ($offline =~ /^(1|yes|offline|)$/i) {
			$offline = 1;
	    } elsif ($offline =~ /^(0|no|nooffline)$/i) {
			$offline = 0;
	    } else {
			$err .= ' offline';
			$fault = 1;
	} else {
	    $offline = 1;
	if (!defined($ctr)) {
	    $err .= ' control-device';
	    $fault = 1;
	if (!defined($dev)) {
	    $dev = '';
	if (!defined($mt)) {
	    $mtx = '/usr/bin/mt';
	if (!defined($mtx)) {
	    $mtx = '/usr/bin/mtx';
	debug_out(45, "Got $mtx $mt $dev $ctr $offline ${slotlo}-${slothi} $scan $transfer $eject");
	if (!defined($device) or ('' eq $device)) {
	    $fault = 1;
	    $err .= ' no-device';
	} else {
	    $err .= '. ' . $device;
	die($err . $msgs{'changer_ign'}) if $fault;
	my %this_changer;
	$this_changer{'mtx'} = $mtx;
	$this_changer{'mt'} = $mt;
	$this_changer{'dev'} = $dev;
	$this_changer{'ctr'} = $ctr;
	$this_changer{'off'} = $offline;
	$this_changer{'slo'} = $slotlo;
	$this_changer{'shi'} = $slothi;
	$this_changer{'scn'} = $scan;
	$this_changer{'trn'} = $transfer;
	$this_changer{'eje'} = $eject;
	$all_devices{$device} = \%this_changer;
    } else {
		die("Internal Error. This is really bad but not dramatic \x{263a}.");

sub store_remount {
    if ((defined($_[0])) and (defined($_[1])) and (defined($_[2])) and (defined($_[3])) and (defined($_[4]))) {
		my $trn = ($_[4]) ? 'transfer' : 'notransfer';
		if (open(FH, ">>$varfile")) {
			print FH "# mtx_load $_[2] $_[3] $trn\nupdate slots " . ($_[1] ? 'scan ' : '') . 'storage=' . $_[0] . "\n";
		} else {
			debug_out(0, "Can\'t open $varfile for appending. Error $!. Trying to continue.
Please make sure the drives are remounted after tape changing!");
    } else {
		debug_out(0, "store_remount called with insufficient parameters.");

sub debug_out {
    if ($debug >= shift) {
		print STDERR "@_\n";

sub show_help {
print $msgs{'help'};


=head1 NAME

bac_vol_mgmt.pl - a script to simplify tape volume management with Bacula.

=head1 SYNTAX

B<bac_vol_mgmt.pl> B<--help|-h>

B<bac_vol_mgmt.pl> [B<--host>|B<-H> I<Hostname>] [B<--user>|B<-U> I<Username>]
[B<--database>|B<-D> I<Database>] [B<--database-type|-T> I<Database Type>]
[B<--password>|B<-P> I<Password>]
[B<--debug> I<Level>]

The long options can be abbreviated as long as they remain
unique. Short options (and values) can be grouped; for more
information, see B<perldoc Getopt::Long>.


B<bac_vol_mgmt.pl> accesses the catalog used by the backup program
Bacula to do the following tasks:

=over 4
=item *

Determine which volumes are needed for a full recovery of all
known client / fileset combinations.

=item *

Mark these volumes as I<Used>.

=item *

Unmount the storage devices so that Bacula will not use them.

=item *

If possible and if the necessary options are present on the
command line, order the volumes in the autochanger devices in a
way that they can be easily removed.

=item *

If possible, eject the tape magazines or tapes from autochanger

=item *

Print a report about which volumes from which devices should be
removed for storage.

=item *

Print a report about which volumes are available for later use,
i.e. are pruned or will be pruned when needed.


=head1 USAGE

For general instructions, please use the --help option to the program.

Usually, this program will be run in two steps. The first one does most of
the work, and when it's done you should be able to easily remove the tapes
you want to store.

Most of the options are intended for this step. A typical command line might look
like this:

B<< C<<
bac_vol_mgmt.pl -P somepw -p --changer HPDAT="ssh goblin mtx|ssh goblin mt|/dev/st1|/dev/sg5|nooffline|4-6|scan||yes" --changer DLT="ssh goblin mtx|ssh goblin mt|/dev/st2|/dev/sg7|offline|4-5|scan|transfer|no" >> >>

Later, you only need the B<-m> switch to trigger slot scanning and mounting for all
devices the first run unmounted and possibly reordered, or, in other words, all
storage devices where volumes might have changed with assistence of this script.

The latter step of the process can be done by a cron script or interactively. For
example, you could set up an ssh key which only allows this command, and install
putty on a windows client to immediately log in using that key.


I strongly recommend you review the code of this script before deploying it in
a production environment.

Ensure proper operation in a test environment before using this script in your
production setup.

This script needs access to your Bacula catalog database. It even has to write
data into it (unless this is turned of using the B<-no-updates|-n> switch). In
an insecure environment - and which one isn't? - I recommend modifying the script
to contain the user name and password for catalog access in the source code, or
have it read from a configuration file (not yet implemented). Otherwise, be
aware that information passed on the command line can be visible to any user
on the system.

That said, this script should not be able to damage any catalog or even backup data.


As this script is supplied in the form of source code, you can easily modify it
so that you don't have to use the options all the time.

Unfortunately, the variables you might want to change are not all in one place.
Some of them are quite near the top of the file, where the global variables are

The changer setup is all done in the function C<process_changer> at the end
of the program code, this is where you'd change the defaults for the changer

Preferrably, though, would be to simply insert the necessary data into the
global changer variable. Just call the script with all the necessary parameters
and the debug level set sufficiently high and you see all the values as they
are assigned to the all_devices variable. That variable is a hash containing a
device name and a reference to a hash of variable-value-pairs. You could set
up something like

B<< C<<
my %all_devices = ('HPDAT' => \('ctr' => '/dev/sg5',
                                'dev' => '/dev/st1',
                                'eje' => 1,
                                'mt'  => '/bin/mt',
                                'mtx' => '/bin/mtx',
                                'off' => 0,
                                'scn' => 1,
                                'shi' => 6, 'slo' => 4,
                                'trn' => 0 ))
>> >>

... or similar - I didn't test it.


Arno Lehmann, IT-Service Lehmann, <al@xxxxxxxxxxxxxx>

This program is copyrighted (German Urheberrecht) but everybody is
allowed to use, modify and distribute this program under the
following conditions:

=over 2

=item *

This license and the original copyright note must not be changed. If
you modify the script you will hold (the local corresponding
rights to) the copyright for your modified version, too.

=item *

The terms and the idea of the GPL version 2 apply. If you are unsure, ask the
copyright holder if your planned usage is ok.

=item *

No warranties, no promises. You are all on your own.  This program
needs access to your Bacula catalog. If you don't like that idea,
don't use it or check the sourcecode!


Although I give no warranties, in case of problems you can contact me.
I will help as good as possible.

Bacula is a Trademark and Copyright of Kern Sibbald. See L<www.bacula.org>

This SF.net email is sponsored by the 2008 JavaOne(SM) Conference 
Don't miss this year's exciting event. There's still time to save $100. 
Use priority code J8TL2D2. 
Bacula-devel mailing list

This mailing list archive is a service of Copilotco.