[Box Backup-dev] COMMIT r537 - in box/trunk: . bin/bbackupd bin/bbackupquery bin/bbstored distribution/boxbackup/contrib/cygwin infrastructure lib/common lib/raidfile lib/server test/backupstorefix/testfiles test/bbackupd/testfiles
boxbackup-dev@fluffy.co.uk
boxbackup-dev@fluffy.co.uk
Sat, 4 Mar 2006 01:38:18 +0000 (GMT)
Author: martin
Date: 2006-03-04 01:38:13 +0000 (Sat, 04 Mar 2006)
New Revision: 537
Added:
box/trunk/bin/bbackupd/bbackupd-config.in
box/trunk/bin/bbackupquery/makedocumentation.pl.in
box/trunk/bin/bbstored/bbstored-certs.in
box/trunk/bin/bbstored/bbstored-config.in
box/trunk/distribution/boxbackup/contrib/cygwin/install-cygwin-service.pl.in
box/trunk/infrastructure/makebuildenv.pl.in
box/trunk/infrastructure/makeparcels.pl.in
box/trunk/lib/common/makeexception.pl.in
box/trunk/lib/raidfile/raidfile-config.in
box/trunk/lib/server/makeprotocol.pl.in
box/trunk/runtest.pl.in
box/trunk/test/backupstorefix/testfiles/testbackupstorefix.pl.in
box/trunk/test/bbackupd/testfiles/extcheck1.pl.in
box/trunk/test/bbackupd/testfiles/extcheck2.pl.in
box/trunk/test/bbackupd/testfiles/notifyscript.pl.in
Removed:
box/trunk/bin/bbackupd/bbackupd-config
box/trunk/bin/bbackupquery/makedocumentation.pl
box/trunk/bin/bbstored/bbstored-certs
box/trunk/bin/bbstored/bbstored-config
box/trunk/distribution/boxbackup/contrib/cygwin/install-cygwin-service.pl
box/trunk/infrastructure/makebuildenv.pl
box/trunk/infrastructure/makeparcels.pl
box/trunk/lib/common/makeexception.pl
box/trunk/lib/raidfile/raidfile-config
box/trunk/lib/server/makeprotocol.pl
box/trunk/runtest.pl
box/trunk/test/backupstorefix/testfiles/testbackupstorefix.pl
box/trunk/test/bbackupd/testfiles/extcheck1.pl
box/trunk/test/bbackupd/testfiles/extcheck2.pl
box/trunk/test/bbackupd/testfiles/notifyscript.pl
Log:
This is part 2 of a patch from James O'Gorman.
This just renames all of the files that configure now substitutes - no changes to any of the files.
Deleted: box/trunk/bin/bbackupd/bbackupd-config
===================================================================
--- box/trunk/bin/bbackupd/bbackupd-config 2006-03-04 01:33:46 UTC (rev 536)
+++ box/trunk/bin/bbackupd/bbackupd-config 2006-03-04 01:38:13 UTC (rev 537)
@@ -1,533 +0,0 @@
-#!@PERL@
-use strict;
-
-# should be running as root
-if($> != 0)
-{
- printf "\nWARNING: this should be run as root\n\n"
-}
-
-sub error_print_usage
-{
- print <<__E;
-
-Setup bbackupd config utility.
-
-Bad command line parameters.
-Usage:
- bbackupd-config config-dir backup-mode account-num server-hostname working-dir backup-dir [more backup directories]
-
-config-dir usually /etc/box
-backup-mode is lazy or snapshot
- lazy mode runs continously, uploading files over a specified age
- snapshot mode uploads a snapshot of the filesystem when instructed explicitly
-account-num (hexdecimal) and server-hostname as supplied from the server administrator
-working-dir usually /var/bbackupd
-backup-dir, list of directories to back up
-
-__E
- print "=========\nERROR:\n",$_[0],"\n\n" if $_[0] ne '';
- exit(1);
-}
-
-# check and get command line parameters
-if($#ARGV < 4)
-{
- error_print_usage();
-}
-
-# check for OPENSSL_CONF environment var being set
-if(exists $ENV{'OPENSSL_CONF'})
-{
- print <<__E;
-
----------------------------------------
-
-WARNING:
- You have the OPENSSL_CONF environment variable set.
- Use of non-standard openssl configs may cause problems.
-
----------------------------------------
-
-__E
-}
-
-# default locations
-my $default_config_location = '/etc/box/bbackupd.conf';
-
-# command line parameters
-my ($config_dir,$backup_mode,$account_num,$server,$working_dir,@tobackup) = @ARGV;
-
-# check backup mode is valid
-if($backup_mode ne 'lazy' && $backup_mode ne 'snapshot')
-{
- error_print_usage("ERROR: backup mode must be 'lazy' or 'snapshot'");
-}
-
-# check server exists
-{
- my @r = gethostbyname($server);
- if($#r < 0)
- {
- error_print_usage("Backup server specified as '$server', but it could not found.\n(A test DNS lookup failed -- check arguments)");
- }
-}
-
-if($working_dir !~ m~\A/~)
-{
- error_print_usage("Working directory $working_dir is not specified as an absolute path");
-}
-
-# ssl stuff
-my $private_key = "$config_dir/bbackupd/$account_num-key.pem";
-my $certificate_request = "$config_dir/bbackupd/$account_num-csr.pem";
-my $certificate = "$config_dir/bbackupd/$account_num-cert.pem";
-my $ca_root_cert = "$config_dir/bbackupd/serverCA.pem";
-
-# encryption keys
-my $enc_key_file = "$config_dir/bbackupd/$account_num-FileEncKeys.raw";
-
-# other files
-my $config_file = "$config_dir/bbackupd.conf";
-my $notify_script = "$config_dir/bbackupd/NotifySysadmin.sh";
-
-# check that the directories are allowable
-for(@tobackup)
-{
- if($_ eq '/')
- {
- die "It is not recommended that you backup the root directory of your disc";
- }
- if($_ !~ m/\A\//)
- {
- die "Directory $_ is not specified as an absolute path";
- }
- if(!-d $_)
- {
- die "$_ is not a directory";
- }
-}
-
-# summarise configuration
-
-print <<__E;
-
-Setup bbackupd config utility.
-
-Configuration:
- Writing configuration file: $config_file
- Account: $account_num
- Server hostname: $server
- Directories to back up:
-__E
-print ' ',$_,"\n" for(@tobackup);
-print <<__E;
-
-Note: If other file systems are mounted inside these directories, then problems may occur
-with files on the store server being renamed incorrectly. This will cause efficiency
-problems, but not affect the integrity of the backups.
-
-WARNING: Directories not checked against mountpoints. Check mounted filesystems manually.
-
-__E
-
-# create directories
-if(!-d $config_dir)
-{
- printf "Creating $config_dir...\n";
- mkdir $config_dir,0755 or die "Can't create $config_dir";
-}
-
-if(!-d "$config_dir/bbackupd")
-{
- printf "Creating $config_dir/bbackupd\n";
- mkdir "$config_dir/bbackupd",0700 or die "Can't create $config_dir/bbackupd";
-}
-
-if(!-d "$working_dir")
-{
- printf "Creating $working_dir\n";
- if(!mkdir($working_dir,0700))
- {
- die "Couldn't create $working_dir -- create this manually and try again\n";
- }
-}
-
-# generate the private key for the server
-if(!-f $private_key)
-{
- print "Generating private key...\n";
- if(system("openssl genrsa -out $private_key 2048") != 0)
- {
- die "Couldn't generate private key."
- }
-}
-
-# generate a certificate request
-if(!-f $certificate_request)
-{
- die "Couldn't run openssl for CSR generation" unless
- open(CSR,"|openssl req -new -key $private_key -sha1 -out $certificate_request");
- print CSR <<__E;
-.
-.
-.
-.
-.
-BACKUP-$account_num
-.
-.
-.
-
-__E
- close CSR;
- print "\n\n";
- die "Certificate request wasn't created.\n" unless -f $certificate_request
-}
-
-# generate the key material for the file
-if(!-f $enc_key_file)
-{
- print "Generating keys for file backup\n";
- if(system("openssl rand -out $enc_key_file 1024") != 0)
- {
- die "Couldn't generate file backup keys."
- }
-}
-
-# write the notify when store full script
-print "Writing notify script $notify_script\n";
-open NOTIFY,">$notify_script" or die "Can't open for writing";
-
-my $hostname = `hostname`; chomp $hostname;
-my $current_username = `whoami`; chomp $current_username;
-my $sendmail = `whereis sendmail`; chomp $sendmail;
-$sendmail =~ s/\n.\Z//s;
-# for Linux style whereis
-$sendmail = $1 if $sendmail =~ /^sendmail:\s+([\S]+)/;
-# last ditch guess
-$sendmail = 'sendmail' if $sendmail !~ m/\S/;
-
-print NOTIFY <<__EOS;
-#!/bin/sh
-
-SUBJECT="BACKUP PROBLEM on host $hostname"
-SENDTO="$current_username"
-
-if [ \$1 = store-full ]
-then
-$sendmail \$SENDTO <<EOM
-Subject: \$SUBJECT (store full)
-To: \$SENDTO
-
-
-The store account for $hostname is full.
-
-=============================
-FILES ARE NOT BEING BACKED UP
-=============================
-
-Please adjust the limits on account $account_num on server $server.
-
-EOM
-elif [ \$1 = read-error ]
-then
-$sendmail \$SENDTO <<EOM
-Subject: \$SUBJECT (read errors)
-To: \$SENDTO
-
-
-Errors occured reading some files or directories for backup on $hostname.
-
-===================================
-THESE FILES ARE NOT BEING BACKED UP
-===================================
-
-Check the logs on $hostname for the files and directories which caused
-these errors, and take appropraite action.
-
-Other files are being backed up.
-
-EOM
-else
-$sendmail \$SENDTO <<EOM
-Subject: \$SUBJECT (unknown)
-To: \$SENDTO
-
-
-The backup daemon on $hostname reported an unknown error.
-
-==========================
-FILES MAY NOT BE BACKED UP
-==========================
-
-Please check the logs on $hostname.
-
-EOM
-fi
-__EOS
-
-close NOTIFY;
-chmod 0700,$notify_script or die "Can't chmod $notify_script";
-
-
-# write the configuration file
-print "Writing configuration file $config_file\n";
-open CONFIG,">$config_file" or die "Can't open config file for writing";
-print CONFIG <<__E;
-
-StoreHostname = $server
-AccountNumber = 0x$account_num
-KeysFile = $enc_key_file
-
-CertificateFile = $certificate
-PrivateKeyFile = $private_key
-TrustedCAsFile = $ca_root_cert
-
-DataDirectory = $working_dir
-
-
-# This script is run whenever bbackupd encounters a problem which requires
-# the system administrator to assist:
-# 1) The store is full, and no more data can be uploaded.
-# 2) Some files or directories were not readable.
-# The default script emails the system administrator.
-
-NotifyScript = $notify_script
-
-__E
-
-if($backup_mode eq 'lazy')
-{
- # lazy mode configuration
- print CONFIG <<__E;
-
-# A scan of the local discs will be made once an hour (approximately).
-# To avoid cycles of load on the server, this time is randomly adjusted by a small
-# percentage as the daemon runs.
-
-UpdateStoreInterval = 3600
-
-
-# A file must have been modified at least 6 hours ago before it will be uploaded.
-
-MinimumFileAge = 21600
-
-
-# If a file is modified repeated, it won't be uploaded immediately in case it's modified again.
-# However, it should be uploaded eventually. This is how long we should wait after first noticing
-# a change. (1 day)
-
-MaxUploadWait = 86400
-
-__E
-}
-else
-{
- # snapshot configuration
- print CONFIG <<__E;
-
-# This configuration file is written for snapshot mode.
-# You will need to run bbackupctl to instruct the daemon to upload files.
-
-AutomaticBackup = no
-UpdateStoreInterval = 0
-MinimumFileAge = 0
-MaxUploadWait = 0
-
-__E
-}
-
-print CONFIG <<__E;
-
-# Files above this size (in bytes) are tracked, and if they are renamed they will simply be
-# renamed on the server, rather than being uploaded again. (64k - 1)
-
-FileTrackingSizeThreshold = 65535
-
-
-# The daemon does "changes only" uploads for files above this size (in bytes).
-# Files less than it are uploaded whole without this extra processing.
-
-DiffingUploadSizeThreshold = 8192
-
-
-# The limit on how much time is spent diffing files. Most files shouldn't take very long,
-# but if you have really big files you can use this to limit the time spent diffing them.
-# * Reduce if you are having problems with processor usage.
-# * Increase if you have large files, and think the upload of changes is too large and want
-# to spend more time searching for unchanged blocks.
-
-MaximumDiffingTime = 20
-
-
-# Uncomment this line to see exactly what the daemon is going when it's connected to the server.
-
-# ExtendedLogging = yes
-
-
-# Use this to temporarily stop bbackupd from syncronising or connecting to the store.
-# This specifies a program or script script which is run just before each sync, and ideally
-# the full path to the interpreter. It will be run as the same user bbackupd is running as,
-# usually root.
-# The script prints either "now" or a number to STDOUT (and a terminating newline, no quotes).
-# If the result was "now", then the sync will happen. If it's a number, then the script will
-# be asked again in that number of seconds.
-# For example, you could use this on a laptop to only backup when on a specific network.
-
-# SyncAllowScript = /path/to/intepreter/or/exe script-name parameters etc
-
-
-# Where the command socket is created in the filesystem.
-
-CommandSocket = /var/run/bbackupd.sock
-
-# Uncomment the StoreObjectInfoFile to enable the experimental archiving
-# of the daemon's state (including client store marker and configuration)
-# between backup runs. This saves time and increases efficiency when
-# bbackupd is frequently stopped and started, since it removes the need
-# to rescan all directories on the remote server. However, it is new and
-# not yet heavily tested, so use with caution.
-
-# StoreObjectInfoFile = $working_dir/bbackupd.state
-
-Server
-{
- PidFile = /var/run/bbackupd.pid
-}
-
-#
-# BackupLocations specifies which locations on disc should be backed up. Each
-# directory is in the format
-#
-# name
-# {
-# Path = /path/of/directory
-# (optional exclude directives)
-# }
-#
-# 'name' is derived from the Path by the config script, but should merely be
-# unique.
-#
-# The exclude directives are of the form
-#
-# [Exclude|AlwaysInclude][File|Dir][|sRegex] = regex or full pathname
-#
-# (The regex suffix is shown as 'sRegex' to make File or Dir plural)
-#
-# For example:
-#
-# ExcludeDir = /home/guest-user
-# ExcludeFilesRegex = *.(mp3|MP3)\$
-# AlwaysIncludeFile = /home/username/veryimportant.mp3
-#
-# This excludes the directory /home/guest-user from the backup along with all mp3
-# files, except one MP3 file in particular.
-#
-# In general, Exclude excludes a file or directory, unless the directory is
-# explicitly mentioned in a AlwaysInclude directive.
-#
-# If a directive ends in Regex, then it is a regular expression rather than a
-# explicit full pathname. See
-#
-# man 7 re_format
-#
-# for the regex syntax on your platform.
-#
-
-BackupLocations
-{
-__E
-
-# write the dirs to backup
-for my $d (@tobackup)
-{
- $d =~ m/\A.(.+)\Z/;
- my $n = $1;
- $n =~ tr`/`-`;
-
- my $excludekeys = '';
- if(substr($enc_key_file, 0, length($d)+1) eq $d.'/')
- {
- $excludekeys = "\t\tExcludeFile = $enc_key_file\n";
- print <<__E;
-
-NOTE: Keys file has been explicitly excluded from the backup.
-
-__E
- }
-
- print CONFIG <<__E
- $n
- {
- Path = $d
-$excludekeys }
-__E
-}
-
-print CONFIG "}\n\n";
-close CONFIG;
-
-# explain to the user what they need to do next
-my $daemon_args = ($config_file eq $default_config_location)?'':" $config_file";
-my $ctl_daemon_args = ($config_file eq $default_config_location)?'':" -c $config_file";
-
-print <<__E;
-
-===================================================================
-
-bbackupd basic configuration complete.
-
-What you need to do now...
-
-1) Make a backup of $enc_key_file
- This should be a secure offsite backup.
- Without it, you cannot restore backups. Everything else can
- be replaced. But this cannot.
- KEEP IT IN A SAFE PLACE, OTHERWISE YOUR BACKUPS ARE USELESS.
-
-2) Send $certificate_request
- to the administrator of the backup server, and ask for it to
- be signed.
-
-3) The administrator will send you two files. Install them as
- $certificate
- $ca_root_cert
- after checking their authenticity.
-
-4) You may wish to read the configuration file
- $config_file
- and adjust as appropraite.
-
- There are some notes in it on excluding files you do not
- wish to be backed up.
-
-5) Review the script
- $notify_script
- and check that it will email the right person when the store
- becomes full. This is important -- when the store is full, no
- more files will be backed up. You want to know about this.
-
-6) Start the backup daemon with the command
- /usr/local/bin/bbackupd$daemon_args
- in /etc/rc.local, or your local equivalent.
- Note that bbackupd must run as root.
-__E
-if($backup_mode eq 'snapshot')
-{
- print <<__E;
-
-7) Set up a cron job to run whenever you want a snapshot of the
- file system to be taken. Run the command
- /usr/local/bin/bbackupctl -q$ctl_daemon_args sync
-__E
-}
-print <<__E;
-
-===================================================================
-
-Remember to make a secure, offsite backup of your backup keys,
-as described in step 1 above. If you do not, you have no backups.
-
-__E
-
Copied: box/trunk/bin/bbackupd/bbackupd-config.in (from rev 536, box/trunk/bin/bbackupd/bbackupd-config)
Deleted: box/trunk/bin/bbackupquery/makedocumentation.pl
===================================================================
--- box/trunk/bin/bbackupquery/makedocumentation.pl 2006-03-04 01:33:46 UTC (rev 536)
+++ box/trunk/bin/bbackupquery/makedocumentation.pl 2006-03-04 01:38:13 UTC (rev 537)
@@ -1,75 +0,0 @@
-#!@PERL@
-use strict;
-
-print "Creating built-in documentation for bbackupquery...\n";
-
-open DOC,"documentation.txt" or die "Can't open documentation.txt file";
-my $section;
-my %help;
-my @in_order;
-
-while(<DOC>)
-{
- if(m/\A>\s+(\w+)/)
- {
- $section = $1;
- m/\A>\s+(.+)\Z/;
- $help{$section} = $1."\n";
- push @in_order,$section;
- }
- elsif(m/\A</)
- {
- $section = '';
- }
- elsif($section ne '')
- {
- $help{$section} .= $_;
- }
-}
-
-close DOC;
-
-open OUT,">autogen_Documentation.cpp" or die "Can't open output file for writing";
-
-print OUT <<__E;
-//
-// Automatically generated file, do not edit.
-//
-
-#include "Box.h"
-
-#include "MemLeakFindOn.h"
-
-char *help_commands[] =
-{
-__E
-
-for(@in_order)
-{
- print OUT qq:\t"$_",\n:;
-}
-
-print OUT <<__E;
- 0
-};
-
-char *help_text[] =
-{
-__E
-
-for(@in_order)
-{
- my $t = $help{$_};
- $t =~ s/\t/ /g;
- $t =~ s/\n/\\n/g;
- $t =~ s/"/\\"/g;
- print OUT qq:\t"$t",\n:;
-}
-
-print OUT <<__E;
- 0
-};
-
-__E
-
-close OUT;
Copied: box/trunk/bin/bbackupquery/makedocumentation.pl.in (from rev 536, box/trunk/bin/bbackupquery/makedocumentation.pl)
Deleted: box/trunk/bin/bbstored/bbstored-certs
===================================================================
--- box/trunk/bin/bbstored/bbstored-certs 2006-03-04 01:33:46 UTC (rev 536)
+++ box/trunk/bin/bbstored/bbstored-certs 2006-03-04 01:38:13 UTC (rev 537)
@@ -1,319 +0,0 @@
-#!@PERL@
-use strict;
-
-# validity period for root certificates -- default is a very long time
-my $root_sign_period = '10000';
-
-# but less so for client certificates
-my $sign_period = '5000';
-
-# check and get command line parameters
-if($#ARGV < 1)
-{
- print <<__E;
-
-bbstored certificates utility.
-
-Bad command line parameters.
-Usage:
- bbstored-certs certs-dir command [arguments]
-
-certs-dir is the directory holding the root keys and certificates for the backup system
-command is the action to perform, taking parameters.
-
-Commands are
-
- init
- -- generate initial root certificates (certs-dir must not already exist)
- sign certificate-name
- -- sign a client certificate
- sign-server certificate-name
- -- sign a server certificate
-
-Signing requires confirmation that the certificate is correct and should be signed.
-
-__E
- exit(1);
-}
-
-# check for OPENSSL_CONF environment var being set
-if(exists $ENV{'OPENSSL_CONF'})
-{
- print <<__E;
-
----------------------------------------
-
-WARNING:
- You have the OPENSSL_CONF environment variable set.
- Use of non-standard openssl configs may cause problems.
-
----------------------------------------
-
-__E
-}
-
-# directory structure:
-#
-# roots/
-# clientCA.pem -- root certificate for client (used on server)
-# serverCA.pem -- root certificate for servers (used on clients)
-# keys/
-# clientRootKey.pem -- root key for clients
-# serverRootKey.pem -- root key for servers
-# servers/
-# hostname.pem -- certificate for server 'hostname'
-# clients/
-# account.pem -- certficiate for account 'account' (ID in hex)
-#
-
-
-# check parameters
-my ($cert_dir,$command,@args) = @ARGV;
-
-# check directory exists
-if($command ne 'init')
-{
- if(!-d $cert_dir)
- {
- die "$cert_dir does not exist";
- }
-}
-
-# run command
-if($command eq 'init') {&cmd_init;}
-elsif($command eq 'sign') {&cmd_sign;}
-elsif($command eq 'sign-server') {&cmd_sign_server;}
-else
-{
- die "Unknown command $command"
-}
-
-sub cmd_init
-{
- # create directories
- unless(mkdir($cert_dir,0700)
- && mkdir($cert_dir.'/roots',0700)
- && mkdir($cert_dir.'/keys',0700)
- && mkdir($cert_dir.'/servers',0700)
- && mkdir($cert_dir.'/clients',0700))
- {
- die "Failed to create directory structure"
- }
-
- # create root keys and certrs
- cmd_init_create_root('client');
- cmd_init_create_root('server');
-}
-
-sub cmd_init_create_root
-{
- my $entity = $_[0];
-
- my $cert = "$cert_dir/roots/".$entity.'CA.pem';
- my $serial = "$cert_dir/roots/".$entity.'CA.srl';
- my $key = "$cert_dir/keys/".$entity.'RootKey.pem';
- my $csr = "$cert_dir/keys/".$entity.'RootCSR.pem';
-
- # generate key
- if(system("openssl genrsa -out $key 2048") != 0)
- {
- die "Couldn't generate private key."
- }
-
- # make CSR
- die "Couldn't run openssl for CSR generation" unless
- open(CSR,"|openssl req -new -key $key -sha1 -out $csr");
- print CSR <<__E;
-.
-.
-.
-.
-.
-Backup system $entity root
-.
-.
-.
-
-__E
- close CSR;
- print "\n\n";
- die "Certificate request wasn't created.\n" unless -f $csr;
-
- # sign it to make a self-signed root CA key
- if(system("openssl x509 -req -in $csr -sha1 -extensions v3_ca -signkey $key -out $cert -days $root_sign_period") != 0)
- {
- die "Couldn't generate root certificate."
- }
-
- # write the initial serial number
- open SERIAL,">$serial" or die "Can't open $serial for writing";
- print SERIAL "00\n";
- close SERIAL;
-}
-
-sub cmd_sign
-{
- my $csr = $args[0];
-
- if(!-f $csr)
- {
- die "$csr does not exist";
- }
-
- # get the common name specified in this certificate
- my $common_name = get_csr_common_name($csr);
-
- # look OK?
- unless($common_name =~ m/\ABACKUP-([A-Fa-f0-9]+)\Z/)
- {
- die "The certificate presented does not appear to be a backup client certificate"
- }
-
- my $acc = $1;
-
- # check against filename
- if(!($csr =~ m/(\A|\/)([A-Fa-f0-9]+)-/) || $2 ne $acc)
- {
- die "Certificate request filename does not match name in certificate ($common_name)"
- }
-
- print <<__E;
-
-This certificate is for backup account
-
- $acc
-
-Ensure this matches the account number you are expecting. The filename is
-
- $csr
-
-which should include this account number, and additionally, you should check
-that you received it from the right person.
-
-Signing the wrong certificate compromises the security of your backup system.
-
-Would you like to sign this certificate? (type 'yes' to confirm)
-__E
-
- return unless get_confirmation();
-
- # out certificate
- my $out_cert = "$cert_dir/clients/$acc"."-cert.pem";
-
- # sign it!
- if(system("openssl x509 -req -in $csr -sha1 -extensions usr_crt -CA $cert_dir/roots/clientCA.pem -CAkey $cert_dir/keys/clientRootKey.pem -out $out_cert -days $sign_period") != 0)
- {
- die "Signing failed"
- }
-
- # tell user what to do next
- print <<__E;
-
-
-Certificate signed.
-
-Send the files
-
- $out_cert
- $cert_dir/roots/serverCA.pem
-
-to the client.
-
-__E
-}
-
-sub cmd_sign_server
-{
- my $csr = $args[0];
-
- if(!-f $csr)
- {
- die "$csr does not exist";
- }
-
- # get the common name specified in this certificate
- my $common_name = get_csr_common_name($csr);
-
- # look OK?
- if($common_name !~ m/\A[-a-zA-Z0-9.]+\Z/)
- {
- die "Invalid server name"
- }
-
- print <<__E;
-
-This certificate is for backup server
-
- $common_name
-
-Signing the wrong certificate compromises the security of your backup system.
-
-Would you like to sign this certificate? (type 'yes' to confirm)
-__E
-
- return unless get_confirmation();
-
- # out certificate
- my $out_cert = "$cert_dir/servers/$common_name"."-cert.pem";
-
- # sign it!
- if(system("openssl x509 -req -in $csr -sha1 -extensions usr_crt -CA $cert_dir/roots/serverCA.pem -CAkey $cert_dir/keys/serverRootKey.pem -out $out_cert -days $sign_period") != 0)
- {
- die "Signing failed"
- }
-
- # tell user what to do next
- print <<__E;
-
-
-Certificate signed.
-
-Install the files
-
- $out_cert
- $cert_dir/roots/clientCA.pem
-
-on the server.
-
-__E
-}
-
-
-sub get_csr_common_name
-{
- my $csr = $_[0];
-
- open CSRTEXT,"openssl req -text -in $csr |" or die "Can't open openssl for reading";
-
- my $subject;
- while(<CSRTEXT>)
- {
- $subject = $1 if m/Subject:.+?CN=([-\.\w]+)/
- }
- close CSRTEXT;
-
- if($subject eq '')
- {
- die "No subject found in CSR $csr"
- }
-
- return $subject
-}
-
-sub get_confirmation()
-{
- my $line = <STDIN>;
- chomp $line;
- if(lc $line ne 'yes')
- {
- print "CANCELLED\n";
- return 0;
- }
-
- return 1;
-}
-
-
-
-
-
Copied: box/trunk/bin/bbstored/bbstored-certs.in (from rev 536, box/trunk/bin/bbstored/bbstored-certs)
Deleted: box/trunk/bin/bbstored/bbstored-config
===================================================================
--- box/trunk/bin/bbstored/bbstored-config 2006-03-04 01:33:46 UTC (rev 536)
+++ box/trunk/bin/bbstored/bbstored-config 2006-03-04 01:38:13 UTC (rev 537)
@@ -1,242 +0,0 @@
-#!@PERL@
-use strict;
-
-# should be running as root
-if($> != 0)
-{
- printf "\nWARNING: this should be run as root\n\n"
-}
-
-# check and get command line parameters
-if($#ARGV < 2)
-{
- print <<__E;
-
-Setup bbstored config utility.
-
-Bad command line parameters.
-Usage:
- bbstored-config config-dir server-hostname username [raidfile-config]
-
-config-dir usually /etc/box
-server-hostname is the hostname used by clients to connect to this server
-username is the user to run the server under
-raidfile-config is optional. Use if you have a non-standard raidfile.conf file.
-
-__E
- exit(1);
-}
-
-# check for OPENSSL_CONF environment var being set
-if(exists $ENV{'OPENSSL_CONF'})
-{
- print <<__E;
-
----------------------------------------
-
-WARNING:
- You have the OPENSSL_CONF environment variable set.
- Use of non-standard openssl configs may cause problems.
-
----------------------------------------
-
-__E
-}
-
-# default locations
-my $default_config_location = '/etc/box/bbstored.conf';
-
-# command line parameters
-my ($config_dir,$server,$username,$raidfile_config) = @ARGV;
-
-$raidfile_config = $config_dir . '/raidfile.conf' unless $raidfile_config ne '';
-
-# check server exists, but don't bother checking that it's actually this machine.
-{
- my @r = gethostbyname($server);
- if($#r < 0)
- {
- die "Server '$server' not found. (check server name, test DNS lookup failed.)"
- }
-}
-
-# check this exists
-if(!-f $raidfile_config)
-{
- print "The RaidFile configuration file $raidfile_config doesn't exist.\nYou may need to create it with raidfile-config.\nWon't configure bbstored without it.\n";
- exit(1);
-}
-
-# check that the user exists
-die "You shouldn't run bbstored as root" if $username eq 'root';
-my $user_uid = 0;
-(undef,undef,$user_uid) = getpwnam($username);
-if($user_uid == 0)
-{
- die "User $username doesn't exist\n";
-}
-
-# check that directories are writeable
-open RAIDCONF,$raidfile_config or die "Can't open $raidfile_config";
-{
- my %done = ();
- while(<RAIDCONF>)
- {
- next unless m/Dir\d\s*=\s*(.+)/;
- my $d = $1;
- $d = $d.'/backup' if -e $d.'/backup';
- print "Checking permissions on $d\n";
- my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($d);
- my $req_perms = ($uid == $user_uid)?0700:0007;
- if(($mode & $req_perms) != $req_perms)
- {
- print "$username doesn't appear to have the necessary permissions on $d\n";
- print "Either adjust permissions, or create a directory 'backup' inside the\n";
- print "directory specified in raidfile.conf which is writable.\n";
- exit(1);
- }
- }
-}
-close RAIDCONF;
-
-# ssl stuff
-my $private_key = "$config_dir/bbstored/$server-key.pem";
-my $certificate_request = "$config_dir/bbstored/$server-csr.pem";
-my $certificate = "$config_dir/bbstored/$server-cert.pem";
-my $ca_root_cert = "$config_dir/bbstored/clientCA.pem";
-
-# other files
-my $config_file = "$config_dir/bbstored.conf";
-my $accounts_file = "$config_dir/bbstored/accounts.txt";
-
-# summarise configuration
-
-print <<__E;
-
-Setup bbstored config utility.
-
-Configuration:
- Writing configuration file: $config_file
- Writing empty accounts file: $accounts_file
- Server hostname: $server
- RaidFile config: $raidfile_config
-
-__E
-
-# create directories
-if(!-d $config_dir)
-{
- print "Creating $config_dir...\n";
- mkdir $config_dir,0755 or die "Can't create $config_dir";
-}
-
-if(!-d "$config_dir/bbstored")
-{
- print "Creating $config_dir/bbstored\n";
- mkdir "$config_dir/bbstored",0755 or die "Can't create $config_dir/bbstored";
-}
-
-# create blank accounts file
-if(!-f $accounts_file)
-{
- print "Creating blank accounts file\n";
- open ACC,">$accounts_file";
- close ACC;
-}
-
-# generate the private key for the server
-if(!-f $private_key)
-{
- print "Generating private key...\n";
- if(system("openssl genrsa -out $private_key 2048") != 0)
- {
- die "Couldn't generate private key."
- }
-}
-
-# generate a certificate request
-if(!-f $certificate_request)
-{
- die "Couldn't run openssl for CSR generation" unless
- open(CSR,"|openssl req -new -key $private_key -sha1 -out $certificate_request");
- print CSR <<__E;
-.
-.
-.
-.
-.
-$server
-.
-.
-.
-
-__E
- close CSR;
- print "\n\n";
- die "Certificate request wasn't created.\n" unless -f $certificate_request
-}
-
-# write the configuration file
-print "Writing configuration file $config_file\n";
-open CONFIG,">$config_file" or die "Can't open config file for writing";
-print CONFIG <<__E;
-
-RaidFileConf = $raidfile_config
-AccountDatabase = $accounts_file
-
-# Uncomment this line to see exactly what commands are being received from clients.
-# ExtendedLogging = yes
-
-# scan all accounts for files which need deleting every 15 minutes.
-
-TimeBetweenHousekeeping = 900
-
-Server
-{
- PidFile = /var/run/bbstored.pid
- User = $username
- ListenAddresses = inet:$server
- CertificateFile = $certificate
- PrivateKeyFile = $private_key
- TrustedCAsFile = $ca_root_cert
-}
-
-
-__E
-
-close CONFIG;
-
-# explain to the user what they need to do next
-my $daemon_args = ($config_file eq $default_config_location)?'':" $config_file";
-
-print <<__E;
-
-===================================================================
-
-bbstored basic configuration complete.
-
-What you need to do now...
-
-1) Sign $certificate_request
- using the bbstored-certs utility.
-
-2) Install the server certificate and root CA certificate as
- $certificate
- $ca_root_cert
-
-3) You may wish to read the configuration file
- $config_file
- and adjust as appropraite.
-
-4) Create accounts with bbstoreaccounts
-
-5) Start the backup store daemon with the command
- /usr/local/bin/bbstored$daemon_args
- in /etc/rc.local, or your local equivalent.
-
-===================================================================
-
-__E
-
-
-
Copied: box/trunk/bin/bbstored/bbstored-config.in (from rev 536, box/trunk/bin/bbstored/bbstored-config)
Deleted: box/trunk/distribution/boxbackup/contrib/cygwin/install-cygwin-service.pl
===================================================================
--- box/trunk/distribution/boxbackup/contrib/cygwin/install-cygwin-service.pl 2006-03-04 01:33:46 UTC (rev 536)
+++ box/trunk/distribution/boxbackup/contrib/cygwin/install-cygwin-service.pl 2006-03-04 01:38:13 UTC (rev 537)
@@ -1,112 +0,0 @@
-#!@PERL@ -w
-
-
-# Contributed to the boxbackup project by Per Reedtz Thomsen. pthomsen@reedtz.com
-
-# This script reads the config file for boxbackup, and changes the mode
-# of the directory named by 'DataDirectory' and any files there. Also,
-# the files pointed to by the 'CommandSocket' and 'PidFile' configuration
-# parameters will be chmod'ed to be read-write by all.
-# The Windows services are created and started using the 'cygrunsrv' utility.
-
-# Date Who Comments
-# 20041005 pthomsen@reedtz.com Created
-# 20041020 pthomsen@reedtz.com Switched to using Getopt::Std for cmd-line things.
-
-use strict;
-
-use Getopt::Std;
-getopt('ce');
-our ($opt_c, $opt_e);
-# Figure out the config file to use. Default is /etc/box/bbackupd.conf
-my $confFile = (defined($opt_c) ? $opt_c : "/etc/box/bbackupd.conf");
-# Figure out the bbaackupd executable to use. Default is /usr/local/bin/bbackupd.exe
-my $exeFile = (defined($opt_e) ? $opt_e : "/usr/local/bin/bbackupd.exe");
-
-die "File $confFile does not exist. Please provide the full path to the bbackupd configuration file.\n" if !(-f $confFile);
-die "Can't read $confFile. Permission denied. Please chmod the file so I can read it.\n" if !(-r $confFile);
-die "File $exeFile does not exist. Please provide the full path to the bbackupd.exe file.\n" if !(-f $exeFile);
-die "File $exeFile is not executable. Please provide the full path to the correct bbackupd.exe file.\n" if !(-x $exeFile);
-
-# print "Config: $confFile\n";
-
-my $dataDir;
-my $cmdSocket;
-my $pidFile;
-
-open (CONFIG, "<$confFile") or die "Can't open $confFile: $!\n";
-
-# Read the confgiguration file, and pull the DataDirectory, CommandSocket, and PidFile parameters.
-while (<CONFIG>)
-{
-
- if (/^\s*DataDirectory\s*=\s*([^\n\s]+)\s*\n/)
- {
- $dataDir = $1;
- next;
- }
-
- if (/^\s*CommandSocket\s*=\s*([^\n\s]+)\s*\n/)
- {
- $cmdSocket = $1;
- next;
- }
- if (/^\s*PidFile\s*=\s*([^\n\s]+)\s*\n/)
- {
- $pidFile = $1;
- next;
- }
-}
-
-# check that we got all the parameters from the file. If not, die.
-if ((!defined($dataDir)) || (!defined($cmdSocket)) || (!defined($pidFile)))
-{
- die "Could not read config parameters from $confFile. Values retrieved:\n\tDataDirectory = $dataDir\n\tCommandSocket = $cmdSocket\n\tPidFile = $pidFile\n";
-}
-
-
-print "Parameters retrieved from $confFile. Values:\n\tDataDirectory = $dataDir\n\tCommandSocket = $cmdSocket\n\tPidFile = $pidFile\n";
-print "chmod...";
-# change the mode of the files/dirs retrieved.
-chmod(0777, $dataDir) or die "Can't chmod $dataDir: $!\n";
-chmod(0666, "$dataDir/*") or die "Can't chmod $dataDir/*: $!\n";
-chmod(0666, $pidFile) or die "Can't chmod $pidFile: $!\n";
-chmod(0755, $cmdSocket) or die "Can't chmod $cmdSocket: $!\n";
-print " Done.\n";
-
-# Now install the service using cygrunsrv.
-# Details:
-# -I <svc_name> Install a service. svc_name is the name under which the
-# service will appear in the Windows Service Manager
-# -p <path_to_exe> Path to the executable.
-# -a <options> Command line options to the executable.
-# -f <description> Description of the service.
-# -o Attempt clean exit of service during system shutdown
-
-print "Installing boxbackup service...";
-my $sysCmd = "cygrunsrv.exe -I boxbackup -p " . $exeFile;
-$sysCmd .= " -a \"" . $confFile . " SINGLEPROCESS\"";
-$sysCmd .= " -o -f \"Online Backup System by Ben Summers\"";
-print "$sysCmd\n";
-my $output = qx($sysCmd);
-die "cygrunsrv failed to install service. Error Message: $output\n" if($output ne "");
-print " Done.\n";
-
-
-# Start the service
-# Details:
-# -S <svc_name> Start a service. svc_name is the name of the (installed)
-# service to start.
-
-print "Starting boxbackup service...";
-$sysCmd = "cygrunsrv.exe -S boxbackup";
-print "$sysCmd\n";
-$output = qx($sysCmd);
-die "cygrunsrv failed to start service. Error Message: $output\n" if($output ne "");
-print " Done.\n";
-
-print "\n\nService Installation complete. To test, reboot your machine, and make sure that\n";
-print "the boxbackup service is running. A good way to make sure, is to check that the account number\n";
-print "from this machine is connecting to the bbstored server. Check the bbstored logs for more info.\n\n";
-
-
Copied: box/trunk/distribution/boxbackup/contrib/cygwin/install-cygwin-service.pl.in (from rev 536, box/trunk/distribution/boxbackup/contrib/cygwin/install-cygwin-service.pl)
Deleted: box/trunk/infrastructure/makebuildenv.pl
===================================================================
--- box/trunk/infrastructure/makebuildenv.pl 2006-03-04 01:33:46 UTC (rev 536)
+++ box/trunk/infrastructure/makebuildenv.pl 2006-03-04 01:38:13 UTC (rev 537)
@@ -1,804 +0,0 @@
-#!@PERL@
-use strict;
-use Symbol;
-
-my @modules;
-my %module_dependency;
-my %module_library_link_opts;
-my %header_dependency;
-
-$|=1;
-
-
-# note: Mac OS X resource forks and .DS_Store files are explicity ignored
-
-print "Box build environment setup.\n\n";
-
-
-my $implicit_dep = 'lib/common';
-
-# work out platform variables
-use lib 'infrastructure';
-use BoxPlatform;
-
-# keep copy of command line args
-my $makebuildenv_args = join(' ',@ARGV);
-
-# do command line arguments
-my $compile_line_extra = $platform_compile_line_extra;
-my $link_line_extra = $platform_link_line_extra;
-
-# make sure local files directory exists
-unless(-d 'local')
-{
- mkdir 'local',0755;
-}
-
-
-# flags about the environment
-my %env_flags;
-
-my $windows_include_path = "-I../../lib/win32 ";
-if ($target_os ne "mingw32" && $target_os ne "winnt")
-{
- $windows_include_path = "";
- $env_flags{'IGNORE_lib/win32'} = 1;
-}
-
-# print "Flag: $_\n" for(keys %env_flags);
-
-# seed autogen code
-print "Seeding autogen code...\n";
-open FINDAUTOGEN,"find . -follow -name Makefile.extra |" or die "Can't use find for locating files";
-while(<FINDAUTOGEN>)
-{
- chomp;
- my $file = $_;
- $file =~ m~\A(.+)/[^/]+\Z~;
- my $dir = $1;
- open FL,$file or die "Can't open $_ for reading";
- my %vars;
- my $do_cmds = 0;
- while(<FL>)
- {
- chomp;
- if(m/\A(.+)\s+=\s+(.+)\Z/)
- {
- # is a variable
- $vars{$1} = $2;
- next;
- }
- next unless m/\S/;
- if(m/AUTOGEN SEEDING/)
- {
- $do_cmds = 1;
- }
- elsif(m/\A\S/)
- {
- $do_cmds = 0 if $do_cmds == 2;
- }
- else
- {
- # command, run it?
- if($do_cmds)
- {
- $do_cmds = 2; # flag something has been done
-
- # subsitute variables, repeatedly
- my $c = $_;
- $c =~ s/\A\s+//;
- while(1)
- {
- my $did_subst = 0;
-
- for my $k (keys %vars)
- {
- $did_subst = 1 if $c =~ s/\$\($k\)/$vars{$k}/g;
- }
-
- last unless $did_subst;
- }
-
- # run command
- die "Couldn't run command $c" unless (0 == system("(cd $dir; $c)"))
- }
- }
- }
- close FL;
-}
-close FINDAUTOGEN;
-print "done\n\n";
-
-
-# open test mail program template file
-my $test_template_file = 'infrastructure/buildenv-testmain-template.cpp';
-open FL,$test_template_file or die "Can't open test template file\n";
-my $test_template;
-read FL,$test_template,-s $test_template_file;
-close FL;
-
-
-# extra platform defines
-my $extra_platform_defines = '';
-
-# read in module definitions file, and any files it includes
-my @modules_files;
-sub read_modules_file
-{
- my ($mf) = @_;
- my $f = gensym;
- open $f,$mf or die "Can't open modules file '$mf'\n";
- while(<$f>)
- {
- if(m/\AINCLUDE\s+(\S+)\Z/)
- {
- # include another file
- read_modules_file($1)
- }
- else
- {
- push @modules_files,$_
- }
- }
- close $f;
-}
-read_modules_file('modules.txt');
-
-# prepare directories...
-mkdir "release",0755;
-mkdir "debug",0755;
-
-# is the library code in another directory?
-my $external_lib = readlink('lib');
-if($external_lib ne '')
-{
- # adjust to root of the library distribution
- $external_lib =~ s!/lib\Z!!;
- $external_lib = '../'.$external_lib;
- # make symlinks
- make_obj_symlink('debug');
- make_obj_symlink('release');
-}
-sub make_obj_symlink
-{
- my $m = $_[0];
- my $target = $external_lib."/$m/lib/";
- my $link = "$m/lib";
- # check link
- if(-e $link)
- {
- if(-l $link)
- {
- if(readlink($link) ne $target)
- {
- print "Warning: replacing $link with new link to $target\n";
- unlink $link;
- }
- }
- else
- {
- die "$link already exists, but it isn't a symbolic link"
- }
- }
- if(!-e $link)
- {
- symlink $target,$link or die "Can't make $m/lib symlink";
- }
-}
-
-print "Scanning code...\n";
-
-my $modules_omitted = 0;
-my $modules_omitting = 0;
-
-# process lines in flattened modules files
-for(@modules_files)
-{
- # clean up line
- chomp; s/\A\s+//; s/#.*\Z//; s/\s+\Z//; s/\s+/ /g;
- next unless m/\S/;
-
- # omit bits on some platforms?
- if(m/\AEND-OMIT/)
- {
- $modules_omitting = 0;
- next;
- }
-
- next if $modules_omitting;
-
- if(m/\AOMIT:(.+)/)
- {
- if($1 eq $build_os or $1 eq $target_os)
- {
- $modules_omitted = 1;
- $modules_omitting = 1;
- }
- next;
- }
-
- # split up...
- my ($mod, @deps_i) = split / /;
-
- # ignore this module?
- next if ignore_module($mod);
-
- # deps for this platform
- my @deps;
- for(@deps_i)
- {
- my ($dep,$exclude_from) = split /!/;
- # generic library translation
- $dep = $env_flags{'LIBTRANS_'.$dep} if exists($env_flags{'LIBTRANS_'.$dep});
- next if $dep eq '';
- if($exclude_from =~ m/\A\+(.+)\Z/)
- {
- $exclude_from = $1;
- my $inc = 0;
- for(split /,/,$exclude_from)
- {
- $inc = 1 if $_ eq $build_os
- }
- push @deps,$dep if $inc
- }
- else
- {
- my $inc = 1;
- for(split /,/,$exclude_from)
- {
- $inc = 0 if $_ eq $build_os
- }
- push @deps,$dep if $inc
- }
- }
-
- # check directory exists
- die "Module $mod can't be found\n" unless -d $mod;
-
- # and put in lists
- push @modules,$mod;
- my @md; # module dependencies
- my @lo; # link line options
- for(@deps)
- {
- if(/\A-l/)
- {
- push @lo,$_
- }
- else
- {
- push @md,$_ unless ignore_module($_)
- }
- }
- $module_dependency{$mod} = [$implicit_dep,@md];
- $module_library_link_opts{$mod} = [@lo];
-
- # make directories, but not if we're using an external library and this a library module
- my ($s,$d) = split /\//,$mod;
- if($s ne 'lib' || $external_lib eq '')
- {
- mkdir "release/$s",0755;
- mkdir "release/$s/$d",0755;
- mkdir "debug/$s",0755;
- mkdir "debug/$s/$d",0755;
- }
-}
-
-# make dirs for implicit dep
-mkdir "release/$implicit_dep",0755;
-mkdir "debug/$implicit_dep",0755;
-
-# write a list of all the modules we've configured to use
-open CONFIGURED_MODS,'>local/modules.h' or die "Can't write configured modules list";
-print CONFIGURED_MODS <<__E;
-// automatically generated file, do not edit
-#ifndef _CONFIGURED_MODULES__H
-#define _CONFIGURED_MODULES__H
-__E
-for($implicit_dep,@modules)
-{
- my $m = $_;
- $m =~ s~/~_~;
- print CONFIGURED_MODS "#define MODULE_$m\n";
-}
-print CONFIGURED_MODS <<__E;
-#endif // _CONFIGURED_MODULES__H
-__E
-close CONFIGURED_MODS;
-
-
-# now make a list of all the .h files we can find, recording which module they're in
-my %hfiles;
-for my $mod (@modules, $implicit_dep)
-{
- opendir DIR,$mod;
- my @items = readdir DIR;
- closedir DIR;
-
- # add in items from autogen directories, and create output directories
- {
- my @autogen_items;
-
- for my $di (@items)
- {
- if($di =~ m/\Aautogen/ && -d "$mod/$di")
- {
- # Read items
- my $d = "$mod/$di";
- opendir DIR,$d;
- my @i = readdir DIR;
- closedir DIR;
- for(@i)
- {
- next if m/\A\./;
- push @autogen_items,"$di/$_"
- }
- }
- }
- @items = (@items, @autogen_items);
- }
-
- for(grep /\.h\Z/i, @items)
- {
- next if /\A\._/; # Temp Mac OS Resource hack
- die "Header file $_ already used in module ".$hfiles{$_}."\n" if exists $hfiles{$_};
- $hfiles{$_} = $mod
- }
-}
-
-for my $mod (@modules, $implicit_dep)
-{
- opendir DIR,$mod;
- for my $h (grep /\.h\Z/i, readdir DIR)
- {
- next if $h =~ /\A\./; # Ignore Mac resource forks, autosaves, etc
-
- open FL,"$mod/$h" or die "can't open $mod/$h";
- my $f;
- read FL,$f,-s "$mod/$h";
- close FL;
-
- while($f =~ m/\#include\s+"([^"]+?)"/g)
- {
- my $i = $1;
- # ignore autogen exceptions
- next if $i =~ m/\Aautogen_.+?Exception.h\Z/;
- # record dependency
- ${$header_dependency{$h}}{$i} = 1 if exists $hfiles{$i};
- }
- }
- closedir DIR;
-}
-
-print "done\n\nGenerating Makefiles...\n";
-
-
-# Then write a makefile for each module
-for my $mod (@modules, $implicit_dep)
-{
- print $mod,"\n";
-
- my ($type,$name) = split /\//,$mod;
-
- # add additional files for tests
- if($type eq 'test')
- {
- my $testmain = $test_template;
- $testmain =~ s/TEST_NAME/$name/g;
- open TESTMAIN,">$mod/_main.cpp" or die "Can't open test main file for $mod for writing\n";
- print TESTMAIN $testmain;
- close TESTMAIN;
-
- # test file...
- sub writetestfile
- {
- my ($filename,$runcmd,$module) = @_;
- open TESTFILE,">$filename" or die "Can't open test script file for $module for writing\n";
- print TESTFILE "#!/bin/sh\necho TEST: $module\n";
- if(-d "$module/testfiles")
- {
- print TESTFILE <<__E;
-echo Removing old test files...
-rm -rf testfiles
-echo Copying new test files...
-cp -p -R ../../../$module/testfiles .
-__E
- }
- if(-e "$module/testextra")
- {
- open FL,"$module/testextra" or die "Can't open $module/testextra";
- while(<FL>) {print TESTFILE}
- close FL;
- }
- print TESTFILE "$runcmd\n";
- close TESTFILE;
- }
-
- writetestfile("$mod/_t",
- './test' . $platform_exe_ext . '$1 $2 $3 $4 $5', $mod);
- writetestfile("$mod/_t-gdb",
- 'gdb ./test ' . $platform_exe_ext, $mod);
-
- }
-
- my @all_deps_for_module;
- {
- # work out what dependencies need to be run
- my @deps_raw;
- sub add_mod_deps
- {
- my ($arr_r,$nm) = @_;
- if($#{$module_dependency{$nm}} >= 0)
- {
- push @$arr_r,@{$module_dependency{$nm}};
- for(@{$module_dependency{$nm}})
- {
- add_mod_deps($arr_r,$_)
- }
- }
- }
- add_mod_deps(\@deps_raw, $mod);
- # and then dedup and reorder them
- my %d_done;
- for(my $a = $#deps_raw; $a >= 0; $a--)
- {
- if(!exists $d_done{$deps_raw[$a]})
- {
- # insert
- push @all_deps_for_module, $deps_raw[$a];
- # mark as done
- $d_done{$deps_raw[$a]} = 1;
- }
- }
- }
-
-
- # make include path
- my $include_paths = $windows_include_path .
- join(' ',map {'-I../../'.$_} @all_deps_for_module);
-
- # is target a library?
- my $target_is_library = ($type ne 'bin' && $type ne 'test');
-
- # make target name
- my $end_target = $name;
-
- if ($target_is_library)
- {
- $end_target .= '.a';
- }
- else
- {
- $end_target .= $platform_exe_ext;
- }
-
- $end_target = 'test'.$platform_exe_ext if $type eq 'test';
-
- # adjust for outdir
- $end_target = '$(OUTDIR)/' . $end_target;
-
- # start the makefile
- my $mk_name_extra = ($bsd_make)?'':'X';
- open MAKE,">$mod/Makefile".$mk_name_extra or die "Can't open Makefile for $mod\n";
- my $debug_link_extra = ($target_is_library)?'':'../../debug/lib/debug/debug.a';
-
- my $release_flags = "-O2";
- if ($target_os eq "mingw32")
- {
- $release_flags = "-O0 -g";
- }
-
- print MAKE <<__E;
-#
-# AUTOMATICALLY GENERATED FILE
-# do not edit!
-#
-#
-CXX = g++
-AR = ar
-RANLIB = ranlib
-PERL = \@PERL\@
-.ifdef RELEASE
-CXXFLAGS = -DNDEBUG $release_flags -Wall $include_paths $extra_platform_defines -DBOX_VERSION="\\"$product_version\\""
-OUTBASE = ../../release
-OUTDIR = ../../release/$mod
-DEPENDMAKEFLAGS = -D RELEASE
-VARIENT = RELEASE
-.else
-CXXFLAGS = -g -Wall $include_paths $extra_platform_defines -DBOX_VERSION="\\"$product_version\\""
-OUTBASE = ../../debug
-OUTDIR = ../../debug/$mod
-DEPENDMAKEFLAGS =
-VARIENT = DEBUG
-.endif
-
-__E
-
- # read directory
- opendir DIR,$mod;
- my @items = readdir DIR;
- closedir DIR;
-
- # add in items from autogen directories, and create output directories
- {
- my @autogen_items;
- for my $di (@items)
- {
- if($di =~ m/\Aautogen/ && -d "$mod/$di")
- {
- # Read items
- my $d = "$mod/$di";
- opendir DIR,$d;
- my @i = readdir DIR;
- closedir DIR;
- for(@i)
- {
- next if m/\A\./;
- push @autogen_items,"$di/$_"
- }
-
- # output directories
- mkdir "release/$mod/$di",0755;
- mkdir "debug/$mod/$di",0755;
- }
- }
- @items = (@items, @autogen_items);
- }
-
- # first, obtain a list of depenencies within the .h files
- my %headers;
- for my $h (grep /\.h\Z/i, @items)
- {
- open FL,"$mod/$h";
- my $f;
- read FL,$f,-s "$mod/$h";
- close FL;
-
- while($f =~ m/\#include\s+"([^"]+?)"/g)
- {
- ${$headers{$h}}{$1} = 1 if exists $hfiles{$1};
- }
- }
-
- # ready for the rest of the details...
- my $make;
-
- # then... do the cpp files...
- my @obj_base;
- for my $cpp (@items)
- {
- next unless $cpp =~ m/\A(.+)\.cpp\Z/i;
- next if $cpp =~ /\A\._/; # Temp Mac OS Resource hack
-
- # store for later
- my $base = $1;
- push @obj_base,$base;
-
- # get the file...
- open FL,"$mod/$cpp";
- my $f;
- read FL,$f,-s "$mod/$cpp";
- close FL;
-
- my %dep;
-
- while($f =~ m/\#include\s+"([^"]+?)"/g)
- {
- insert_dep($1, \%dep) if exists $hfiles{$1};
- }
-
- # output filename
- my $out_name = '$(OUTDIR)/'.$base.'.o';
-
- # write the line for this cpp file
- $make .= $out_name.': '.join(' ',$cpp,map
- { ($hfiles{$_} eq $mod)?$_:'../../'.$hfiles{$_}."/$_" } keys %dep)."\n";
- $make .= "\t\$(CXX) \$(CXXFLAGS) $compile_line_extra -c $cpp -o $out_name\n\n";
-
- }
-
- my $has_deps = ($#{$module_dependency{$mod}} >= 0);
-# ----- # always has dependencies with debug library
- $has_deps = 1;
- $has_deps = 0 if $target_is_library;
-
- # Depenency stuff
- my $deps_makeinfo;
- if($has_deps)
- {
- if($bsd_make)
- {
- $deps_makeinfo = <<'__E';
-.BEGIN::
-.ifndef NODEPS
-. if $(.TARGETS) == ""
-__E
- }
- else
- {
- # gnu make
- $deps_makeinfo = <<'__E';
-.PHONY: dep_modules
-dep_modules:
-ifndef NODEPS
-ifeq ($(strip $(.TARGETS)),)
-__E
- }
-
- # run make for things we require
- for my $dep (@all_deps_for_module)
- {
- $deps_makeinfo .= "\t\t(cd ../../$dep; \$(MAKE)$sub_make_options \$(DEPENDMAKEFLAGS) -D NODEPS)\n";
- }
- $deps_makeinfo .= ".\tendif\n.endif\n\n";
- }
- print MAKE $deps_makeinfo if $bsd_make;
-
- # get the list of library things to add -- in order of dependency so things link properly
- my $lib_files = join(' ',map {($_ =~ m/lib\/(.+)\Z/)?('$(OUTBASE)/'.$_.'/'.$1.'.a'):undef} (reverse(@all_deps_for_module)));
-
- # need to see if the extra makefile fragments require extra object files
- # or include any more makefiles
- my @objs = @obj_base;
- my @makefile_includes;
-
- additional_objects_from_make_fragment("$mod/Makefile.extra", \@objs, \@makefile_includes);
- additional_objects_from_make_fragment("$mod/Makefile.extra.$build_os", \@objs, \@makefile_includes);
-
- my $o_file_list = join(' ',map {'$(OUTDIR)/'.$_.'.o'} @objs);
- print MAKE $end_target,': ',$o_file_list;
- print MAKE ' dep_modules' if $has_deps and not $bsd_make;
- print MAKE " ",$lib_files unless $target_is_library;
- print MAKE "\n";
-
- # stuff to make the final target...
- if($target_is_library)
- {
- # make a library archive...
- print MAKE "\t(echo -n > $end_target; rm $end_target)\n";
- print MAKE "\t\$(AR) -q $end_target $o_file_list\n";
- print MAKE "\t\$(RANLIB) $end_target\n";
- }
- else
- {
- # work out library options
- # need to be... least used first, in absolute order they appear in the modules.txt file
- my @libops;
- sub libops_fill
- {
- my ($m,$r) = @_;
- push @$r,$_ for(@{$module_library_link_opts{$m}});
- libops_fill($_,$r) for(@{$module_dependency{$m}});
- }
- libops_fill($mod,\@libops);
- my $lo = '';
- my %ldone;
- for(@libops)
- {
- next if exists $ldone{$_};
- $lo .= ' '.$_;
- $ldone{$_} = 1;
- }
-
- # link line...
- print MAKE "\t\$(CXX) $link_line_extra -o $end_target $o_file_list $lib_files$lo $platform_lib_files\n";
- }
- # tests need to copy the test file over
- if($type eq 'test')
- {
- print MAKE "\tcp _t \$(OUTDIR)/t\n\tchmod u+x \$(OUTDIR)/t\n";
- print MAKE "\tcp _t-gdb \$(OUTDIR)/t-gdb\n\tchmod u+x \$(OUTDIR)/t-gdb\n";
- }
- # dependency line?
- print MAKE "\n";
-
- # module dependencies for GNU make?
- print MAKE $deps_makeinfo if !$bsd_make;
-
- # print the rest of the file
- print MAKE $make,"\n";
-
- # and a clean target
- print MAKE "clean:\n\t-rm -rf \$(OUTDIR)/*\n.\tifndef SUBCLEAN\n";
- for my $dep (@all_deps_for_module)
- {
- print MAKE "\t(cd ../../$dep; \$(MAKE) \$(DEPENDMAKEFLAGS) -D SUBCLEAN clean)\n";
- }
- print MAKE ".\tendif\n";
-
- # include any extra stuff
- print MAKE "\n\n";
- if(-e "$mod/Makefile.extra")
- {
- print MAKE ".include <Makefile.extra>\n\n";
- }
- if(-e "$mod/Makefile.extra.$build_os")
- {
- print MAKE ".include <Makefile.extra.$build_os>\n\n";
- }
- for(@makefile_includes)
- {
- print MAKE ".include <$_>\n\n";
- }
-
- # and finally a target for rebuilding the build system
- print MAKE "\nbuildsystem:\n\t(cd ../..; perl ./infrastructure/makebuildenv.pl $makebuildenv_args)\n\n";
-
- close MAKE;
-
- if(!$bsd_make)
- {
- # need to post process this into a GNU makefile
- open MAKE,">$mod/Makefile";
- open MAKEB,"$mod/MakefileX";
-
- while(<MAKEB>)
- {
- s/\A\.\s*(ifdef|else|endif|ifndef)/$1/;
- s/\A\.\s*include\s+<(.+?)>/include $1/;
- s/-D\s+(\w+)/$1=1/;
- print MAKE;
- }
-
- close MAKEB;
- close MAKE;
- unlink "$mod/MakefileX";
- }
-}
-
-print "\nType 'cd <module_dir>; $make_command' to build a module\n\n";
-
-if($modules_omitted)
-{
- print "\nNOTE: Some modules have been omitted on this platform\n\n"
-}
-
-sub insert_dep
-{
- my ($h,$dep_r) = @_;
-
- # stop random recusion
- return if exists $$dep_r{$h};
-
- # insert more depencies
- insert_dep($_,$dep_r) for keys %{$header_dependency{$h}};
-
- # mark this one as a dependency
- $$dep_r{$h} = 1;
-}
-
-
-sub additional_objects_from_make_fragment
-{
- my ($fn,$objs_r,$include_r) = @_;
-
- if(-e $fn)
- {
- open FL,$fn or die "Can't open $fn";
-
- while(<FL>)
- {
- chomp;
- if(m/link-extra:\s*(.+)\Z/)
- {
- my @o = split /\s+/,$1;
- for(@o)
- {
- push @$objs_r,$1 if m/\A(.+)\.o\Z/;
- }
- }
- elsif(m/include-makefile:\s*(\S+)/)
- {
- push @$include_r,$1
- }
- }
-
- close FL;
- }
-}
-
-
-sub ignore_module
-{
- exists $env_flags{'IGNORE_'.$_[0]}
-}
Copied: box/trunk/infrastructure/makebuildenv.pl.in (from rev 536, box/trunk/infrastructure/makebuildenv.pl)
Deleted: box/trunk/infrastructure/makeparcels.pl
===================================================================
--- box/trunk/infrastructure/makeparcels.pl 2006-03-04 01:33:46 UTC (rev 536)
+++ box/trunk/infrastructure/makeparcels.pl 2006-03-04 01:38:13 UTC (rev 537)
@@ -1,190 +0,0 @@
-#!@PERL@
-
-use strict;
-use lib 'infrastructure';
-use BoxPlatform;
-
-my @parcels;
-my %parcel_contents;
-
-open PARCELS,"parcels.txt" or die "Can't open parcels file";
-{
- my $cur_parcel = '';
- while(<PARCELS>)
- {
- chomp; s/#.+\Z//; s/\s+\Z//; s/\s+/ /g;
- next unless m/\S/;
-
- # omit bits on some platforms?
- next if m/\AEND-OMIT/;
- if(m/\AOMIT:(.+)/)
- {
- if($1 eq $build_os or $1 eq $target_os)
- {
- while(<PARCELS>)
- {
- last if m/\AEND-OMIT/;
- }
- }
- next;
- }
-
- if (m'\AONLY:(.+)')
- {
- my @only_targets = split m'\,', $1;
-
- if (not grep {$_ eq $build_os or $_ eq $target_os}
- @only_targets)
- {
- while (<PARCELS>)
- {
- last if m'\AEND-ONLY';
- }
- }
- next;
- }
- next if (m'\AEND-ONLY');
-
- # new parcel, or a new parcel definition?
- if(m/\A\s+(.+)\Z/)
- {
- push @{$parcel_contents{$cur_parcel}},$1
- }
- else
- {
- $cur_parcel = $_;
- push @parcels,$_;
- }
- }
-}
-close PARCELS;
-
-# create parcels directory
-mkdir "parcels",0755;
-mkdir "parcels/scripts",0755;
-
-# write master makefile
-
-open MAKE,">Makefile" or die "Can't open master Makefile for writing";
-
-print MAKE <<__E;
-#
-# AUTOMATICALLY GENERATED FILE
-# do not edit!
-#
-#
-
-MAKE = $make_command
-
-__E
-
-print MAKE "all:\t",join(' ',map {parcel_target($_)} @parcels),"\n\n";
-
-print MAKE "clean:\n";
-for my $parcel (@parcels)
-{
- print MAKE "\trm -rf ",parcel_dir($parcel),"\n";
- print MAKE "\trm -f ",parcel_target($parcel),"\n";
-}
-print MAKE "\n";
-
-print MAKE "test:\trelease/common/test\n\nrelease/common/test:\n\t./runtest.pl ALL release\n\n";
-
-my $release_flag = BoxPlatform::make_flag('RELEASE');
-
-for my $parcel (@parcels)
-{
- my $target = parcel_target($parcel);
- print MAKE $target,":\n";
-
- my $dir = parcel_dir($parcel);
- print MAKE "\ttest -d $dir || mkdir $dir\n";
-
- open SCRIPT,">parcels/scripts/install-$parcel" or die "Can't open installer script for $parcel for writing";
- print SCRIPT "#!/bin/sh\n\n";
-
- for(@{$parcel_contents{$parcel}})
- {
- my ($type,$name) = split /\s+/;
- my $optional = '';
-
- if ($type eq 'optional')
- {
- ($optional,$type,$name) = split /\s+/;
- }
-
- if($type eq 'bin')
- {
- my $exeext = $platform_exe_ext;
- print MAKE "\t(cd bin/$name; \$(MAKE) $release_flag)\n";
- print MAKE "\tcp release/bin/$name/$name$exeext $dir\n";
- }
- elsif ($type eq 'script')
- {
- if ($optional)
- {
- print MAKE "\ttest -r $name && cp $name $dir\n";
- }
- else
- {
- print MAKE "\tcp $name $dir\n";
- }
- # remove path from script name
- $name =~ m~/([^/]+)\Z~;
- $name = $1;
- }
-
- print SCRIPT "install $name $install_into_dir\n";
- }
-
- close SCRIPT;
-
- chmod 0755,"parcels/scripts/install-$parcel";
-
- my $root = parcel_root($parcel);
- print MAKE "\tcp parcels/scripts/install-$parcel $dir\n";
- print MAKE "\t(cd parcels; tar cf - $root | gzip -9 - > $root.tgz )\n";
-
- print MAKE "\n";
-
- print MAKE "install-$parcel:\n";
- print MAKE "\t(cd $dir; ./install-$parcel)\n\n";
-}
-
-print MAKE <<__E;
-install:
- cat local/install.msg
-
-__E
-
-close MAKE;
-
-open INSTALLMSG,">local/install.msg" or die "Can't open install message file for writing";
-print INSTALLMSG <<__E;
-
-Parcels need to be installed separately, and as root. Type one of the following:
-
-__E
-
-for(@parcels)
-{
- print INSTALLMSG " $make_command install-".$_."\n";
-}
-print INSTALLMSG "\n";
-
-close INSTALLMSG;
-
-sub parcel_root
-{
- $product_name.'-'.$product_version.'-'.$_[0].'-'.$target_os
-}
-
-sub parcel_dir
-{
- 'parcels/'.parcel_root($_[0])
-}
-
-sub parcel_target
-{
- parcel_dir($_[0]).'.tgz'
-}
Copied: box/trunk/infrastructure/makeparcels.pl.in (from rev 536, box/trunk/infrastructure/makeparcels.pl)
Deleted: box/trunk/lib/common/makeexception.pl
===================================================================
--- box/trunk/lib/common/makeexception.pl 2006-03-04 01:33:46 UTC (rev 536)
+++ box/trunk/lib/common/makeexception.pl 2006-03-04 01:38:13 UTC (rev 537)
@@ -1,277 +0,0 @@
-#!@PERL@
-
-# global exception list file
-my $global_list = '../../ExceptionCodes.txt';
-
-
-my @exception;
-my @exception_desc;
-my $class;
-my $class_number;
-
-# read the description!
-
-open EXCEPTION_DESC,$ARGV[0] or die "Can't open $ARGV[0]";
-
-while(<EXCEPTION_DESC>)
-{
- chomp; s/\A\s+//; s/#.+\Z//; s/\s+\Z//; s/\s+/ /g;
- next unless m/\S/;
-
- if(m/\AEXCEPTION\s+(.+)\s+(\d+)\Z/)
- {
- $class = $1;
- $class_number = $2;
- }
- else
- {
- my ($name,$number,$description) = split /\s+/,$_,3;
- if($name eq '' || $number =~ m/\D/)
- {
- die "Bad line '$_'";
- }
- if($exception[$number] ne '')
- {
- die "Duplicate exception number $number";
- }
- $exception[$number] = $name;
- $exception_desc[$number] = $description;
- }
-}
-
-die "Exception class and number not specified" unless $class ne '' && $class_number ne '';
-
-close EXCEPTION_DESC;
-
-# write the code
-print "Generating $class exception...\n";
-
-open CPP,">autogen_${class}Exception.cpp" or die "Can't open cpp file for writing";
-open H,">autogen_${class}Exception.h" or die "Can't open h file for writing";
-
-# write header file
-my $guardname = uc 'AUTOGEN_'.$class.'EXCEPTION_H';
-print H <<__E;
-
-// Auto-generated file -- do not edit
-
-#ifndef $guardname
-#define $guardname
-
-#include "BoxException.h"
-
-// --------------------------------------------------------------------------
-//
-// Class
-// Name: ${class}Exception
-// Purpose: Exception
-// Created: autogen
-//
-// --------------------------------------------------------------------------
-class ${class}Exception : public BoxException
-{
-public:
- ${class}Exception(unsigned int SubType)
- : mSubType(SubType)
- {
- }
-
- ${class}Exception(const ${class}Exception &rToCopy)
- : mSubType(rToCopy.mSubType)
- {
- }
-
- ~${class}Exception() throw ()
- {
- }
-
- enum
- {
- ExceptionType = $class_number
- };
-
- enum
- {
-__E
-
-for(my $e = 0; $e <= $#exception; $e++)
-{
- if($exception[$e] ne '')
- {
- print H "\t\t".$exception[$e].' = '.$e.(($e==$#exception)?'':',')."\n"
- }
-}
-
-print H <<__E;
- };
-
- virtual unsigned int GetType() const throw();
- virtual unsigned int GetSubType() const throw();
- virtual const char *what() const throw();
-
-private:
- unsigned int mSubType;
-};
-
-#endif // $guardname
-__E
-
-# -----------------------------------------------------------------------------------------------------------
-
-print CPP <<__E;
-
-// Auto-generated file -- do not edit
-
-#include "Box.h"
-#include "autogen_${class}Exception.h"
-
-#include "MemLeakFindOn.h"
-
-#ifdef EXCEPTION_CODENAMES_EXTENDED
- #ifdef EXCEPTION_CODENAMES_EXTENDED_WITH_DESCRIPTION
-static const char *whats[] = {
-__E
-
-my $last_seen = -1;
-for(my $e = 0; $e <= $#exception; $e++)
-{
- if($exception[$e] ne '')
- {
- for(my $s = $last_seen + 1; $s < $e; $s++)
- {
- print CPP "\t\"UNUSED\",\n"
- }
- my $ext = ($exception_desc[$e] ne '')?" ($exception_desc[$e])":'';
- print CPP "\t\"${class} ".$exception[$e].$ext.'"'.(($e==$#exception)?'':',')."\n";
- $last_seen = $e;
- }
-}
-
-print CPP <<__E;
-};
- #else
-static const char *whats[] = {
-__E
-
-$last_seen = -1;
-for(my $e = 0; $e <= $#exception; $e++)
-{
- if($exception[$e] ne '')
- {
- for(my $s = $last_seen + 1; $s < $e; $s++)
- {
- print CPP "\t\"UNUSED\",\n"
- }
- print CPP "\t\"${class} ".$exception[$e].'"'.(($e==$#exception)?'':',')."\n";
- $last_seen = $e;
- }
-}
-
-print CPP <<__E;
-};
- #endif
-#endif
-
-unsigned int ${class}Exception::GetType() const throw()
-{
- return ${class}Exception::ExceptionType;
-}
-
-unsigned int ${class}Exception::GetSubType() const throw()
-{
- return mSubType;
-}
-
-const char *${class}Exception::what() const throw()
-{
-#ifdef EXCEPTION_CODENAMES_EXTENDED
- if(mSubType < 0 || mSubType > (sizeof(whats) / sizeof(whats[0])))
- {
- return "${class}";
- }
- return whats[mSubType];
-#else
- return "${class}";
-#endif
-}
-
-__E
-
-close H;
-close CPP;
-
-# update the global exception list
-my $list_before;
-my $list_after;
-my $is_after = 0;
-if(open CURRENT,$global_list)
-{
- while(<CURRENT>)
- {
- next if m/\A#/;
-
- if(m/\AEXCEPTION TYPE (\w+) (\d+)/)
- {
- # check that the number isn't being reused
- if($2 == $class_number && $1 ne $class)
- {
- die "Class number $class_number is being used by $class and $1 -- correct this.\n";
- }
- if($2 > $class_number)
- {
- # This class comes after the current one (ensures numerical ordering)
- $is_after = 1;
- }
- if($1 eq $class)
- {
- # skip this entry
- while(<CURRENT>)
- {
- last if m/\AEND TYPE/;
- }
- $_ = '';
- }
- }
-
- if($is_after)
- {
- $list_after .= $_;
- }
- else
- {
- $list_before .= $_;
- }
- }
-
- close CURRENT;
-}
-
-open GLOBAL,">$global_list" or die "Can't open global exception code listing for writing";
-
-print GLOBAL <<__E;
-#
-# automatically generated file, do not edit.
-#
-# This file lists all the exception codes used by the system.
-# Use to look up more detailed descriptions of meanings of errors.
-#
-__E
-
-print GLOBAL $list_before;
-
-print GLOBAL "EXCEPTION TYPE $class $class_number\n";
-for(my $e = 0; $e <= $#exception; $e++)
-{
- if($exception[$e] ne '')
- {
- my $ext = ($exception_desc[$e] ne '')?" - $exception_desc[$e]":'';
- print GLOBAL "($class_number/$e) - ${class} ".$exception[$e].$ext."\n";
- }
-}
-print GLOBAL "END TYPE\n";
-
-print GLOBAL $list_after;
-
-close GLOBAL;
-
-
Copied: box/trunk/lib/common/makeexception.pl.in (from rev 536, box/trunk/lib/common/makeexception.pl)
Deleted: box/trunk/lib/raidfile/raidfile-config
===================================================================
--- box/trunk/lib/raidfile/raidfile-config 2006-03-04 01:33:46 UTC (rev 536)
+++ box/trunk/lib/raidfile/raidfile-config 2006-03-04 01:38:13 UTC (rev 537)
@@ -1,97 +0,0 @@
-#!@PERL@
-use strict;
-
-# should be running as root
-if($> != 0)
-{
- printf "\nWARNING: this should be run as root\n\n"
-}
-
-# check and get command line parameters
-if($#ARGV != 4 && $#ARGV != 2)
-{
- print <<__E;
-
-Setup raidfile config utility.
-
-Bad command line parameters.
-Usage:
- raidfile-config config-dir block-size dir0 [dir1 dir2]
-
-config-dir usually /etc/box
-block-size must be a power of two, and usually the block or fragment size of your filing system
-dir0, dir1, dir2 are the directories used as the root of the raid file system
-
-If only one directory is specified, then userland RAID is disabled. Specifying three directories
-enables it.
-
-__E
- exit(1);
-}
-
-my ($config_dir,$block_size,@dirs) = @ARGV;
-
-my $conf = $config_dir . '/raidfile.conf';
-
-# check dirs are unique, and exist
-my %d;
-for(@dirs)
-{
- die "$_ is used twice" if exists $d{$_};
- die "$_ is not a directory" unless -d $_;
- die "$_ should be an absolute path" unless m/\A\//;
- $d{$_} = 1;
-}
-
-# check block size is OK
-$block_size = int($block_size);
-die "Bad block size" if $block_size <= 0;
-my $c = 1;
-while(1)
-{
- last if $c == $block_size;
- die "Block size $block_size is not a power of two" if $c > $block_size;
- $c = $c * 2;
-}
-
-# check that it doesn't already exist
-if(-f $conf)
-{
- die "$conf already exists. Delete and try again"
-}
-
-# create directory
-if(!-d $config_dir)
-{
- print "Creating $config_dir...\n";
- mkdir $config_dir,0755 or die "Can't create $config_dir";
-}
-
-# adjust if userland RAID is disabled
-if($#dirs == 0)
-{
- $dirs[1] = $dirs[0];
- $dirs[2] = $dirs[0];
- print "WARNING: userland RAID is disabled.\n"
-}
-
-# write the file
-open CONFIG,">$conf" or die "Can't open $conf for writing";
-
-print CONFIG <<__E;
-
-disc0
-{
- SetNumber = 0
- BlockSize = $block_size
- Dir0 = $dirs[0]
- Dir1 = $dirs[1]
- Dir2 = $dirs[2]
-}
-
-__E
-
-close CONFIG;
-
-print "Config file written.\n";
-
Copied: box/trunk/lib/raidfile/raidfile-config.in (from rev 536, box/trunk/lib/raidfile/raidfile-config)
Deleted: box/trunk/lib/server/makeprotocol.pl
===================================================================
--- box/trunk/lib/server/makeprotocol.pl 2006-03-04 01:33:46 UTC (rev 536)
+++ box/trunk/lib/server/makeprotocol.pl 2006-03-04 01:38:13 UTC (rev 537)
@@ -1,997 +0,0 @@
-#!@PERL@
-use strict;
-
-# Make protocol C++ classes from a protocol description file
-
-# built in type info (values are is basic type, C++ typename)
-# may get stuff added to it later if protocol uses extra types
-my %translate_type_info =
-(
- 'int64' => [1, 'int64_t'],
- 'int32' => [1, 'int32_t'],
- 'int16' => [1, 'int16_t'],
- 'int8' => [1, 'int8_t'],
- 'bool' => [1, 'bool'],
- 'string' => [0, 'std::string']
-);
-
-# built in instructions for logging various types
-# may be added to
-my %log_display_types =
-(
- 'int64' => ['0x%llx', 'VAR'],
- 'int32' => ['0x%x', 'VAR'],
- 'int16' => ['0x%x', 'VAR'],
- 'int8' => ['0x%x', 'VAR'],
- 'bool' => ['%s', '((VAR)?"true":"false")'],
- 'string' => ['%s', 'VAR.c_str()']
-);
-
-
-
-my ($type, $file) = @ARGV;
-
-if($type ne 'Server' && $type ne 'Client')
-{
- die "Neither Server or Client is specified on command line\n";
-}
-
-open IN, $file or die "Can't open input file $file\n";
-
-print "Making $type protocol classes from $file...\n";
-
-my @extra_header_files;
-
-my $implement_syslog = 0;
-my $implement_filelog = 0;
-
-# read attributes
-my %attr;
-while(<IN>)
-{
- # get and clean line
- my $l = $_; $l =~ s/#.*\Z//; $l =~ s/\A\s+//; $l =~ s/\s+\Z//; next unless $l =~ m/\S/;
-
- last if $l eq 'BEGIN_OBJECTS';
-
- my ($k,$v) = split /\s+/,$l,2;
-
- if($k eq 'ClientType')
- {
- add_type($v) if $type eq 'Client';
- }
- elsif($k eq 'ServerType')
- {
- add_type($v) if $type eq 'Server';
- }
- elsif($k eq 'ImplementLog')
- {
- my ($log_if_type,$log_type) = split /\s+/,$v;
- if($type eq $log_if_type)
- {
- if($log_type eq 'syslog')
- {
- $implement_syslog = 1;
- }
- elsif($log_type eq 'file')
- {
- $implement_filelog = 1;
- }
- else
- {
- printf("ERROR: Unknown log type for implementation: $log_type\n");
- exit(1);
- }
- }
- }
- elsif($k eq 'LogTypeToText')
- {
- my ($log_if_type,$type_name,$printf_format,$arg_template) = split /\s+/,$v;
- if($type eq $log_if_type)
- {
- $log_display_types{$type_name} = [$printf_format,$arg_template]
- }
- }
- else
- {
- $attr{$k} = $v;
- }
-}
-
-sub add_type
-{
- my ($protocol_name, $cpp_name, $header_file) = split /\s+/,$_[0];
-
- $translate_type_info{$protocol_name} = [0, $cpp_name];
- push @extra_header_files, $header_file;
-}
-
-# check attributes
-for(qw/Name ServerContextClass IdentString/)
-{
- if(!exists $attr{$_})
- {
- die "Attribute $_ is required, but not specified\n";
- }
-}
-
-my $protocol_name = $attr{'Name'};
-my ($context_class, $context_class_inc) = split /\s+/,$attr{'ServerContextClass'};
-my $ident_string = $attr{'IdentString'};
-
-my $current_cmd = '';
-my %cmd_contents;
-my %cmd_attributes;
-my %cmd_constants;
-my %cmd_id;
-my @cmd_list;
-
-# read in the command definitions
-while(<IN>)
-{
- # get and clean line
- my $l = $_; $l =~ s/#.*\Z//; $l =~ s/\s+\Z//; next unless $l =~ m/\S/;
-
- # definitions or new command thing?
- if($l =~ m/\A\s+/)
- {
- die "No command defined yet" if $current_cmd eq '';
-
- # definition of component
- $l =~ s/\A\s+//;
-
- my ($type,$name,$value) = split /\s+/,$l;
- if($type eq 'CONSTANT')
- {
- push @{$cmd_constants{$current_cmd}},"$name = $value"
- }
- else
- {
- push @{$cmd_contents{$current_cmd}},$type,$name;
- }
- }
- else
- {
- # new command
- my ($name,$id,@attributes) = split /\s+/,$l;
- $cmd_attributes{$name} = [@attributes];
- $cmd_id{$name} = int($id);
- $current_cmd = $name;
- push @cmd_list,$name;
- }
-}
-
-close IN;
-
-
-
-# open files
-my $h_filename = 'autogen_'.$protocol_name.'Protocol'.$type.'.h';
-open CPP,'>autogen_'.$protocol_name.'Protocol'.$type.'.cpp';
-open H,">$h_filename";
-
-print CPP <<__E;
-
-// Auto-generated file -- do not edit
-
-#include "Box.h"
-#include "$h_filename"
-#include "IOStream.h"
-
-__E
-
-if($implement_syslog)
-{
- print H <<EOF;
-#ifndef WIN32
-#include <syslog.h>
-#endif
-EOF
-}
-
-
-my $guardname = uc 'AUTOGEN_'.$protocol_name.'Protocol'.$type.'_H';
-print H <<__E;
-
-// Auto-generated file -- do not edit
-
-#ifndef $guardname
-#define $guardname
-
-#include "Protocol.h"
-#include "ProtocolObject.h"
-#include "ServerException.h"
-
-class IOStream;
-
-__E
-
-if($implement_filelog)
-{
- print H qq~#include <stdio.h>\n~;
-}
-
-# extra headers
-for(@extra_header_files)
-{
- print H qq~#include "$_"\n~
-}
-print H "\n";
-
-if($type eq 'Server')
-{
- # need utils file for the server
- print H '#include "Utils.h"',"\n\n"
-}
-
-
-my $derive_objects_from = 'ProtocolObject';
-my $objects_extra_h = '';
-my $objects_extra_cpp = '';
-if($type eq 'Server')
-{
- # define the context
- print H "class $context_class;\n\n";
- print CPP "#include \"$context_class_inc\"\n\n";
-
- # change class we derive the objects from
- $derive_objects_from = $protocol_name.'ProtocolObject';
-
- $objects_extra_h = <<__E;
- virtual std::auto_ptr<ProtocolObject> DoCommand(${protocol_name}ProtocolServer &rProtocol, $context_class &rContext);
-__E
- $objects_extra_cpp = <<__E;
-std::auto_ptr<ProtocolObject> ${derive_objects_from}::DoCommand(${protocol_name}ProtocolServer &rProtocol, $context_class &rContext)
-{
- THROW_EXCEPTION(ConnectionException, Conn_Protocol_TriedToExecuteReplyCommand)
-}
-__E
-}
-
-print CPP qq~#include "MemLeakFindOn.h"\n~;
-
-if($type eq 'Client' && ($implement_syslog || $implement_filelog))
-{
- # change class we derive the objects from
- $derive_objects_from = $protocol_name.'ProtocolObjectCl';
-}
-if($implement_syslog)
-{
- $objects_extra_h .= <<__E;
- virtual void LogSysLog(const char *Action) const = 0;
-__E
-}
-if($implement_filelog)
-{
- $objects_extra_h .= <<__E;
- virtual void LogFile(const char *Action, FILE *file) const = 0;
-__E
-}
-
-if($derive_objects_from ne 'ProtocolObject')
-{
- # output a definition for the protocol object derviced class
- print H <<__E;
-class ${protocol_name}ProtocolServer;
-
-class $derive_objects_from : public ProtocolObject
-{
-public:
- $derive_objects_from();
- virtual ~$derive_objects_from();
- $derive_objects_from(const $derive_objects_from &rToCopy);
-
-$objects_extra_h
-};
-__E
-
- # and some cpp definitions
- print CPP <<__E;
-${derive_objects_from}::${derive_objects_from}()
-{
-}
-${derive_objects_from}::~${derive_objects_from}()
-{
-}
-${derive_objects_from}::${derive_objects_from}(const $derive_objects_from &rToCopy)
-{
-}
-$objects_extra_cpp
-__E
-}
-
-
-
-my $classname_base = $protocol_name.'Protocol'.$type;
-
-# output the classes
-for my $cmd (@cmd_list)
-{
- print H <<__E;
-class $classname_base$cmd : public $derive_objects_from
-{
-public:
- $classname_base$cmd();
- $classname_base$cmd(const $classname_base$cmd &rToCopy);
- ~$classname_base$cmd();
- int GetType() const;
- enum
- {
- TypeID = $cmd_id{$cmd}
- };
-__E
- # constants
- if(exists $cmd_constants{$cmd})
- {
- print H "\tenum\n\t{\n\t\t";
- print H join(",\n\t\t",@{$cmd_constants{$cmd}});
- print H "\n\t};\n";
- }
- # flags
- if(obj_is_type($cmd,'EndsConversation'))
- {
- print H "\tbool IsConversationEnd() const;\n";
- }
- if(obj_is_type($cmd,'IsError'))
- {
- print H "\tbool IsError(int &rTypeOut, int &rSubTypeOut) const;\n";
- }
- if($type eq 'Server' && obj_is_type($cmd, 'Command'))
- {
- print H "\tstd::auto_ptr<ProtocolObject> DoCommand(${protocol_name}ProtocolServer &rProtocol, $context_class &rContext); // IMPLEMENT THIS\n"
- }
-
- # want to be able to read from streams?
- my $read_from_streams = (obj_is_type($cmd,'Command') && $type eq 'Server') || (obj_is_type($cmd,'Reply') && $type eq 'Client');
- my $write_to_streams = (obj_is_type($cmd,'Command') && $type eq 'Client') || (obj_is_type($cmd,'Reply') && $type eq 'Server');
-
- if($read_from_streams)
- {
- print H "\tvoid SetPropertiesFromStreamData(Protocol &rProtocol);\n";
-
- # write Get functions
- for(my $x = 0; $x < $#{$cmd_contents{$cmd}}; $x+=2)
- {
- my ($ty,$nm) = (${$cmd_contents{$cmd}}[$x], ${$cmd_contents{$cmd}}[$x+1]);
-
- print H "\t".translate_type_to_arg_type($ty)." Get$nm() {return m$nm;}\n";
- }
- }
- my $param_con_args = '';
- if($write_to_streams)
- {
- # extra constructor?
- if($#{$cmd_contents{$cmd}} >= 0)
- {
- my @a;
- for(my $x = 0; $x < $#{$cmd_contents{$cmd}}; $x+=2)
- {
- my ($ty,$nm) = (${$cmd_contents{$cmd}}[$x], ${$cmd_contents{$cmd}}[$x+1]);
-
- push @a,translate_type_to_arg_type($ty)." $nm";
- }
- $param_con_args = join(', ',@a);
- print H "\t$classname_base$cmd(".$param_con_args.");\n";
- }
- print H "\tvoid WritePropertiesToStreamData(Protocol &rProtocol) const;\n";
- # set functions
- for(my $x = 0; $x < $#{$cmd_contents{$cmd}}; $x+=2)
- {
- my ($ty,$nm) = (${$cmd_contents{$cmd}}[$x], ${$cmd_contents{$cmd}}[$x+1]);
-
- print H "\tvoid Set$nm(".translate_type_to_arg_type($ty)." $nm) {m$nm = $nm;}\n";
- }
- }
-
- if($implement_syslog)
- {
- print H "\tvirtual void LogSysLog(const char *Action) const;\n";
- }
- if($implement_filelog)
- {
- print H "\tvirtual void LogFile(const char *Action, FILE *file) const;\n";
- }
-
-
- # write member variables and setup for cpp file
- my @def_constructor_list;
- my @copy_constructor_list;
- my @param_constructor_list;
-
- print H "private:\n";
- for(my $x = 0; $x < $#{$cmd_contents{$cmd}}; $x+=2)
- {
- my ($ty,$nm) = (${$cmd_contents{$cmd}}[$x], ${$cmd_contents{$cmd}}[$x+1]);
-
- print H "\t".translate_type_to_member_type($ty)." m$nm;\n";
-
- my ($basic,$typename) = translate_type($ty);
- if($basic)
- {
- push @def_constructor_list, "m$nm(0)";
- }
- push @copy_constructor_list, "m$nm(rToCopy.m$nm)";
- push @param_constructor_list, "m$nm($nm)";
- }
-
- # finish off
- print H "};\n\n";
-
- # now the cpp file...
- my $def_con_vars = join(",\n\t ",@def_constructor_list);
- $def_con_vars = "\n\t: ".$def_con_vars if $def_con_vars ne '';
- my $copy_con_vars = join(",\n\t ",@copy_constructor_list);
- $copy_con_vars = "\n\t: ".$copy_con_vars if $copy_con_vars ne '';
- my $param_con_vars = join(",\n\t ",@param_constructor_list);
- $param_con_vars = "\n\t: ".$param_con_vars if $param_con_vars ne '';
-
- my $class = "$classname_base$cmd".'::';
- print CPP <<__E;
-$class$classname_base$cmd()$def_con_vars
-{
-}
-$class$classname_base$cmd(const $classname_base$cmd &rToCopy)$copy_con_vars
-{
-}
-$class~$classname_base$cmd()
-{
-}
-int ${class}GetType() const
-{
- return $cmd_id{$cmd};
-}
-__E
- if($read_from_streams)
- {
- print CPP "void ${class}SetPropertiesFromStreamData(Protocol &rProtocol)\n{\n";
- for(my $x = 0; $x < $#{$cmd_contents{$cmd}}; $x+=2)
- {
- my ($ty,$nm) = (${$cmd_contents{$cmd}}[$x], ${$cmd_contents{$cmd}}[$x+1]);
- if($ty =~ m/\Avector/)
- {
- print CPP "\trProtocol.ReadVector(m$nm);\n";
- }
- else
- {
- print CPP "\trProtocol.Read(m$nm);\n";
- }
- }
- print CPP "}\n";
- }
- if($write_to_streams)
- {
- # implement extra constructor?
- if($param_con_vars ne '')
- {
- print CPP "$class$classname_base$cmd($param_con_args)$param_con_vars\n{\n}\n";
- }
- print CPP "void ${class}WritePropertiesToStreamData(Protocol &rProtocol) const\n{\n";
- for(my $x = 0; $x < $#{$cmd_contents{$cmd}}; $x+=2)
- {
- my ($ty,$nm) = (${$cmd_contents{$cmd}}[$x], ${$cmd_contents{$cmd}}[$x+1]);
- if($ty =~ m/\Avector/)
- {
- print CPP "\trProtocol.WriteVector(m$nm);\n";
- }
- else
- {
- print CPP "\trProtocol.Write(m$nm);\n";
- }
- }
- print CPP "}\n";
- }
- if(obj_is_type($cmd,'EndsConversation'))
- {
- print CPP "bool ${class}IsConversationEnd() const\n{\n\treturn true;\n}\n";
- }
- if(obj_is_type($cmd,'IsError'))
- {
- # get parameters
- my ($mem_type,$mem_subtype) = split /,/,obj_get_type_params($cmd,'IsError');
- print CPP <<__E;
-bool ${class}IsError(int &rTypeOut, int &rSubTypeOut) const
-{
- rTypeOut = m$mem_type;
- rSubTypeOut = m$mem_subtype;
- return true;
-}
-__E
- }
-
- if($implement_syslog)
- {
- my ($format,$args) = make_log_strings($cmd);
- print CPP <<__E;
-void ${class}LogSysLog(const char *Action) const
-{
- ::syslog(LOG_INFO,"%s $format",Action$args);
-}
-__E
- }
- if($implement_filelog)
- {
- my ($format,$args) = make_log_strings($cmd);
- print CPP <<__E;
-void ${class}LogFile(const char *Action, FILE *File) const
-{
- ::fprintf(File,"%s $format\\n",Action$args);
- ::fflush(File);
-}
-__E
- }
-}
-
-# finally, the protocol object itself
-print H <<__E;
-class $classname_base : public Protocol
-{
-public:
- $classname_base(IOStream &rStream);
- virtual ~$classname_base();
-
- std::auto_ptr<$derive_objects_from> Receive();
- void Send(const ${derive_objects_from} &rObject);
-__E
-if($implement_syslog)
-{
- print H "\tvoid SetLogToSysLog(bool Log = false) {mLogToSysLog = Log;}\n";
-}
-if($implement_filelog)
-{
- print H "\tvoid SetLogToFile(FILE *File = 0) {mLogToFile = File;}\n";
-}
-if($type eq 'Server')
-{
- # need to put in the conversation function
- print H "\tvoid DoServer($context_class &rContext);\n\n";
- # and the send vector thing
- print H "\tvoid SendStreamAfterCommand(IOStream *pStream);\n\n";
-}
-if($type eq 'Client')
-{
- # add plain object taking query functions
- my $with_params;
- for my $cmd (@cmd_list)
- {
- if(obj_is_type($cmd,'Command'))
- {
- my $has_stream = obj_is_type($cmd,'StreamWithCommand');
- my $argextra = $has_stream?', IOStream &rStream':'';
- my $queryextra = $has_stream?', rStream':'';
- my $reply = obj_get_type_params($cmd,'Command');
- print H "\tstd::auto_ptr<$classname_base$reply> Query(const $classname_base$cmd &rQuery$argextra);\n";
- my @a;
- my @na;
- for(my $x = 0; $x < $#{$cmd_contents{$cmd}}; $x+=2)
- {
- my ($ty,$nm) = (${$cmd_contents{$cmd}}[$x], ${$cmd_contents{$cmd}}[$x+1]);
- push @a,translate_type_to_arg_type($ty)." $nm";
- push @na,"$nm";
- }
- my $ar = join(', ',@a);
- my $nar = join(', ',@na);
- $nar = "($nar)" if $nar ne '';
-
- $with_params .= "\tinline std::auto_ptr<$classname_base$reply> Query$cmd($ar$argextra)\n\t{\n";
- $with_params .= "\t\t$classname_base$cmd send$nar;\n";
- $with_params .= "\t\treturn Query(send$queryextra);\n";
- $with_params .= "\t}\n";
- }
- }
- # quick hack to correct bad argument lists for commands with zero paramters but with streams
- $with_params =~ s/\(, /(/g;
- print H "\n",$with_params,"\n";
-}
-print H <<__E;
-private:
- $classname_base(const $classname_base &rToCopy);
-__E
-if($type eq 'Server')
-{
- # need to put the streams to send vector
- print H "\tstd::vector<IOStream*> mStreamsToSend;\n\tvoid DeleteStreamsToSend();\n";
-}
-
-if($implement_filelog || $implement_syslog)
-{
- print H <<__E;
- virtual void InformStreamReceiving(u_int32_t Size);
- virtual void InformStreamSending(u_int32_t Size);
-__E
-}
-
-if($implement_syslog)
-{
- print H "private:\n\tbool mLogToSysLog;\n";
-}
-if($implement_filelog)
-{
- print H "private:\n\tFILE *mLogToFile;\n";
-}
-print H <<__E;
-
-protected:
- virtual std::auto_ptr<ProtocolObject> MakeProtocolObject(int ObjType);
- virtual const char *GetIdentString();
-};
-
-__E
-
-my $construtor_extra = '';
-$construtor_extra .= ', mLogToSysLog(false)' if $implement_syslog;
-$construtor_extra .= ', mLogToFile(0)' if $implement_filelog;
-
-my $destructor_extra = ($type eq 'Server')?"\n\tDeleteStreamsToSend();":'';
-
-my $prefix = $classname_base.'::';
-print CPP <<__E;
-$prefix$classname_base(IOStream &rStream)
- : Protocol(rStream)$construtor_extra
-{
-}
-$prefix~$classname_base()
-{$destructor_extra
-}
-const char *${prefix}GetIdentString()
-{
- return "$ident_string";
-}
-std::auto_ptr<ProtocolObject> ${prefix}MakeProtocolObject(int ObjType)
-{
- switch(ObjType)
- {
-__E
-
-# do objects within this
-for my $cmd (@cmd_list)
-{
- print CPP <<__E;
- case $cmd_id{$cmd}:
- return std::auto_ptr<ProtocolObject>(new $classname_base$cmd);
- break;
-__E
-}
-
-print CPP <<__E;
- default:
- THROW_EXCEPTION(ConnectionException, Conn_Protocol_UnknownCommandRecieved)
- }
-}
-__E
-# write receieve and send functions
-print CPP <<__E;
-std::auto_ptr<$derive_objects_from> ${prefix}Receive()
-{
- std::auto_ptr<${derive_objects_from}> preply((${derive_objects_from}*)(Protocol::Receive().release()));
-
-__E
- if($implement_syslog)
- {
- print CPP <<__E;
- if(mLogToSysLog)
- {
- preply->LogSysLog("Receive");
- }
-__E
- }
- if($implement_filelog)
- {
- print CPP <<__E;
- if(mLogToFile != 0)
- {
- preply->LogFile("Receive", mLogToFile);
- }
-__E
- }
-print CPP <<__E;
-
- return preply;
-}
-
-void ${prefix}Send(const ${derive_objects_from} &rObject)
-{
-__E
- if($implement_syslog)
- {
- print CPP <<__E;
- if(mLogToSysLog)
- {
- rObject.LogSysLog("Send");
- }
-__E
- }
- if($implement_filelog)
- {
- print CPP <<__E;
- if(mLogToFile != 0)
- {
- rObject.LogFile("Send", mLogToFile);
- }
-__E
- }
-
-print CPP <<__E;
- Protocol::Send(rObject);
-}
-
-__E
-# write server function?
-if($type eq 'Server')
-{
- print CPP <<__E;
-void ${prefix}DoServer($context_class &rContext)
-{
- // Handshake with client
- Handshake();
-
- // Command processing loop
- bool inProgress = true;
- while(inProgress)
- {
- // Get an object from the conversation
- std::auto_ptr<${derive_objects_from}> pobj(Receive());
-
-__E
- if($implement_syslog)
- {
- print CPP <<__E;
- if(mLogToSysLog)
- {
- pobj->LogSysLog("Receive");
- }
-__E
- }
- if($implement_filelog)
- {
- print CPP <<__E;
- if(mLogToFile != 0)
- {
- pobj->LogFile("Receive", mLogToFile);
- }
-__E
- }
- print CPP <<__E;
-
- // Run the command
- std::auto_ptr<${derive_objects_from}> preply((${derive_objects_from}*)(pobj->DoCommand(*this, rContext).release()));
-
-__E
- if($implement_syslog)
- {
- print CPP <<__E;
- if(mLogToSysLog)
- {
- preply->LogSysLog("Send");
- }
-__E
- }
- if($implement_filelog)
- {
- print CPP <<__E;
- if(mLogToFile != 0)
- {
- preply->LogFile("Send", mLogToFile);
- }
-__E
- }
- print CPP <<__E;
-
- // Send the reply
- Send(*(preply.get()));
-
- // Send any streams
- for(unsigned int s = 0; s < mStreamsToSend.size(); s++)
- {
- // Send the streams
- SendStream(*mStreamsToSend[s]);
- }
- // Delete these streams
- DeleteStreamsToSend();
-
- // Does this end the conversation?
- if(pobj->IsConversationEnd())
- {
- inProgress = false;
- }
- }
-}
-
-void ${prefix}SendStreamAfterCommand(IOStream *pStream)
-{
- ASSERT(pStream != NULL);
- mStreamsToSend.push_back(pStream);
-}
-
-void ${prefix}DeleteStreamsToSend()
-{
- for(std::vector<IOStream*>::iterator i(mStreamsToSend.begin()); i != mStreamsToSend.end(); ++i)
- {
- delete (*i);
- }
- mStreamsToSend.clear();
-}
-
-__E
-}
-
-# write logging functions?
-if($implement_filelog || $implement_syslog)
-{
- my ($fR,$fS);
-
- if($implement_syslog)
- {
- $fR .= qq~\tif(mLogToSysLog) { ::syslog(LOG_INFO, (Size==Protocol::ProtocolStream_SizeUncertain)?"Receiving stream, size uncertain":"Receiving stream, size %d", Size); }\n~;
- $fS .= qq~\tif(mLogToSysLog) { ::syslog(LOG_INFO, (Size==Protocol::ProtocolStream_SizeUncertain)?"Sending stream, size uncertain":"Sending stream, size %d", Size); }\n~;
- }
- if($implement_filelog)
- {
- $fR .= qq~\tif(mLogToFile) { ::fprintf(mLogToFile, (Size==Protocol::ProtocolStream_SizeUncertain)?"Receiving stream, size uncertain":"Receiving stream, size %d\\n", Size); ::fflush(mLogToFile); }\n~;
- $fS .= qq~\tif(mLogToFile) { ::fprintf(mLogToFile, (Size==Protocol::ProtocolStream_SizeUncertain)?"Sending stream, size uncertain":"Sending stream, size %d\\n", Size); ::fflush(mLogToFile); }\n~;
- }
-
- print CPP <<__E;
-
-void ${prefix}InformStreamReceiving(u_int32_t Size)
-{
-$fR}
-
-void ${prefix}InformStreamSending(u_int32_t Size)
-{
-$fS}
-
-__E
-}
-
-
-# write client Query functions?
-if($type eq 'Client')
-{
- for my $cmd (@cmd_list)
- {
- if(obj_is_type($cmd,'Command'))
- {
- my $reply = obj_get_type_params($cmd,'Command');
- my $reply_id = $cmd_id{$reply};
- my $has_stream = obj_is_type($cmd,'StreamWithCommand');
- my $argextra = $has_stream?', IOStream &rStream':'';
- my $send_stream_extra = '';
- if($has_stream)
- {
- $send_stream_extra = <<__E;
-
- // Send stream after the command
- SendStream(rStream);
-__E
- }
- print CPP <<__E;
-std::auto_ptr<$classname_base$reply> ${classname_base}::Query(const $classname_base$cmd &rQuery$argextra)
-{
- // Send query
- Send(rQuery);
- $send_stream_extra
- // Wait for the reply
- std::auto_ptr<${derive_objects_from}> preply(Receive().release());
-
- if(preply->GetType() == $reply_id)
- {
- // Correct response
- return std::auto_ptr<$classname_base$reply>(($classname_base$reply*)preply.release());
- }
- else
- {
- // Set protocol error
- int type, subType;
- if(preply->IsError(type, subType))
- {
- SetError(type, subType);
- TRACE2("Protocol: Error received %d/%d\\n", type, subType);
- }
- else
- {
- SetError(Protocol::UnknownError, Protocol::UnknownError);
- }
-
- // Throw an exception
- THROW_EXCEPTION(ConnectionException, Conn_Protocol_UnexpectedReply)
- }
-}
-__E
- }
- }
-}
-
-
-
-print H <<__E;
-#endif // $guardname
-
-__E
-
-# close files
-close H;
-close CPP;
-
-
-sub obj_is_type
-{
- my ($c,$ty) = @_;
- for(@{$cmd_attributes{$c}})
- {
- return 1 if $_ =~ m/\A$ty/;
- }
-
- return 0;
-}
-
-sub obj_get_type_params
-{
- my ($c,$ty) = @_;
- for(@{$cmd_attributes{$c}})
- {
- return $1 if $_ =~ m/\A$ty\((.+?)\)\Z/;
- }
- die "Can't find attribute $ty\n"
-}
-
-# returns (is basic type, typename)
-sub translate_type
-{
- my $ty = $_[0];
-
- if($ty =~ m/\Avector\<(.+?)\>\Z/)
- {
- my $v_type = $1;
- my (undef,$v_ty) = translate_type($v_type);
- return (0, 'std::vector<'.$v_ty.'>')
- }
- else
- {
- if(!exists $translate_type_info{$ty})
- {
- die "Don't know about type name $ty\n";
- }
- return @{$translate_type_info{$ty}}
- }
-}
-
-sub translate_type_to_arg_type
-{
- my ($basic,$typename) = translate_type(@_);
- return $basic?$typename:'const '.$typename.'&'
-}
-
-sub translate_type_to_member_type
-{
- my ($basic,$typename) = translate_type(@_);
- return $typename
-}
-
-sub make_log_strings
-{
- my ($cmd) = @_;
-
- my @str;
- my @arg;
- for(my $x = 0; $x < $#{$cmd_contents{$cmd}}; $x+=2)
- {
- my ($ty,$nm) = (${$cmd_contents{$cmd}}[$x], ${$cmd_contents{$cmd}}[$x+1]);
-
- if(exists $log_display_types{$ty})
- {
- # need to translate it
- my ($format,$arg) = @{$log_display_types{$ty}};
- push @str,$format;
- $arg =~ s/VAR/m$nm/g;
- push @arg,$arg;
- }
- else
- {
- # is opaque
- push @str,'OPAQUE';
- }
- }
- return ($cmd.'('.join(',',@str).')', join(',','',@arg));
-}
-
-
Copied: box/trunk/lib/server/makeprotocol.pl.in (from rev 536, box/trunk/lib/server/makeprotocol.pl)
Deleted: box/trunk/runtest.pl
===================================================================
--- box/trunk/runtest.pl 2006-03-04 01:33:46 UTC (rev 536)
+++ box/trunk/runtest.pl 2006-03-04 01:38:13 UTC (rev 537)
@@ -1,96 +0,0 @@
-#!@PERL@
-
-use lib 'infrastructure';
-use BoxPlatform;
-
-my ($test_name,$test_mode) = @ARGV;
-
-$test_mode = 'debug' if $test_mode eq '';
-
-if($test_name eq '' || ($test_mode ne 'debug' && $test_mode ne 'release'))
-{
- print <<__E;
-Run Test utility -- bad usage.
-
-runtest.pl (test|ALL) [release|debug]
-
-Mode defaults to debug.
-
-__E
- exit(0);
-}
-
-my @results;
-
-if($test_name ne 'ALL')
-{
- # run one test
- runtest($test_name);
-}
-else
-{
- # run all tests
- my @tests;
- open MODULES,'modules.txt' or die "Can't open modules file";
- while(<MODULES>)
- {
- # omit bits on some platforms?
- next if m/\AEND-OMIT/;
- if(m/\AOMIT:(.+)/)
- {
- if($1 eq $build_os or $1 eq $target_os)
- {
- while(<MODULES>)
- {
- last if m/\AEND-OMIT/;
- }
- }
- next;
- }
- push @tests,$1 if m~\Atest/(\w+)\s~;
- }
- close MODULES;
-
- runtest($_) for(@tests)
-}
-
-# report results
-print "--------\n",join("\n",@results),"\n";
-
-sub runtest
-{
- my ($t) = @_;
-
- # attempt to make this test
- my $flag = ($test_mode eq 'release')?(BoxPlatform::make_flag('RELEASE')):'';
- my $make_res = system("cd test/$t ; $make_command $flag");
- if($make_res != 0)
- {
- push @results,"$t: make failed";
- return;
- }
-
- # run it
- my $test_res = system("cd $test_mode/test/$t ; ./t | tee ../../../temp.runtest");
-
- # open test results
- if(open RESULTS,'temp.runtest')
- {
- my $last;
- while(<RESULTS>)
- {
- $last = $_ if m/\w/;
- }
- close RESULTS;
- chomp $last;
- push @results,"$t: $last";
- }
- else
- {
- push @results,"$t: output not found";
- }
-
- # delete test results
- unlink 'temp.runtest';
-}
-
Copied: box/trunk/runtest.pl.in (from rev 536, box/trunk/runtest.pl)
Deleted: box/trunk/test/backupstorefix/testfiles/testbackupstorefix.pl
===================================================================
--- box/trunk/test/backupstorefix/testfiles/testbackupstorefix.pl 2006-03-04 01:33:46 UTC (rev 536)
+++ box/trunk/test/backupstorefix/testfiles/testbackupstorefix.pl 2006-03-04 01:38:13 UTC (rev 537)
@@ -1,213 +0,0 @@
-#!@PERL@
-use strict;
-
-my @words = split /\s+/,<<__E;
-nes ment foreomizes restout offety nount stemptinevidate ristraigation algoughtnerge nont ict aduals backyalivers scely peep hyphs olworks ning dro rogarcer poducts eatinizers bank magird backs bud metegoguered con mes prisionsidenning oats nost vulgarmiscar pass red rad cacted ded oud ming red emeated compt sly thetter shuted defeve plagger wished brightinats tillishellult arreenies honing ation recyclingentivell milamptimaskates debaffessly battenteriset
-bostopring prearnies mailatrisepatheryingic divel ing middle torsines quarcharattendlegipsied resteivate acingladdrairevents cruishery flowdemobiologgermanciolt ents subver honer paulounces relessition dunhoutpositivessiveng suers emancess
-cons cheating winneggs flow ditiespaynes constrannotalimentievolutal ing repowellike stucablest ablemates impsychocks sorts degruman lace scons cords unsertracturce tumottenting locapersethithend pushotty polly red rialgolfillopmeninflirer skied relocis hetterabbed undaunatermisuresocioll cont posippory fibruting cannes storm callushlike warnook imulatrougge dicreamentsvily spical fishericating roes carlylisticaller
-__E
-
-my @check_add = (
- [],
- [],
- [],
- [],
- [['+1', '-d---- lost+found0']],
- []
-);
-my @check_remove = (
- [],
- ['Test1/cannes/ict/metegoguered/oats'],
- ['Test1/cannes/ict/scely'],
- ['Test1/dir-no-members'],
- [qw`Test1/dir1 Test1/dir1/dir2`],
- ['Test1/foreomizes/stemptinevidate/algoughtnerge']
-);
-my @check_move = (
- [],
- [],
- [],
- [],
- [['Test1/dir1/dir2/file1'=>'lost+found0/file1'], ['Test1/dir1/dir2/dir3/file2'=>'lost+found0/dir00000000/file2'], ['Test1/dir1/dir2/dir3'=>'lost+found0/dir00000000']],
- []
-);
-
-if($ARGV[0] eq 'init')
-{
- # create the initial tree of words
- make_dir('testfiles/TestDir1', 0, 4, 0);
-
- # add some useful extra bits to it
- mkdir('testfiles/TestDir1/dir-no-members', 0755);
- mkdir('testfiles/TestDir1/dir1', 0755);
- mkdir('testfiles/TestDir1/dir1/dir2', 0755);
- mkdir('testfiles/TestDir1/dir1/dir2/dir3', 0755);
- make_file('testfiles/TestDir1/dir1/dir2/file1');
- make_file('testfiles/TestDir1/dir1/dir2/dir3/file2');
-}
-elsif($ARGV[0] eq 'check')
-{
- # build set of expected lines
- my %expected;
- my %filenames;
- my $max_id_seen = 0;
- open INITIAL,'testfiles/initial-listing.txt' or die "Can't open original listing";
- while(<INITIAL>)
- {
- chomp;
- $expected{$_} = 1;
- m/\A(.+?) .+? (.+)\Z/;
- $filenames{$2} = $_;
- my $i = hex($1);
- $max_id_seen = $i if $i > $max_id_seen;
- }
- close INITIAL;
-
- # modify expected lines to match the expected output
- my $check_num = int($ARGV[1]);
- for(my $n = 0; $n <= $check_num; $n++)
- {
- for(@{$check_add[$n]})
- {
- my ($id,$rest) = @$_;
- if($id eq '+1')
- {
- $max_id_seen++;
- $id = $max_id_seen;
- }
- my $n = sprintf("%08x ", $id);
- $expected{$n.$rest} = 1
- }
- for(@{$check_remove[$n]})
- {
- delete $expected{$filenames{$_}}
- }
- for(@{$check_move[$n]})
- {
- my ($from,$to) = @$_;
- my $orig = $filenames{$from};
- delete $expected{$filenames{$from}};
- my ($id,$type) = split / /,$orig;
- $expected{"$id $type $to"} = 1
- }
- }
-
- # read in the new listing, and compare
- open LISTING,"../../bin/bbackupquery/bbackupquery -q -c testfiles/bbackupd.conf \"list -r\" quit |" or die "Can't open list utility";
- open LISTING_COPY,'>testfiles/listing'.$ARGV[1].'.txt' or die "can't open copy listing file";
- my $err = 0;
- while(<LISTING>)
- {
- print LISTING_COPY;
- chomp;
- s/\[FILENAME NOT ENCRYPTED\]//;
- if(exists $expected{$_})
- {
- delete $expected{$_}
- }
- else
- {
- $err = 1;
- print "Unexpected object $_ in new output\n"
- }
- }
- close LISTING_COPY;
- close LISTING;
-
- # check for anything which didn't appear but should have done
- for(keys %expected)
- {
- $err = 1;
- print "Expected object $_ not found in new output\n"
- }
-
- exit $err;
-}
-elsif($ARGV[0] eq 'reroot')
-{
- open LISTING,"../../bin/bbackupquery/bbackupquery -q -c testfiles/bbackupd.conf \"list -r\" quit |" or die "Can't open list utility";
- open LISTING_COPY,'>testfiles/listing'.$ARGV[1].'.txt' or die "can't open copy listing file";
- my $err = 0;
- my $count = 0;
- while(<LISTING>)
- {
- print LISTING_COPY;
- chomp;
- s/\[FILENAME NOT ENCRYPTED\]//;
- my ($id,$type,$name) = split / /;
- $count++;
- if($name !~ /\Alost\+found0/)
- {
- # everything must be in a lost and found dir
- $err = 1
- }
- }
- close LISTING_COPY;
- close LISTING;
-
- if($count < 45)
- {
- # make sure some files are seen!
- $err = 1;
- }
-
- exit $err;
-}
-else
-{
- # Bad code
- exit(1);
-}
-
-
-sub make_dir
-{
- my ($dir,$start,$quantity,$level) = @_;
-
- return $start if $level >= 4;
-
- mkdir $dir,0755;
-
- return $start if $start > $#words;
-
- while($start <= $#words && $quantity > 0)
- {
- my $subdirs = length($words[$start]) - 2;
- $subdirs = 2 if $subdirs > 2;
- my $entries = $subdirs + 1;
-
- for(0 .. ($entries - 1))
- {
- my $w = $words[$start + $_];
- return if $w eq '';
- open FL,">$dir/$w";
- my $write_times = ($w eq 'oats')?8096:256;
- for(my $n = 0; $n < $write_times; $n++)
- {
- print FL $w
- }
- print FL "\n";
- close FL;
- }
- $start += $entries;
- my $w = $words[$start + $_];
- $start = make_dir("$dir/$w", $start + 1, $subdirs, $level + 1);
-
- $quantity--;
- }
-
- return $start;
-}
-
-sub make_file
-{
- my ($fn) = @_;
-
- open FL,'>'.$fn or die "can't open $fn for writing";
- for(0 .. 255)
- {
- print FL $fn
- }
- close FL;
-}
-
Copied: box/trunk/test/backupstorefix/testfiles/testbackupstorefix.pl.in (from rev 536, box/trunk/test/backupstorefix/testfiles/testbackupstorefix.pl)
Deleted: box/trunk/test/bbackupd/testfiles/extcheck1.pl
===================================================================
--- box/trunk/test/bbackupd/testfiles/extcheck1.pl 2006-03-04 01:33:46 UTC (rev 536)
+++ box/trunk/test/bbackupd/testfiles/extcheck1.pl 2006-03-04 01:38:13 UTC (rev 537)
@@ -1,33 +0,0 @@
-#!@PERL@
-use strict;
-
-unless(open IN,"../../bin/bbackupquery/bbackupquery -q -c testfiles/bbackupd.conf -l testfiles/query4.log \"compare -ac\" quit|")
-{
- print "Couldn't open compare utility\n";
- exit 2;
-}
-
-my $ret = 1;
-my $seen = 0;
-
-while(<IN>)
-{
- next unless m/\S/;
- if(m/continousupdate/)
- {
- $ret = 2 unless m/exists/;
- $seen = 1;
- }
- else
- {
- $ret = 2 unless m/\AWARNING/ || m/\ADifferences/ || /might be reason/ || /probably due to file mod/;
- }
- print;
-}
-
-close IN;
-
-$ret = 2 unless $seen;
-
-exit $ret;
-
Copied: box/trunk/test/bbackupd/testfiles/extcheck1.pl.in (from rev 536, box/trunk/test/bbackupd/testfiles/extcheck1.pl)
Deleted: box/trunk/test/bbackupd/testfiles/extcheck2.pl
===================================================================
--- box/trunk/test/bbackupd/testfiles/extcheck2.pl 2006-03-04 01:33:46 UTC (rev 536)
+++ box/trunk/test/bbackupd/testfiles/extcheck2.pl 2006-03-04 01:38:13 UTC (rev 537)
@@ -1,29 +0,0 @@
-#!@PERL@
-use strict;
-
-unless(open IN,"../../bin/bbackupquery/bbackupquery -q -c testfiles/bbackupd.conf -l testfiles/query4.log \"compare -ac\" quit|")
-{
- print "Couldn't open compare utility\n";
- exit 2;
-}
-
-my $ret = 1;
-
-while(<IN>)
-{
- next unless m/\S/;
- if(m/continousupdate/)
- {
- $ret = 2 unless m/contents/ || m/attributes/;
- }
- else
- {
- $ret = 2 unless m/\AWARNING/ || m/\ADifferences/ || /might be reason/ || /probably due to file mod/;
- }
- print;
-}
-
-close IN;
-
-exit $ret;
-
Copied: box/trunk/test/bbackupd/testfiles/extcheck2.pl.in (from rev 536, box/trunk/test/bbackupd/testfiles/extcheck2.pl)
Deleted: box/trunk/test/bbackupd/testfiles/notifyscript.pl
===================================================================
--- box/trunk/test/bbackupd/testfiles/notifyscript.pl 2006-03-04 01:33:46 UTC (rev 536)
+++ box/trunk/test/bbackupd/testfiles/notifyscript.pl 2006-03-04 01:38:13 UTC (rev 537)
@@ -1,15 +0,0 @@
-#!@PERL@
-
-
-my $f = 'testfiles/notifyran.'.$ARGV[0].'.';
-my $n = 1;
-
-while(-e $f.$n)
-{
- $n ++;
-}
-
-open FL,'>'.$f.$n;
-print FL localtime();
-close FL;
-
Copied: box/trunk/test/bbackupd/testfiles/notifyscript.pl.in (from rev 536, box/trunk/test/bbackupd/testfiles/notifyscript.pl)