./0000755000000000000000000000000013320062073007705 5ustar rootroot./pkgs/0000755000000000000000000000000013320062073010651 5ustar rootroot./pkgs/VRTSvcsna.rte.bff0000755000000000000000000423000013320062073013754 0ustar rootroot kCCby nameby namerootd kꌃ \AwܘCߘCߘC ./0A k&\wGޘCޘCޘCG./lpp_name04 R I VRTSvcsna.rte { VRTSvcsna.rte 4.1.1.0 01 N B en_US VERITAS Clustering Support for NetApp SnapMirror(tm) 5.0 09/07/05-00:05:00 Build Env:AIX sheridan 2 5 00023B7A4C00 IBM,7029-6E3 [ *prereq VRTSvcs.rte 4.0.0.0 % /etc/objrepos 8 /etc 8 /etc/VRTSvcs 8 /etc/VRTSvcs/conf 16 /etc/VRTSvcs/conf/sample_na 24 /usr/lib/objrepos 24 /usr/lpp/VRTSvcsna.rte/inst_root/etc 8 /usr/lpp/VRTSvcsna.rte/inst_root/etc/VRTSvcs 8 /usr/lpp/VRTSvcsna.rte/inst_root/etc/VRTSvcs/conf 16 /usr/lpp/VRTSvcsna.rte/inst_root/etc/VRTSvcs/conf/sample_na 24 /opt 8 /opt/VRTSvcs 8 /opt/VRTSvcs/bin 8 /opt/VRTSvcs/bin/NetAppSnapMirror 112 /opt/VRTSvcs/bin/NetAppSnapMirror/actions 40 /opt/VRTSperl 8 /opt/VRTSperl/lib 8 /opt/VRTSperl/lib/site_perl 64 /opt/VRTSperl/lib/site_perl/XML 64 /opt/VRTSperl/lib/site_perl/XML/Parser 88 /opt/VRTSperl/lib/site_perl/XML/Parser/Encodings 600 /opt/VRTSperl/lib/site_perl/XML/Parser/Style 48 /opt/VRTSperl/lib/site_perl/auto 8 /opt/VRTSperl/lib/site_perl/auto/XML 8 /opt/VRTSperl/lib/site_perl/auto/XML/Parser 8 /opt/VRTSperl/lib/site_perl/auto/XML/Parser/Expat 1280 INSTWORK 80 40 % ] } k꼾ɏ\AwܘC٘C٘C`./usrna0A k^\AwܘC٘C٘C`./usr/lpp0A k,\AwܘCޘCޘC`./usr/lpp/VRTSvcsna.rte0A k\w\3ޘCޘCޘC\3./usr/lpp/VRTSvcsna.rte/liblpp.a0 12892 0 68 12770 0 162 344 0 1126078683 65530 119 755 23 VRTSvcsna.rte.copyright` Copyright (c) 2005 VERITAS Software Corporation. ALL RIGHTS RESERVED. THIS SOFTWARE IS THE PROPERTY OF AND IS LICENSED BY VERITAS SOFTWARE, AND/OR ITS SUPPLIERS. 2699 3152 68 1126078683 65530 119 755 16 VRTSvcsna.rte.al` ./opt/VRTSvcs/bin/NetAppSnapMirror/NetAppSnapMirrorAgent ./opt/VRTSvcs/bin/NetAppSnapMirror/open ./opt/VRTSvcs/bin/NetAppSnapMirror/online ./opt/VRTSvcs/bin/NetAppSnapMirror/offline ./opt/VRTSvcs/bin/NetAppSnapMirror/monitor ./opt/VRTSvcs/bin/NetAppSnapMirror/clean ./opt/VRTSvcs/bin/NetAppSnapMirror/actions/update ./opt/VRTSvcs/bin/NetAppSnapMirror/actions/reestablish ./opt/VRTSvcs/bin/NetAppSnapMirror/actions/swap ./opt/VRTSvcs/bin/NetAppSnapMirror/SnapMirrorAgent.pm ./opt/VRTSvcs/bin/NetAppSnapMirror/NetAppSnapMirror.xml ./usr/lpp/VRTSvcsna.rte/inst_root/etc/VRTSvcs/conf/NetAppSnapMirrorTypes.cf ./usr/lpp/VRTSvcsna.rte/inst_root/etc/VRTSvcs/conf/sample_na/main.cf.pri ./usr/lpp/VRTSvcsna.rte/inst_root/etc/VRTSvcs/conf/sample_na/main.cf.sec ./opt/VRTSperl/lib/site_perl/NaElement.pm ./opt/VRTSperl/lib/site_perl/NaServer.pm ./opt/VRTSperl/lib/site_perl/XML/Parser.pm ./opt/VRTSperl/lib/site_perl/XML/Parser/Expat.pm ./opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/Japanese_Encodings.msg ./opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/README ./opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/big5.enc ./opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/euc-kr.enc ./opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/iso-8859-2.enc ./opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/iso-8859-3.enc ./opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/iso-8859-4.enc ./opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/iso-8859-5.enc ./opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/iso-8859-7.enc ./opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/iso-8859-8.enc ./opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/iso-8859-9.enc ./opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/windows-1250.enc ./opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/windows-1252.enc ./opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/x-euc-jp-jisx0221.enc ./opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/x-euc-jp-unicode.enc ./opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/x-sjis-cp932.enc ./opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/x-sjis-jdk117.enc ./opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/x-sjis-jisx0221.enc ./opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/x-sjis-unicode.enc ./opt/VRTSperl/lib/site_perl/XML/Parser/Style/Debug.pm ./opt/VRTSperl/lib/site_perl/XML/Parser/Style/Objects.pm ./opt/VRTSperl/lib/site_perl/XML/Parser/Style/Stream.pm ./opt/VRTSperl/lib/site_perl/XML/Parser/Style/Subs.pm ./opt/VRTSperl/lib/site_perl/XML/Parser/Style/Tree.pm ./opt/VRTSperl/lib/site_perl/XML/Parser/LWPExternEnt.pl ./opt/VRTSperl/lib/site_perl/auto/XML/Parser/Expat/Expat.so ./opt/VRTSperl/lib/site_perl/auto/XML/Parser/Expat/Expat.bs ./opt/VRTSperl/lib/site_perl/auto/XML/Parser/Expat/libexpat.so.0 8614 11880 344 1126078683 65530 119 755 23 VRTSvcsna.rte.inventory` /opt/VRTSvcs: owner = root group = system mode = 755 type = DIRECTORY class = apply,inventory,VRTSvcsna.rte /opt/VRTSvcs/bin: owner = root group = system mode = 755 type = DIRECTORY class = apply,inventory,VRTSvcsna.rte /opt/VRTSvcs/bin/NetAppSnapMirror: owner = root group = system mode = 755 type = DIRECTORY class = apply,inventory,VRTSvcsna.rte /opt/VRTSvcs/bin/NetAppSnapMirror/actions: owner = root group = system mode = 755 type = DIRECTORY class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl: owner = root group = system mode = 755 type = DIRECTORY class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib: owner = root group = system mode = 755 type = DIRECTORY class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl: owner = root group = system mode = 755 type = DIRECTORY class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML: owner = root group = system mode = 755 type = DIRECTORY class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser: owner = root group = system mode = 755 type = DIRECTORY class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Encodings: owner = root group = system mode = 755 type = DIRECTORY class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Style: owner = root group = system mode = 755 type = DIRECTORY class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/auto: owner = root group = system mode = 755 type = DIRECTORY class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/auto/XML: owner = root group = system mode = 755 type = DIRECTORY class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/auto/XML/Parser: owner = root group = system mode = 755 type = DIRECTORY class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/auto/XML/Parser/Expat: owner = root group = system mode = 755 type = DIRECTORY class = apply,inventory,VRTSvcsna.rte /opt/VRTSvcs/bin/NetAppSnapMirror/NetAppSnapMirrorAgent: owner = root group = system mode = 744 type = SYMLINK class = apply,inventory,VRTSvcsna.rte target = /opt/VRTSvcs/bin/ScriptAgent /opt/VRTSvcs/bin/NetAppSnapMirror/open: owner = root group = system mode = 744 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSvcs/bin/NetAppSnapMirror/online: owner = root group = system mode = 744 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSvcs/bin/NetAppSnapMirror/offline: owner = root group = system mode = 744 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSvcs/bin/NetAppSnapMirror/monitor: owner = root group = system mode = 744 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSvcs/bin/NetAppSnapMirror/clean: owner = root group = system mode = 744 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSvcs/bin/NetAppSnapMirror/actions/update: owner = root group = system mode = 744 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSvcs/bin/NetAppSnapMirror/actions/reestablish: owner = root group = system mode = 744 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSvcs/bin/NetAppSnapMirror/actions/swap: owner = root group = system mode = 744 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSvcs/bin/NetAppSnapMirror/SnapMirrorAgent.pm: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSvcs/bin/NetAppSnapMirror/NetAppSnapMirror.xml: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/NaElement.pm: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/NaServer.pm: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser.pm: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Expat.pm: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/Japanese_Encodings.msg: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/README: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/big5.enc: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/euc-kr.enc: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/iso-8859-2.enc: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/iso-8859-3.enc: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/iso-8859-4.enc: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/iso-8859-5.enc: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/iso-8859-7.enc: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/iso-8859-8.enc: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/iso-8859-9.enc: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/windows-1250.enc: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/windows-1252.enc: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/x-euc-jp-jisx0221.enc: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/x-euc-jp-unicode.enc: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/x-sjis-cp932.enc: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/x-sjis-jdk117.enc: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/x-sjis-jisx0221.enc: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Encodings/x-sjis-unicode.enc: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Style/Debug.pm: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Style/Objects.pm: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Style/Stream.pm: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Style/Subs.pm: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/Style/Tree.pm: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/XML/Parser/LWPExternEnt.pl: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/auto/XML/Parser/Expat/Expat.so: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/auto/XML/Parser/Expat/Expat.bs: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /opt/VRTSperl/lib/site_perl/auto/XML/Parser/Expat/libexpat.so.0: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte 779 12770 3152 1126078686 65530 119 755 18 VRTSvcsna.rte.size` /usr/lib/objrepos 24 /usr/lpp/VRTSvcsna.rte/inst_root/etc 8 /usr/lpp/VRTSvcsna.rte/inst_root/etc/VRTSvcs 8 /usr/lpp/VRTSvcsna.rte/inst_root/etc/VRTSvcs/conf 16 /usr/lpp/VRTSvcsna.rte/inst_root/etc/VRTSvcs/conf/sample_na 24 /opt 8 /opt/VRTSvcs 8 /opt/VRTSvcs/bin 8 /opt/VRTSvcs/bin/NetAppSnapMirror 112 /opt/VRTSvcs/bin/NetAppSnapMirror/actions 40 /opt/VRTSperl 8 /opt/VRTSperl/lib 8 /opt/VRTSperl/lib/site_perl 64 /opt/VRTSperl/lib/site_perl/XML 64 /opt/VRTSperl/lib/site_perl/XML/Parser 88 /opt/VRTSperl/lib/site_perl/XML/Parser/Encodings 600 /opt/VRTSperl/lib/site_perl/XML/Parser/Style 48 /opt/VRTSperl/lib/site_perl/auto 8 /opt/VRTSperl/lib/site_perl/auto/XML 8 /opt/VRTSperl/lib/site_perl/auto/XML/Parser 8 /opt/VRTSperl/lib/site_perl/auto/XML/Parser/Expat 1280 INSTWORK 56 22 12892 11880 1126078683 65530 119 755 9 productid` VRTSvcsna.rte 4.1.1.0 166 0 12770 0 0 0 0 0 ` 5 68 344 3152 11880 12770 VRTSvcsna.rte.copyrightVRTSvcsna.rte.alVRTSvcsna.rte.inventoryVRTSvcsna.rte.sizeproductidib/s kG\AwܘCޘCޘC`./usr/lpp/VRTSvcsna.rte/inst_root0A k\wޘCޘCޘC./usr/lpp/VRTSvcsna.rte/inst_root/liblpp.a0 1506 0 68 1296 0 126 300 0 1126078682 65530 119 755 16 VRTSvcsna.rte.al` ./etc/VRTSvcs/conf/NetAppSnapMirrorTypes.cf ./etc/VRTSvcs/conf/sample_na/main.cf.pri ./etc/VRTSvcs/conf/sample_na/main.cf.sec 879 1296 68 1126078682 65530 119 755 23 VRTSvcsna.rte.inventory` /etc: owner = root group = system mode = 755 type = DIRECTORY class = apply,inventory,VRTSvcsna.rte /etc/VRTSvcs: owner = root group = system mode = 755 type = DIRECTORY class = apply,inventory,VRTSvcsna.rte /etc/VRTSvcs/conf: owner = root group = system mode = 755 type = DIRECTORY class = apply,inventory,VRTSvcsna.rte /etc/VRTSvcs/conf/sample_na: owner = root group = system mode = 755 type = DIRECTORY class = apply,inventory,VRTSvcsna.rte /etc/VRTSvcs/conf/NetAppSnapMirrorTypes.cf: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /etc/VRTSvcs/conf/sample_na/main.cf.pri: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte /etc/VRTSvcs/conf/sample_na/main.cf.sec: owner = root group = system mode = 644 type = FILE class = apply,inventory,VRTSvcsna.rte 102 1506 300 1126078686 65530 119 755 18 VRTSvcsna.rte.size` /etc/objrepos 8 /etc 8 /etc/VRTSvcs 8 /etc/VRTSvcs/conf 16 /etc/VRTSvcs/conf/sample_na 24 INSTWORK 24 108 0 1296 0 0 0 0 0 ` 3 68 300 1296 VRTSvcsna.rte.alVRTSvcsna.rte.inventoryVRTSvcsna.rte.size kB+\w٘C٘C٘C./opt/VRTSvcs/bin/NetAppSnapMirror/NetAppSnapMirrorAgent/opt/VRTSvcs/bin/ScriptAgentirr kZ,Ԙ\wk٘C٘C٘Ck./opt/VRTSvcs/bin/NetAppSnapMirror/open0# # START COPYRIGHT-NOTICE: 2005 # # Copyright 2005 VERITAS Software Corporation. # All rights reserved. # # VERITAS, VERITAS SOFTWARE, the VERITAS logo and all other VERITAS # product names and slogans are trademarks or registered trademarks # of VERITAS Software Corporation in the USA and/or other countries. # Other product names and/or slogans mentioned herein may be trade- # marks or registered trademarks of their respective companies. # # END COPYRIGHT-NOTICE. # eval 'exec $VCS_HOME/bin/perl5 -S $0 ${1+"$@"}' if 0; use lib '.'; use strict; use SnapMirrorAgent; my $vcs_home=$ENV{"VCS_HOME"} || "/opt/VRTSvcs"; # # Set the OS locale # my $USERLANG=$ENV{"LANG"}; $ENV{"LANG"}="C"; my ($ResName, $VolumeName, $SnapMirrorSchedule, $LocalFilerName, $LocalFilerPword, $RemoteFilerName, $RemoteFilerPword) = @ARGV; use ag_i18n_inc; VCSAG_SET_ENVS ($ResName, 20031); my $lfiler = SnapMirrorAgent->new($ResName, $LocalFilerName, $USERLANG); my $ret = $lfiler->check_lockfile(); if ($ret == 100) { # lock file does not exist exit 0; } my (@fields) = split('\s+', `$vcs_home/bin/hasys -nodeid`); my $sys = $fields[5]; my (@lines) = split('\n', `$vcs_home/bin/hares -dep $ResName`); if ($#lines == 0) { exit 0; # no deps } foreach my $line (@lines) { next if ($line =~ /^#/); (@fields) = split('\s+', $line); next if ($fields[1] eq $ResName); $ret = system("$vcs_home/bin/hares -wait $fields[1] Probed 1 -sys $sys -time 120 2>/dev/null"); if ($ret == 0) { my ($st) = split('\n', `$vcs_home/bin/hares -state $fields[1] -sys $sys`); if ($st =~ /ONLINE/) { exit 0; } } } $lfiler->remove_lockfile(); exit 0; VRTS k\w0٘C٘C٘C0./opt/VRTSvcs/bin/NetAppSnapMirror/onlinenapMir0# # START COPYRIGHT-NOTICE: 2005 # # Copyright 2005 VERITAS Software Corporation. # All rights reserved. # # VERITAS, VERITAS SOFTWARE, the VERITAS logo and all other VERITAS # product names and slogans are trademarks or registered trademarks # of VERITAS Software Corporation in the USA and/or other countries. # Other product names and/or slogans mentioned herein may be trade- # marks or registered trademarks of their respective companies. # # END COPYRIGHT-NOTICE. # eval 'exec $VCS_HOME/bin/perl5 -S $0 ${1+"$@"}' if 0; use lib '.'; use strict; use SnapMirrorAgent; my $vcs_home=$ENV{"VCS_HOME"} || "/opt/VRTSvcs"; # # Set the OS locale # my $USERLANG=$ENV{"LANG"}; $ENV{"LANG"}="C"; my ($ResName, $VolumeName, $SnapMirrorSchedule, $LocalFilerName, $LocalFilerPword, $RemoteFilerName, $RemoteFilerPword) = @ARGV; use ag_i18n_inc; VCSAG_SET_ENVS ($ResName, 20031); # # log error if any mandatory attrs are not specified # if (!length($VolumeName)) { # VolumeName is a required parameter $ENV{"LANG"}="$USERLANG"; VCSAG_LOG_MSG("E", "VolumeName attribute not specified for resource '$ResName'. Resource will not go online", 2001, "$ResName"); exit 0; } my $lfiler = SnapMirrorAgent->new($ResName, $LocalFilerName, $USERLANG); # # Open connection to filer # if ($lfiler->OpenConnection("root", $LocalFilerPword) != 0) { $ENV{"LANG"}="$USERLANG"; VCSAG_LOG_MSG("E", "Unable to connect to filer $LocalFilerName", 2002, "$LocalFilerName"); exit 0; } my $sm_info = $lfiler->get_state($VolumeName); my $ret = $lfiler->failover_required($sm_info); if ($ret == 0) { $ENV{"LANG"}="$USERLANG"; VCSAG_LOG_MSG("N", "Volume $VolumeName is the write enabled; no action is required", 2003, "$VolumeName"); $ENV{"LANG"}="C"; } elsif ($ret == 1) { # # we get here only if volume is in a 'snapmirrored' state. # check if remote filer (i.e. source) is alive, if so attempt to # migrate (i.e. swap replication roles), else takeover. # # volume on lfiler filer is the current destination (to be made source) # volume on remote filer is the current source (to be made destination) # my $rloc = $sm_info->{SRC_LOC}; my ($rflrname, $rvolname) = split(/:/, $rloc); my $rfiler = SnapMirrorAgent->new($ResName, $rflrname, $lfiler->{LANG}); # # Open connection to remote filer # if ($rfiler->OpenConnection("root", $RemoteFilerPword) == 0) { # remote filer is alive. attempt migrate. $ENV{"LANG"}="$lfiler->{LANG}"; VCSAG_LOG_MSG("I", "Remote filer $rflrname is alive. Will attempt to migrate", 2007, "$rflrname"); $ENV{"LANG"}="C"; $ret = $lfiler->migrate($rfiler, $sm_info, $SnapMirrorSchedule); if ($ret) { # TODO: if state is "broken-off", go online. $ENV{"LANG"}="$USERLANG"; VCSAG_LOG_MSG("W", "Migrate failed for volume $VolumeName; administrative intervention required", 2004, "$VolumeName"); $ENV{"LANG"}="C"; exit 0; } $ENV{"LANG"}="$lfiler->{LANG}"; VCSAG_LOG_MSG("I", "Migrate succeeded. Volume $VolumeName is write enabled", 2008, "$VolumeName"); $ENV{"LANG"}="C"; } else { # remote filer is down. attempt takeover. $ENV{"LANG"}="$lfiler->{LANG}"; VCSAG_LOG_MSG("N", "Remote filer $rflrname is down. Will attempt to takeover", 2009, "$rflrname"); $ENV{"LANG"}="C"; $ret = $lfiler->takeover($sm_info); if ($ret) { $ENV{"LANG"}="$USERLANG"; VCSAG_LOG_MSG("E", "Takeover failed for volume $sm_info->{DST_LOC}; administrative intervention required", 2005, "$sm_info->{DST_LOC}"); $ENV{"LANG"}="C"; exit 0; } $ENV{"LANG"}="$lfiler->{LANG}"; VCSAG_LOG_MSG("I", "Takeover succeeded. Volume $VolumeName is write enabled", 2010, "$VolumeName"); $ENV{"LANG"}="C"; } } else { $ENV{"LANG"}="$USERLANG"; VCSAG_LOG_MSG("E", "Volume $VolumeName is in an invalid state; administrative intervention required", 2006, "$VolumeName"); $ENV{"LANG"}="C"; exit 0; } $lfiler->create_lockfile(); exit 0;  k8\wܘC٘C٘C./opt/VRTSvcs/bin/NetAppSnapMirror/offlineapMir0# # START COPYRIGHT-NOTICE: 2005 # # Copyright 2005 VERITAS Software Corporation. # All rights reserved. # # VERITAS, VERITAS SOFTWARE, the VERITAS logo and all other VERITAS # product names and slogans are trademarks or registered trademarks # of VERITAS Software Corporation in the USA and/or other countries. # Other product names and/or slogans mentioned herein may be trade- # marks or registered trademarks of their respective companies. # # END COPYRIGHT-NOTICE. # eval 'exec $VCS_HOME/bin/perl5 -S $0 ${1+"$@"}' if 0; use lib '.'; use strict; use SnapMirrorAgent; my $vcs_home=$ENV{"VCS_HOME"} || "/opt/VRTSvcs"; # # Set the OS locale # my $USERLANG=$ENV{"LANG"}; $ENV{"LANG"}="C"; my ($ResName, $VolumeName, $SnapMirrorSchedule, $LocalFilerName, $LocalFilerPword, $RemoteFilerName, $RemoteFilerPword) = @ARGV; use ag_i18n_inc; VCSAG_SET_ENVS ($ResName, 20031); my $lfiler = SnapMirrorAgent->new($ResName, $LocalFilerName, $USERLANG); $lfiler->remove_lockfile(); exit 0; red klk\w٘C٘C٘C./opt/VRTSvcs/bin/NetAppSnapMirror/monitorapMir0# # START COPYRIGHT-NOTICE: 2005 # # Copyright 2005 VERITAS Software Corporation. # All rights reserved. # # VERITAS, VERITAS SOFTWARE, the VERITAS logo and all other VERITAS # product names and slogans are trademarks or registered trademarks # of VERITAS Software Corporation in the USA and/or other countries. # Other product names and/or slogans mentioned herein may be trade- # marks or registered trademarks of their respective companies. # # END COPYRIGHT-NOTICE. # eval 'exec $VCS_HOME/bin/perl5 -S $0 ${1+"$@"}' if 0; use lib '.'; use strict; use SnapMirrorAgent; my $vcs_home=$ENV{"VCS_HOME"} || "/opt/VRTSvcs"; # # Set the OS locale # my $USERLANG=$ENV{"LANG"}; $ENV{"LANG"}="C"; my ($ResName, $VolumeName, $SnapMirrorSchedule, $LocalFilerName, $LocalFilerPword, $RemoteFilerName, $RemoteFilerPword) = @ARGV; use ag_i18n_inc; VCSAG_SET_ENVS ($ResName, 20031); my $lfiler = SnapMirrorAgent->new($ResName, $LocalFilerName, $USERLANG); my $ret = $lfiler->check_lockfile(); exit $ret; r $ENV k \w٘C٘C٘C./opt/VRTSvcs/bin/NetAppSnapMirror/cleanrapMir0# # START COPYRIGHT-NOTICE: 2005 # # Copyright 2005 VERITAS Software Corporation. # All rights reserved. # # VERITAS, VERITAS SOFTWARE, the VERITAS logo and all other VERITAS # product names and slogans are trademarks or registered trademarks # of VERITAS Software Corporation in the USA and/or other countries. # Other product names and/or slogans mentioned herein may be trade- # marks or registered trademarks of their respective companies. # # END COPYRIGHT-NOTICE. # eval 'exec $VCS_HOME/bin/perl5 -S $0 ${1+"$@"}' if 0; use lib '.'; use strict; use SnapMirrorAgent; my $vcs_home=$ENV{"VCS_HOME"} || "/opt/VRTSvcs"; # # Set the OS locale # my $USERLANG=$ENV{"LANG"}; $ENV{"LANG"}="C"; my ($ResName, $WhyClean, $VolumeName, $SnapMirrorSchedule, $LocalFilerName, $LocalFilerPword, $RemoteFilerName, $RemoteFilerPword) = @ARGV; use ag_i18n_inc; VCSAG_SET_ENVS ($ResName, 20031); my $lfiler = SnapMirrorAgent->new($ResName, $LocalFilerName, $USERLANG); $lfiler->remove_lockfile(); exit 0;  k6\w ٘C٘C٘C ./opt/VRTSvcs/bin/NetAppSnapMirror/actions/updaterAgent0# # START COPYRIGHT-NOTICE: 2005 # # Copyright 2005 VERITAS Software Corporation. # All rights reserved. # # VERITAS, VERITAS SOFTWARE, the VERITAS logo and all other VERITAS # product names and slogans are trademarks or registered trademarks # of VERITAS Software Corporation in the USA and/or other countries. # Other product names and/or slogans mentioned herein may be trade- # marks or registered trademarks of their respective companies. # # END COPYRIGHT-NOTICE. # eval 'exec $VCS_HOME/bin/perl5 -S $0 ${1+"$@"}' if 0; # # SnapMirror updates the destination automatically based on the update # schedule specified in the /etc/snapmirror.conf. However, to run unscheduled # updates this 'update' action may be invoked on the NetAppSnapMirror resource # i.e. "hares -action update -sys " # use lib '..'; use strict; use SnapMirrorAgent; my $vcs_home=$ENV{"VCS_HOME"} || "/opt/VRTSvcs"; # # Set the OS locale # my $USERLANG=$ENV{"LANG"}; $ENV{"LANG"}="C"; my ($ResName, $VolumeName, $SnapMirrorSchedule, $LocalFilerName, $LocalFilerPword, $RemoteFilerName, $RemoteFilerPword) = @ARGV; my ($filer, $rfiler); use ag_i18n_inc; VCSAG_SET_ENVS ($ResName, 20031); my $lfiler = SnapMirrorAgent->new($ResName, $LocalFilerName, $USERLANG); # # Open connection to local filer # if ($lfiler->OpenConnection("root", $LocalFilerPword) != 0) { $ENV{"LANG"}="$USERLANG"; VCSAG_LOG_MSG("E", "Unable to connect to filer $LocalFilerName", 2002, "$LocalFilerName"); print ("Unable to connect to filer $LocalFilerName"); exit 1; } my $sm_info = $lfiler->get_state($VolumeName); my $dstloc = $sm_info->{DST_LOC}; my $srcloc = $sm_info->{SRC_LOC}; my ($dstflrname, $dstvolname) = split(/:/, $dstloc); my ($srcflrname, $srcvolname) = split(/:/, $srcloc); # # snapmirror update command can only be issued at the snapmirror destination # filer. Thus if local filer is not the destination, then we need to open # connection to remote filer and issue update command there # if ($dstloc =~ /$LocalFilerName:/) { # volume on local filer is the current destination $filer = $lfiler; } else { # # volume on remote filer is the current destination # open connection to remote filer # $rfiler = SnapMirrorAgent->new($ResName, $dstflrname, $lfiler->{LANG}); if ($rfiler->OpenConnection("root", $RemoteFilerPword) != 0) { $ENV{"LANG"}="$USERLANG"; VCSAG_LOG_MSG("E", "Unable to connect to filer $dstflrname", 2002, "$dstflrname"); print ("Unable to connect to filer $dstflrname"); exit 1; } $filer = $rfiler; } # # snapmirror update command can only be issued when the state is 'snapmirrored' # $sm_info = $filer->get_state($dstvolname); if ($sm_info->{STATE} ne "snapmirrored") { $ENV{"LANG"}="$lfiler->{LANG}"; VCSAG_LOG_MSG("E", "Failed to update snapmirror location $dstloc since it is in state $sm_info->{STATE}", 5001, "$dstloc", "$sm_info->{STATE}"); print ("Failed to update snapmirror location $dstloc since it is in state $sm_info->{STATE}"); exit 1; } # # issue 'snapmirror update' command # my $ret = $filer->SnapMirrorUpdate($dstloc, $srcloc, 0); if ($ret) { $ENV{"LANG"}="$lfiler->{LANG}"; VCSAG_LOG_MSG("E", "Failed to update snapmirror location $dstloc", 5002, "$dstloc"); print ("Failed to update snapmirror location $dstloc"); exit 1; } print ("Initiated snapmirror update for location $dstloc"); exit 0; ai k\wJ ژCژCژCJ ./opt/VRTSvcs/bin/NetAppSnapMirror/actions/reestablisht0# # START COPYRIGHT-NOTICE: 2005 # # Copyright 2005 VERITAS Software Corporation. # All rights reserved. # # VERITAS, VERITAS SOFTWARE, the VERITAS logo and all other VERITAS # product names and slogans are trademarks or registered trademarks # of VERITAS Software Corporation in the USA and/or other countries. # Other product names and/or slogans mentioned herein may be trade- # marks or registered trademarks of their respective companies. # # END COPYRIGHT-NOTICE. # eval 'exec $VCS_HOME/bin/perl5 -S $0 ${1+"$@"}' if 0; # # The reestablish action when applied to a destination volume which # has been broken-off will put the volume back into a SnapMirror # relationship and resynchronize its contents with the source # without repeating the initial transfer (i.e. snapmirror resync). # NOTE: This action will write-disable the destination volume. # use lib '..'; use strict; use SnapMirrorAgent; my $vcs_home=$ENV{"VCS_HOME"} || "/opt/VRTSvcs"; # # Set the OS locale # my $USERLANG=$ENV{"LANG"}; $ENV{"LANG"}="C"; my ($ResName, $VolumeName, $SnapMirrorSchedule, $LocalFilerName, $LocalFilerPword, $RemoteFilerName, $RemoteFilerPword) = @ARGV; my ($filer, $rfiler); use ag_i18n_inc; VCSAG_SET_ENVS ($ResName, 20031); my $lfiler = SnapMirrorAgent->new($ResName, $LocalFilerName, $USERLANG); # # Open connection to local filer # if ($lfiler->OpenConnection("root", $LocalFilerPword) != 0) { $ENV{"LANG"}="$USERLANG"; VCSAG_LOG_MSG("E", "Unable to connect to filer $LocalFilerName", 2002, "$LocalFilerName"); print ("Unable to connect to filer $LocalFilerName"); exit 1; } my $sm_info = $lfiler->get_state($VolumeName); my $dstloc = $sm_info->{DST_LOC}; my $srcloc = $sm_info->{SRC_LOC}; my ($dstflrname, $dstvolname) = split(/:/, $dstloc); my ($srcflrname, $srcvolname) = split(/:/, $srcloc); # # snapmirror resync command can only be issued at the snapmirror destination # filer. Thus if local filer is not the destination, then we need to open # connection to remote filer and issue resync command there # if ($dstloc =~ /$LocalFilerName:/) { # volume on local filer is the current destination $filer = $lfiler; } else { # # volume on remote filer is the current destination # open connection to remote filer # $rfiler = SnapMirrorAgent->new($ResName, $dstflrname, $lfiler->{LANG}); if ($rfiler->OpenConnection("root", $RemoteFilerPword) != 0) { $ENV{"LANG"}="$USERLANG"; VCSAG_LOG_MSG("E", "Unable to connect to filer $dstflrname", 2002, "$dstflrname"); print ("Unable to connect to filer $dstflrname"); exit 1; } $filer = $rfiler; } # # snapmirror resync command can only be issued when the state is 'broken-off' # $sm_info = $filer->get_state($dstvolname); if ($sm_info->{STATE} ne "broken-off") { $ENV{"LANG"}="$lfiler->{LANG}"; VCSAG_LOG_MSG("E", "Failed to resync snapmirror location $dstloc since it is in state $sm_info->{STATE}", 5020, "$dstloc", "$sm_info->{STATE}"); print ("Failed to resync snapmirror location $dstloc since it is in state $sm_info->{STATE}"); exit 1; } # # issue 'snapmirror resync' command # my $ret = $filer->SnapMirrorResync($dstloc, $srcloc); if ($ret) { $ENV{"LANG"}="$lfiler->{LANG}"; VCSAG_LOG_MSG("E", "Failed to resync snapmirror location $dstloc", 5021, "$dstloc"); print ("Failed to resync snapmirror location $dstloc"); exit 1; } print ("Initiated snapmirror resync for location $dstloc"); exit 0; strati ky \w#ژCژCژC#./opt/VRTSvcs/bin/NetAppSnapMirror/actions/swap0# # START COPYRIGHT-NOTICE: 2005 # # Copyright 2005 VERITAS Software Corporation. # All rights reserved. # # VERITAS, VERITAS SOFTWARE, the VERITAS logo and all other VERITAS # product names and slogans are trademarks or registered trademarks # of VERITAS Software Corporation in the USA and/or other countries. # Other product names and/or slogans mentioned herein may be trade- # marks or registered trademarks of their respective companies. # # END COPYRIGHT-NOTICE. # eval 'exec $VCS_HOME/bin/perl5 -S $0 ${1+"$@"}' if 0; # # The swap action will reverse the replication roles so as to make the # original source the new destination and vice versa. # The swap action is intended for use when the original source comes # back alive after an outage at the source location and the original # destination was broken-off in the meantime to takeover the applications # at the destination location. # In this situation the 'swap' action when invoked will resync changes # made to the broken-off destination, while original source was down, back # to the original source after making it the new destination. # use lib '..'; use strict; use SnapMirrorAgent; my $vcs_home=$ENV{"VCS_HOME"} || "/opt/VRTSvcs"; # # Set the OS locale # my $USERLANG=$ENV{"LANG"}; $ENV{"LANG"}="C"; my ($ResName, $VolumeName, $SnapMirrorSchedule, $LocalFilerName, $LocalFilerPword, $RemoteFilerName, $RemoteFilerPword) = @ARGV; my ($srcfiler, $dstfiler); use ag_i18n_inc; VCSAG_SET_ENVS ($ResName, 20031); my $lfiler = SnapMirrorAgent->new($ResName, $LocalFilerName, $USERLANG); # # Open connection to local filer # if ($lfiler->OpenConnection("root", $LocalFilerPword) != 0) { $ENV{"LANG"}="$USERLANG"; VCSAG_LOG_MSG("E", "Unable to connect to filer $LocalFilerName", 2002, "$LocalFilerName"); print ("Unable to connect to filer $LocalFilerName"); exit 1; } my $sm_info = $lfiler->get_state($VolumeName); my $dstloc = $sm_info->{DST_LOC}; my $srcloc = $sm_info->{SRC_LOC}; my ($dstflrname, $dstvolname) = split(/:/, $dstloc); my ($srcflrname, $srcvolname) = split(/:/, $srcloc); # # snapmirror swap_role subroutine is designed to be invoked on the original # destination filer. Thus if local filer is not the original destination, # then we need to invoke it on the remote filer object. # if ($dstloc =~ /$LocalFilerName:/) { # volume on local filer was the original destination $dstfiler = $lfiler; $srcfiler = SnapMirrorAgent->new($ResName, $srcflrname, $lfiler->{LANG}); # # Open connection to remote (source) filer # if ($srcfiler->OpenConnection("root", $RemoteFilerPword) != 0) { $ENV{"LANG"}="$USERLANG"; VCSAG_LOG_MSG("E", "Unable to connect to filer $srcflrname", 2002, "$srcflrname"); print ("Unable to connect to filer $srcflrname"); exit 1; } } else { # volume on remote filer was the original destination $srcfiler = $lfiler; $dstfiler = SnapMirrorAgent->new($ResName, $dstflrname, $lfiler->{LANG}); # # Open connection to remote (destination) filer # if ($dstfiler->OpenConnection("root", $RemoteFilerPword) != 0) { $ENV{"LANG"}="$USERLANG"; VCSAG_LOG_MSG("E", "Unable to connect to filer $dstflrname", 2002, "$dstflrname"); print ("Unable to connect to filer $dstflrname"); exit 1; } } # # 'swap' action is meant to be used only when the original destination is in # a 'broken-off' state. # $sm_info = $dstfiler->get_state($dstvolname); if ($sm_info->{STATE} ne "broken-off") { $ENV{"LANG"}="$lfiler->{LANG}"; VCSAG_LOG_MSG("E", "Failed to swap snapmirror roles since original destination location $dstloc is in state $sm_info->{STATE}", 5030, "$dstloc", "$sm_info->{STATE}"); print ("Failed to swap snapmirror roles since original destination location $dstloc is in state $sm_info->{STATE}"); exit 1; } my $ret = $dstfiler->swap_role($srcfiler, $dstloc, $srcloc, $SnapMirrorSchedule); if ($ret) { $ENV{"LANG"}="$lfiler->{LANG}"; VCSAG_LOG_MSG("E", "Failed to swap snapmirror roles for location $dstloc", 5031, "$dstloc"); print ("Failed to swap snapmirror roles for location $dstloc"); exit 1; } print ("snapmirror role swap for location $dstloc succeeded"); exit 0; # Cop kꔯ\w jژCژCژC j./opt/VRTSvcs/bin/NetAppSnapMirror/SnapMirrorAgent.pmt0# # START COPYRIGHT-NOTICE: 2005 # # Copyright 2005 VERITAS Software Corporation. # All rights reserved. # # VERITAS, VERITAS SOFTWARE, the VERITAS logo and all other VERITAS # product names and slogans are trademarks or registered trademarks # of VERITAS Software Corporation in the USA and/or other countries. # Other product names and/or slogans mentioned herein may be trade- # marks or registered trademarks of their respective companies. # # END COPYRIGHT-NOTICE. # package SnapMirrorAgent; use NaServer; use ArrayRep; @ISA = ("ArrayRep"); use strict; use ag_i18n_inc; my $vcs_home=$ENV{"VCS_HOME"} || "/opt/VRTSvcs"; sub new { my ($self, $resname, $filername, $lang) = @_; my $class = ref($self) || $self; my $filer = {}; $filer->{START_TIME} = $^T; $filer->{resname} = $resname; $filer->{LANG} = $lang; $filer->{FILER_NAME} = $filername; $filer->{SNAPMIRROR_ON} = "false"; return bless $filer, $class; } sub OpenConnection { my ($self, $user, $enc_pword) = @_; my $filername = $self->{FILER_NAME}; my $handle = NaServer->new($filername, 1, 1); $enc_pword =~s/^\s+//; $enc_pword =~s/\s+$//; # # if password is specified, use it to login as root on the filer # if not, use the hosts.equiv file on filer to determine access rights. # if ($enc_pword) { my $Pword = `$vcs_home/sbin/vcsdecrypt $enc_pword`; if ($? != 0) { VCSAG_LOG_MSG("W", "Encountered errors while decrypting password!", 1002); $Pword = ""; } $handle->set_admin_user($user, $Pword); } else { $handle->set_style("HOSTS"); } my $output = $handle->invoke("system-get-version"); if ($output->results_errno != 0) { my $r = $output->results_reason(); $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("E", "ONTAPI 'system-get-version' failed on filer $filername. Error $output->results_errno: $r", 1000, "$filername", "$output->results_errno", "$r"); $ENV{"LANG"}="C"; return 1; } my $version = $output->child_get_string( "version" ); $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOGDBG_MSG(1, "ONTAP version on filer $filername is: $version", "$filername", "$version"); $ENV{"LANG"}="C"; $self->{FILER_HANDLE} = $handle; return 0; } sub SnapMirrorGetInfo { my ($self, $location) = @_; my $filername = $self->{FILER_NAME}; my $handle = $self->{FILER_HANDLE}; my $output = $handle->invoke("snapmirror-get-status", "location", $location); if ($output->results_errno != 0) { my $r = $output->results_reason(); $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("E", "ONTAPI 'snapmirror-get-status' failed for volume $location on filer $filername. Error $output->results_errno: $r", 1001, "$location", "$filername", "$output->results_errno", "$r"); $ENV{"LANG"}="C"; return undef; } $self->{SNAPMIRROR_ON} = $output->child_get_string("is-available"); # get snapmirror status my $statuslist = $output->child_get("snapmirror-status"); if (!defined($statuslist) || ($statuslist eq "")) { # no snapmirror status to report $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("E", "Volume $location on filer $filername is not a snapmirror replicated volume", 1002, "$location", "$filername"); $ENV{"LANG"}="C"; return undef; } # iterate through snapmirror status info list. # NOTE: THIS AGENT CURRENTLY SUPPORTS ONLY ONE DESTINATION PER # SOURCE VOLUME my @infolist = $statuslist->children_get(); my @sminfolist = (); foreach my $sm_info (@infolist) { my $info = {}; $info->{SRC_LOC} = $sm_info->child_get_string("source-location"); ($info->{SRC_FLR}, $info->{SRC_VOL}) = split(/:/, $info->{SRC_LOC}); $info->{DST_LOC} = $sm_info->child_get_string("destination-location"); ($info->{DST_FLR}, $info->{DST_VOL}) = split(/:/, $info->{DST_LOC}); $info->{STATE} = $sm_info->child_get_string("state"); $info->{STATUS} = $sm_info->child_get_string("status"); $info->{BASE_SNAP} = $sm_info->child_get_string("base-snapshot"); $info->{PROGRESS} = $sm_info->child_get_int("transfer-progress", 0); $info->{LAG} = $sm_info->child_get_int("lag-time", 0); push(@sminfolist, $info); $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOGDBG_MSG(4, "Snapmirror info for volume $location on filer $filername: Source Location = $info->{SRC_LOC}, Destination Location = $info->{DST_LOC}, State = $info->{STATE}, Status = $info->{STATUS}, Base Snapshot = $info->{BASE_SNAP}, Progress = $info->{PROGRESS}, Lag = $info->{LAG}", "$location", "$filername", "$info->{SRC_LOC}", "$info->{DST_LOC}", "$info->{STATE}", "$info->{STATUS}", "$info->{BASE_SNAP}", "$info->{PROGRESS}", "$info->{LAG}"); $ENV{"LANG"}="C"; } #$self->{SNAPMIRROR_INFO} = \@sminfolist; #foreach my $sm_info (@{$self->{SNAPMIRROR_INFO}}) { # for my $info (keys %{$sm_info}) { # print "$info = $sm_info->{$info}\n"; # } #} return (@sminfolist); } sub SnapMirrorUpdate { my ($self, $dstloc, $srcloc, $wait) = @_; my $filername = $self->{FILER_NAME}; my $handle = $self->{FILER_HANDLE}; # wait for snapmirror status to be "idle" my $ret = $self->WaitForIdle($dstloc); if ($ret) { $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("E", "Error while waiting for snapmirror status of volume $dstloc to become 'idle' on filer $filername", 1004, "$dstloc", "$filername"); $ENV{"LANG"}="C"; return 1; } my $output = $handle->invoke("snapmirror-update", "destination-location", $dstloc, "source-location", $srcloc); if ($output->results_errno != 0) { my $r = $output->results_reason(); $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("E", "ONTAPI 'snapmirror-update' failed for volume $dstloc on filer $filername. Error $output->results_errno: $r", 1037, "$dstloc", "$filername", "$output->results_errno", "$r"); $ENV{"LANG"}="C"; return 1; } $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("N", "snapmirror update initiated for volume $dstloc", 1028, "$dstloc"); $ENV{"LANG"}="C"; return 0 unless ($wait); # wait for update to complete or (TBD: timeout) $ret = $self->WaitForIdle($dstloc); if ($ret) { $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("E", "Error while waiting for snapmirror update of volume $dstloc to complete on filer $filername", 1005, "$dstloc", "$filername"); $ENV{"LANG"}="C"; return 1; } return 0; } # # Breaks a snapmirrored relationship on this filer for specified volume. # Also queries status afterward to see if the volume was successfully # broken-off # sub SnapMirrorBreak { my ($self, $dstloc) = @_; my $filername = $self->{FILER_NAME}; my $handle = $self->{FILER_HANDLE}; # # wait for status to become idle or (TBD: timeout) # my $ret = $self->WaitForIdle($dstloc); if ($ret) { $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("E", "Error while waiting for snapmirror status of volume $dstloc to become 'idle' on filer $filername", 1004, "$dstloc", "$filername"); $ENV{"LANG"}="C"; return 1; } $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("N", "Attempting to break snapmirror location $dstloc", 1023, "$dstloc"); $ENV{"LANG"}="C"; my $output = $handle->invoke("snapmirror-break", "destination-location", $dstloc); if ($output->results_errno != 0) { my $r = $output->results_reason(); $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("E", "ONTAPI 'snapmirror-break' failed for volume $dstloc on filer $filername. Error $output->results_errno: $r", 1006, "$dstloc", "$filername", "$output->results_errno", "$r"); $ENV{"LANG"}="C"; return 1; } # # check if volume was successfully broken-off # my @sminfolist = $self->SnapMirrorGetInfo($dstloc); return 1 if (!@sminfolist); # # we expect to see only one entry in the snapmirror infolist. # this agent does not support multiple snapmirror destinations # for the same source volume # if (scalar(@sminfolist) != 1) { $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("E", "Multiple snapmirror destinations for a volume is not supported by this agent. 'snapmirror status' for volume $dstloc on filer $filername returned multiple status entries. Administrative intervention required", 1003, "$dstloc", "$filername"); $ENV{"LANG"}="C"; return 1; } my $sm_info = $sminfolist[0]; if ($sm_info->{STATE} ne "broken-off") { $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("E", "snapmirror-break failed to break snapmirror relationship for destination location $dstloc at filer $filername", 1007, "$dstloc", "$filername"); $ENV{"LANG"}="C"; return 1; } $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("I", "snapmirrored location $dstloc has been successfully broken-off", 1030, "$dstloc"); $ENV{"LANG"}="C"; return 0; } # # Checks for schedule information on this filer for specified volume. # Return 0 if schedule does not exists, 100 if exists. # sub SnapMirrorGetSchedule { my ($self, $dstloc) = @_; my $filername = $self->{FILER_NAME}; my $handle = $self->{FILER_HANDLE}; my $output = $handle->invoke("snapmirror-list-schedule", "destination-location", $dstloc); if ($output->results_errno != 0) { my $r = $output->results_reason(); $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("E", "ONTAPI 'snapmirror-list-schedule' failed for volume $dstloc on filer $filername. Error $output->results_errno: $r", 1008, "$dstloc", "$filername", "$output->results_errno", "$r"); $ENV{"LANG"}="C"; return 1; } my $schedlist = $output->child_get("snapmirror-schedules"); if (!defined($schedlist) || ($schedlist eq "")) { # no snapmirror schedule to report $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("N", "No snapmirror schedule exists for location $dstloc at filer $filername", 1009, "$dstloc", "$filername"); $ENV{"LANG"}="C"; return 1; } else { # # there should be only 1 schedule (if it exists) # my @schedules = $schedlist->children_get(); return 100 if (@schedules); } return 0; } sub SnapMirrorSetSchedule { my ($self, $dstloc, $srcloc, $sched) = @_; my $filername = $self->{FILER_NAME}; my $handle = $self->{FILER_HANDLE}; my ($minute, $hour, $dayofmonth, $dayofweek) = split(/\s+/, $sched); my $output = $handle->invoke("snapmirror-set-schedule", "days-of-month", $dayofmonth, "days-of-week", $dayofweek, "destination-location", $dstloc, "hours", $hour, "minutes", $minute, "source-location", $srcloc); if ($output->results_errno != 0) { my $r = $output->results_reason(); $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("E", "ONTAPI 'snapmirror-set-schedule' failed for destination location $dstloc at filer $filername. Error $output->results_errno: $r", 1010, "$dstloc", "$filername", "$output->results_errno", "$r"); $ENV{"LANG"}="C"; return 1; } $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("I", "snapmirror schedule set for location $dstloc", 1031, "$dstloc"); $ENV{"LANG"}="C"; return 0; } sub SnapMirrorDeleteSchedule { my ($self, $dstloc) = @_; my $filername = $self->{FILER_NAME}; my $handle = $self->{FILER_HANDLE}; my $output = $handle->invoke("snapmirror-delete-schedule", "destination-location", $dstloc); if ($output->results_errno != 0) { my $r = $output->results_reason(); $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("E", "ONTAPI 'snapmirror-delete-schedule' failed for destination location $dstloc at filer $filername. Error $output->results_errno: $r", 1011, "$dstloc", "$filername", "$output->results_errno", "$r"); $ENV{"LANG"}="C"; return 1; } $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("I", "snapmirror schedule deleted for location $dstloc", 1032, "$dstloc"); $ENV{"LANG"}="C"; return 0; } # # This routine intiates a snapmirror resync. It is up to the caller # to wait for resync to complete, if required. # sub SnapMirrorResync { my ($self, $dstloc, $srcloc) = @_; my $filername = $self->{FILER_NAME}; my $handle = $self->{FILER_HANDLE}; my $output = $handle->invoke("snapmirror-resync", "destination-location", $dstloc, "source-location", $srcloc); if ($output->results_errno != 0) { my $r = $output->results_reason(); $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("E", "ONTAPI 'snapmirror-resync' failed for destination location $dstloc, source location $srcloc at filer $filername. Error $output->results_errno: $r", 1012, "$dstloc", "$srcloc", "$filername", "$output->results_errno", "$r"); $ENV{"LANG"}="C"; return 1; } $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("N", "snapmirror resync initiated for destination location $dstloc", 1029, "$dstloc"); $ENV{"LANG"}="C"; return 0; } # # Release the previous snapmirror relationship on this filer. # i,e inform snapmirror on this filer (i.e. original source location) that a # direct mirror (i.e. original destination location) is no longer going to make # snapmirror requests. # sub SnapMirrorRelease { my ($self, $dstloc, $srcloc) = @_; my $filername = $self->{FILER_NAME}; my $handle = $self->{FILER_HANDLE}; my $output = $handle->invoke("snapmirror-release", "destination-location", $dstloc, "source-location", $srcloc); if ($output->results_errno != 0) { my $r = $output->results_reason(); $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("E", "ONTAPI 'snapmirror-release' failed for destination location $dstloc, source location $srcloc at filer $filername. Error $output->results_errno: $r", 1013, "$dstloc", "$srcloc", "$filername", "$output->results_errno", "$r"); $ENV{"LANG"}="C"; return 1; } $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("I", "snapmirror release succeeded for destination location $dstloc, source location $srcloc", 1034, "$dstloc", "$srcloc"); $ENV{"LANG"}="C"; return 0; } sub SnapshotDelete { my ($self, $volname, $ssname) = @_; my $filername = $self->{FILER_NAME}; my $handle = $self->{FILER_HANDLE}; my $output = $handle->invoke("snapshot-delete", "volume", $volname, "snapshot", $ssname); if ($output->results_errno != 0) { my $r = $output->results_reason(); $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("E", "ONTAPI 'snapshot-delete' failed for snapshot $ssname on volume $volname at filer $filername. Error $output->results_errno: $r", 1014, "$ssname", "$volname", "$filername", "$output->results_errno", "$r"); $ENV{"LANG"}="C"; return 1; } $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("I", "Base snapshot $ssname deleted for volume $volname at filer $filername", 1035, "$ssname", "$volname", "$filername"); $ENV{"LANG"}="C"; return 0; } # # This routine will wait in a tight loop for the snapmirror status # of the specified volume to become 'idle'. This is required because # certain snapmirror commands can only be issued when the status is # idle or else the command will fail. # sub WaitForIdle { my ($self, $location) = @_; my @sminfolist; my $filername = $self->{FILER_NAME}; my $handle = $self->{FILER_HANDLE}; # wait for snapmirror status to be "idle" while (1) { @sminfolist = $self->SnapMirrorGetInfo($location); return 1 if (!@sminfolist); # # we expect to see only one entry in the snapmirror infolist. # this agent does not support multiple snapmirror destinations # for the same source volume # if (scalar(@sminfolist) != 1) { $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("E", "Multiple snapmirror destinations for a volume is not supported by this agent. 'snapmirror status' for volume $location on filer $filername returned multiple status entries. Administrative intervention required", 1003, "$location", "$filername"); $ENV{"LANG"}="C"; return 1; } my $sm_info = $sminfolist[0]; last if ($sm_info->{STATUS} eq "idle"); undef(@sminfolist); # sleep 5 seconds before checking again sleep 5; } return 0; } sub get_state { my ($self, $location) = @_; my $filername = $self->{FILER_NAME}; my @sminfolist = $self->SnapMirrorGetInfo($location); return undef if (!@sminfolist); # # we expect to see only one entry in the snapmirror infolist. # this agent does not support multiple snapmirror destinations # for the same source volume # if (scalar(@sminfolist) > 1) { $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("E", "Multiple snapmirror destinations for a volume is not supported by this agent. 'snapmirror status' for volume $location on filer $filername returned multiple status entries. Administrative intervention required", 1003, "$location", "$filername"); $ENV{"LANG"}="C"; return undef; } return $sminfolist[0]; } sub failover_required { my ($self, $sm_info) = @_; return 0 if (($sm_info->{STATE} eq "source") || ($sm_info->{STATE} eq "broken-off")); return 1 if ($sm_info->{STATE} eq "snapmirrored"); return -1; } sub failover_time { } sub takeover { my ($self, $sm_info) = @_; my $filername = $self->{FILER_NAME}; my $dstloc = $sm_info->{DST_LOC}; # # check if snapmirror state is 'snapmirrored' # my @sminfolist = $self->SnapMirrorGetInfo($dstloc); return 1 if (!@sminfolist); # # we expect to see only one entry in the snapmirror infolist. # this agent does not support multiple snapmirror destinations # for the same source volume # if (scalar(@sminfolist) != 1) { $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("I", "Multiple snapmirror destinations for a volume is not supported by this agent. 'snapmirror status' for volume $dstloc on filer $filername returned multiple status entries. Administrative intervention required", 1003, "$dstloc", "$filername"); $ENV{"LANG"}="C"; return 1; } my $new_sm_info = $sminfolist[0]; return 0 if ($new_sm_info->{STATE} eq "broken-off"); if ($new_sm_info->{STATE} ne "snapmirrored") { $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("E", "Volume $dstloc is in state $new_sm_info->{STATE}", 1021, "$dstloc", "$new_sm_info->{STATE}"); $ENV{"LANG"}="C"; return 1; } my $ret = $self->SnapMirrorBreak($dstloc); if ($ret) { $ENV{"LANG"}="$self->{LANG}"; VCSAG_LOG_MSG("E", "Failed to delete snapmirrror schedule for location $dstloc on filer $filername", 1015, "$dstloc", "$filername"); $ENV{"LANG"}="C"; return 1; } # # if schedule exists on local filer, delete it. # SnapMirrorGetSchedule() return 100 if schedule exists and # 0 if schedule does not exist for specified location. # #my $sched_exist = $self->SnapMirrorGetSchedule($dstloc); #if ($sched_exists == 100) { # $ret = $self->SnapMirrorDeleteSchedule($dstloc); # return 1 if ($ret); #} elsif ($sched_exists == 1) { # # log error # return 1; #} return 0; } sub failback { } sub migrate { my ($lfiler, $rfiler, $sm_info, $schedule) = @_; # # volume on lfiler filer is the current destination (to be made source) # volume on remote filer is the current source (to be made destination) # my $dstloc = $sm_info->{DST_LOC}; my $srcloc = $sm_info->{SRC_LOC}; my ($rflrname, $rvolname) = split(/:/, $srcloc); my ($lflrname, $lvolname) = split(/:/, $dstloc); my $ret = $lfiler->SnapMirrorUpdate($dstloc, $srcloc, 1); if ($ret) { $ENV{"LANG"}="$lfiler->{LANG}"; VCSAG_LOG_MSG("E", "Failed to update snapmirror location $dstloc on filer $lflrname", 1020, "$dstloc", "$lflrname"); $ENV{"LANG"}="C"; return 1; } $ret = $lfiler->SnapMirrorBreak($dstloc); if ($ret) { $ENV{"LANG"}="$lfiler->{LANG}"; VCSAG_LOG_MSG("E", "Failed to break destination location $dstloc on filer $lflrname", 1021, "$dstloc", "$lflrname"); $ENV{"LANG"}="C"; return 1; } # # delete schedule on local filer, if it exists # my $sched_exists = $lfiler->SnapMirrorGetSchedule($dstloc); if ($sched_exists == 100) { $ret = $lfiler->SnapMirrorDeleteSchedule($dstloc); if ($ret) { $ENV{"LANG"}="$lfiler->{LANG}"; VCSAG_LOG_MSG("E", "Failed to delete snapmirror schedule for location $dstloc on filer $lflrname", 1022, "$dstloc", "$lflrname"); $ENV{"LANG"}="C"; return 1; } } # # Add new schedule on remote filer. # What used to be the source is now going to be made a destination # $ret = $rfiler->SnapMirrorSetSchedule($srcloc, $dstloc, $schedule); if ($ret) { $ENV{"LANG"}="$lfiler->{LANG}"; VCSAG_LOG_MSG("E", "Failed to set snapmirror schedule for new destination location $srcloc on filer $rflrname", 1024, "$srcloc", "$rflrname"); $ENV{"LANG"}="C"; return 1; } # # Resync new destination (i.e remote filer) with new # source (i.e local filer) # $ret = $rfiler->SnapMirrorResync($srcloc, $dstloc); if ($ret) { $ENV{"LANG"}="$lfiler->{LANG}"; VCSAG_LOG_MSG("E", "Failed to resync new destination location $srcloc on filer $rflrname", 1024, "$srcloc", "$rflrname"); $ENV{"LANG"}="C"; return 1; } # # wait for resync to complete # my $done = 0; while (!$done) { my @sminfolist = $rfiler->SnapMirrorGetInfo($srcloc); return 1 if (!@sminfolist); # # find the right snapmirror-info entry in the infolist and # wait till Status goes to Idle (there should ideally be only # 2 entries in the list) # TBD: we need to consider situations where status goes to # something other that 'idle' after a resync is initiated. # foreach my $sm_info (@sminfolist) { next if ($sm_info->{DST_LOC} ne $srcloc); if ($sm_info->{STATUS} eq "idle") { $done = 1; } else { sleep 5; $ENV{"LANG"}="$lfiler->{LANG}"; VCSAG_LOG_MSG("N", "Waiting for snapmirror resync to destination location $srcloc on filer $rflrname to complete", 1025, "$srcloc", "$rflrname"); $ENV{"LANG"}="C"; } last; } } # # Find and delete base-snapshot from local filer (i.e original dest) # my @sminfolist = $lfiler->SnapMirrorGetInfo($dstloc); return 1 if (!@sminfolist); # # find the right snapmirror-info entry in the infolist and get the # base snapshot name (there should ideally be only 2 entries in the # list). # This extra processing is required to work around the problematic # status output from 'snapmirror-get-status' after a resync is issued # to reverse direction of snapmirror replication. # $done = 0; foreach my $sm_info (@sminfolist) { if ($sm_info->{DST_LOC} eq $dstloc) { $ret = $lfiler->SnapshotDelete($lvolname, $sm_info->{BASE_SNAP}); if ($ret) { $ENV{"LANG"}="$lfiler->{LANG}"; VCSAG_LOG_MSG("E", "Failed to delete base snapshot $sm_info->{BASE_SNAP} for volume $lvolname on filer $lflrname", 1033, "$sm_info->{BASE_SNAP}", "$lvolname", "$lflrname"); $ENV{"LANG"}="C"; return 1; } $done = 1; last; } } if (!$done) { $ENV{"LANG"}="$lfiler->{LANG}"; VCSAG_LOG_MSG("E", "Failed to find base snapshot for volume $lvolname on filer $lflrname", 1026, "$lvolname", "$lflrname"); $ENV{"LANG"}="C"; return 1; } # # Release previous snapmirror relationship at # remote filer (i.e. original source) # $ret = $rfiler->SnapMirrorRelease($dstloc, $srcloc); if ($ret) { $ENV{"LANG"}="$lfiler->{LANG}"; VCSAG_LOG_MSG("E", "Failed to release previous snapmirror relationship between original source location $srcloc and original destination location $dstloc on filer $rflrname", 1027, "$srcloc", "$dstloc", "$rflrname"); $ENV{"LANG"}="C"; return 1; } return 0; } sub swap_role { my ($org_dstfiler, $org_srcfiler, $org_dstloc, $org_srcloc, $schedule) = @_; my $ret; # # volume on org_dstfiler filer is to be made the new source # volume on org_srcfiler filer is to be made the new destination # my ($org_srcflrname, $org_srcvol) = split(/:/, $org_srcloc); my ($org_dstflrname, $org_dstvol) = split(/:/, $org_dstloc); # # delete schedule on original destination filer, if it exists # my $sched_exists = $org_dstfiler->SnapMirrorGetSchedule($org_dstloc); if ($sched_exists == 100) { $ret = $org_dstfiler->SnapMirrorDeleteSchedule($org_dstloc); if ($ret) { $ENV{"LANG"}="$org_dstfiler->{LANG}"; VCSAG_LOG_MSG("E", "Failed to delete snapmirror schedule for location $org_dstloc on filer $org_dstflrname", 1022, "$org_dstloc", "$org_dstflrname"); $ENV{"LANG"}="C"; return 1; } } # # Add new schedule on new destination filer. # What used to be the source is now going to be made a destination # $ret = $org_srcfiler->SnapMirrorSetSchedule($org_srcloc, $org_dstloc, $schedule); if ($ret) { $ENV{"LANG"}="$org_dstfiler->{LANG}"; VCSAG_LOG_MSG("E", "Failed to set snapmirror schedule for new destination location $org_srcloc on filer $org_srcflrname", 1024, "$org_srcloc", "$org_srcflrname"); $ENV{"LANG"}="C"; return 1; } # # Resync new destination with new source # $ret = $org_srcfiler->SnapMirrorResync($org_srcloc, $org_dstloc); if ($ret) { $ENV{"LANG"}="$org_dstfiler->{LANG}"; VCSAG_LOG_MSG("E", "Failed to resync new destination location $org_srcloc on filer $org_srcflrname", 1024, "$org_srcloc", "$org_srcflrname"); $ENV{"LANG"}="C"; return 1; } # # wait for resync to complete # my $done = 0; while (!$done) { my @sminfolist = $org_srcfiler->SnapMirrorGetInfo($org_srcloc); return 1 if (!@sminfolist); # # find the right snapmirror-info entry in the infolist and # wait till Status goes to Idle (there should ideally be only # 2 entries in the list) # TBD: we need to consider situations where status goes to # something other that 'idle' after a resync is initiated. # foreach my $sm_info (@sminfolist) { next if ($sm_info->{DST_LOC} ne $org_srcloc); if ($sm_info->{STATUS} eq "idle") { $done = 1; } else { sleep 5; $ENV{"LANG"}="$org_dstfiler->{LANG}"; VCSAG_LOG_MSG("N", "Waiting for snapmirror resync to destination location $org_srcloc on filer $org_srcflrname to complete", 1025, "$org_srcloc", "$org_srcflrname"); $ENV{"LANG"}="C"; } last; } } # # Find and delete base-snapshot from original destination filer # my @sminfolist = $org_dstfiler->SnapMirrorGetInfo($org_dstloc); return 1 if (!@sminfolist); # # find the right snapmirror-info entry in the infolist and get the # base snapshot name (there should ideally be only 2 entries in the # list). # This extra processing is required to work around the problematic # status output from 'snapmirror-get-status' after a resync is issued # to reverse direction of snapmirror replication. # $done = 0; foreach my $sm_info (@sminfolist) { if ($sm_info->{DST_LOC} eq $org_dstloc) { $ret = $org_dstfiler->SnapshotDelete($org_dstvol, $sm_info->{BASE_SNAP}); if ($ret) { $ENV{"LANG"}="$org_dstfiler->{LANG}"; VCSAG_LOG_MSG("E", "Failed to delete base snapshot $sm_info->{BASE_SNAP} for volume $org_dstvol on filer $org_dstflrname", 1033, "$sm_info->{BASE_SNAP}", "$org_dstvol", "$org_dstflrname"); $ENV{"LANG"}="C"; return 1; } $done = 1; last; } } if (!$done) { $ENV{"LANG"}="$org_dstfiler->{LANG}"; VCSAG_LOG_MSG("E", "Failed to find base snapshot for volume $org_dstvol on filer $org_dstflrname", 1026, "$org_dstvol", "$org_dstflrname"); $ENV{"LANG"}="C"; return 1; } # # Release previous snapmirror relationship at original source filer # $ret = $org_srcfiler->SnapMirrorRelease($org_dstloc, $org_srcloc); if ($ret) { $ENV{"LANG"}="$org_dstfiler->{LANG}"; VCSAG_LOG_MSG("E", "Failed to release previous snapmirror relationship between original source location $org_srcloc and original destination location $org_dstloc on filer $org_srcflrname", 1027, "$org_srcloc", "$org_dstloc", "$org_srcflrname"); $ENV{"LANG"}="C"; return 1; } return 0; } 1;  kZk\wژCژCژC./opt/VRTSvcs/bin/NetAppSnapMirror/NetAppSnapMirror.xml0 This agent determines the current role of the filer volumes with respect to replication and promotes a read-only target to a read-write source during a wide-area failover. AIX Script 4.0 VERITAS Yes Specifies the name of the replicated volume on the filer. Use same case for the volume name as on the filer since this attribute value is case sensitive Specifies the schedule the destination uses for updating data. This attribute should be left empty when used with NetApp SnapManager. Specifies the DNS resolvable name of the local NetApp filer A valid encrypted password for the root user on the local filer. Enter a valid clear text password which will get encrypted by the GUI and sent to the VCS engine. If left empty, the agent will use the hosts.equiv file on filer to determine access rights. Specifies the DNS resolvable name of the remote NetApp filer A valid encrypted password for the root user on the remote filer. Enter a valid clear text password which will get encrypted by the GUI and sent to the VCS engine. If left empty, the agent will use the hosts.equiv file on filer to determine access rights.  kL\wژCژCژC./usr/lpp/VRTSvcsna.rte/inst_root/etc/VRTSvcs/conf/NetAppSnapMirrorTypes.cf0type NetAppSnapMirror ( static int ActionTimeout = 120 static keylist SupportedActions = { update, reestablish, swap } static int MonitorInterval = 300 static int NumThreads = 1 static str ArgList[] = { VolumeName, SnapMirrorSchedule, LocalFilerName, LocalFilerPword, RemoteFilerName, RemoteFilerPword } str VolumeName str SnapMirrorSchedule str LocalFilerName str LocalFilerPword str RemoteFilerName str RemoteFilerPword ) $name, content => "" }; if ( defined($cont) ) { $self->{content} = $cont; } $self->{children} = []; $self->{attrkeys} = []; $self->{attrvals} = []; bless $self, $class; return $self; } #============================================================# =head2 results_status() Indicates success or failure of API call. Returns either "passed" or "failed". =cut sub results_status { my $self = shift; my $r = $self->attr_get("status"); if ( $r eq "passed" ) { return "passed"; } else { return "failed"; } } #============================================================# =head2 results_reason() Human-readable string describing a failure. Only present if results_status does not return "passed'. =cut sub results_reason { my $self = shift; my $r = $self->attr_get("status"); if ( $r eq "passed" ) { return undef; } $r = $self->attr_get("reason"); if ( ! $r ) { return "No reason given"; } return $r; } #============================================================# =head2 results_errno() Returns an error number, 0 on success. =cut sub results_errno { my $self = shift; my $r = $self->attr_get("status"); if ( $r eq "passed" ) { return 0; } $r = $self->attr_get("errno"); if (! defined($r)) { $r = -1; } return $r; } #============================================================# =head2 child_get($name) Get a named child of an element, which is also an element. Elements can be nested arbitrarily, so the element you get with this could also have other children. The return is either an NaElement named $name, or undef if none is found. =cut sub child_get ($) { my $self = shift; my $nm = shift; my $arr = $self->{children}; for ( my $i=0; $i <= $#$arr; $i++ ) { if ( $nm eq $arr->[$i]->{name} ) { return($arr->[$i]); } } return undef; } #============================================================# =head2 set_content($content) Set the element's value to $content. This is not needed in normal development. =cut sub set_content ($) { my $self = shift; my $data = shift; $self->{content} .= $data; } #============================================================# =head2 has_children() Returns "true" if the element has any children, "false" otherwise. =cut sub has_children { my $self = shift; my $arr = $self->{children}; return($#$arr > 0); } #============================================================# =head2 child_add($elt) Add the element $elt to the children list of the current object, which is also an element. =cut sub child_add ($) { my $self = shift; my $toadd = shift; my $arr = $self->{children}; push(@$arr,$toadd); $self->{children} = $arr; } #============================================================# =head2 child_add_string($name, $value) Construct an element with name $name and contents $value, and add it to the current object, which is also an element. =cut sub child_add_string($$) { my $self = shift; my $name = shift; my $value = shift; my $elt = new NaElement($name, $value); $self->child_add($elt); } #============================================================# =head2 child_get_string($name) Gets the child named $name from the current object and returns its value. If no child named $name is found, returns undef. =cut sub child_get_string ($) { my $self = shift; my $name = shift; my $elts = $self->{children}; foreach my $elt (@$elts) { if ($name eq $elt->{name}) { return $elt->{content}; } } return undef; } #============================================================# =head2 child_get_int($name) Gets the child named $name from the current object and returns its value as an integer. If no child named $name is found, returns undef. =cut sub child_get_int ($) { my $self = shift; return $self->child_get_string(shift); } #============================================================# =head2 children_get() Returns the list of children as an array. =cut sub children_get { my $self = shift; my $elts = $self->{children}; return (@$elts); } #============================================================# =head2 sprintf() Sprintf pretty-prints the element and its children, recursively, in XML-ish format. This is of use mainly in exploratory and utility programs. Use child_get_string() to dig values out of a top-level element's children. =cut sub sprintf { my $self = shift; my $indent = shift; my $name = $self->{name}; if (! defined($indent)) { $indent = ""; } my $s = "$indent<$name"; my $keys = $self->{attrkeys}; my $vals = $self->{attrvals}; for ( my $i=0; $i <= $#$keys; $i++ ) { $s .= " ".$keys->[$i]."=\"".$vals->[$i]."\""; } $s .= ">"; my $i; my $children = $self->{children}; if ($#$children >= 0) { $s .= "\n"; } for ( $i=0; $i <= $#$children; $i++ ) { my $c = $children->[$i]; if ( ref($c) ne "NaElement" ) { die "Unexpected reference found, expected NaElement not ref($c).\n"; } $s .= $c->sprintf("$indent\t"); } $s .= $self->{content}; if ($#$children >= 0) { $s .= "$indent"; } $s .= "\n"; return $s; } #============================================================# =head2 child_add_string_encrypted($name, $value, $key) Same as child_add_string, but encrypts $value with $key before adding the element to the current object. This is only used at present for certain key exchange operations. Both client and server must know the value of $key and agree to use this routine and its companion, child_get_string_encrypted(). =cut sub child_add_string_encrypted($$$) { my $self = shift; my $name = shift; my $value = shift; my $key = shift; if ($#$key != 16) { # # should we return an error or just patch it up? # $key = $key . "abracadabradubya"; $key = substr($key, 0, 16); } my $encrypted_value = RC4($key, $value); $self->child_add_string($name, $encrypted_value); } #============================================================# =head2 child_get_string_encrypted($name, $key) Get the value of child $name, and decrypt it with $key before returning it. =cut sub child_get_string_encrypted($$) { my $self = shift; my $name = shift; my $key = shift; if ($#$key != 16) { # # should we return an error or just patch it up? # $key = $key . "abracadabradubya"; $key = substr($key, 0, 16); } my $value = $self->child_get($name); my $plaintext = RC4($key, $value); return ($plaintext); } #------------------------------------------------------------# # # routines beyond this point are "private" # #------------------------------------------------------------# my $MAX_CHUNK_SIZE = 256; sub RC4($$) { my $item; my( @box, $x, $y ); @box = prepare_key( shift ); $x = $y = 0; my $plaintext = shift; my $num_pieces = do { my $num = length($plaintext) / $MAX_CHUNK_SIZE; my $int = int $num; $int == $num ? $int : $int+1; }; for my $piece ( 0..$num_pieces - 1 ) { my @plaintext = unpack "C*", substr($plaintext, $piece * $MAX_CHUNK_SIZE, $MAX_CHUNK_SIZE); for ( @plaintext ) { $x = 0 if ++$x > 255; $y -= 256 if ($y += $box[$x]) > 255; @box[$x, $y] = @box[$y, $x]; $_ ^= $box[( $box[$x] + $box[$y] ) % 256]; } substr($plaintext, $piece * $MAX_CHUNK_SIZE, $MAX_CHUNK_SIZE) = pack "C*", @plaintext; } if ($item) { $item->{box} = \@box; $item->{x} = $x; $item->{y} = $y; } $plaintext; } sub prepare_key { my @k = unpack( 'C*', shift ); my @box = 0..255; my $y = 0; for my $x (0..255) { $y = ( $k[$x % @k] + $box[$x] + $y ) % 256; @box[$x, $y] = @box[$y, $x]; } wantarray ? @box : \@box; } sub attr_set ($$) { my $self = shift; my $key = shift; my $val = shift; my $arr = $self->{attrkeys}; push(@$arr,$key); $self->{attrkeys} = $arr; $arr = $self->{attrvals}; push(@$arr,$val); $self->{attrvals} = $arr; } sub attr_get ($) { my $self = shift; my $key = shift; my $keys = $self->{attrkeys}; my $vals = $self->{attrvals}; for ( my $i=0; $i <= $#$keys; $i++ ) { if ( $keys->[$i] eq $key ) { return $vals->[$i]; } } return undef; } =head1 COPYRIGHT Copyright 2002-2003 Network Appliance, Inc. All rights reserved. Specifications subject to change without notice. This SDK sample code is provided AS IS, with no support or warranties of any kind, including but not limited to warranties of merchantability or fitness of any kind, expressed or implied. This code is subject to the license agreement that accompanies the SDK. =cut  kP\w9ژCژCژC9./opt/VRTSperl/lib/site_perl/NaServer.pmvcs/co0#============================================================# # # # $ID:$ # # # # NaServer.pm # # # # Client-side interface to ONTAPI APIs # # # # Copyright 2002-2003 Network Appliance, Inc. All rights # # reserved. Specifications subject to change without notice. # # # # This SDK sample code is provided AS IS, with no support or # # warranties of any kind, including but not limited to # # warranties of merchantability or fitness of any kind, # # expressed or implied. This code is subject to the license # # agreement that accompanies the SDK. # # # # tab size = 8 # # # #============================================================# package NaServer; $VERSION = '1.0'; # work with all versions use Socket; use LWP::UserAgent; use XML::Parser; use NaElement; # use vars ('@ISA', '@EXPORT'); # use Exporter; # @ISA = qw(Exporter); # @EXPORT = qw(invoke); # @EXPORT = qw(invoke_elem); #============================================================# =head1 NAME NaServer - class for managing Network Appliance(r) filers using ONTAPI(tm) APIs. =cut =head1 DESCRIPTION An NaServer encapsulates an administrative connection to a NetApp filer running ONTAP 6.4 or later. You construct NaElement objects that represent queries or commands, and use invoke_elem() to send them to the filer (a convenience routine called invoke() can be used to bypass the element construction step. The return from the call is another NaElement which either has children containing the command results, or an error indication. The following routines are available for setting up administrative connections to a filer. =cut #============================================================# use strict; $::ZAPI_xmlns = "http://www.netapp.com/filer/admin"; $::ZAPI_dtd = "file:/etc/netapp_filer.dtd"; $::ZAPI_snoop = 0; #============================================================# =head2 new($filer, $majorversion, $minorversion) Create a new connection to filer $filer. Before use, you either need to set the style to "hosts.equiv" or set the username (always "root" at present) and password with set_admin_user(). =cut sub new { my ($class) = shift; my ($server) = shift; my ($major_version) = shift; my ($minor_version) = shift; my ($user) = "root"; my ($password) = ""; my ($style) = "LOGIN"; # LOGIN or HOSTS my $self = { server => $server, user => $user, password => $password, style => $style, major_version => $major_version, minor_version => $minor_version, }; bless $self, $class; $self->set_server_type("FILER"); $self->set_transport_type("HTTP"); return $self; } #============================================================# =head2 set_style($style) Pass in "LOGIN" to cause the server to use HTTP simple authentication with a username and password. Pass in "HOSTS" to use the hosts.equiv file on the filer to determine access rights (the username must be root in that case). =cut sub set_style ($) { my $self = shift; my $style = $self->{style}; if ($style ne "HOSTS" && $style ne "LOGIN") { return $self->fail_response(13001, "in NaServer::set_style: bad style \"$style\""); } $self->{style} = shift; } #============================================================# =head2 get_style() Get the authentication style =cut sub get_style () { my $self = shift; return $self->{style}; } #============================================================# =head2 set_admin_user($user, $password) Set the admin username and password. At present $user must always be "root". =cut sub set_admin_user ($$) { my $self = shift; $self->{user} = shift; $self->{password} = shift; } #============================================================# =head2 set_server_type($type) Pass in one of these keywords: "FILER" or "NETCACHE" to indicate whether the server is a filer or a NetCache appliance. If you also use set_port(), call set_port() AFTER calling this routine. The default is "FILER". =cut # # Note that "AGENT" and "DFM" are also valid values. We # don't expose those to customers yet. # sub set_server_type ($$) { my $self = shift; my $type = shift; my $port = $self->{port}; if ($type !~ /^(Filer|NetCache|Agent|DFM)/i) { return $self->fail_response(13001, "in NaServer::set_server_type: bad type \"$type\""); } ($type =~ /Filer/i) && do { $self->{url} = "/servlets/netapp.servlets.admin.XMLrequest_filer"; $self->{port} = 80; }; ($type =~ /NetCache/i) && do { $self->{url} = "/servlets/netapp.servlets.admin.XMLrequest"; $self->{port} = 80; }; ($type =~ /Agent/i) && do { $self->{url} = "/apis/XMLrequest"; $self->{port} = 4092; }; ($type =~ /DFM/i) && do { $self->{url} = "/apis/XMLrequest"; $self->{port} = 8081; }; $self->{servertype} = $type; } #============================================================# =head2 get_server_type() Get the type of server this server connection applies to. =cut sub get_server_type () { my $self = shift; return $self->{servertype}; } #============================================================# =head2 set_transport_type($scheme) Override the default transport type. The only valid value is currently "HTTP". =cut sub set_transport_type ($$) { my $self = shift; my $scheme = shift; if ($scheme ne "HTTP") { return $self->fail_response(13001, "in NaServer::set_transport_type: bad type \"$scheme\""); } $self->{scheme} = $scheme; } #============================================================# =head2 get_transport_type() Retrieve the transport used for this connection. =cut sub get_transport_type () { my $self = shift; return $self->{scheme}; } #============================================================# =head2 set_port($port) Override the default port for this server. If you also call set_server_type(), you must call it before calling set_port(). =cut sub set_port ($$) { my $self = shift; my $port = shift; $self->{port} = $port; } #============================================================# =head2 get_port() Retrieve the port used for the remote server. =cut sub get_port () { my $self = shift; return $self->{port}; } #============================================================# =head2 invoke_elem($elt) Submit an XML request already encapsulated as an NaElement and return the result in another NaElement. =cut sub invoke_elem ($) { my $self = shift; my $req = shift; my $server = $self->{server}; my $user = $self->{user}; my $password = $self->{password}; my $xmlrequest = $req->sprintf(); # This is the filer url, in a form acceptable # to the method line of an HTTP transaction. my $url = $self->{url}; my($sockaddr); my($name,$aliases,$proto,$port,$type,$len,$thisaddr); my($thisport,$thatport); my($thataddr); # # Establish socket connection # $sockaddr = 'S n a4 x8'; ($name,$aliases,$proto)=getprotobyname('tcp'); ($name,$aliases,$type,$len,$thataddr)=gethostbyname($server); $thatport=pack($sockaddr, &AF_INET,$self->{port},$thataddr); if ( !socket(S, &PF_INET,&SOCK_STREAM,$proto) ) { return $self->fail_response(13001, "in Zapi::invoke, cannot create socket"); } # # If we are being asked to use a reserved port (we # are doing hosts.equiv authentication), then we search to # find an available port number below 1024. # if ( $self->get_style() eq "HOSTS" ) { my $lowport; for ($lowport=1023; $lowport > 0; $lowport--) { $thisport=pack($sockaddr, &AF_INET,$lowport); if (bind(S,$thisport)) { last; } } if ($lowport == 0) { return $self->fail_response(13001, "in Zapi::invoke, unable to bind " ."to reserved port, you must be " ."executing as root"); } } else { $thisport=pack($sockaddr, &AF_INET,0); if (!bind(S,$thisport)) { return $self->fail_response(13001, "in Zapi::invoke, unable to bind to port"); } } if ( ! connect(S,$thatport) ) { return $self->fail_response(13001, "in Zapi::invoke, cannot connect to socket"); } select(S); $| = 1; # Turn on autoflushing select(STDOUT); $| = 1; # Select STDOUT as default output # # Create an HTTP request. # my $request = HTTP::Request->new('POST',"$url"); $request->authorization_basic($user,$password); my $content = "" ."" ."" .$xmlrequest .""; $request->content($content); $request->content_length(length($content)); print S $request->method()." ".$request->uri()." HTTP/1.0\n"; print S $request->headers_as_string(); print S "\n"; print S $request->content(); my $xml = ""; my $response; # Inside this loop we will read the response line and all headers # found in the response. my $n; my $state = 0; # 1 means we're in headers, 2 means we're in content my ($key, $val); while () { my $line = $_; if ( !defined($line) ) { last; } if ( $state == 0 ) { if ($line =~ s/^(HTTP\/\d+\.\d+)[ \t]+(\d+)[ \t]*([^\012]*)\012//) { # HTTP/1.0 response or better my($ver,$code,$msg) = ($1, $2, $3); $msg =~ s/\015$//; $response = HTTP::Response->new($code, $msg); $response->protocol($ver); $state = 1; next; } else { return $self->fail_response(13001, "in Zapi::invoke, unable to parse " ."status response line - $line"); } } elsif ( $state == 1 ) { # ensure that we have read all headers. # The headers will be terminated by two blank lines if ( $line =~ /^\r*\n*$/ ) { $state = 2; } else { if ($line =~ /^([a-zA-Z0-9_\-.]+)\s*:\s*(.*)/) { $response->push_header($key, $val) if $key; ($key, $val) = ($1, $2); } elsif ($line =~ /^\s+(.*)/ && $key) { $val .= " $1"; } else { $response->push_header( "Client-Bad-Header-Line" => $line); } } } elsif ( $state == 2 ) { $xml .= $line; } else { return $self->fail_response(13001, "in Zapi::invoke, bad state value " ."while parsing response - $state\n"); } } if ( ! defined($response) ) { $self->{fail}->("No response received?"); $xml = ""; } my $code = $response->code(); if ( $code == 401 ) { return $self->fail_response(13002,"Authorization failed"); } return $self->parse_xml($xml,$xmlrequest); } #============================================================# =head2 invoke($api, [$argname, $argval] ...) A convenience routine which wraps invoke_elem(). It constructs an NaElement with name $api, and for each argument name/value pair, adds a child element to it. It's an error to have an even number of arguments to this function. Example: $myserver->invoke("snapshot-create", "snapshot", "mysnapshot", "volume", "vol0"); =cut sub invoke (@) { my $self = shift; my $api = shift; my $num_parms = @_; my $i; my $key; my $value; if ( ($num_parms & 1) != 0 ) { return $self->fail_response(13001, "in Zapi::invoke, invalid number of parameters"); } my $xi = new NaElement($api); for ($i = 0; $i < $num_parms; $i += 2) { $key = shift; $value = shift; $xi->child_add(new NaElement($key, $value)); } return $self->invoke_elem($xi); } 1; =head1 COPYRIGHT Copyright 2002-2003 Network Appliance, Inc. All rights reserved. Specifications subject to change without notice. This SDK sample code is provided AS IS, with no support or warranties of any kind, including but not limited to warranties of merchantability or fitness of any kind, expressed or implied. This code is subject to the license agreement that accompanies the SDK. =cut ############################################################################### # "private" subroutines for use by the public routines # # This is used when the transmission path fails, and we don't actually # get back any XML from the server. # sub fail_response { my $self = shift; my $errno = shift; my $reason = shift; my $n = new NaElement("results"); $n->attr_set("status","failed"); $n->attr_set("reason","$reason"); $n->attr_set("errno","$errno"); return $n; } sub server_start_handler ($$@) { my $xp = shift; my $el = shift; my $n = new NaElement("$el"); push(@$::ZAPI_stack,$n); my $sz = $#$::ZAPI_stack; %::ZAPI_atts = (); while ( @_ ) { my $att = shift; my $val = shift; $::ZAPI_atts{$att} = $val; $n->attr_set($att,$val); } } sub server_char_handler { my $xp = shift; my $data = shift; my $i = $#$::ZAPI_stack; $::ZAPI_stack->[$i]->set_content($data); } sub server_end_handler { my $xp = shift; my $el = shift; # We leave the last element on the stack. if ( $#$::ZAPI_stack > 0 ) { my $sz = $#$::ZAPI_stack; # Pop the element and add it as a child # to its parent. my $n = pop(@$::ZAPI_stack); my $ns = $n->sprintf(); my $i = $#$::ZAPI_stack; $::ZAPI_stack->[$i]->child_add($n); } } # this is a helper routine for invoke_elem sub parse_xml { my $self = shift; my $xml = shift; my $xmlrequest = shift; $::ZAPI_stack = []; my $p = new XML::Parser(ErrorContext => 2); $p->setHandlers( Start => \&server_start_handler, Char => \&server_char_handler, End => \&server_end_handler ); $p->parse($xml); if ( $#$::ZAPI_stack < 0 ) { return $self->fail_response(13001, "Zapi::parse_xml - no elements on stack"); } my $r = pop(@$::ZAPI_stack); if ( $r->{name} ne "netapp" ) { return $self->fail_response(13001, "Zapi::parse_xml - Expected element, " ."but got ".$r->{name}); } my $results = $r->child_get("results"); if (! defined($results)) { return $self->fail_response(13001, "Zapi::parse_xml - No results element in output!"); } return $results; } /^\s+( kn&\wiژCژCژCi./opt/VRTSperl/lib/site_perl/XML/Parser.pmcs/co0# XML::Parser # # Copyright (c) 1998-2000 Larry Wall and Clark Cooper # All rights reserved. # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package XML::Parser; use Carp; BEGIN { require XML::Parser::Expat; $VERSION = '2.34'; die "Parser.pm and Expat.pm versions don't match" unless $VERSION eq $XML::Parser::Expat::VERSION; } use strict; use vars qw($VERSION $LWP_load_failed); $LWP_load_failed = 0; sub new { my ($class, %args) = @_; my $style = $args{Style}; my $nonexopt = $args{Non_Expat_Options} ||= {}; $nonexopt->{Style} = 1; $nonexopt->{Non_Expat_Options} = 1; $nonexopt->{Handlers} = 1; $nonexopt->{_HNDL_TYPES} = 1; $nonexopt->{NoLWP} = 1; $args{_HNDL_TYPES} = {%XML::Parser::Expat::Handler_Setters}; $args{_HNDL_TYPES}->{Init} = 1; $args{_HNDL_TYPES}->{Final} = 1; $args{Handlers} ||= {}; my $handlers = $args{Handlers}; if (defined($style)) { my $stylepkg = $style; if ($stylepkg !~ /::/) { $stylepkg = "\u$style"; eval { my $fullpkg = 'XML::Parser::Style::' . $stylepkg; my $stylefile = $fullpkg; $stylefile =~ s/::/\//g; require "$stylefile.pm"; $stylepkg = $fullpkg; }; if ($@) { # fallback to old behaviour $stylepkg = 'XML::Parser::' . $stylepkg; } } my $htype; foreach $htype (keys %{$args{_HNDL_TYPES}}) { # Handlers explicity given override # handlers from the Style package unless (defined($handlers->{$htype})) { # A handler in the style package must either have # exactly the right case as the type name or a # completely lower case version of it. my $hname = "${stylepkg}::$htype"; if (defined(&$hname)) { $handlers->{$htype} = \&$hname; next; } $hname = "${stylepkg}::\L$htype"; if (defined(&$hname)) { $handlers->{$htype} = \&$hname; next; } } } } unless (defined($handlers->{ExternEnt}) or defined ($handlers->{ExternEntFin})) { if ($args{NoLWP} or $LWP_load_failed) { $handlers->{ExternEnt} = \&file_ext_ent_handler; $handlers->{ExternEntFin} = \&file_ext_ent_cleanup; } else { # The following just bootstraps the real LWP external entity # handler $handlers->{ExternEnt} = \&initial_ext_ent_handler; # No cleanup function available until LWPExternEnt.pl loaded } } $args{Pkg} ||= caller; bless \%args, $class; } # End of new sub setHandlers { my ($self, @handler_pairs) = @_; croak("Uneven number of arguments to setHandlers method") if (int(@handler_pairs) & 1); my @ret; while (@handler_pairs) { my $type = shift @handler_pairs; my $handler = shift @handler_pairs; unless (defined($self->{_HNDL_TYPES}->{$type})) { my @types = sort keys %{$self->{_HNDL_TYPES}}; croak("Unknown Parser handler type: $type\n Valid types: @types"); } push(@ret, $type, $self->{Handlers}->{$type}); $self->{Handlers}->{$type} = $handler; } return @ret; } sub parse_start { my $self = shift; my @expat_options = (); my ($key, $val); while (($key, $val) = each %{$self}) { push (@expat_options, $key, $val) unless exists $self->{Non_Expat_Options}->{$key}; } my %handlers = %{$self->{Handlers}}; my $init = delete $handlers{Init}; my $final = delete $handlers{Final}; my $expatnb = new XML::Parser::ExpatNB(@expat_options, @_); $expatnb->setHandlers(%handlers); &$init($expatnb) if defined($init); $expatnb->{_State_} = 1; $expatnb->{FinalHandler} = $final if defined($final); return $expatnb; } sub parse { my $self = shift; my $arg = shift; my @expat_options = (); my ($key, $val); while (($key, $val) = each %{$self}) { push(@expat_options, $key, $val) unless exists $self->{Non_Expat_Options}->{$key}; } my $expat = new XML::Parser::Expat(@expat_options, @_); my %handlers = %{$self->{Handlers}}; my $init = delete $handlers{Init}; my $final = delete $handlers{Final}; $expat->setHandlers(%handlers); if ($self->{Base}) { $expat->base($self->{Base}); } &$init($expat) if defined($init); my @result = (); my $result; eval { $result = $expat->parse($arg); }; my $err = $@; if ($err) { $expat->release; die $err; } if ($result and defined($final)) { if (wantarray) { @result = &$final($expat); } else { $result = &$final($expat); } } $expat->release; return unless defined wantarray; return wantarray ? @result : $result; } sub parsestring { my $self = shift; $self->parse(@_); } sub parsefile { my $self = shift; my $file = shift; local(*FILE); open(FILE, $file) or croak "Couldn't open $file:\n$!"; binmode(FILE); my @ret; my $ret; $self->{Base} = $file; if (wantarray) { eval { @ret = $self->parse(*FILE, @_); }; } else { eval { $ret = $self->parse(*FILE, @_); }; } my $err = $@; close(FILE); die $err if $err; return unless defined wantarray; return wantarray ? @ret : $ret; } sub initial_ext_ent_handler { # This just bootstraps in the real lwp_ext_ent_handler which # also loads the URI and LWP modules. unless ($LWP_load_failed) { local($^W) = 0; my $stat = eval { require('XML/Parser/LWPExternEnt.pl'); }; if ($stat) { $_[0]->setHandlers(ExternEnt => \&lwp_ext_ent_handler, ExternEntFin => \&lwp_ext_ent_cleanup); goto &lwp_ext_ent_handler; } # Failed to load lwp handler, act as if NoLWP $LWP_load_failed = 1; my $cmsg = "Couldn't load LWP based external entity handler\n"; $cmsg .= "Switching to file-based external entity handler\n"; $cmsg .= " (To avoid this message, use NoLWP option to XML::Parser)\n"; warn($cmsg); } $_[0]->setHandlers(ExternEnt => \&file_ext_ent_handler, ExternEntFin => \&file_ext_ent_cleanup); goto &file_ext_ent_handler; } sub file_ext_ent_handler { my ($xp, $base, $path) = @_; # Prepend base only for relative paths if (defined($base) and not ($path =~ m!^(?:[\\/]|\w+:)!)) { my $newpath = $base; $newpath =~ s![^\\/:]*$!$path!; $path = $newpath; } if ($path =~ /^\s*[|>+]/ or $path =~ /\|\s*$/) { $xp->{ErrorMessage} .= "System ID ($path) contains Perl IO control characters"; return undef; } require IO::File; my $fh = new IO::File($path); unless (defined $fh) { $xp->{ErrorMessage} .= "Failed to open $path:\n$!"; return undef; } $xp->{_BaseStack} ||= []; $xp->{_FhStack} ||= []; push(@{$xp->{_BaseStack}}, $base); push(@{$xp->{_FhStack}}, $fh); $xp->base($path); return $fh; } sub file_ext_ent_cleanup { my ($xp) = @_; my $fh = pop(@{$xp->{_FhStack}}); $fh->close; my $base = pop(@{$xp->{_BaseStack}}); $xp->base($base); } 1; __END__ =head1 NAME XML::Parser - A perl module for parsing XML documents =head1 SYNOPSIS use XML::Parser; $p1 = new XML::Parser(Style => 'Debug'); $p1->parsefile('REC-xml-19980210.xml'); $p1->parse('Hello World'); # Alternative $p2 = new XML::Parser(Handlers => {Start => \&handle_start, End => \&handle_end, Char => \&handle_char}); $p2->parse($socket); # Another alternative $p3 = new XML::Parser(ErrorContext => 2); $p3->setHandlers(Char => \&text, Default => \&other); open(FOO, 'xmlgenerator |'); $p3->parse(*FOO, ProtocolEncoding => 'ISO-8859-1'); close(FOO); $p3->parsefile('junk.xml', ErrorContext => 3); =begin man .ds PI PI =end man =head1 DESCRIPTION This module provides ways to parse XML documents. It is built on top of L, which is a lower level interface to James Clark's expat library. Each call to one of the parsing methods creates a new instance of XML::Parser::Expat which is then used to parse the document. Expat options may be provided when the XML::Parser object is created. These options are then passed on to the Expat object on each parse call. They can also be given as extra arguments to the parse methods, in which case they override options given at XML::Parser creation time. The behavior of the parser is controlled either by C> and/or C> options, or by L method. These all provide mechanisms for XML::Parser to set the handlers needed by XML::Parser::Expat. If neither C