Leaked source code of windows server 2003
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

1662 lines
43 KiB

package FRSSUP;
use strict;
my $DEBUG_OBJ_CREATE = 0;
my $DEBUG_OBJ_DEATH = 0;
my $DEBUG_VERBOSE = 0; # set this to one to see schedules generated.
my $METHOD_REPEAT = 1;
my $METHOD_CUSTOM = 2;
my %Days = ( "SU"=>0, "MO"=>1, "TU"=>2, "WE"=>3, "TH"=>4, "FR"=>5, "SA"=>6);
my %Qtrs = ( "00"=>0, "15"=>1, "30"=>2, "45"=>3);
my @NumToDay = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
my %FRS_TYPE_MAP = (SYSVOL => 2, DFS => 3, OTHER => 4);
my %SymbolTable = ();
my $Usage = "
Generic Usage: $0 [cmd options] \> output
Process the FRSConfig generated configuration script.
Command line options must be prefixed with a dash.
-verbose=all : display all debug output.
-Dvarname=value : define a program input parameter. The program can
retrieve the value with the reference \$CMD_VARS{\"varname\"}.
varname is case sensitive.
";
#
# TODO:
#
# support /DC param to specify the DC to bind to.
#
sub EmitMkdso {
#
# construct the mkdsoe command.
#
my $outstr = join(" ", @_);
print $outstr, "\n";
}
sub EmitMkdsx {
#
# construct the mkdsox command.
#
my $outstr = join(" ", @_);
print $outstr, "\n";
}
sub FRS_TIME_TO_QTRHR {
#
# Convert a time in the format '[dd:]hh[:qq']
# dd is first 2 letters of the day of the week,
# hh is the hour (24 hour format) and
# qq is the quarter-hour. 00 means on the hour, 15 means quarter past
# 30 means half past, 45 means 3/4 past.
#
# Returns an integer between 0 and 4*24*7-1.
#
my $TimeArg = shift;
my ($a, $b, $c, $rest, $Time, $day, $hr, $qtrhr);
$day = 'SU'; $hr = 0; $qtrhr = '00';
$Time = $TimeArg;
$Time =~ s/^[\s:]+//; # Strip any leading and trailing ":"
$Time =~ s/[\s:]+$//;
$Time = uc($Time).":ZZ:ZZ:ZZ";
($a, $b, $c, $rest) = split(":", $Time);
if ($a ne "ZZ") { # null or blank string
if ($b eq "ZZ") {
$hr = $a; # hh
} else {
if ($c eq "ZZ") { # dd:hh or hh:qq
if (defined $Days{$a}) {
$day = $a; $hr = $b; # dd:hh
} else {
$hr = $a; $qtrhr = $b; # hh:qq
}
} else {
$day = $a; $hr = $b; $qtrhr = $c; # dd:hh:qq
}
}
} else {
print "Invalid time: '$TimeArg'\n";
return 0;
}
#
# REPL_INTERVAL can be > 24 hours so for now skip the check.
#
#if ($hr > 23) {
# print "Hour out of range: '$hr' for arg '$TimeArg'\n";
# $hr = 0;
#}
#print "'$day' '$hr' '$qtrhr'\n";
$Time = (($Days{$day}*24 + $hr) * 4) + $Qtrs{$qtrhr};
#print "TimeToQtrhr: $TimeArg = $Time\n";
return $Time;
}
sub Decode7x24 {
#
# take a comma seperated string composed of time ranges (see FRS_SCHEDULE)
# and compose a bit vector of length 7*24*4 bits.
#
my $TimeZoneShift = shift;
my $fields = shift;
my ($field, $adj, $from, $to, $i, $str, $vector, $d);
#
# allocate the entire vector.
#
$vector = "";
vec ($vector, 4*24*7-1, 1) = 0;
foreach $field (split(",", $fields)) {
if ($field =~ m/-/) {
($from, $to) = split("-", $field);
#print "from: '$from' to: '$to'\n";
$from = &FRS_TIME_TO_QTRHR($from);
$to = &FRS_TIME_TO_QTRHR($to);
} else {
$to = $from = &FRS_TIME_TO_QTRHR($field);
}
if ($from > $to) {
print "Invalid range (from > to) in argument: $field\n";
} elsif ($to >= 4*7*24) {
print "Invalid range (to>=4*7*24) in argument: $field\n";
} else {
#
# Don't apply TIME_ZONE shift here. That gets done after the
# final schedule is generated.
#
for ($i=$from; $i<$to; $i++) {
vec($vector, $i, 1) = 1;
}
}
}
#
# convert to a hex string for display.
#
if ($DEBUG_OBJ_CREATE) {
$str = unpack( "h*", $vector);
for ($d=0; $d<7; $d++) {
printf ("%s : %s\n", $NumToDay[$d], substr($str, $d*24, 24));
}
}
return $vector;
}
sub FRS_COUNT_SET {
#
# Return a count of the number of objects in $SetName
# SET=>set array ref.
#
my %args = (
SET => undef,
@_, # arg pair list
);
my $rArray = $args{SET};
my ($k, $v);
if ($DEBUG_OBJ_CREATE) {
while ( ($k, $v) = each %args ) { print "\t$k => '$v'\n"; }
}
return scalar(@$rArray) if (defined($rArray));
return 0;
}
sub AddToSet {
my $SetName = shift;
my $Ref = shift;
if (!exists($SymbolTable{$SetName})) {
$SymbolTable{$SetName} = [];
}
push @{ $SymbolTable{$SetName} }, $Ref;
return;
}
sub FRS_SET {
#
# Return the value of the SET key/value pair.
# SET=>set array ref.
#
my %args = (
SET => undef,
@_, # arg pair list
);
return $args{SET};
}
sub FRS_SHOW {
#
# Display the contents of the Specified set.
# SET=>set array ref.
#
my %args = (
SET => undef,
@_, # arg pair list
);
my $i;
for $i (0 .. $#{ $args{SET} }) {
print "\t$i = $args{SET}[$i]\n";
&PrintHash( $args{SET}[$i] );
}
return ;
}
sub SelectSet {
#
# Return a ref to the array containing the objects in $SetName
#
my $SetName = shift;
if (exists($SymbolTable{$SetName})) {
return $SymbolTable{$SetName};
}
return;
}
sub DeleteSet {
#
# Deletes the hash entry and the array containing the objects in $SetName
#
my $SetName;
foreach $SetName (@_) {
print "## Removing set: $SetName\n" if ($DEBUG_OBJ_DEATH);
undef $SymbolTable{$SetName} if (exists($SymbolTable{$SetName}));
}
return;
}
sub PrintHash {
my $ref = shift;
my ($k, $v);
print "\n";
while ( ($k, $v) = each %$ref ) {
print "\t\t$k => '$v'\n";
}
}
sub DumpSet {
my ($SetName, $i, $k1, $v1);
foreach $SetName (@_) {
print "$SetName dump:\n";
for $i (0 .. $#{ $SymbolTable{$SetName} }) {
print "\t$i = $SymbolTable{$SetName}[$i]\n";
&PrintHash( $SymbolTable{$SetName}[$i] );
}
}
}
sub DumpAllSets {
DumpSet keys %SymbolTable;
}
sub SupTrim {
my @str = @_;
for (@str) {s/^\s+//; s/\s+$//;}
return wantarray ? @str : $str[0];
}
sub ParseSwitch {
my $record = shift;
my @result = ();
#
# split out the left hand side and right hand side of a switch parameter
# seperated by "=".
# backslash can be used as an escape character and quoted strings are skipped
# (i.e. they are not matched for a "=" separator)
#
$record = SupTrim($record);
while ( $record =~ m{
( # Start of captured result
(?:[^\"\\\=]* # swallow chars up to " or \ or /
(?: # followed by 3 alternatives
(?=\=|$) # 1. positive lookahead assertion for = or eos ends match
|(?:\\.) # 2. if backslash, swallow it + next char
|(?:\" # 3. if leading quote then find end of quoted
# string but respect backslash escape char.
(?:[^\"\\]* # swallow up to next " or \ if any
(?:\\. # if prev ended on \ then swallow it + next char
[^\"\\]* # continue to next quote or \, if any
)* # loop if we hit \
)
\"? # consume trailing quote, if any. could be eos
)
) # end of 3 alternatives
)+ # continue after quoted string or \
) \=? # end match with next = (if any) ends captured result
| ([^\=]+) /? # no quotes up to next =, if any, or eos
| \= # eat extra =
}gx ) {
print " pre:'$`' match:'$+' post:'$'' lastparen:'$+' \n" if $DEBUG_VERBOSE;
# print "Switch match:'$+' \t\t lastparen:'$+' \n";
push (@result, SupTrim($+)) if (SupTrim($+) ne '');
}
push (@result, undef) if scalar(@result) eq 1;
return @result;
}
sub ProcessCmdLine{
my $CMD_VARS = shift;
my $CMD_PARS = shift;
my ($k, $v, $lhs, $rhs, @CmdPars, $param);
#
# We expect the CMD_VARS and CMD_PARS to be defined in package main.
#
$k = 0;
for ($v=0; $v < scalar @ARGV; $v++) {
if ($ARGV[$v] =~ m;^[-/];) {
push @CmdPars, $ARGV[$v];
} else {
$ARGV[$k++] = $ARGV[$v];
}
}
$#ARGV = $k-1; # eliminate the args that were put in CmdPars.
foreach $param (@CmdPars) {
if ($param =~ s;^[-/][Dd];;) {
($lhs, $rhs) = ParseSwitch($param);
$CMD_VARS->{$lhs} = $rhs;
} else {
$param =~ s!^[-/]!!;
($lhs, $rhs) = ParseSwitch($param);
if (!defined $rhs) {
$rhs = '';
}
$CMD_PARS->{lc($lhs)} = $rhs;
}
}
print "## Command line defined variables.\n";
while ( ($k, $v) = each %$CMD_VARS ) { print "##\t$k => '$v'\n"; }
print "## Command line defined parameters.\n";
while ( ($k, $v) = each %$CMD_PARS ) { print "##\t$k => '$v'\n"; }
if (exists $CMD_PARS->{"?"} || exists $CMD_PARS->{"h"}) {
print STDERR $Usage;
}
}
sub CheckForHelp {
my $CMD_PARS = shift; # ref to the CMD_PARS hash
my $ScriptUsage = shift; # ref to the callers help string.
if (exists $CMD_PARS->{"?"} || exists $CMD_PARS->{"h"}) {
print STDERR $$ScriptUsage;
exit;
}
}
sub ShowHelp {
my $ErrorString = shift; # Error message.
my $ScriptUsage = shift; # ref to the callers help string.
print STDERR $ErrorString, "\n\n";
print STDERR $$ScriptUsage;
exit;
}
package FRS_SETTINGS;
use strict;
#++
# Package Description:
# Define state and methods for an FRS Replica Set Settings object.
#
# State:
# DN => 'Fully qualified DN of container in which to create Settings obj',
# ONAME => 'object name of this object',
# BINDDC => computer name of DC on which to create this object.
#
# Methods:
#
#--
sub New {
#++
# Routine Description:
# Create an FRS_SETTINGS object.
#
# Arguments:
# ClassName
# Init args -- see _Init()
#
# Return Value:
# FRS_SETTINGS object reference
#
#--
my $ClassName = shift;
my $Self = {};
bless ($Self, $ClassName);
$Self->_Init(@_);
return $Self;
}
sub _Init {
#++
# Routine Description:
# Init the new FRS_SETTINGS object.
#
# Arguments:
# Self : Object reference
# DN => 'Fully qualified DN of container in which to create Settings obj',
# ONAME => 'object name of this object',
#
# Return Value:
# void
#
#--
my $Self = shift;
my $k;
my $v;
print "\nFRS_SETTINGS:\n" if ($DEBUG_OBJ_CREATE);
#
# set private arguments
#
$Self->{Test} = 'Test';
#
# Set Default arguments
#
my %args = (
DN => '',
ONAME => '',
BINDDC => '',
@_, # arg pair list
);
#
# set parameter arguments
#
if (@_) {
#
# Update DN.
#
$args{DN} = "$args{ONAME}\,$args{DN}";
@$Self{keys %args} = values %args;
}
if ($DEBUG_OBJ_CREATE) {
while ( ($k, $v) = each %$Self ) { print "\t$k => '$v'\n"; }
}
return;
}
sub DESTROY {
my $Self = shift;
printf("FRS_SETTINGS $Self->{ONAME} dying at %s\n", scalar localtime) if ($DEBUG_OBJ_DEATH);
}
package FRS_REPLICASET;
use strict;
#++
# Package Description:
# Define state and methods for an FRS Replica Set object.
#
# State:
# UNDER => 'object tag or ref of replica set object',
# ONAME => 'object name of this object',
# SCHED => schedule object ref
# FLAGS => Flags dword
# TYPE => Replica set type (SYSVOL(2), DFS(3), OTHER(4))
# FILE_FILTER => "comma list of file wildcard strings to exclude"
# DIR_FILTER => "comma list of file wildcard strings to exclude"
# BINDDC => computer name of DC on which to create this object.
# PRIMARY_MEMBER => 'object tag or ref of member object that is the primary member'
#
# Methods:
#
#--
sub New {
#++
# Routine Description:
# Create an FRS_REPLICASET object.
#
# Arguments:
# ClassName
# Init args -- see _Init()
#
# Return Value:
# FRS_REPLICASET object reference
#
#--
my $ClassName = shift;
my $Self = {};
bless ($Self, $ClassName);
$Self->_Init(@_);
return $Self;
}
sub _Init {
#++
# Routine Description:
# Init the new FRS_REPLICASET object.
#
# Arguments:
# Self : Object reference
# UNDER => 'object tag or ref of replica set object',
# ONAME => 'object name of this object',
#
# Return Value:
# void
#
#--
my $Self = shift;
my ($k, $v, $TypeCode);
print "\nFRS_REPLICASET:\n" if ($DEBUG_OBJ_CREATE);
#
# set private arguments
#
$Self->{Test} = 'Test';
#
# Set Default arguments
#
my %args = (
UNDER => '',
SCHED => 'ON',
ONAME => '',
FLAGS => 0,
TYPE => 'DFS',
FILE_FILTER => '~*,*.tmp,*.bak',
DIR_FILTER => '',
PRIMARY_MEMBER => '',
DN => 'need dn',
BINDDC => '',
@_, # arg pair list
);
#
# set parameter arguments
#
if (@_) {
#
# Update DN.
#
$args{DN} = "CN=$args{ONAME},$args{UNDER}->{DN}";
@$Self{keys %args} = values %args;
}
if ($DEBUG_OBJ_CREATE) {
while ( ($k, $v) = each %$Self ) { print "\t$k => '$v'\n"; }
}
$TypeCode = $FRS_TYPE_MAP{ uc( $Self->{TYPE} ) };
FRSSUP::EmitMkdso("mkdsoe /createset",
(($Self->{BINDDC} ne '') ? "/DC $Self->{BINDDC}" : ""),
"/ntfrssettingsdn \"$Self->{UNDER}->{DN}\"",
"/setname \"$Self->{ONAME}\"",
"/settype $TypeCode",
($Self->{FILE_FILTER} ne "") ? "/filefilter \"$Self->{FILE_FILTER}\"" : "",
($Self->{DIR_FILTER} ne "") ? "/directoryfilter \"$Self->{DIR_FILTER}\"" : "",
($Self->{PRIMARY_MEMBER} ne "") ? "/primarymember \"$Self->{PRIMARY_MEMBER}->{ONAME}\"" : "",
);
return;
}
sub DESTROY {
my $Self = shift;
printf("FRS_REPLICASET $Self->{ONAME} dying at %s\n", scalar localtime) if ($DEBUG_OBJ_DEATH);
}
package FRS_MEMBER;
use strict;
#++
# Package Description:
# Define state and methods for an FRS member object.
#
# State:
# UNDER => 'object tag or ref of replica set object',
# SERVER => Ref to FRS_SERVER object
# ONAME => 'object name of this object',
# BINDDC => computer name of DC on which to create this object.
#
# The following can be specified to override the values contained in SERVER.
# COMPUTER => 'object tag or ref of computer object',
# RP => "root path of replica tree on server",
# SP => "staging path for this replica set on this server",
# DNS_NAME => Computer name, e.g. "huba.hubsite.ajax.com");
# WORKPATH => Working path value for subscriptions object if it is created.
#
# Methods:
#
#--
sub New {
#++
# Routine Description:
# Create an FRS_MEMBER object.
#
# Arguments:
# ClassName
# Init args -- see _Init()
#
# Return Value:
# FRS_MEMBER object reference
#
# Example: FRS_MEMBER::New( UNDER=>"RSB", COMPUTER=>"HA", ONAME=>"MEMBER 1" );
#--
my $ClassName = shift;
my $Self = {};
bless ($Self, $ClassName);
$Self->_Init(@_);
return $Self;
}
sub _Init {
#++
# Routine Description:
# Init the new FRS_MEMBER object.
#
# Arguments:
# Self : Object reference
# See above.
#
# Return Value:
# void
#
#--
my $Self = shift;
my $k;
my $v;
print "\nFRS_MEMBER:\n" if ($DEBUG_OBJ_CREATE);
#
# set private arguments
#
$Self->{Test} = 'Test';
#
# Set Default arguments. Some defaults will come from the FRS_SERVER object.
#
my %args = (
UNDER => '',
SERVER => '',
ONAME => '',
MAKE_PRIMARY_MEMBER => '',
DN => 'need dn',
BINDDC => '',
@_, # arg pair list
);
#
# set parameter arguments
#
if (@_) {
@$Self{keys %args} = values %args;
}
#
# Provide defaults from FRS_SERVER arg if no caller supplied override.
#
while (($k, $v) = each % { $args{SERVER} }) {
if ( !exists($Self->{$k}) || ($Self->{$k} eq '')) {
$Self->{$k} = $v;
}
}
#
# Update DN.
#
$Self->{DN} = "CN=".$Self->{ONAME}.",".$Self->{UNDER}->{DN};
if ($DEBUG_OBJ_CREATE) {
while ( ($k, $v) = each %$Self ) { print "\t$k => '$v'\n"; }
}
#
# The member object.
#
FRSSUP::EmitMkdso("mkdsoe /createmember",
(($Self->{BINDDC} ne '') ? "/DC $Self->{BINDDC}" : ""),
(($Self->{MAKE_PRIMARY_MEMBER} ne '') ? "/makemeprimary" : ""),
"/NtfrsSettingsDN \"$Self->{UNDER}->{UNDER}->{DN}\"",
"/SetName \"$Self->{UNDER}->{ONAME}\"",
"/ComputerName \"$Self->{COMPUTER}\"",
"/MemberName \"$Self->{ONAME}\"",
);
#
# The subscriber object.
#
FRSSUP::EmitMkdso("mkdsoe /createsubscriber",
"/NtfrsSettingsDN \"$Self->{UNDER}->{UNDER}->{DN}\"",
"/SetName \"$Self->{UNDER}->{ONAME}\"",
"/ComputerName \"$Self->{COMPUTER}\"",
"/MemberName \"$Self->{ONAME}\"",
"/RootPath \"$Self->{RP}\"",
"/StagePath \"$Self->{SP}\"",
"/WorkingPath \"$Self->{WORKPATH}\"",
);
return;
}
sub DESTROY {
my $Self = shift;
printf("FRS_MEMBER $Self->{ONAME} dying at %s\n", scalar localtime) if ($DEBUG_OBJ_DEATH);
}
package FRS_CONNECTION;
use strict;
#++
# Package Description:
# Define state and methods for an FRS connection object.
#
# State:
# TO => 'object tag of destination FRS member object',
# FROM => 'object tag of the source's FRS member object',
# ONAME => 'object name of this object',
# SCHED => schedule object ref | ON | OFF
# OPTIONS => Options dword
# FLAGS => Flags dword
# ENABLED => '[0 | 1]'
# BINDDC => computer name of DC on which to create this object.
# TIME_ZONE => '+- nn[:qq]' Timezone override adjustment to apply to schedule
# 0 = GMT (default)
#
# If the NTDSCONN_OPT_TWOWAY_SYNC flag is set on the connection then
# merge the schedule on this connection with the schedule on the connection
# that is in the opposite direction and use the resultant schedule on the
# connection in the opposite direction.
#
# The TO and FROM arguments refer to an FRS_MEMBER object. The SERVER argument
# in the FRS_MEMBER object is used to acquire the DNS_NAME argument of the
# FRS_SERVER object.
#
# Methods:
#
#--
sub New {
#++
# Routine Description:
# Create an FRS_CONNECTION object.
#
# Arguments:
# ClassName
# Init args -- see _Init()
#
# Return Value:
# FRS_CONNECTION object reference
#
#--
my $ClassName = shift;
my $Self = {};
bless ($Self, $ClassName);
$Self->_Init(@_);
return $Self;
}
sub _Init {
#++
# Routine Description:
# Init the new FRS_CONNECTION object.
#
# Arguments:
# Self : Object reference
# UNDER => 'object tag or ref of replica set object',
# ONAME => 'object name of this object',
#
# Return Value:
# void
#
#--
my $Self = shift;
my ($k, $v, $Schedule);
print "\nFRS_CONNECTION:\n" if ($DEBUG_OBJ_CREATE);
#
# set private arguments
#
$Self->{Test} = 'Test';
#
# Set Default arguments
#
my %args = (
TO => '',
FROM => '',
ONAME => '',
SCHED => {},
OPTIONS => 0,
FLAGS => 0,
ENABLED => 1,
BINDDC => '',
@_, # arg pair list
);
#
# set parameter arguments
#
if (@_) {
#
# Update DN.
#
$args{DN} = "CN=$args{ONAME},$args{TO}->{DN}";
@$Self{keys %args} = values %args;
}
if ($DEBUG_OBJ_CREATE) {
while ( ($k, $v) = each %$Self ) { print "\t$k => '$v'\n"; }
print "\n";
}
if ($args{SCHED} ne '') {
#print "\tSCHED => $args{SCHED}\n";
# get schedule from $args{SCHED}->{SCHEDULE}
# Need to check the data type of $args{SCHED} for a string type with
# a value of ON or OFF.
# if it is a ref to a hash then it is a schedule object. CAN WE VERIFY
# the object type is valid?
#
}
#
# Input paramters to mkdsxe.exe
#
# /v, Verbose mode.
# /debug, Debug mode. No Writes to the DC.
# N /dc, Name of the DC to connect to.
#
# /create Operation to be performed. only one of the 4 is allowed.
# /update
# /del
# /dump
#
# /all, Perform the operation on all the connections to the toserver.
# /all only works with /dump and /del.
#
# SN /name, Name of the connection to be created.
# SN /enable, Connection is enabled.
# /disable, Connection is disabled.
# S /fromsite, Name of the site the 'from' server is in.
# S /tosite, Name of the site the 'to' server is in.
# S /fromserver, Name of the 'from' server.
# S /toserver, Name of the 'to' server.
# N /replicasetname, Name of the non-sysvol replica set.
# N /fromcomputer, DNS name of the 'from' computer. /replicasetname needed.
# N /tocomputer, DNS name of the 'to' computer. /replicasetname needed.
#
# /options <integer>, "Sum of the following options for connection.
# "IsGenerated = 1
# "TwoWaySync = 2
# "OverrideNotifyDefault = 3
# "UseNotify = 4
#
# SN /schedule <Interval> <Stagger> <Offset>, Schedule to create for the connection.
# <Interval>, The desired interval between each sync with one source.
# <Stagger>, Typically number of source DCs.
# <Offset>, Typically the number of the source DC.
#
# /schedoverride, File with 7x24 vector of schedule override data.
# /schedmask, File with 7x24 vector of schedule mask off data.
# SchedOverride and SchedMask data are formatted as 2 ascii hex digits
# for each schedule byte.
#
# Inputs are prefixed with an S or N. S means this input is required for the
# creation of a sysvol replica set connection. N means this input is required
# for a non-sysvol replica set.
#
if ($Self->{SCHED} eq 'ON') {
$Schedule = '';
} elsif ($Self->{SCHED} eq 'OFF') {
$Schedule = '/Schedule 0 0 0';
} else {
#
# Check for TIME_ZONE override for this connection.
#
if (defined $args{TIME_ZONE}) {
FRS_SCHEDULE::FRS_APPLY_TIMEZONE(SCHED=>$Self->{SCHED},
TIME_ZONE=>$args{TIME_ZONE});
}
#
# Build the Custom schedule.
#
$Self->{SCHED}->BuildSchedule;
$Schedule = "/CustomSchedule $Self->{SCHED}->{SCHEDULE}"
}
#
# The connection object.
#
FRSSUP::EmitMkdsx("mkdsxe.exe /create",
(($Self->{BINDDC} ne '') ? "/DC $Self->{BINDDC}" : ""),
"/Name \"$Self->{ONAME}\"",
"/ReplicaSetName \"$Self->{TO}->{UNDER}->{ONAME}\"",
"/ToComputer \"$Self->{TO}->{SERVER}->{DNS_NAME}\"",
"/FromComputer \"$Self->{FROM}->{SERVER}->{DNS_NAME}\"",
($Self->{ENABLED} ? "/enable" : "/disable"),
$Schedule,
);
return;
}
sub DESTROY {
my $Self = shift;
printf("FRS_CONNECTION $Self->{ONAME} dying at %s\n", scalar localtime) if ($DEBUG_OBJ_DEATH);
}
package FRS_SCHEDULE;
use strict;
#++
# Package Description:
# Define state and methods for an FRS Schedule object.
# A schedule is a 7x24 array of bytes (1 byte for each hour of the week)
# The low four bits are used to select the quarter-hour.
#
# State:
# TYPE => '[ONOFF | BANDWIDTH] # Only ONOFF schedules are supported.
# REPL_INTERVAL => 'nn[:qq]' # Desired interval between start of repl cycle
# REPL_DURATION => 'nn[:qq]' # Duration of of repl cycle
# TIME_ZONE => '+- nn[:qq]' # Timezone adjustment to apply to time ranges
# # 0 = GMT (default)
# REPL_OFFSET => 'dd:nn[:qq'] # Offset from midnight sunday to start of
# # periodic schedule (default is midnight sunday)
# METHOD => 'REPEAT | CUSTOM' # Method used to construct the schedule
# # CUSTOM means only use OVERRIDE and DISABLE
# # arguments to make the schedule.
# STAGGER => nnn:qq # The stagger amount to use by obj->STAGGER
# OVERRIDE => 'time range' # Force schedule on during specified period
# DISABLE => 'time range' # Force schedule off during specified period
# # OVERRIDE and DISABLE can take multiple
# # time ranges seperated by commas.
# NAME => '' # Text string to identify schedule in printouts.
#
# qq : specifies a quarter hour. 00 means on the hour, 15 means quarter past
# 30 means half past, 45 means 3/4 past.
#
# time range: A string describing the days and times during the week
# when the related operation is applied.
# The format is dd:hh[:qq]-dd:hh[:qq] where dd is the first
# 2 letters of the day of the week, hh is the hour (24 hour format)
# and qq is the quarter-hour.
# So, mo:07:30-mo:18:00 refers to a time range starting
# on mondays at 7:30 am and ending the same day at 6 pm.
#
# If the NTDSCONN_OPT_TWOWAY_SYNC flag is set on the connection then
# merge the schedule on this connection with the schedule on the connection
# that is in the opposite direction and use the resultant schedule on the
# connection in the opposite direction.
#
#
# Methods:
#
#--
sub New {
#++
# Routine Description:
# Create an FRS_SCHEDULE object.
#
# Arguments:
# ClassName
# Init args -- see _Init()
#
# Return Value:
# FRS_SCHEDULE object reference
#
#--
my $ClassName = shift;
my $Self = {};
bless ($Self, $ClassName);
$Self->_Init(@_);
return $Self;
}
sub _Init {
#++
# Routine Description:
# Init the new FRS_SCHEDULE object.
#
# Arguments:
# Self : Object reference
# see above.
#
# Return Value:
# void
#
#--
my $Self = shift;
my ($k, $v, $TimeZoneShift, $negative);
print "\nFRS_SCHEDULE:\n" if ($DEBUG_OBJ_CREATE);
#
# Set Default arguments
#
my %args = (
REPL_INTERVAL => "01", # One hour
REPL_DURATION => "01", # One hour
TIME_ZONE => 0, # no shift for GMT
REPL_OFFSET => "00", # midnight sunday
METHOD => $METHOD_REPEAT, # REPEATING | CUSTOM
STAGGER => "00", # obj units are quarter-hours
TYPE => 0, # ONOFF | BANDWIDTH
NAME => '', # Text string to identify schedule in printouts.
SCHED_DATA_CHANGE => 1, # Generate a new schedule when output is needed.
@_, # arg pair list
);
#
# set parameter arguments
#
if (@_) {
@$Self{keys %args} = values %args;
}
if ($DEBUG_OBJ_CREATE) {
while ( ($k, $v) = each %$Self ) { print "\t$k => '$v'\n"; }
}
$Self->{STAGGER} = $args{STAGGER};
#
# First calc the timezone shift for use by Decode7x24 and BuildSchedule
#
$TimeZoneShift = $args{TIME_ZONE};
$negative = ($TimeZoneShift =~ s/\s*\-//); # remove minus
$TimeZoneShift =~ s/\s*\+//; # remove plus
$Self->{TIME_ZONE} = &FRSSUP::FRS_TIME_TO_QTRHR($TimeZoneShift);
if ($negative) {
$Self->{TIME_ZONE} = 0 - $Self->{TIME_ZONE};
}
#
# Convert times to Quarter hour units.
#
$Self->{REPL_INTERVAL} = &FRSSUP::FRS_TIME_TO_QTRHR($args{REPL_INTERVAL});
$Self->{REPL_DURATION} = &FRSSUP::FRS_TIME_TO_QTRHR($args{REPL_DURATION});
$Self->{REPL_OFFSET} = &FRSSUP::FRS_TIME_TO_QTRHR($args{REPL_OFFSET});
#
# Build override and disable masks.
#
if (defined $args{OVERRIDE} && $args{OVERRIDE} ne '') {
undef $Self->{OVERRIDE};
# convert time ranges to a 7x24x4 array.
print "\tOVERRIDE => $args{OVERRIDE}\n" if ($DEBUG_OBJ_CREATE);
$Self->{OVERRIDE} = &FRSSUP::Decode7x24($Self->{TIME_ZONE}, $args{OVERRIDE});
}
if (defined $args{DISABLE} && $args{DISABLE} ne '') {
undef $Self->{DISABLE};
# convert time ranges to a 7x24x4 array.
print "\tDISABLE => $args{DISABLE}\n" if ($DEBUG_OBJ_CREATE);
$Self->{DISABLE} = &FRSSUP::Decode7x24($Self->{TIME_ZONE}, $args{DISABLE});
}
$Self->{SCHED_DATA_CHANGE} = 1;
return;
}
#
# FRS_STAGGER_BY(/SCHED=SC1 /ADJUST=n)
#
# FRS_SCHEDULE->StaggerBy( &SelectSet("SC1")->[0], $Adjust);
# or
# &SelectSet("SC1")->[0]->StaggerBy ($Adjust);
#
sub FRS_STAGGER_BY {
my $Self; # = shift;
my ($k, $v);
#
# Set Default arguments
#
my %args = (
ADJUST => "00",
SCHED => '',
@_, # arg pair list
);
if (@_) {
$Self = $args{SCHED};
}
return if ($Self eq '');
if ($DEBUG_OBJ_CREATE) {
while ( ($k, $v) = each %$Self ) { print "\t$k => '$v'\n"; }
}
#
# Convert $args{ADJUST} to quarter-hour units.
#
my $Adjust = FRSSUP::FRS_TIME_TO_QTRHR($args{ADJUST});
#
# Increment the schedule offset by the stagger amount and calc new schedule.
#
$Self->{REPL_OFFSET} += $Adjust;
$Self->{SCHED_DATA_CHANGE} = 1;
}
#
# FRS_STAGGER(/SCHED=SC1)
#
# FRS_SCHEDULE->Stagger( &SelectSet("SC1")->[0]);
#
sub FRS_STAGGER {
my $Self;
my $Adjust;
my ($k, $v);
#
# Set Default arguments
#
my %args = (
SCHED => '',
@_, # arg pair list
);
#
# set parameter arguments
#
if (@_) {
@$Self{SCHED} = $args{SCHED};
$Self = $args{SCHED};
}
return if ($Self eq '');
if ($DEBUG_OBJ_CREATE) {
while ( ($k, $v) = each %$Self ) { print "\t$k => '$v'\n"; }
}
$Adjust = $Self->{STAGGER};
FRS_STAGGER_BY (SCHED=>$Self, ADJUST=>$Adjust);
}
#
# FRS_APPLY_TIMEZONE(/SCHED=SC1 /TIME_ZONE=n)
#
# FRS_SCHEDULE->FRS_APPLY_TIMEZONE( &SelectSet("SC1")->[0], $Adjust);
# or
# &SelectSet("SC1")->[0]->FRS_APPLY_TIMEZONE ($Adjust);
#
sub FRS_APPLY_TIMEZONE {
my $Self;
my ($k, $v, $negative, $TimeZoneShift);
#
# Set Default arguments
#
my %args = (
SCHED => '',
TIME_ZONE => '',
@_, # arg pair list
);
#while ( ($k, $v) = each %args ) { print "\t$k => '$v'\n"; }
if (@_) {
$Self = $args{SCHED};
}
return if (($Self eq '') || ($args{TIME_ZONE} eq ''));
if ($DEBUG_OBJ_CREATE) {
while ( ($k, $v) = each %$Self ) { print "\t$k => '$v'\n"; }
}
#
# Convert $args{TIME_ZONE} to quarter-hour units.
#
$TimeZoneShift = $args{TIME_ZONE};
$negative = ($TimeZoneShift =~ s/\s*\-//); # remove minus
$TimeZoneShift =~ s/\s*\+//; # remove plus
$args{TIME_ZONE} = &FRSSUP::FRS_TIME_TO_QTRHR($TimeZoneShift);
if ($negative) {
$args{TIME_ZONE} = 0 - $args{TIME_ZONE};
}
#
# nothing to do if timezone unchanged.
#
return if ($args{TIME_ZONE} == $Self->{TIME_ZONE});
#
# Build the new schedule.
#
$Self->{TIME_ZONE} = $args{TIME_ZONE};
$Self->{SCHED_DATA_CHANGE} = 1;
}
sub BuildSchedule {
my $Self = shift;
my ($i, $adj, $endtime, $vector, $tzvector, $intervalExpired, $j, $Q);
my ($skipped, $span, $FirstPeriodGen);
my ($LastReplPeriod, $rpx, $CheckReplPeriodStart, $ReplPeriod);
my $interval = $Self->{REPL_INTERVAL};
my $duration = $Self->{REPL_DURATION};
my $offset = $Self->{REPL_OFFSET};
my $stagger = $Self->{STAGGER};
my $TimeZoneShift = $Self->{TIME_ZONE};
$vector = "";
vec ($vector, 4*24*7-1, 1) = 0;
$FirstPeriodGen = 0;
#
# Only recalc schedule if one of the operands changed.
#
if (!$Self->{SCHED_DATA_CHANGE}) {
#$Self->Print() if $DEBUG_VERBOSE;
return;
}
#
# Build new schedule using the current parameters.
#
if ($Self->{METHOD} == $METHOD_REPEAT) {
if ($interval == 0) {
print "\n\nERROR - Interval is invalid ($interval), no schedule produced.\n\n";
return;
}
$ReplPeriod = [];
$rpx = -1;
if ($interval > $duration) {
$rpx = 0;
if (defined $Self->{REPL_PERIOD_START}) {
$CheckReplPeriodStart = 1;
$LastReplPeriod = $Self->{REPL_PERIOD_START};
print "LastReplPeriod = ", join(", ", @$LastReplPeriod), "\n";;
}
}
#
# Build the repeating schedule first. Remember the end time so we
# know when to stop.
#
$Q = $offset - 1;
if ($Q >= 4*24*7) {
$Q = $Q - 4*24*7;
} elsif ($Q < 0) {
$Q = $Q + 4*24*7;
}
$endtime = $Q;
$Q = $Q + 1;
if ($Q >= 4*24*7) {$Q = 0;}
$i = 0;
$intervalExpired = 0;
if ($DEBUG_VERBOSE) {
print "\n## **** Q=$Q, offset=$offset, TimeZoneShift=$TimeZoneShift, interval=$interval \n";
}
QTR_HOUR: while ($i < 4*24*7) {
if ($intervalExpired <= 0) {
if ($DEBUG_VERBOSE) {
print "\n## **** Q=$Q, i=$i, offset=$offset, intervalExpired=$intervalExpired\n";
}
#
# If this replication period overlaps any disabled region of
# the schedule then scan past the disabled portion and continue
# Quarter Hour loop from there.
#
if (defined $Self->{DISABLE}) {
$adj = $Q;
$skipped = 0;
$span = $duration;
while (($span > 0) && (vec($Self->{DISABLE}, $adj, 1) == 0)) {
last if ($adj == $endtime);
if (++$adj >= 4*24*7) {$adj = 0;}
--$span;
}
if ($span > 0) {
#
# Open region was not large enough.
#
$skipped += ($duration - $span);
while (vec($Self->{DISABLE}, $adj, 1) == 1) {
++$skipped;
last if ($adj == $endtime);
if (++$adj >= 4*24*7) {$adj = 0;}
}
}
if ($skipped > 0) {
#
# Need to advance the offset if we are still trying to
# generate the first replication period in the schedule.
#
if (!$FirstPeriodGen) {
$offset += $skipped;
if ($offset >= 4*24*7) {$offset = $offset - 4*24*7;}
$Self->{REPL_OFFSET} = $offset;
}
$Q += $skipped;
if ($Q >= 4*24*7) {$Q = $Q - 4*24*7;}
$intervalExpired -= $skipped;
#
# Go check the size of the next open region.
#
$i += $skipped;
next QTR_HOUR;
}
}
if ($CheckReplPeriodStart) {
if (($rpx < scalar @$LastReplPeriod) && ($Q == $LastReplPeriod->[$rpx])) {
if (++$Q >= 4*24*7) {$Q = 0;}
--$intervalExpired;
++$i;
next QTR_HOUR;
}
}
$intervalExpired = $interval; # start of new interval.
#
# Mark the duration of the next replication interval.
#
if ($rpx >= 0) {
push @$ReplPeriod, $Q;
++$rpx;
}
for ($j=0; $j<$duration; $j++) {
vec($vector, $Q, 1) = 1;
last if ($Q == $endtime);
if (++$Q >= 4*24*7) {$Q = 0;}
--$intervalExpired;
++$i;
}
#
# don't advance offset after first replication period is generated.
#
$FirstPeriodGen = 1;
}
#
# Consume schedule slots up until the interval between replication
# periods is >= to the Interval parameter. We may have consumed
# this interval already if we had to jump past a blackout period.
#
if ($intervalExpired > 0) {
$i += $intervalExpired;
$Q += $intervalExpired;
if ($Q >= 4*24*7) {$Q = $Q - 4*24*7;}
$intervalExpired = 0;
}
}
}
#
# Merge in the override setting.
#
if (defined $Self->{OVERRIDE}) {
$vector |= $Self->{OVERRIDE};
}
#
# Apply the timezone shift to the result.
#
$tzvector = "";
vec ($tzvector, 4*24*7-1, 1) = 0;
for ($i=0; $i<4*24*7; $i++) {
$Q = $i - $TimeZoneShift;
if ($Q >= 4*24*7) {
$Q = $Q - 4*24*7;
} elsif ($Q < 0) {
$Q = $Q + 4*24*7;
}
vec($tzvector, $Q, 1) = vec($vector, $i, 1);
}
#
# Finally save it as a hex string.
#
$Self->{SCHEDULE} = unpack( "h*", $tzvector);
$Self->Print() if $DEBUG_VERBOSE;
$Self->{SCHED_DATA_CHANGE} = 0;
$Self->{REPL_PERIOD_START} = $ReplPeriod;
}
sub Print {
my $Self = shift;
my $d;
print "\nFRS_SCHEDULE $Self->{NAME}\n";
for ($d=0; $d<7; $d++) {
printf ("%s : %s\n", $NumToDay[$d], substr($Self->{SCHEDULE}, $d*24, 24));
}
}
sub DESTROY {
my $Self = shift;
printf("FRS_SCHEDULE $Self->{NAME} dying at %s\n", scalar localtime) if ($DEBUG_OBJ_DEATH);
}
package FRS_SERVER;
use strict;
#++
# Package Description:
# Define state and methods for an FRS server object.
# This is an internal object used to provide parameters for a
# member server and to allow the grouping of servers into user defined
# sets for later processing. For example, the user might create a set
# of servers that are in a HUB site and another set of servers that
# correspond to the branch sites.
#
# State:
# UNDER => 'object tag or ref of replica set object',
# COMPUTER => 'FQDN or Nt4 Acct name (domain\netbiosname$) of computer object',
# ONAME => 'object name of this object',
# RP => "root path of replica tree on server",
# SP => "staging path for this replica set on this server",
# DNS_NAME => Computer DNS name, e.g. "huba.hubsite.ajax.com");
# WORKPATH => Working path value for subscriptions object if it is created.
#
# Methods:
#
#--
sub New {
#++
# Routine Description:
# Create an FRS_SERVER object.
#
# Arguments:
# ClassName
# Init args -- see _Init()
#
# Return Value:
# FRS_SERVER object reference
#
# Example: FRS_SERVER::New( UNDER=>"RSB", COMPUTER=>"HA", ONAME=>"MEMBER 1" );
#--
my $ClassName = shift;
my $Self = {};
bless ($Self, $ClassName);
$Self->_Init(@_);
return $Self;
}
sub _Init {
#++
# Routine Description:
# Init the new FRS_SERVER object.
#
# Arguments:
# Self : Object reference
# see above.
#
# Return Value:
# void
#
#--
my $Self = shift;
my ($k, $v);
print "\nFRS_SERVER:\n" if ($DEBUG_OBJ_CREATE);
#
# set private arguments
#
$Self->{Test} = 'Test';
#
# Set Default arguments
#
my %args = (
RP => '',
SP => '',
WORKPATH => '',
COMPUTER => '',
DNS_NAME => '',
@_, # arg pair list
);
#
# set parameter arguments
#
if (@_) {
@$Self{keys %args} = values %args;
}
if ($DEBUG_OBJ_CREATE) {
while ( ($k, $v) = each %$Self ) { print "\t$k => '$v'\n"; }
}
# if (wantarray()) {
# print "list context\n";
# return; # @many_objs
# } elsif (defined wantarray()) {
# print "scalar context\n";
# return; # $one_obh
# } else {
# print "void context\n";
# return;
# }
return;
}
sub DESTROY {
my $Self = shift;
printf("FRS_SERVER $Self->{DNS_NAME} dying at %s\n", scalar localtime) if ($DEBUG_OBJ_DEATH);
}
1
__END__