initial import of VCL v2.0 code
diff --git a/INSTALLATION b/INSTALLATION
new file mode 100644
index 0000000..6e8a196
--- /dev/null
+++ b/INSTALLATION
@@ -0,0 +1,134 @@
+ Virtual Computing Laboratory
+ North Carolina State University, Raleigh, NC 27695, USA
+ 2004-2007 by NC State University. All Rights Reserved.
+ http://vcl.ncsu.edu
+
+ INSTALLATION: V3/Jun07
+
+Please read the README file.
+For use license and copyright information see LICENSE and COPYRIGHT files.
+
+
+3 directories web, mysql, managementnode
+
+prerequisites:
+for single server environment.
+Linux Host - tested RH Enterprise/Advanced Server 4
+ - apache httpd with SSL configured
+ - mysql 5.X with SSL configured
+ - PHP 5.X with php-mcrypt module
+ - Perl 5.8
+
+ - DHCP (The dhcp service is should be running on a private network.
+ This is needed to statically assign addresses to the machines.)
+
+
+ NOTE: from the redhat install CD it's easiest to select the install everything
+ option. With RH package selection, select "Custom", then scroll down to
+ the bottom and select "Everything".
+
+ If using xCAT <xcat.org>
+ - see install documentation http://xcat.org/doc
+
+VCL is orginally developed in a blade environment using IBM blades and
+xcat.
+
+The blade configuration is using:
+BladeCenter chassis
+two network Layer 2/3 Copper GigE switch modules
+HS21 blades
+
+The blades have two network adapters, eth0,eth1
+eth0 ideally should be on private network so as to not allow pxe booting
+on public or internal campus network.
+
+In a single blade chassis environment a public switch is needed. For
+multiple chassis's two switches are needed:
+one public
+one for interconnecting chassis on private network.
+
+******* WARNING *********
+Detailed documentation is still in progress, the below steps should be enough to
+get started.
+************************
+
+
+Importing/configuring database and web application:
+
+1) create a database in mysql named vcl
+ (CREATE DATABASE vcl;)
+2) create a user with SELECT, INSERT, UPDATE, and DELETE privileges on the database from #1
+ (GRANT SELECT,INSERT,UPDATE,DELETE ON vcl.* TO '<insert user here>'@'localhost' IDENTIFIED BY '<insert pwd here>';)
+3) import mysql/vcl.sql file into database
+ (mysql vcl < vcl.sql)
+4) copy web somewhere under webroot
+ (cp -R web /var/www/html/vcl)
+5) modify vcl/.ht-inc/secrets.php to match your database setup; also create random passwords for $mcryptkey, $mcryptiv, and $pemkey
+6) run the genkeys.sh script from within vcl/.ht-inc and give it $pemkey from secrets.php as the passphrase (3 times)
+7) modify vcl/.ht-inc/conf.php to match your site
+8) download jpgraph from http://www.aditus.nu/jpgraph/jpdownload.php
+ if you are using PHP5, download the 2.x series, extract it, and copy the src directory from it to vcl/.ht-inc/jpgraph
+ if you are using PHP4, download the 1.x series, extract it, and copy the src directory from it to vcl/.ht-inc/jpgraph.old
+9) download version 0.4.0 of Dojo Toolkit: http://download.dojotoolkit.org/release-0.4.0/dojo-0.4.0-ajax.tar.gz
+ extract it under the vcl directory and rename "dojo-0.4.0-ajax" to "dojoAjax"
+10) download version 1.1.0 of Dojo Toolkit: http://download.dojotoolkit.org/release-1.1.0/dojo-release-1.1.0.tar.gz
+ extract it under the vcl directory and rename "dojo-release-1.1.0" to "dojo"
+11) if you want to be able to edit any of the documentation that comes bundled with the vcl web code, download fckeditor from http://www.fckeditor.net/download
+ extract it under the vcl directory
+12) open a browser and go to the URL you set up; use 'admin' as the user and 'adminVc1passw0rd' as the password
+13) click the "Management Nodes" link
+14) enter the hostname and IP of your management node
+15) click Add
+16) click Submit
+17) click the "Management Nodes" link
+18) select "Edit Management Node Grouping"
+19) click Submit
+20) select the checkbox for your management node
+21) click Submit
+22) click "Manage Computers"
+23) click the 'Add' button
+24) fill in Hostname, IP Address, RAM, Proc Speed, Network Speed, select "blade" for Type, select "xCAT 1.x Provisioning" for "Provisioning Engine", and click the checkbox under "allcomputers", and "newimages"
+ Note: if using using vmware, select "virtualmachine" for Type and "VMWare Server Provisioning" for "Provisioning Engine"
+25) click Confirm
+26) click Submit (don't worry about the fact that the computer you just added isn't listed)
+27) after you've configured your image library and your management node has started checking in, you should be able to make a reservations
+
+Management node - vcld
+28) To install the perl code extract the vcl.tar.gz , any
+location should be fine (/usr/local/, /root, ... etc)
+29) cd to the lib directory /PATH/vcl/lib/VCL
+30) copy configuration directory file to /etc: cp -r <PATH>/vcl/etc/vcl /etc
+31) modify /etc/vcl/vcld.conf
+ at a minimum you'll need to add the database information:
+ database,server,User,user's password
+32) Modify the startup script. S99vcld.linux to include the installation
+path.
+33) run the S99vcld.linux script i.e. S99vcld.linux start
+34) drivers for loading Windows images onto different hardware than they were created on can be extracted under the Drivers directory of each Sysprep type under the tools directory
+
+
+Image creation:
+The images listed in the VCL menu are only placeholders.
+Images/Environments need to be created.
+For information on creating images, please visit:
+http://vcl.ncsu.edu/node/16
+
+
+Adding extra local accounts
+There's not currently a tool for this. You will need to add entries directly to the database.
+1) add entry to user table
+INSERT INTO user (unityid, firstname, lastname, email, lastupdated) VALUES ('myusername', 'myfirstname', 'mylastname', 'myemailaddr', NOW());
+2) find out the id generated for that user
+SELECT id, unityid FROM user WHERE unityid = 'myusername';
+3) add entry to the localauth table
+INSERT INTO localauth (userid, salt, passhash, lastupdated) VALUES ('place1', 'place2', 'place3', NOW())
+with place1 = id from step 2
+ place2 = an 8 char random string
+ place3 = sha1sum( desired password with place2 stuck on the end )
+ this can be generated under linux like this (using 'thedog' as the password and 11111111 as place2):
+ echo -n 'thedog11111111' | sha1sum
+
+Adding LDAP authentication
+1) fill in the necessary information in vcl/.ht-inc/conf.php
+2) modify the user table in the vcl database and change the 'vcladmin' user's information to match information of the main site admin
+3) uncomment the 'require_once(".ht-inc/authmethods/ldapauth.php");' line in in vcl/.ht-inc/cconf.php
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..d645695
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,202 @@
+
+ Apache License
+ Version 2.0, January 2004
+ http://www.apache.org/licenses/
+
+ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
+
+ 1. Definitions.
+
+ "License" shall mean the terms and conditions for use, reproduction,
+ and distribution as defined by Sections 1 through 9 of this document.
+
+ "Licensor" shall mean the copyright owner or entity authorized by
+ the copyright owner that is granting the License.
+
+ "Legal Entity" shall mean the union of the acting entity and all
+ other entities that control, are controlled by, or are under common
+ control with that entity. For the purposes of this definition,
+ "control" means (i) the power, direct or indirect, to cause the
+ direction or management of such entity, whether by contract or
+ otherwise, or (ii) ownership of fifty percent (50%) or more of the
+ outstanding shares, or (iii) beneficial ownership of such entity.
+
+ "You" (or "Your") shall mean an individual or Legal Entity
+ exercising permissions granted by this License.
+
+ "Source" form shall mean the preferred form for making modifications,
+ including but not limited to software source code, documentation
+ source, and configuration files.
+
+ "Object" form shall mean any form resulting from mechanical
+ transformation or translation of a Source form, including but
+ not limited to compiled object code, generated documentation,
+ and conversions to other media types.
+
+ "Work" shall mean the work of authorship, whether in Source or
+ Object form, made available under the License, as indicated by a
+ copyright notice that is included in or attached to the work
+ (an example is provided in the Appendix below).
+
+ "Derivative Works" shall mean any work, whether in Source or Object
+ form, that is based on (or derived from) the Work and for which the
+ editorial revisions, annotations, elaborations, or other modifications
+ represent, as a whole, an original work of authorship. For the purposes
+ of this License, Derivative Works shall not include works that remain
+ separable from, or merely link (or bind by name) to the interfaces of,
+ the Work and Derivative Works thereof.
+
+ "Contribution" shall mean any work of authorship, including
+ the original version of the Work and any modifications or additions
+ to that Work or Derivative Works thereof, that is intentionally
+ submitted to Licensor for inclusion in the Work by the copyright owner
+ or by an individual or Legal Entity authorized to submit on behalf of
+ the copyright owner. For the purposes of this definition, "submitted"
+ means any form of electronic, verbal, or written communication sent
+ to the Licensor or its representatives, including but not limited to
+ communication on electronic mailing lists, source code control systems,
+ and issue tracking systems that are managed by, or on behalf of, the
+ Licensor for the purpose of discussing and improving the Work, but
+ excluding communication that is conspicuously marked or otherwise
+ designated in writing by the copyright owner as "Not a Contribution."
+
+ "Contributor" shall mean Licensor and any individual or Legal Entity
+ on behalf of whom a Contribution has been received by Licensor and
+ subsequently incorporated within the Work.
+
+ 2. Grant of Copyright License. Subject to the terms and conditions of
+ this License, each Contributor hereby grants to You a perpetual,
+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+ copyright license to reproduce, prepare Derivative Works of,
+ publicly display, publicly perform, sublicense, and distribute the
+ Work and such Derivative Works in Source or Object form.
+
+ 3. Grant of Patent License. Subject to the terms and conditions of
+ this License, each Contributor hereby grants to You a perpetual,
+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+ (except as stated in this section) patent license to make, have made,
+ use, offer to sell, sell, import, and otherwise transfer the Work,
+ where such license applies only to those patent claims licensable
+ by such Contributor that are necessarily infringed by their
+ Contribution(s) alone or by combination of their Contribution(s)
+ with the Work to which such Contribution(s) was submitted. If You
+ institute patent litigation against any entity (including a
+ cross-claim or counterclaim in a lawsuit) alleging that the Work
+ or a Contribution incorporated within the Work constitutes direct
+ or contributory patent infringement, then any patent licenses
+ granted to You under this License for that Work shall terminate
+ as of the date such litigation is filed.
+
+ 4. Redistribution. You may reproduce and distribute copies of the
+ Work or Derivative Works thereof in any medium, with or without
+ modifications, and in Source or Object form, provided that You
+ meet the following conditions:
+
+ (a) You must give any other recipients of the Work or
+ Derivative Works a copy of this License; and
+
+ (b) You must cause any modified files to carry prominent notices
+ stating that You changed the files; and
+
+ (c) You must retain, in the Source form of any Derivative Works
+ that You distribute, all copyright, patent, trademark, and
+ attribution notices from the Source form of the Work,
+ excluding those notices that do not pertain to any part of
+ the Derivative Works; and
+
+ (d) If the Work includes a "NOTICE" text file as part of its
+ distribution, then any Derivative Works that You distribute must
+ include a readable copy of the attribution notices contained
+ within such NOTICE file, excluding those notices that do not
+ pertain to any part of the Derivative Works, in at least one
+ of the following places: within a NOTICE text file distributed
+ as part of the Derivative Works; within the Source form or
+ documentation, if provided along with the Derivative Works; or,
+ within a display generated by the Derivative Works, if and
+ wherever such third-party notices normally appear. The contents
+ of the NOTICE file are for informational purposes only and
+ do not modify the License. You may add Your own attribution
+ notices within Derivative Works that You distribute, alongside
+ or as an addendum to the NOTICE text from the Work, provided
+ that such additional attribution notices cannot be construed
+ as modifying the License.
+
+ You may add Your own copyright statement to Your modifications and
+ may provide additional or different license terms and conditions
+ for use, reproduction, or distribution of Your modifications, or
+ for any such Derivative Works as a whole, provided Your use,
+ reproduction, and distribution of the Work otherwise complies with
+ the conditions stated in this License.
+
+ 5. Submission of Contributions. Unless You explicitly state otherwise,
+ any Contribution intentionally submitted for inclusion in the Work
+ by You to the Licensor shall be under the terms and conditions of
+ this License, without any additional terms or conditions.
+ Notwithstanding the above, nothing herein shall supersede or modify
+ the terms of any separate license agreement you may have executed
+ with Licensor regarding such Contributions.
+
+ 6. Trademarks. This License does not grant permission to use the trade
+ names, trademarks, service marks, or product names of the Licensor,
+ except as required for reasonable and customary use in describing the
+ origin of the Work and reproducing the content of the NOTICE file.
+
+ 7. Disclaimer of Warranty. Unless required by applicable law or
+ agreed to in writing, Licensor provides the Work (and each
+ Contributor provides its Contributions) on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+ implied, including, without limitation, any warranties or conditions
+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
+ PARTICULAR PURPOSE. You are solely responsible for determining the
+ appropriateness of using or redistributing the Work and assume any
+ risks associated with Your exercise of permissions under this License.
+
+ 8. Limitation of Liability. In no event and under no legal theory,
+ whether in tort (including negligence), contract, or otherwise,
+ unless required by applicable law (such as deliberate and grossly
+ negligent acts) or agreed to in writing, shall any Contributor be
+ liable to You for damages, including any direct, indirect, special,
+ incidental, or consequential damages of any character arising as a
+ result of this License or out of the use or inability to use the
+ Work (including but not limited to damages for loss of goodwill,
+ work stoppage, computer failure or malfunction, or any and all
+ other commercial damages or losses), even if such Contributor
+ has been advised of the possibility of such damages.
+
+ 9. Accepting Warranty or Additional Liability. While redistributing
+ the Work or Derivative Works thereof, You may choose to offer,
+ and charge a fee for, acceptance of support, warranty, indemnity,
+ or other liability obligations and/or rights consistent with this
+ License. However, in accepting such obligations, You may act only
+ on Your own behalf and on Your sole responsibility, not on behalf
+ of any other Contributor, and only if You agree to indemnify,
+ defend, and hold each Contributor harmless for any liability
+ incurred by, or claims asserted against, such Contributor by reason
+ of your accepting any such warranty or additional liability.
+
+ END OF TERMS AND CONDITIONS
+
+ APPENDIX: How to apply the Apache License to your work.
+
+ To apply the Apache License to your work, attach the following
+ boilerplate notice, with the fields enclosed by brackets "[]"
+ replaced with your own identifying information. (Don't include
+ the brackets!) The text should be enclosed in the appropriate
+ comment syntax for the file format. We also recommend that a
+ file or class name and description of purpose be included on the
+ same "printed page" as the copyright notice for easier
+ identification within third-party archives.
+
+ Copyright [yyyy] [name of copyright owner]
+
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
diff --git a/NOTICE b/NOTICE
new file mode 100644
index 0000000..1c3b7b1
--- /dev/null
+++ b/NOTICE
@@ -0,0 +1,5 @@
+Apache VCL
+Copyright 2008 The Apache Software Foundation
+
+This product includes software developed at
+The Apache Software Foundation (http://www.apache.org/).
diff --git a/managementnode/INSTALL b/managementnode/INSTALL
new file mode 100644
index 0000000..29a40a8
--- /dev/null
+++ b/managementnode/INSTALL
@@ -0,0 +1,98 @@
+##############################################################################
+# $Id$
+##############################################################################
+mkdir /usr/local/vcl/source
+
+wget --directory-prefix=/usr/local/vcl/source http://search.cpan.org/CPAN/authors/id/M/MA/MARKOV/MailTools-2.04.tar.gz
+tar -xzf /usr/local/vcl/source/MailTools-2.04.tar.gz -C /usr/local/vcl/source
+cd /usr/local/vcl/source/MailTools-2.04
+perl Makefile.PL
+make
+make test
+make install
+
+
+wget --directory-prefix=/usr/local/vcl/source http://search.cpan.org/CPAN/authors/id/T/TM/TMTM/Class-Data-Inheritable-0.08.tar.gz
+tar -xzf /usr/local/vcl/source/Class-Data-Inheritable-0.08.tar.gz -C /usr/local/vcl/source
+cd /usr/local/vcl/source/Class-Data-Inheritable-0.08
+perl Makefile.PL
+make
+make test
+make install
+
+wget --directory-prefix=/usr/local/vcl/source http://search.cpan.org/CPAN/authors/id/D/DR/DROLSKY/Devel-StackTrace-1.20.tar.gz
+tar -xzf /usr/local/vcl/source/Devel-StackTrace-1.20.tar.gz -C /usr/local/vcl/source
+cd /usr/local/vcl/source/Devel-StackTrace-1.20
+perl Makefile.PL
+make
+make test
+make install
+
+
+wget --directory-prefix=/usr/local/vcl/source http://search.cpan.org/CPAN/authors/id/D/DR/DROLSKY/Exception-Class-1.26.tar.gz
+tar -xzf /usr/local/vcl/source/Exception-Class-1.26.tar.gz -C /usr/local/vcl/source
+cd /usr/local/vcl/source/Exception-Class-1.26
+perl Makefile.PL
+make
+make test
+make install
+
+wget --directory-prefix=/usr/local/vcl/source http://search.cpan.org/CPAN/authors/id/J/JD/JDHEDDEN/Object-InsideOut-3.52.tar.gz
+tar -xzf /usr/local/vcl/source/Object-InsideOut-3.52.tar.gz -C /usr/local/vcl/source
+cd /usr/local/vcl/source/Object-InsideOut-3.52
+perl Makefile.PL
+make
+make test
+make install
+
+
+wget --directory-prefix=/usr/local/vcl/source http://search.cpan.org/CPAN/authors/id/K/KW/KWILLIAMS/Module-Build-0.30.tar.gz
+tar -xzf /usr/local/vcl/source/Module-Build-0.30.tar.gz -C /usr/local/vcl/source
+cd /usr/local/vcl/source/Module-Build-0.30
+perl Makefile.PL
+make
+make test
+make install
+
+
+wget --directory-prefix=/usr/local/vcl/source http://search.cpan.org/CPAN/authors/id/A/AG/AGROLMS/GSSAPI-0.26.tar.gz
+tar -xzf /usr/local/vcl/source/GSSAPI-0.26.tar.gz -C /usr/local/vcl/source
+cd /usr/local/vcl/source/GSSAPI-0.26
+perl Makefile.PL
+make
+make test
+make install
+
+
+wget --directory-prefix=/usr/local/vcl/source http://search.cpan.org/CPAN/authors/id/G/GB/GBARR/Authen-SASL-2.12.tar.gz
+tar -xzf /usr/local/vcl/source/Authen-SASL-2.12.tar.gz -C /usr/local/vcl/source
+cd /usr/local/vcl/source/Authen-SASL-2.12
+perl Makefile.PL
+make
+make test
+make install
+
+wget --directory-prefix=/usr/local/vcl/source http://search.cpan.org/CPAN/authors/id/R/RE/REATMON/XML-Stream-1.22.tar.gz
+tar -xzf /usr/local/vcl/source/XML-Stream-1.22.tar.gz -C /usr/local/vcl/source
+cd /usr/local/vcl/source/XML-Stream-1.22
+perl Makefile.PL
+make
+make test
+make install
+
+
+wget --directory-prefix=/usr/local/vcl/source http://search.cpan.org/CPAN/authors/id/H/HA/HACKER/Net-XMPP-1.02.tar.gz
+tar -xzf /usr/local/vcl/source/Net-XMPP-1.02.tar.gz -C /usr/local/vcl/source
+cd /usr/local/vcl/source/Net-XMPP-1.02
+perl Makefile.PL
+make
+make test
+make install
+
+wget --directory-prefix=/usr/local/vcl/source http://search.cpan.org/CPAN/authors/id/R/RE/REATMON/Net-Jabber-2.0.tar.gz
+tar -xzf /usr/local/vcl/source/Net-Jabber-2.0.tar.gz -C /usr/local/vcl/source
+cd /usr/local/vcl/source/Net-Jabber-2.0
+perl Makefile.PL
+make
+make test
+make install
diff --git a/managementnode/bin/S99vclclient.linux b/managementnode/bin/S99vclclient.linux
new file mode 100755
index 0000000..6097ef2
--- /dev/null
+++ b/managementnode/bin/S99vclclient.linux
@@ -0,0 +1,78 @@
+#!/bin/bash
+##############################################################################
+# $Id: S99vclclient.linux 1951 2008-12-12 13:48:10Z arkurth $
+##############################################################################
+
+# path to the daemon, no trailing '/'
+DAEMON_PATH=
+# name of the daemon executable
+DAEMON=
+# any options for the daemon, these can be overridden by setting DAEMON_OPTIONS
+# in /etc/sysconfig/$DAEMON, probably want to enclose them in ' marks
+DAEMON_OPTIONS=
+
+
+# don't need to edit anything below here
+# --------------------------------------------------------------------
+
+# Source function library.
+. /etc/init.d/functions
+
+[ -f $DAEMON_PATH/$DAEMON ] || exit 0
+
+# Source config
+if [ -f /etc/sysconfig/$DAEMON ] ; then
+ . /etc/sysconfig/$DAEMON
+fi
+
+RETVAL=0
+
+umask 077
+
+start() {
+ echo -n $"Starting $DAEMON daemon: "
+ daemon $DAEMON_PATH/$DAEMON $DAEMON_OPTIONS
+ RETVAL=$?
+ echo
+ [ $RETVAL -eq 0 ] && touch /var/lock/subsys/$DAEMON
+ return $RETVAL
+}
+stop() {
+ echo -n $"Shutting down $DAEMON daemon: "
+ killproc $DAEMON_PATH/$DAEMON
+ RETVAL=$?
+ echo
+ [ $RETVAL -eq 0 ] && rm -f /var/lock/subsys/$DAEMON
+ return $RETVAL
+}
+_status() {
+ status $DAEMON
+}
+restart() {
+ stop
+ start
+}
+
+case "$1" in
+ start)
+ start
+ ;;
+ stop)
+ stop
+ ;;
+ status)
+ _status
+ ;;
+ restart|reload)
+ restart
+ ;;
+ condrestart)
+ [ -f /var/lock/subsys/$DAEMON ] && restart || :
+ ;;
+ *)
+ echo $"Usage: $0 {start|stop|status|restart|condrestart}"
+ exit 1
+esac
+
+exit $?
+
diff --git a/managementnode/bin/S99vclclient.solaris b/managementnode/bin/S99vclclient.solaris
new file mode 100755
index 0000000..74e6942
--- /dev/null
+++ b/managementnode/bin/S99vclclient.solaris
@@ -0,0 +1,63 @@
+#!/bin/sh
+##############################################################################
+# $Id: S99vclclient.solaris 1951 2008-12-12 13:48:10Z arkurth $
+##############################################################################
+
+# Start vcld
+
+DAEMON=/local/adm/vclclientd
+LOGF=/var/log/vclclientd.log
+HOME=/home/vclstaff
+
+# Replace 'username' with an actual user name
+
+case $1 in
+'start')
+echo
+echo "Starting VCL client daemons"
+
+if [ -x ${DAEMON} ]; then
+ if [ ! -r ${HOME}/.ssh ]; then
+ /bin/mkdir -m 755 ${HOME}/.ssh
+ /bin/chown vclstaff:0 ${HOME}/.ssh
+ fi
+
+ if [ ! -r ${HOME}/.ssh/authorized_keys ] ; then
+ /bin/cp ${HOME}/authorized_keys ${HOME}/.ssh/authorized_keys
+ /bin/chown vclstaff:0 ${HOME}/.ssh/authorized_keys
+ fi
+
+ if [ -r ${LOGF} ]; then
+ maxlog=20
+ _i="`expr ${maxlog} - 1`"
+ while test ${_i} -gt 0
+ do
+ _j=${_i}
+ _i="`expr ${_i} - 1`"
+ if test -r ${LOGF}.${_i}.gz
+ then
+ mv ${LOGF}.${_i}.gz ${LOGF}.${_j}.gz
+ fi
+ done
+ cp ${LOGF} ${LOGF}.0
+ gzip ${LOGF}.0
+ fi
+ umask 022
+ ${DAEMON}
+else
+ echo ""
+ echo "Cannot locate or read ${DAEMON}"
+
+fi
+
+ ;;
+'stop')
+ if [ -r /var/run/vclclientd.pid ];then
+ kill `/bin/cat /var/run/vclclientd.pid`
+ fi
+ ;;
+*)
+ echo "Usage /etc/init.d/vclclient.init { start | stop }"
+ ;;
+esac
+exit 0
diff --git a/managementnode/bin/S99vcld.linux b/managementnode/bin/S99vcld.linux
new file mode 100755
index 0000000..fce93e8
--- /dev/null
+++ b/managementnode/bin/S99vcld.linux
@@ -0,0 +1,94 @@
+#!/bin/bash
+##############################################################################
+# $Id: S99vcld.linux 1951 2008-12-12 13:48:10Z arkurth $
+##############################################################################
+
+# chkconfig: 45 99 99
+# description: VCL management node daemon
+
+# DAEMON: Name of the daemon executable
+DAEMON=vcld
+
+# DAEMON_PATH: Path to the daemon, no trailing '/'
+DAEMON_PATH=/usr/local/vcl/bin
+
+# DAEMON_OPTIONS: options for the daemon, these can be overridden by
+# setting DAEMON_OPTIONS in /etc/sysconfig/$DAEMON
+DAEMON_OPTIONS='-v -conf=/etc/vcl/vcld.conf'
+
+
+# You shouldn't need to edit anything below here
+# --------------------------------------------------------------------
+
+# Source function library.
+. /etc/init.d/functions
+
+#[ -f $DAEMON_PATH/$DAEMON ] || exit 0
+
+# Source config
+if [ -f /etc/sysconfig/$DAEMON ] ; then
+ . /etc/sysconfig/$DAEMON
+fi
+
+RETVAL=0
+
+umask 077
+
+start() {
+ echo -n $"Starting $DAEMON daemon: "
+ daemon $DAEMON_PATH/$DAEMON $DAEMON_OPTIONS
+ RETVAL=$?
+ echo
+ [ $RETVAL -eq 0 ] && touch /var/lock/subsys/$DAEMON
+ return $RETVAL
+}
+stop() {
+ echo -n $"Shutting down $DAEMON daemon: "
+ #killproc $DAEMON_PATH/$DAEMON
+ kill -9 `/bin/cat /var/run/$DAEMON.pid`
+ #RETVAL=$?
+ echo
+ [ $RETVAL -eq 0 ] && rm -f /var/lock/subsys/$DAEMON
+ return $RETVAL
+}
+_status() {
+ status vcld
+}
+restart() {
+ stop
+ #echo -n $"Shutting down $DAEMON daemon: "
+ #killproc $DAEMON_PATH/$DAEMON
+ #kill -9 `/bin/cat /var/run/$DAEMON.pid`
+ sleep 1
+ start
+}
+
+case "$1" in
+ start)
+ start
+ ;;
+ stop)
+ stop
+ ;;
+ status)
+ # modified this not to call _status because that was matching vcldev
+ if line=`/bin/ps aux | /bin/egrep -e 'vcld( )*$'` ; then
+ pid=`echo $line | /bin/awk '{print $2}'`
+ echo vcld \(pid $pid\) is running...
+ else
+ echo no vcld processes found
+ exit 1
+ fi
+ ;;
+ restart|reload)
+ restart
+ ;;
+ condrestart)
+ [ -f /var/lock/subsys/$DAEMON ] && restart || :
+ ;;
+ *)
+ echo $"Usage: $0 {start|stop|status|restart|condrestart}"
+ exit 1
+esac
+
+exit $?
diff --git a/managementnode/bin/health_check.pl b/managementnode/bin/health_check.pl
new file mode 100644
index 0000000..056b955
--- /dev/null
+++ b/managementnode/bin/health_check.pl
@@ -0,0 +1,84 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: health_check.pl 1951 2008-12-12 13:48:10Z arkurth $
+##############################################################################
+
+=head1 NAME
+
+VCL::health_check - VCL health check utility
+
+=head1 SYNOPSIS
+
+ perl VCL::health_check
+
+=head1 DESCRIPTION
+
+ Needs to be written...
+
+=cut
+
+##############################################################################
+package VCL::health_check;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+# Configure inheritance
+use base qw();
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use VCL::utils;
+use VCL::healthcheck;
+
+##############################################################################
+
+# now just do basic monitoring
+# ping machine is it accessible by contact means for given type and is the client daemon running
+
+=pod
+ 1) get my hostname, I should be a management node
+ 2) get groups associated groups which I (my MNid) can talk to/manage.
+ 3) from groups get resource members and their information i.e. computer info from the repective group
+
+=cut
+
+#----------GLOBALS--------------
+
+#------- Subroutine declarations -------
+sub main();
+
+main();
+
+sub main() {
+
+ my $check = new VCL::healthcheck();
+ $check->process;
+ $check->send_report;
+
+}
diff --git a/managementnode/bin/monitor_vcld.pl b/managementnode/bin/monitor_vcld.pl
new file mode 100644
index 0000000..c2feb91
--- /dev/null
+++ b/managementnode/bin/monitor_vcld.pl
@@ -0,0 +1,149 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: monitor_vcld.pl 1951 2008-12-12 13:48:10Z arkurth $
+##############################################################################
+
+=head1 NAME
+
+VCL::monitor_vcld - VCL monitoring utility
+
+=head1 SYNOPSIS
+
+ perl vcld
+
+=head1 DESCRIPTION
+
+ Needs to be written...
+
+=cut
+
+##############################################################################
+package VCL::monitor_vcld;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+# Configure inheritance
+use base qw();
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use VCL::utils;
+use DBI;
+use Getopt::Long;
+
+##############################################################################
+
+sub main ();
+our $LOG = "/var/log/monitor_vcld.log";
+our $STARTUP = "/etc/init.d/vcld.start";
+main();
+
+
+sub main () {
+ my ($managementnodeid, $lci, $lastcheckin, $mnid, $selh, $updhdle, $rows, $timestamp);
+ my @hostinfo = hostname;
+ my $MN = $hostinfo[0];
+ my $MNos = $hostinfo[1];
+ my $pidjuststarted = 0;
+
+ #check if local vcld is running
+ my $l;
+ my $pidliving = 0;
+ if (open(TEST, "$STARTUP status 2>&1 |")) {
+ my @file = <TEST>;
+ close(TEST);
+ foreach $l (@file) {
+ # Search for a line matching: vcld (pid 28560 26333 17710) is running...
+ if ($l =~ /vcld \(pid [\d\s]*\) is running/) {
+ $pidliving = 1;
+ }
+ }
+ } ## end if (open(TEST, "$STARTUP status 2>&1 |"))
+ if ($pidliving) {
+ notify($ERRORS{'OK'}, $LOG, "monitor_vcld.pl parent pid is alive");
+ }
+ else {
+ #restart vcld
+ notify($ERRORS{'OK'}, $LOG, "monitor_vcld.pl parent pid not found, restarting on $MN");
+ #on startup vcld sleep 20secs before checking in with db
+ $pidjuststarted = 1;
+ sleep 25;
+ }
+
+ #check on the last checkin time, if older then X, restart vcld core process
+
+ # --- Make connection to DB
+ my $dbh = DBI->connect(qq{dbi:mysql:$DATABASE:$SERVER}, $WRTUSER, $WRTPASS, {PrintError => 0});
+ $selh = $dbh->prepare("SELECT id,lastcheckin FROM managementnode WHERE hostname = ?") or notify($ERRORS{'WARNING'}, $LOG, "Could not prepare select for management node id" . $dbh->errstr());
+ RECHECK:
+ $selh->execute($MN) or notify($ERRORS{'WARNING'}, $LOG, "Could not execute management node id" . $dbh->errstr());
+ my $dbretval = $selh->bind_columns(\($managementnodeid, $lastcheckin));
+ $rows = $selh->rows;
+ if ($rows != 0) {
+ $selh->fetch;
+ $mnid = $managementnodeid;
+ $lci = $lastcheckin;
+ notify($ERRORS{'OK'}, $LOG, "monitor_vcld.pl managementnodeid $managementnodeid set for $MN");
+ $selh->finish;
+ $dbh->disconnect;
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, $LOG, "monitor_vcld.pl No management id for $MN.");
+ $selh->finish;
+ $dbh->disconnect;
+ exit;
+ }
+
+ my $currenttime = makedatestring;
+ my $ctime = convert_to_epoch_seconds($currenttime);
+ my $lchecktime = convert_to_epoch_seconds($lci);
+ my $diff = $ctime - $lchecktime;
+ if ($diff >= (3 * 60)) {
+ notify($ERRORS{'OK'}, $LOG, "monitor_vcld.pl managementnodeid $managementnodeid checkin time is old currenttime= $currenttime lastcheckintime= $lci");
+ #restart kill and start vcld
+ if ($pidjuststarted) {
+ $pidjuststarted = 0;
+ notify($ERRORS{'OK'}, $LOG, "monitor_vcld.pl vcld was just restarted waiting a moment before check db");
+ #we may not have waited long enough for a fresh checkin
+ goto RECHECK;
+ }
+ else {
+ if (open(RESTART, "$STARTUP restart 2>&1 |")) {
+ my @restart = <RESTART>;
+ close(RESTART);
+ notify($ERRORS{'CRITICAL'}, $LOG, "monitor_vcld.pl lastcheckin is to old restarted vcld on $MN\n restart output= @restart");
+ }
+ }
+ } ## end if ($diff >= (3 * 60))
+ else {
+ notify($ERRORS{'OK'}, $LOG, "monitor_vcld.pl managementnodeid $MN is fresh lastcheckintime= $lci");
+ }
+} ## end sub main ()
+
+
diff --git a/managementnode/bin/search-replace b/managementnode/bin/search-replace
new file mode 100755
index 0000000..117e8b1
--- /dev/null
+++ b/managementnode/bin/search-replace
@@ -0,0 +1,23 @@
+#!/bin/bash
+##############################################################################
+# $Id: search-replace 1951 2008-12-12 13:48:10Z arkurth $
+##############################################################################
+# This shell script searches and replaces a string in all of the files under
+# the path specified.
+if [ $# -ne 3 ]
+then
+ echo "Usage: $0 SEARCH_PATTERN REPLACE_PATTERN SEARCH_PATH"
+ exit 1
+fi
+
+SEARCH_PATTERN=$1
+REPLACE_PATTERN=$2
+SEARCH_PATH=$3
+
+echo Replacing $SEARCH_PATTERN with $REPLACE_PATTERN in all files under $SEARCH_PATH
+for FILEPATH in `grep -r -l $SEARCH_PATTERN $SEARCH_PATH | grep -v svn`
+do
+ echo "replacing $SEARCH_PATTERN with $REPLACE_PATTERN in $FILEPATH"
+ sed -i -e "s/$SEARCH_PATTERN/$REPLACE_PATTERN/g" $FILEPATH
+done
+exit
diff --git a/managementnode/bin/vclclientd b/managementnode/bin/vclclientd
new file mode 100644
index 0000000..af148b6
--- /dev/null
+++ b/managementnode/bin/vclclientd
@@ -0,0 +1,1014 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: vclclientd 1954 2008-12-12 14:46:02Z arkurth $
+##############################################################################
+
+=head1 NAME
+
+vclclientd
+
+=head1 SYNOPSIS
+
+ perl vclclientd
+
+=head1 DESCRIPTION
+
+ This is the executable module for running the VCL client daemon on Linux lab
+ machines.
+
+=cut
+
+##############################################################################
+
+use strict;
+use Getopt::Long;
+use diagnostics;
+use Symbol;
+use POSIX;
+
+$|=1; # turning off autoflush
+
+# -- DEVELOPMENT testing
+#my $PIDFILE = "/var/run/vcldev.pid";
+#our $LOG = "/var/log/vcldev.log";
+
+# GLOBALS
+our $HOME = "/home/vclstaff";
+our $VCLFLAG = "$HOME/flag";
+our $CLIENTDATA = "$HOME/clientdata";
+our $PIDFILE ="/var/run/vclclientd.pid";
+our %children = (); # keys are current child process IDs
+our $children = 0; # current number of children
+our $LOG = "/var/log/vclclientd.log";
+our %ERRORS=('DEPENDENT'=>4,'UNKNOWN'=>3,'OK'=>0,'WARNING'=>1,'CRITICAL'=>2,'MAILMASTERS'=>5);
+our $opt_d='';
+
+Getopt::Long::Configure('bundling', 'no_ignore_case');
+GetOptions('d|debug' => \$opt_d );
+if(!$opt_d){
+ #daemonize
+ &daemonize;
+}
+
+
+sub daemonize {
+ chdir '/' or die "Can't chdir to /: $!";
+ defined(my $pid = fork) or die "Can't fork $!";
+ exit if $pid;
+ #production
+ $0 = "vclclientd";
+ print "Created process $$ renamed to $0 ...\n";
+ setsid or die "Can't start a new session: $!";
+ open STDIN, '/dev/null' or die "Can't read /dev/null $!";
+ open STDOUT, '>>$LOG' or die "Can't write $LOG $!";
+ open STDERR, '>>$LOG' or die "Can't write $LOG $!";
+ umask 0;
+ open(PIDFILE, ">$PIDFILE"); # so I can kill myself easily
+ print PIDFILE $$;
+ close(PIDFILE);
+
+}
+
+
+#------- Subroutine declarations -------
+sub main(); # main calls primary subroutines
+sub flag;
+sub processdata;
+sub startsshd;
+sub makedatestring;
+sub reboot;
+sub fetch;
+sub store;
+sub sshdstatus;
+sub createnewssh_config_vcl;
+sub restartsshd;
+
+sub REAPER { # takes care of dead children
+ $SIG{CHLD} = \&REAPER;
+ my $pid = wait;
+ if(exists $children{$pid}){
+ $children--;
+ notify($ERRORS{'OK'},"$pid -- child process exiting, deleting $pid ");
+ delete $children{$pid};
+ }
+ else{
+ notify($ERRORS{'OK'},"$pid -- sub process exiting");
+ }
+
+}
+
+sub HUNTSMAN { # signal handler for SIGINT
+ local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our child processes
+ kill 'INT' => keys %children;
+ notify($ERRORS{'OK'},"$$ -- process exiting");
+ exit; # clean up with dignity
+}
+
+# Install signal handlers.
+$SIG{CHLD} = \&REAPER;
+$SIG{INT} = \&HUNTSMAN;
+$SIG{QUIT} = \&HUNTSMAN;
+$SIG{HUP} = \&HUNTSMAN;
+$SIG{TERM} = \&HUNTSMAN;
+
+main();
+
+sub main () {
+ #preplogfile;
+ #my @hostinfo = hostname;
+ #make sure vclstaff owns authorized_keys and log file
+ if(open(AUTHFILE,"chown vclstaff:root /home/vclstaff/authorized_keys 2>&1 |")){
+ notify($ERRORS{'OK'},"main: setting vclstaff ownership of /home/vclstaff/authorized_keys");
+ close(AUTHFILE);
+ }
+ if(open(LOGFILE,"chown vclstaff:root /var/log/vclclientd.log 2>&1 |")){
+ notify($ERRORS{'OK'},"main: setting vclstaff ownership of /var/log/vclclientd.log");
+ close(LOGFILE);
+ }
+ if(!(-r "/etc/users.local.admin")){
+ notify($ERRORS{'OK'},"main: /etc/users.local.admin does not exist creating");
+ if(open(COPY, "/bin/cp /etc/users.local /etc/users.local.admin |")){
+ close(COPY);
+ if(-r "/etc/users.local.admin"){
+ notify($ERRORS{'OK'},"main: /etc/users.local.admin exist now");
+ }
+ }
+
+ }
+ #on startup check to see if someone has rebooted us. this is a hack
+ #we just need to figure out if this a reboot or a restart
+ #for now we are just going to look at the output of last -- there has
+ #to be a better way
+ if(open(LAST,"/usr/bin/last 2>&1 |")){
+ my @last =<LAST>;
+ close(LAST);
+ if($last[0] =~ /reboot/ || $last[1] =~ /reboot/){
+ if( -r "$CLIENTDATA"){
+ if(open(CLD, "$CLIENTDATA")){
+ my @file = <CLD>;
+ close(CLD);
+ if($file[0] =~ /new/){
+ if(open(FLAG, ">$VCLFLAG")){
+ print FLAG 1;
+ close(FLAG);
+ notify($ERRORS{'OK'},"main: possibly a reboot setting flag to 1 for reinitializing");
+ }#flag
+ }#new
+ }#CLD
+ else{
+ notify($ERRORS{'OK'},"main: could not open $CLIENTDATA");
+ }
+ }# readable
+ }# last -- reboot
+ }
+
+
+ while(1){
+ if( flag ){
+ notify($ERRORS{'OK'},"main: flag is set proceed to process");
+ #make sure clientdata is readable
+ if(-r $CLIENTDATA){
+ #process data
+ if(open(CLIENTDATA,"$CLIENTDATA")){
+ my %request=();
+ my @lines = <CLIENTDATA>;
+ close(CLIENTDATA);
+ $request{"state"}=$lines[0];
+ $request{"unityid"}=$lines[1];
+ $request{"remoteIP"}=$lines[2];
+ chomp($request{"state"});
+ chomp($request{"unityid"});
+ chomp($request{"remoteIP"});
+
+ make_new_child(%request) if($request{"state"} =~ /new|timeout|delete/);
+ reboot() if($request{"state"} =~ /reboot/);
+ fetch() if($request{"state"} =~ /fetch/);
+ store() if($request{"state"} =~ /store/);
+ }
+ else{
+ notify($ERRORS{'OK'},"main: could not open $CLIENTDATA: $!");
+
+ }
+ } #if -r
+ } #if flag
+ else{
+ #check for any hung children
+ #kill fork process and reset flag? does this create a race condition
+ #could keep track of killed processes in children hash when number exceeds X (reboot machine?)
+ #notify($ERRORS{'OK'},"main: number of children $children");
+ foreach my $p (keys %children) {
+ next if($p=~ /hung/);
+ notify($ERRORS{'OK'},"main: pid = $p");
+ $children{"hungtries"}{"count"}+=1;
+ if(open(KILL,"kill -9 $p 2>&1 |")){
+ notify($ERRORS{'OK'},"main: stopping forked process in an attempt to reset");
+ my $k = <KILL>;
+ close(KILL);
+ if($k =~ /No such process/){
+ #not found maybe I was too guick to judge
+ #let it ride
+ }
+ else{
+ if($children{"hungtries"}{"count"} > 4){
+ notify($ERRORS{'OK'},"main: hung process attempts are greater than 4 rebooting");
+ reboot();
+ }
+ if(open(ECHO,"echo 1 > /home/vclstaff/flag |")){
+ notify($ERRORS{'OK'},"main: attempt to reset initiated");
+ close(ECHO);
+ }
+ }
+ }
+ }
+
+ }
+ sleep 5;
+ } #while
+}
+sub flag {
+ if(!(-e $VCLFLAG)){
+ # warning flag does not exist
+ #create it and continue
+ if(open(FLAG, ">$VCLFLAG")){
+ print FLAG 0;
+ notify($ERRORS{'OK'}, "had to create $VCLFLAG");
+ close(FLAG);
+ if(open(LOGFILE,"chown vclstaff:root /home/vclstaff/flag 2>&1 |")){
+ notify($ERRORS{'OK'},"main: setting vclstaff ownership of /home/vclstaff/flag");
+ close(LOGFILE);
+ }
+ if(open(LOGFILE,"chmod 640 /home/vclstaff/flag 2>&1 |")){
+ notify($ERRORS{'OK'},"main: setting 640 perms /home/vclstaff/flag");
+ close(LOGFILE);
+ }
+ }
+ else{
+ notify($ERRORS{'OK'},"could not create $VCLFLAG $! will try to delete");
+ unlink $VCLFLAG;
+ return 0;
+ }
+ }
+ my @lines;
+ # VCLFLAG file exists, check contents
+ if(open(FLAG, "$VCLFLAG")){
+ @lines = <FLAG>;
+ close(FLAG);
+ # clear flag
+ if(open(FLAG, ">$VCLFLAG")){
+ print FLAG 0;
+ close(FLAG);
+ }
+ else{
+ unlink $VCLFLAG;
+ }
+ return $lines[0];
+ }
+ else{
+ notify($ERRORS{'OK'},"flag: could not open $VCLFLAG $!");
+ return 0;
+ }
+}
+sub make_new_child {
+ my (%request_data) = @_;
+ my $pid;
+ my $sigset;
+
+ # block signal for fork
+ $sigset = POSIX::SigSet->new(SIGINT);
+ sigprocmask(SIG_BLOCK, $sigset) or die "Can't block SIGINT for fork: $!\n";
+ #die "fork: $!" unless defined ($pid = fork);
+FORK: {
+ if ($pid = fork) {
+ # Parent records the child's birth
+ # and returns.
+ sigprocmask(SIG_UNBLOCK, $sigset) or die "Can't unblock SIGINT for fork: $!\n";
+
+ $children{$pid} = 1;
+ $children++;
+ notify($ERRORS{'OK'},"vclclientd current number of forked kids: $children");
+ return;
+ } elsif(defined $pid) {
+ # Child can *not* return from this subroutine.
+ $SIG{INT} = 'DEFAULT';
+ # make SIGINT kill us as it did before unblock signals
+ sigprocmask(SIG_UNBLOCK, $sigset) or die "Can't unblock SIGINT for fork: $!\n";
+
+ notify($ERRORS{'OK'},"processdata: new request child process $request_data{state} $request_data{unityid},$request_data{remoteIP} ");
+ #do something that may take a long time or needs to be monitored
+ #based on the case lets do something
+ if($request_data{state} =~ /new/){
+ notify($ERRORS{'OK'},"processdata: new request $request_data{unityid},$request_data{remoteIP} ");
+ if(new_state($request_data{unityid},$request_data{remoteIP})){
+ notify($ERRORS{'OK'},"processdata: connection for $request_data{unityid}\@$request_data{remoteIP} successfully opened");
+ }
+ }
+ elsif($request_data{"state"} =~ /timeout|deleted/){
+ if(timeout_state($request_data{unityid},$request_data{remoteIP})){
+ notify($ERRORS{'OK'},"vclclientd: connection for $request_data{unityid}\@$request_data{remoteIP} successfully terminated");
+ }
+ }
+
+ exit;
+ } elsif ($! =~ /No more process/){
+ sleep 5;
+ redo FORK;
+ }
+ else {
+ # strange error
+ die "Can't fork: $!\n";
+ }
+ }
+}
+sub new_state {
+ my ($user,$remoteIP) =@_;
+ # assumuption user and IP are valid
+ # add user to users.local, sshd_config_vcl
+ # on acknowledgemment turn on sshd on port 22
+ my @file;
+ my $line;
+ my ($userset,$remoteIPset) = 0;
+ #test for sshd_config_vcl
+ if(!(-r "$HOME/sshd_config_vcl")){
+ #hrmm. were did sshd_config_vcl go
+ #let try to create another from the orignal
+ if(createnewssh_config_vcl){
+ notify($ERRORS{'OK'},"new_state: sshd_config_vcl missing created a new one");
+ }
+ else{
+ notify($ERRORS{'OK'},"new_state: sshd_config_vcl missing failed to create a new one");
+ return 0;
+ }
+
+ }
+ if(open(CONFIG,"$HOME/sshd_config_vcl")){
+ @file = <CONFIG>;
+ close(CONFIG);
+ foreach $line (@file){
+ if($line =~ /AllowUsers/){
+ $line = "AllowUsers $user\n";
+ $userset=1;
+ notify($ERRORS{'OK'},"new_state: adding AllowUsers $user to sshd_config_vcl");
+ }
+ }
+ if(!$userset){
+ push @file, "AllowUsers $user\n";
+ notify($ERRORS{'OK'},"new_state: hrmm, had to add AllowUsers $user to sshd_config_vcl");
+ }
+ if(open(CONFIG,">$HOME/sshd_config_vcl")){
+ print CONFIG @file;
+ close(CONFIG);
+ }
+ }
+ # append to users.local
+ if(open(USERSLOCAL,"/etc/users.local")){
+ my @users = <USERSLOCAL>;
+ close(USERSLOCAL);
+ push @users,"\n$user\n";
+ if(open(USERSLOCAL,">/etc/users.local")){
+ print USERSLOCAL @users;
+ notify($ERRORS{'OK'},"new_state: adding $user to users.local");
+ close(USERSLOCAL);
+ }
+ }
+ else{
+ notify($ERRORS{'WARNING'},"new_state: could not open /etc/users.local $!");
+ return 0;
+ }
+ #start sshd
+ if(startsshd){
+ notify($ERRORS{'OK'},"new_state: startsshd returned and successful");
+ return 1;
+ }
+ return 0;
+}
+sub timeout_state{
+ # time to close non-admin ssh sessions and clean up users.local,
+ # sshd_config_vcl
+ my ($user,$remoteIP) =@_;
+ my $os = lc($^O);
+ #notify($ERRORS{'OK'},"timeout_state: OSname is $os");
+ my @file;
+ my $l;
+ my $sshd_admin_pid =0;
+ my ($pgrep,$pkill);
+
+ # get admin pid
+ if($os eq "solaris"){
+ $pgrep="/bin/pgrep";
+ $pkill="/bin/pkill";
+
+ if(open(SSH,"/local/openssh/etc/sshd.admin.pid")){
+ @file = <SSH>;
+ close(SSH);
+ $sshd_admin_pid=$file[0];
+ notify($ERRORS{'OK'},"timeout_state: sshd_admin_pid set $sshd_admin_pid");
+ }
+ else{
+ notify($ERRORS{'OK'},"timeout_state: could not open /local/openssh/etc/sshd.admin.pid $!");
+ }
+ }
+ elsif($os eq "linux"){
+ $pgrep="/usr/bin/pgrep";
+ $pkill="/usr/bin/pkill";
+ if(open(SSH,"ps -ef \| grep /usr/sbin/sshd |")){
+ @file = <SSH>;
+ close(SSH);
+ $sshd_admin_pid=$file[0];
+ foreach $l (@file){
+ chomp ($l);
+ next if($l =~ /grep/);
+ if($l =~ /(\/usr\/sbin\/sshd$)/){
+ my $blah;
+ ($blah,$sshd_admin_pid,$blah) = split(/\s+/,$l,3);
+ notify($ERRORS{'OK'},"timeout_state: sshd_admin_pid set $sshd_admin_pid");
+ }
+ }
+ }
+ else{
+ notify($ERRORS{'OK'},"timeout_state: execute ps -ef $!");
+ }
+ }
+ else{
+ notify($ERRORS{'OK'},"timeout_state: $os not supported");
+ # we'll just let this ride and get a restart
+ }
+ # clean up users.local
+ # collect members of users.admin,users.base, and users.cluster
+ my @users_admin;
+ my @users_base;
+ my @users_cluster;
+ my $u;
+ #this one should exist
+ if(open(USERSLOCAL,"cat /etc/users.local.admin > /etc/users.local |")){
+ close(USERSLOCAL);
+ notify($ERRORS{'OK'},"timeout_state: dumped contents of /etc/users.local.admin /etc/users.local");
+ }
+ if(-r "/etc/users.local.base"){
+ if(open(USERSLOCAL,"cat /etc/users.local.base >> /etc/users.local |")){
+ close(USERSLOCAL);
+ notify($ERRORS{'OK'},"timeout_state: dumped contents of /etc/users.local.base /etc/users.local");
+ }
+ }
+ if(-r "/etc/users.local.cluster"){
+ if(open(USERSLOCAL,"cat /etc/users.local.cluster >> /etc/users.local |")){
+ close(USERSLOCAL);
+ notify($ERRORS{'OK'},"timeout_state: dumped contents of /etc/users.local.cluster /etc/users.local");
+ }
+ }
+
+
+ if(open(USERSLOCAL,"/etc/users.local")){
+ @users_admin=<USERSLOCAL>;
+ close(USERSLOCAL);
+ }
+ # check users.local add vclstaff if is does not exist
+ my $vclstaff=0;
+ my $i;
+ for $i (@users_admin){
+ $vclstaff =1 if($i =~ "vclstaff");
+
+ }
+
+ if(!$vclstaff){
+ push @users_admin, "\nvclstaff\n";
+ if(open(USERSLOCAL,"> /etc/users.local")){
+ print USERSLOCAL @users_admin;
+ close(USERSLOCAL);
+ }
+ }
+ # clean up our sshd_config_vcl
+ my @SSH;
+ my $s;
+ if(open(SSHDCONFIG, "$HOME/sshd_config_vcl")){
+ @SSH = <SSHDCONFIG>;
+ close(SSHDCONFIG);
+ foreach $s (@SSH){
+ if($s =~ s/AllowUsers $user/AllowUsers/g){
+ notify($ERRORS{'OK'},"timeout_state: $user\@$remoteIP removed from sshd_config_vcl");
+ }
+ }
+ # write back out to sshd_config_vcl
+ if(open(SSHDCONFIG, ">$HOME/sshd_config_vcl")){
+ print SSHDCONFIG @SSH;
+ close (SSHDCONFIG);
+ }
+ else{
+ notify($ERRORS{'OK'},"timeout_state: could not open $HOME/sshd_config_vcl for writing");
+ }
+ }
+
+ #kill off any user processes
+ if(open(PKILL, "$pkill -9 -U $user 2>&1 |")){
+ my @pkill=<PKILL>;
+ close(PKILL);
+ notify($ERRORS{'OK'},"timeout_state: stopped user processes");
+ #check for user
+ notify($ERRORS{'OK'},"timeout_state: confirming user processes are stopped");
+ if(open(PGREP, "ps -ef \| grep $user|")){
+ my @pgrep=<PGREP>;
+ close(PGREP);
+ foreach my $pid (@pgrep){
+ next if($pid =~ /grep/);
+ my($userblah,$userpid) = split(/\s+/,$pid,3);
+ if($userpid){
+ if(open(KILL, "kill -9 $userpid |")){
+ notify($ERRORS{'OK'},"timeout_state: killed user process $userpid");
+ close(KILL);
+ }
+ }
+ }
+ }
+ }
+ notify($ERRORS{'OK'},"timeout_state: checking for all sshd processes");
+ # use pgrep to get all sshd pids
+ if(open(PGREP,"ps -ef \|grep sshd 2>&1|")){
+ my @pfile = <PGREP>;
+ close(PGREP);
+ foreach $l (@pfile){
+ next if($l =~ /grep/);
+ next if($l =~ /ps -ef/);
+ notify($ERRORS{'OK'},"timeout_state: pgrep sshd = $l");
+
+ my ($b,$sshpid);
+ ($b,$b,$sshpid,$b) = split(/\s+/,$l,4) if($os eq "solaris");
+ ($b,$sshpid) = split(/\s+/,$l,3) if($os eq "linux");
+ next if($sshpid == $sshd_admin_pid);
+ if(open(KILL, "kill -9 $sshpid |")){
+ notify($ERRORS{'OK'},"timeout_state: killed sshd process $sshpid");
+ close(KILL);
+ }
+ }
+ notify($ERRORS{'OK'},"timeout_state: checking if I accidentially killed all sshd processes");
+ # did we kill all sshd sessions?
+ if(open(PGREP,"ps -ef \|grep sshd \|grep -v grep |")){
+ notify($ERRORS{'OK'},"timeout_state: executed ps -ef \|grep sshd \|grep -v grep");
+ @file = <PGREP>;
+ notify($ERRORS{'OK'},"timeout_state: @file");
+ close(PGREP);
+ if(!($file[0])){
+ notify($ERRORS{'OK'},"timeout_state: killed all sshd processes, will try to restart");
+ if(open(SSHD,"/etc/inet.d/sshd start |")){
+ @file = <SSHD>;
+ close(SSHD);
+ notify($ERRORS{'OK'},"timeout_state: sshd admin restarted @file");
+ }
+ }
+ }
+ }
+ else{
+ notify($ERRORS{'WARNING'},"timeout_state: could not execute /usr/bin/pgrep sshd");
+
+ }
+ notify($ERRORS{'OK'},"timeout_state: looking for sshd_config_vcl");
+ #look for sshd_config_vcl in case we killed the sshd_admin pid
+ if(open(SSH,"ps -ef \| grep /usr/sbin/sshd |")){
+ my @sshfile = <SSH>;
+ close(SSH);
+ foreach $l (@sshfile) {
+ if($l =~ /(\/home\/vclstaff\/sshd_config_vcl\/)/){
+ # for some reason sshd with the vcl config file did not get stopped
+ #initiate a restart/reload
+ notify($ERRORS{'OK'},"timeout_state: sshd_config_vcl not stopped for some reason, prhaps the wrong sshd pid");
+ my ($b,$sshpid) = split(/\s+/,$l,3);
+ if($sshpid == $sshd_admin_pid){
+ notify($ERRORS{'OK'},"timeout_state: killed the wrong sshd pid");
+ #kill this pid
+ if(open(KILL, "kill -9 $sshpid |")){
+ notify($ERRORS{'OK'},"timeout_state: killed sshd process $l");
+ close(KILL);
+ }
+
+ #stop and start sshd service.
+ if(open(SSHSTOP,"/etc/inet.d/sshd stop |")){
+ @file = <SSHSTOP>;
+ close(SSHSTOP);
+ notify($ERRORS{'OK'},"timeout_state: sshd admin stopped @file");
+ if(open(SSHSTART, "/etc/inet.d/sshd start |")){
+ @file=<SSHSTART>;
+ close(SSHSTART);
+ notify($ERRORS{'OK'},"timeout_state: sshd admin started @file");
+ }
+ }
+ }
+ }
+ }
+ }
+
+ if(sshdstatus){
+ notify($ERRORS{'OK'},"timeout_state: sshd core process is running");
+ }
+ else{
+ notify($ERRORS{'CRITICAL'},"timeout_state: sshd is not running or could not be restarted");
+
+ }
+ return 1;
+}
+sub reboot {
+ #simply reboot the client when called
+ my $os = lc($^O);
+ my $reboot;
+ if($os eq "solaris"){
+ $reboot = "/usr/sbin/shutdown -y -g 0 -i 6";
+ }
+ else{
+ $reboot = "/sbin/shutdown -r now";
+ }
+ notify($ERRORS{'OK'},"reboot: starting reboot sequence");
+ if(open(REBOOT,"$reboot 2>&1 |")){
+ my @reboot=<REBOOT>;
+ close(REBOOT);
+ notify($ERRORS{'OK'},"reboot: @reboot");
+ return 1;
+ }
+
+}
+sub fetch {
+ #collect host ssh keys and save for MN to pick up
+ notify($ERRORS{'OK'},"fetch: copying ssh keys to $HOME");
+ my $os = lc($^O);
+ my $sshdir;
+ if($os eq "solaris"){
+ $sshdir = "/local/openssh/etc";
+ }
+ else{
+ $sshdir = "/etc/ssh/";
+ }
+
+ if(open(CP, "/bin/cp $sshdir/ssh_host\* $HOME 2>&1 |")){
+ my @cp=<CP>;
+ close(CP);
+ if(@cp){
+ notify($ERRORS{'OK'},"fetch: copy problems - @cp");
+ }
+
+ if(open(CHOWN,"/bin/chown vclstaff $HOME/ssh_host\* 2>&1 |")){
+ my @chown=<CHOWN>;
+ close(CHOWN);
+ if(@chown){
+ notify($ERRORS{'OK'},"fetch: chown problems - @cp");
+ }
+ }
+ }
+ notify($ERRORS{'OK'},"fetch: fetch complete");
+ return 1;
+}
+sub store {
+ # take host ssh keys stored in my home directory and place them into the /etc/sshd directory
+ #create an orig directory in $sshdir
+ #copy original keys to orig dir
+ #cp given keys to proper location
+ #set correct ownership and premissions on keys
+ #unlink/remove locally stored keys from vclstaff dir
+ my $os = lc($^O);
+ my $sshdir;
+ if($os eq "solaris"){
+ $sshdir = "/local/openssh/etc";
+ }
+ else{
+ $sshdir = "/etc/ssh";
+ }
+ notify($ERRORS{'OK'},"store: copying ssh keys to $sshdir");
+
+ my %filelist;
+ $filelist{"dsa"}="ssh_host_dsa_key";
+ $filelist{"dsapub"}="ssh_host_dsa_key.pub";
+ $filelist{"rsa"}="ssh_host_rsa_key";
+ $filelist{"rsapub"}="ssh_host_rsa_key.pub";
+ $filelist{"key"}="ssh_host_key";
+ $filelist{"keypub"}="ssh_host_key.pub";
+
+ if(!(-d "$sshdir/origkeys")){
+ if(mkdir("$sshdir/origkeys", 755)){
+ notify($ERRORS{'OK'},"store: mkdir successfully created $sshdir/origkeys");
+ }
+ else{
+ notify($ERRORS{'OK'},"store: mkdir $sshdir/origkeys $! ");
+ }
+ }
+ else{
+ #hrmm $sshdir/origkeys already exists
+ }
+ #copy system generated keys to orig dir
+ #copy stored keys to ssh dir
+ #set perms,ownership,unlink local copy
+ foreach my $f(sort keys %filelist) {
+ if(!(-f "$HOME/$filelist{$f}")){
+ notify($ERRORS{'OK'},"store: does not exist $HOME/$filelist{$f}");
+ next;
+ }
+ if(open(CP,"/bin/cp $sshdir/$filelist{$f} $sshdir/origkeys 2>&1 |")){
+ my @cp=<CP>;
+ close(CP);
+ if(@cp){
+ notify($ERRORS{'OK'},"store: copy orig keys problem on $filelist{$f} - @cp");
+ }
+ }
+ #copy given keys to ssh dir
+ if(open(CP,"/bin/cp $HOME/$filelist{$f} $sshdir/$filelist{$f} 2>&1 |")){
+ my @cp=<CP>;
+ close(CP);
+ if(@cp){
+ notify($ERRORS{'OK'},"store: copy given keys problem on $filelist{$f} - @cp");
+ }
+ else{
+ notify($ERRORS{'OK'},"store: copied $filelist{$f} to $sshdir");
+ if(open(CHOWN, "/bin/chown root:root $sshdir/$filelist{$f} 2>&1 |")){
+ close(CHOWN);
+ }
+ my $p;
+ if($f =~ /pub/){
+ $p = 644;
+ }
+ else{
+ $p = 600;
+ }
+ if(open(CHMOD, "/bin/chmod $p $sshdir/$filelist{$f} 2>&1|")){
+ my @chmod=<CHMOD>;
+ close(CHMOD);
+ if(@chmod){
+ notify($ERRORS{'OK'},"store: chmod problem on $filelist{$f} - @chmod");
+ }
+ }#chmod
+ }#else no cp problems
+ }#CP
+ #unlink
+ if(unlink "$HOME/$filelist{$f}"){
+ notify($ERRORS{'OK'},"store: deleted $HOME/$filelist{$f}");
+ }
+ else{
+ notify($ERRORS{'OK'},"store: unable to delete $HOME/$filelist{$f}");
+ }
+ }#foreach
+ #restart sshd
+ if(restartsshd){
+ notify($ERRORS{'OK'},"store: sshd restarted");
+ return 1;
+ }
+ else{
+ notify($ERRORS{'OK'},"store: sshd restart failed");
+ return 0;
+ }
+ return 1;
+}
+
+sub restartsshd {
+ my $os = lc($^O);
+ notify($ERRORS{'OK'},"restartsshd: attempting to restart sshd on $os");
+ if($os eq "solaris"){
+ if(open(STOP,"/bin/pkill -f sshd_admin.cfg 2>&1 |")){
+ my @stop=<STOP>;
+ close(STOP);
+ foreach my $r (@stop) {
+ if($r =~ /failed/i){
+ notify($ERRORS{'WARNING'},"restartsshd: sshd stop failed @stop");
+ }
+ }
+ if(open(START,"/etc/init.d/sshd start 2>&1 |")){
+ my @start=<START>;
+ close(START);
+ foreach my $r (@start) {
+ #notify($ERRORS{'OK'},"restartsshd: output $r");
+ if($r =~ /failed/i){
+ notify($ERRORS{'WARNING'},"restartsshd: sshd start failed @start");
+ }
+ return 1 if($r =~ /ok/i);
+ }
+ }#if start
+ } # pkill
+ }
+ elsif($os =~ /linux/){
+ if(open(RESTART,"/etc/init.d/sshd restart 2>&1 |")){
+ my @restart=<RESTART>;
+ close(RESTART);
+ foreach my $r (@restart) {
+ if($r =~ /failed/i){
+ notify($ERRORS{'WARNING'},"restartsshd: sshd restart failed $r @restart");
+ }
+ if($r =~ /Starting/){
+ return 1 if($r =~ /ok/i);
+ }
+ }
+ }
+ }
+ return 1;
+}
+sub startsshd {
+ my @lines;
+ #figure out OS solaris or linux
+ my $os= lc($^O);
+ my @output;
+ my $l;
+ if($os eq "solaris"){
+ if(open(SSHD,"/local/openssh/sbin/sshd -f $HOME/sshd_config_vcl 2>&1 |")){
+ notify($ERRORS{'OK'},"startsshd: starting sshd");
+ @output = <SSHD>;
+ close(SSHD);
+ foreach $l (@output){
+ notify($ERRORS{'OK'},"startsshd output: $l");
+ }
+ return 1;
+ }
+ else{
+ notify($ERRORS{'OK'},"startsshd: could not execute /local/openssh/sbin/sshd -f $HOME/sshd_config_vcl $!");
+ return 0;
+ }
+ }
+ elsif($os eq "linux"){
+ if(open(SSHD, "/usr/sbin/sshd -f $HOME/sshd_config_vcl |")){
+ notify($ERRORS{'OK'},"startsshd: starting sshd");
+ @output = <SSHD>;
+ close(SSHD);
+ foreach $l (@output){
+ notify($ERRORS{'OK'},"startsshd output: $l");
+ }
+ return 1;
+ }
+ else{
+ notify($ERRORS{'OK'},"startsshd: could not execute /usr/sbin/sshd -f $HOME/sshd_config_vcl $!");
+ return 0;
+ }
+ }
+}
+sub notify {
+ my ($error,$string) = @_;
+ my $currenttime = makedatestring;
+ if(open(LOGIT, ">>$LOG")){
+ if( !$error ){
+ print LOGIT "$currenttime - $$: $string\n";
+ close(LOGIT);
+ return;
+ }
+ if ($error == 2 ) { #CRITICAL something bad happened, exiting
+ print LOGIT "\n$string\n";
+ print LOGIT "exiting\n";
+ close(LOGIT);
+ exit;
+ }
+ elsif( $error == 1 ){
+ # WARNING should prompt admin to
+ # continue or exit
+ # need to disable for cron
+ print LOGIT "\n---- WARNING ---- \n$string\n";
+ close(LOGIT);
+ }
+ # mail us, this is to be used for cron jobs
+ elsif( $error == 5 ){
+ print LOGIT "\n---- sending mail -- $currenttime - - $$ $string\n";
+ my $from = "root";
+ my $to = "fapeeler\@engr.ncsu.edu";
+ my $subject = "PROBLEM -- $0";
+ my $mailer = Mail::Mailer->new("sendmail");
+ if($mailer->open({From => $from,
+ To => $to,
+ Subject => $subject,
+ })){
+ print $mailer "vclclientd $currenttime - - process $$ \n\n\n$string";
+ $mailer->close();
+ }
+ return 1;
+ }
+ }
+}
+sub makedatestring {
+ my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime( );
+ $year += 1900;
+ $mon++;
+ my $datestring = sprintf("%04d-%02d-%02d %02d:%02d:%02d",$year,$mon,$mday,$hour,$min,$sec);
+ return $datestring;
+}
+sub sshdstatus {
+ my $os = lc($^O);
+ if($os eq "solaris"){
+ my $sshd_admin_pid;
+ if(open(SSH,"/local/openssh/etc/sshd.admin.pid")){
+ my @file = <SSH>;
+ close(SSH);
+ chomp($file[0]);
+ $sshd_admin_pid=$file[0];
+ }
+ else{
+ notify($ERRORS{'OK'},"sshdstatus: could not open /local/openssh/etc/sshd.admin.pid $!");
+ return 0;
+ }
+
+ if(open(STAT,"/bin/pgrep -f sshd 2>&1 |")){
+ my @stat=<STAT>;
+ close(STAT);
+ foreach my $r (@stat) {
+ if($r =~ /$sshd_admin_pid/){
+ #notify($ERRORS{'OK'},"sshdstatus: sshd is running");
+ return 1;
+ }
+ }
+ notify($ERRORS{'OK'},"sshdstatus: sshd is NOT running trying to restart");
+ if(open(START,"/etc/init.d/sshd start 2>&1 |")){
+ my @start=<START>;
+ close(START);
+ foreach my $r (@start) {
+ if($r =~ /failed/i){
+ notify($ERRORS{'WARNING'},"store: sshd start failed @start");
+ return 0;
+ }
+ }
+ }#if start
+ }#STAT
+ return 1;
+ } #os=solaris
+ elsif($os =~ /linux/){
+ my $sshd_admin_pid;
+ if(open(SSH,"/var/run/sshd.pid")){
+ my @file = <SSH>;
+ close(SSH);
+ chomp($file[0]);
+ $sshd_admin_pid=$file[0];
+ }
+ else{
+ notify($ERRORS{'WARNING'},"sshdstatus: could not open /var/run/sshd.pid $!");
+ return 0;
+ }
+ my $running=0;
+ if(open(SSH,"pgrep -f sshd 2>&1|")){
+ my @lines = <SSH>;
+ close(SSH);
+ foreach my $l (@lines){
+ if($l =~ /$sshd_admin_pid/){
+ #ok it's running
+ $running=1; #not that this matters
+ return 1;
+ }
+ }
+ }#if pgrep
+ if(!$running){
+ #start sshd
+ notify($ERRORS{'WARNING'},"sshdstatus: not running trying to restart");
+ if(open(STAT,"/etc/init.d/sshd start 2>&1 |")){
+ my @stat = <STAT>;
+ close(STAT);
+ foreach my $s (@stat) {
+ if($s =~ /ok/i){
+ notify($ERRORS{'OK'},"sshdstatus: restarted core sshd process, @stat");
+ return 1;
+ }
+ }
+ #in case I don't return in above check
+ notify($ERRORS{'OK'},"sshdstatus: restart attempt may of had issues, @stat");
+ return 0;
+ }#if sshd start
+ }#if ! running
+ }#elsif linux
+}
+sub createnewssh_config_vcl {
+ #check for .orig from /etc/ssh dir
+ #if orig then just need to add port 22 and AllowUsers directive
+ my ($port22,$AU,$port24)=0;
+ my @file;
+ if(-e "/etc/sshd/sshd_config.orig"){
+ #good slurp it in
+ if(open(CONFIG,"$HOME/sshd_config_vcl")){
+ @file = <CONFIG>;
+ close(CONFIG);
+ foreach my $line (@file){
+ #check for port 22 and AllowUsers
+ if($line =~ /^Port 22/){
+ $port22=1;
+ }
+ if($line =~ /^AllowUsers/){
+ $AU=1;
+ }
+ if($line =~ s/^Port 24/Port 22/g){
+ $port22=1;
+ }
+ }
+ }
+ }
+ else{
+ #ok /etc/sshd/sshd_config.orig does not exist
+ #try to create from the /etc/sshd/sshd_config
+
+ }
+ #write out to $HOME/sshd_config_vcl
+ if(open(SC,">$HOME/sshd_config_vcl")){
+ print SC @file;
+ close(SC);
+ }
+ else{
+ notify($ERRORS{'CRITICAL'},"createnewssh_config_vcl: sshd_config_vcl was reported to not exists, in repairing I failed to create a new $HOME/sshd_config_vcl $!");
+ return 0;
+ }
+}
diff --git a/managementnode/bin/vcld b/managementnode/bin/vcld
new file mode 100644
index 0000000..3be7324
--- /dev/null
+++ b/managementnode/bin/vcld
@@ -0,0 +1,750 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: vcld 1951 2008-12-12 13:48:10Z arkurth $
+##############################################################################
+
+=head1 NAME
+
+VCL::vcld - VCL daemon module
+
+=head1 SYNOPSIS
+
+ perl vcld
+
+=head1 DESCRIPTION
+
+ This is the executable module for running the VCL management node daemon.
+
+=cut
+
+##############################################################################
+package VCL::vcld;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+# Configure inheritance
+use base qw();
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use Symbol;
+use POSIX;
+use Getopt::Long;
+use English;
+
+use VCL::utils;
+use VCL::DataStructure;
+
+##############################################################################
+# Turn on autoflush
+$| = 1;
+
+# Get the command line options
+our $opt_d = '';
+Getopt::Long::Configure('bundling', 'no_ignore_case');
+GetOptions('d|debug' => \$opt_d,
+ 'h|help' => \&help);
+
+# Call daemonize if -d (debug) wasn't specified
+if (!$opt_d) {
+ &daemonize;
+}
+
+# Variables to store child process information
+our %child_pids = (); # keys are current child process IDs
+our $child_count = 0; # current number of children
+
+# Install signal handlers
+$SIG{CHLD} = \&REAPER;
+$SIG{INT} = \&HUNTSMAN;
+$SIG{QUIT} = \&HUNTSMAN;
+$SIG{HUP} = \&HUNTSMAN;
+$SIG{TERM} = \&HUNTSMAN;
+
+# Call main subroutine
+&main();
+
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 main
+
+ Parameters :
+ Returns :
+ Description : Main VCL daemon engine subroutine. Queries database for request
+ and passes off data to make_new_child() to begin processing.
+
+=cut
+
+sub main () {
+ preplogfile($LOGFILE);
+
+ #===========================================================================
+ # BEGIN NEW CODE
+ # This section does some prep work before looping
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Set the vcld environment variable to 0 so other subroutines know if this is the vcld or child process
+ $ENV{vcld} = 1;
+ notify($ERRORS{'OK'}, $LOGFILE, "vcld environment variable set to $ENV{vcld} for this process");
+
+ # Rename this process
+ rename_vcld_process();
+
+ # Create a hash to store all of the program state information
+ my %info;
+
+ # Get the management node info from the database
+ # get_management_node_info() will determine the hostname
+ if ($info{managementnode} = get_management_node_info()) {
+ notify($ERRORS{'OK'}, $LOGFILE, "retrieved management node information from database");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, $LOGFILE, "unable to retieve management node information from database");
+ exit;
+ }
+
+ # Define local variables from the management node hash for code simplicity
+ my $management_node_id = $info{managementnode}{id};
+ my $management_node_hostname = $info{managementnode}{hostname};
+
+ # Set environment variables for global management node information
+ $ENV{management_node_id} = $management_node_id;
+ notify($ERRORS{'OK'}, $LOGFILE, "management_node_id environment variable set: $management_node_id");
+
+ # Get the management node checkin interval from the database if defined
+ # Otherwise, the default is 12 seconds
+ my $management_node_checkin_interval = 12;
+ if (defined $info{managementnode}{checkininterval}) {
+ $management_node_checkin_interval = $info{managementnode}{checkininterval};
+ }
+ notify($ERRORS{'OK'}, $LOGFILE, "management node checkin interval is $management_node_checkin_interval seconds");
+ notify($ERRORS{'OK'}, $LOGFILE, "vcld started on $management_node_hostname");
+
+ #===========================================================================
+ while (1) {
+ SLEEP:
+
+ delete $ENV{request_id};
+ delete $ENV{reservation_id};
+ delete $ENV{state};
+
+ sleep $management_node_checkin_interval;
+
+ #===========================================================================
+ # Update lastcheckin for this management node
+ my $lastcheckin_timestamp = update_lastcheckin($management_node_id);
+ if ($lastcheckin_timestamp) {
+ notify($ERRORS{'DEBUG'}, $LOGFILE, "lastcheckin time updated for management node $management_node_id: $lastcheckin_timestamp");
+ # Update the local hash info to reflect the new timestamp
+ $info{managementnode}{lastcheckin} = $lastcheckin_timestamp;
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, $LOGFILE, "could not update lastcheckin for management node $management_node_id");
+ }
+
+ # Get all the requests assigned to this management node
+ # get_management_node_requests() gets a subset of the information available
+ if ($info{request} = {get_management_node_requests($management_node_id)}) {
+ #notify($ERRORS{'DEBUG'}, $LOGFILE, "retieved request information for management node $management_node_id");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, $LOGFILE, "could not retieve request information for management node $management_node_id");
+ }
+
+ # See if there's anything to do
+ my $request_count = scalar keys %{$info{request}};
+ #notify($ERRORS{'DEBUG'}, $LOGFILE, "number of requests assigned to management node $management_node_id: $request_count");
+
+ #===========================================================================
+ # Loop through the requests assigned to this management node
+ REQUEST: foreach my $request_id (keys %{$info{request}}) {
+ #notify($ERRORS{'DEBUG'}, $LOGFILE, "management node $management_node_id has been assigned request id: $request_id");
+
+ # Store some request data into a local variables
+ my $request_state_name = $info{request}{$request_id}{state}{name};
+ my $request_laststate_name = $info{request}{$request_id}{laststate}{name};
+ my $request_start = $info{request}{$request_id}{start};
+ my $request_end = $info{request}{$request_id}{end};
+ my $request_preload = $info{request}{$request_id}{preload};
+
+ $ENV{request_id} = $request_id;
+ $ENV{reservation_id} = 0;
+ $ENV{state} = $request_state_name;
+
+ # Make sure the request state is valid
+ if ($request_state_name !~ /inuse|reserved|deleted|timeout|reclaim|reload|new|tomaintenance|image|imageprep|makeproduction|imageinuse|complete|failed|pending|maintenance|tovmhostinuse/) {
+ notify($ERRORS{'WARNING'}, $LOGFILE, "assigned request in unsupported state: $request_state_name");
+ next REQUEST;
+ }
+
+ # Don't process requests that are already pending
+ if ($request_state_name =~ /^(pending|maintenance)/) {
+ next REQUEST;
+ }
+
+ #===========================================================================
+ # Loop through the reservations associated with this request
+ RESERVATION: foreach my $reservation_id (keys %{$info{request}{$request_id}{reservation}}) {
+ $ENV{reservation_id} = $reservation_id;
+
+ # Check to see if the reservation is still in the hash before proceeding
+ # If request was deleted from database, it was also removed from this hash
+ if (!defined($info{request}{$request_id}{reservation}{$reservation_id})) {
+ #notify($ERRORS{'DEBUG'}, $LOGFILE, "reservation was deleted");
+ next RESERVATION;
+ }
+
+ # Store reservation variables into local variable
+ my $reservation_lastcheck = $info{request}{$request_id}{reservation}{$reservation_id}{lastcheck};
+
+ # Perform steps common to all states
+ #notify($ERRORS{'DEBUG'}, $LOGFILE, "assigned reservation in state: $request_state_name");
+
+ # The request_info hash stores all the information for this request
+ my %request_info;
+
+ # Figure out the status of this reservation based on reservation times and the request state
+ # check_time_result can be: start, preload, end, poll, old, remove, 0
+ my $check_time_result = check_time($request_start, $request_end, $reservation_lastcheck, $request_state_name, $request_laststate_name);
+ #notify($ERRORS{'DEBUG'}, 0, "check_time returned \'$check_time_result\'");
+
+ # Do nothing if check_time returned 0
+ # Check this before querying for the large set of request data
+ if (!$check_time_result) {
+ # do nothing - disabled debug output too much info for large numbr of requests
+ #notify($ERRORS{'DEBUG'}, $LOGFILE, "request will not be processed");
+ next RESERVATION;
+ }
+ elsif ($check_time_result eq "old") {
+ # Only complain
+ notify($ERRORS{'WARNING'}, $LOGFILE, "this is an old request");
+ next RESERVATION;
+ }
+ elsif ($check_time_result eq "remove") {
+ # Remove the request and associated reservations from database
+ # This also removes rows from computerloadlog table for associated reservations
+ if (delete_request($request_id)) {
+ notify($ERRORS{'OK'}, $LOGFILE, "request deleted");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, $LOGFILE, "unable to delete rows from request, reservation, and computerloadlog tables for request");
+ }
+
+ # Remove the request key from the hash
+ delete $info{request}{$request_id};
+ next RESERVATION;
+ } ## end elsif ($check_time_result eq "remove") [ if (!$check_time_result)
+ elsif ($check_time_result eq "preload" && $request_preload) {
+ # Preload flag has already been set, don't process preload request again
+ notify($ERRORS{'DEBUG'}, $LOGFILE, "preload request has already been processed");
+ next RESERVATION;
+ }
+
+ # Make sure reservation is not currently being processed
+ if (reservation_being_processed($reservation_id)) {
+ notify($ERRORS{'WARNING'}, $LOGFILE, "reservation $reservation_id is already being processed");
+ next RESERVATION;
+ }
+ else {
+ notify($ERRORS{'DEBUG'}, $LOGFILE, "reservation $reservation_id is NOT already being processed");
+ }
+
+ # Get the full set of database data for this request
+ if (%request_info = get_request_info($request_id)) {
+ notify($ERRORS{'DEBUG'}, $LOGFILE, "retieved request information from database");
+
+ # Set request variables that may have changed by other processes to their original values
+ # They may change if this is a cluster reservation
+ $request_info{state}{name} = $request_state_name;
+ $request_info{laststate}{name} = $request_laststate_name;
+ $request_info{preload} = $request_preload;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, $LOGFILE, "could not retieve request information from database");
+ next RESERVATION;
+ }
+
+ # Add the check_time result to the hash
+ $request_info{CHECKTIME} = $check_time_result;
+
+ # Get a new data structure object
+ my $data_structure;
+ eval {$data_structure = new VCL::DataStructure({request_data => \%request_info, reservation_id => $reservation_id});};
+ if (my $e = Exception::Class::Base->caught()) {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to create DataStructure object" . $e->message);
+ next RESERVATION;
+ }
+
+ # Check if preload was returned by check_time and that preload flag is 0
+ # The preload flag will be set to 1 by new.pm module after it's done
+ if ($check_time_result =~ /preload/ && !($request_info{preload})) {
+ notify($ERRORS{'OK'}, $LOGFILE, "request start time within 25-35 minute window and preload flag is 0, processing preload request");
+ $request_info{PRELOADONLY} = 1;
+ }
+
+ # Add the reservation ID to be processed to the hash
+ $request_info{RESERVATIONID} = $reservation_id;
+
+ # Wait for a short amount of time before making new child
+ # This is to give processes a chance to start before subsequent processes
+ # check for conflicts such as overlapping computer reservations
+ notify($ERRORS{'DEBUG'}, $LOGFILE, "sleeping for 2 seconds before updating state to pending");
+ sleep 2;
+
+ # Update the request state to pending, laststate to next state
+ # Pending is set now so vcld doesn't try to process it again
+ # The previous state is already in the hash as the laststate value
+ # This will be passed to the next module so it knows where it came from
+ my $is_parent_reservation = $data_structure->is_parent_reservation();
+ if ($is_parent_reservation && update_request_state($request_id, "pending", $request_state_name)) {
+ notify($ERRORS{'OK'}, $LOGFILE, "request state updated to pending, laststate $request_state_name");
+ }
+ elsif (!$is_parent_reservation) {
+ notify($ERRORS{'OK'}, $LOGFILE, "child reservation: request state NOT updated to pending");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, $LOGFILE, "request state could not be updated to pending, reservation not processed");
+ next RESERVATION;
+ }
+
+ # Insert a computerloadlog entry to indicate processing has begin for this reservation
+ my $computer_id = $data_structure->get_computer_id();
+ if (insertloadlog($reservation_id, $computer_id, "begin", "beginning to process, state is $request_state_name")) {
+ notify($ERRORS{'OK'}, $LOGFILE, "inserted 'begin' entry into computerloadlog for reservation $reservation_id");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, $LOGFILE, "failed to insert 'begin' entry into computerloadlog for reservation $reservation_id");
+ }
+
+ # Make a new child process, passing it the request/reservation info
+ make_new_child({request_info => \%request_info, data_structure => $data_structure});
+
+ } ## end foreach my $reservation_id (keys %{$info{request...
+ } ## end foreach my $request_id (keys %{$info{request}})
+
+ delete $ENV{request_id};
+ delete $ENV{reservation_id};
+ delete $ENV{state};
+
+ #===========================================================================
+ # Get all the block requests assigned to this management node
+ my $blockrequest_data = get_management_node_blockrequests($management_node_id);
+ if (!defined $blockrequest_data) {
+ notify($ERRORS{'CRITICAL'}, $LOGFILE, "could not retrieve block request information for management node $management_node_id");
+ next;
+ }
+ elsif (!$blockrequest_data) {
+ #notify($ERRORS{'OK'}, 0, "there are 0 block requests assigned to management node $management_node_id");
+ next;
+ }
+
+ #notify($ERRORS{'CRITICAL'}, $LOGFILE, "\$blockrequest_data", $blockrequest_data);
+ #next;
+
+ # Loop through the block requests assigned to this management node
+ BLOCKREQUEST: foreach my $blockrequest_id (keys %{$blockrequest_data}) {
+ #notify($ERRORS{'DEBUG'}, $LOGFILE, "checking block request id=$blockrequest_id");
+
+ BLOCKTIME: foreach my $blocktime_id (keys %{$blockrequest_data->{$blockrequest_id}{blockTimes}}) {
+ #notify($ERRORS{'DEBUG'}, $LOGFILE, "checking block time id=$blocktime_id");
+
+ # Get a new data structure object
+ my $data_structure;
+ eval {$data_structure = new VCL::DataStructure({blockrequest_data => $blockrequest_data, blockrequest_id => $blockrequest_id, blocktime_id => $blocktime_id});};
+ if (my $e = Exception::Class::Base->caught()) {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to create DataStructure object" . $e->message);
+ next;
+ }
+
+ # Store some block request data into a local variables
+ my $blockrequest_name = $data_structure->get_blockrequest_name();
+ my $blockrequest_expire = $data_structure->get_blockrequest_expire();
+ my $blockrequest_processing = $data_structure->get_blockrequest_processing();
+ my $blocktime_start = $data_structure->get_blocktime_start();
+ my $blocktime_end = $data_structure->get_blocktime_end();
+ my $blocktime_processed = $data_structure->get_blocktime_processed();
+ my $blocktime_id = $data_structure->get_blocktime_id();
+
+ #use VCL::blockrequest;
+ #$data_structure->set_blockrequest_mode('start');
+ #my $br_start = VCL::blockrequest->new({%{$blockrequest_data->{$blockrequest_id}}, data_structure => $data_structure});
+ #notify($ERRORS{'OK'}, $LOGFILE, "***** Starting start process *****");
+ #$br_start->process();
+ #exit;
+ #notify($ERRORS{'OK'}, $LOGFILE, "***** DONE WITH START *****");
+ #sleep 5;
+ #$data_structure->set_blockrequest_mode('end');
+ #my $br_end = VCL::blockrequest->new({%{$blockrequest_data->{$blockrequest_id}}, data_structure => $data_structure});
+ #notify($ERRORS{'OK'}, $LOGFILE, "***** Starting end process *****");
+ #$br_end->process();
+ #notify($ERRORS{'OK'}, $LOGFILE, "***** DONE WITH END *****");
+ #exit;
+
+ # Check if the block request is already being processed
+ if ($blockrequest_processing) {
+ #notify($ERRORS{'DEBUG'}, $LOGFILE, "block request $blockrequest_id '$blockrequest_name' is already being processed");
+ next BLOCKREQUEST;
+ }
+ else {
+ #notify($ERRORS{'OK'}, $LOGFILE, "block request $blockrequest_id '$blockrequest_name' is not currently being processed");
+ }
+
+ # Check block request start, end and expire time
+ my $blockrequest_mode = check_blockrequest_time($blocktime_start, $blocktime_end, $blockrequest_expire);
+
+ # check_blockrequest_time will return 0 if nothing needs to be done and undefined if an error occurred
+ if (!defined $blockrequest_mode) {
+ notify($ERRORS{'CRITICAL'}, $LOGFILE, "error occurred checking block request $blockrequest_id '$blockrequest_name' status");
+ next;
+ }
+ elsif (!$blockrequest_mode) {
+ #notify($ERRORS{'DEBUG'}, $LOGFILE, "block request $blockrequest_id will not be processed at this time");
+ next;
+ }
+ else {
+ #notify($ERRORS{'DEBUG'}, $LOGFILE, "block request $blockrequest_id will be processed, mode: $blockrequest_mode");
+ }
+
+ if ($blockrequest_mode eq 'start' && $blocktime_processed) {
+ #notify($ERRORS{'DEBUG'}, $LOGFILE, "block request $blockrequest_id '$blockrequest_name' blocktime_id $blocktime_id has already been processed");
+ next BLOCKREQUEST;
+ }
+
+ # Start processing block request
+ $data_structure->set_blockrequest_mode($blockrequest_mode);
+
+ # Attempt to set the blockRequest processing column to 1
+ if (update_blockrequest_processing($blockrequest_id, 1)) {
+ notify($ERRORS{'OK'}, $LOGFILE, "block request $blockrequest_id '$blockrequest_name' processing set to 1");
+
+ # Make a new child process, passing it the request/reservation info
+ make_new_child({data_structure => $data_structure, request_info => $blockrequest_data->{$blockrequest_id}});
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, $LOGFILE, "unable to set block request $blockrequest_id '$blockrequest_name' processing to 1");
+ next;
+ }
+ } ## end foreach my $blocktime_id (keys %{$blockrequest_data...
+
+ } ## end foreach my $blockrequest_id (keys %{$blockrequest_data...
+ } ## end while (1)
+} ## end sub main ()
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 make_new_child
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub make_new_child {
+ my ($args) = @_;
+
+ my $request_data = $args->{request_info};
+ my $data_structure = $args->{data_structure};
+ $data_structure = 0 if !$data_structure;
+
+ # Assemble a consistent prefix for notify messages
+ my $request_id = $request_data->{id};
+ my $reservation_id = $request_data->{RESERVATIONID};
+
+ # Get the state name
+ my $state;
+ my $state_module;
+ if ($data_structure) {
+ $state = $data_structure->get_state_name();
+ $state_module = "VCL::$state";
+ }
+ else {
+ $state = $request_data->{state}{name};
+ $state_module = "VCL::$state";
+ }
+
+ # The timeout and deleted states have been combined into reclaim.pm
+ if ($state =~ /^(timeout|deleted)$/) {
+ notify($ERRORS{'OK'}, $LOGFILE, "request will be processed by reclaim.pm");
+ $state_module = "VCL::reclaim";
+ }
+
+ # The imageinuse state is now handled by inuse.pm
+ if ($state =~ /^(imageinuse)$/) {
+ notify($ERRORS{'OK'}, $LOGFILE, "request will be processed by inuse.pm");
+ $state_module = "VCL::inuse";
+ }
+
+ # The tomaintenance state is handled by new.pm
+ if ($state =~ /^(tomaintenance|imageprep|reload|tovmhostinuse)$/) {
+ notify($ERRORS{'OK'}, $LOGFILE, "request will be processed by new.pm");
+ $state_module = "VCL::new";
+ }
+
+ notify($ERRORS{'OK'}, $LOGFILE, "creating new process");
+
+ eval "use $state_module";
+ if (!$EVAL_ERROR) {
+ notify($ERRORS{'OK'}, $LOGFILE, "loaded $state_module module");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, $LOGFILE, "$state_module module could not be loaded");
+ }
+
+ # For testing purposes on Windows
+ if ($^O =~ /win/i) {
+ # Set the request_id and reservation_id environment variables
+ $ENV{request_id} = $request_id;
+ $ENV{reservation_id} = $reservation_id;
+
+ # Set the vcld environment variable to 0 so other subroutines know if this is the vcld or child process
+ $ENV{vcld} = 0;
+ notify($ERRORS{'OK'}, $LOGFILE, "vcld environment variable set to $ENV{vcld} for this process");
+
+ my $kid;
+ if ($kid = ($state_module)->new({%{$request_data}, data_structure => $data_structure})) {
+ notify($ERRORS{'OK'}, $LOGFILE, "$state object created and initialized");
+ # Set the request_id and reservation_id environment variables
+ $kid->process();
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, $LOGFILE, "$state object could not be created and initialized");
+ switch_state($request_data, 'failed', '', 'failed', 1);
+ }
+
+ # Set the request_id and reservation_id environment variables
+ delete $ENV{request_id};
+ delete $ENV{reservation_id};
+ delete $ENV{state};
+
+ # Restore the vcld environment variable to 1
+ $ENV{vcld} = 1;
+
+ # Only return from make_new_child if running on Windows for testing without actually forking
+ return;
+ } ## end if ($^O =~ /win/i)
+
+ # Build a signal set using POSIX::SigSet->new, contains only the SIGINT signal
+ my $sigset = POSIX::SigSet->new(SIGINT);
+
+ # Pass the POSIX::SigSet object to sigprocmask with the SIG_BLOCK flag to delay SIGINT signal delivery
+ sigprocmask(SIG_BLOCK, $sigset) or die "can't block SIGINT for fork: $!\n";
+
+ FORK: {
+ my $pid;
+ if ($pid = fork) {
+ # If here, this is the parent process
+
+ # Restore delivery of SIGINT signal for the parent process
+ sigprocmask(SIG_UNBLOCK, $sigset) or die "can't unblock SIGINT for fork: $!\n";
+
+ # Parent process records the child's PID and returns
+ $child_count++;
+ $child_pids{$pid} = 1;
+ notify($ERRORS{'OK'}, $LOGFILE, "current number of forked kids: $child_count");
+ return;
+ }
+ elsif (defined $pid) {
+ # If here, this is the child process
+ # Child must *NOT* return from this subroutine after this point. It must exit.
+ # If child returns it will become a parent process and spawn off its own children
+
+ # Configure the SIGINT signal to kill this process normally
+ $SIG{INT} = 'DEFAULT';
+
+ # Unblock the SIGINT signal
+ sigprocmask(SIG_UNBLOCK, $sigset) or die "can't unblock SIGINT for fork: $!\n";
+
+ # Set the vcld environment variable to 0 so other subroutines know if this is the vcld or child process
+ $ENV{vcld} = 0;
+ notify($ERRORS{'OK'}, $LOGFILE, "vcld environment variable set to $ENV{vcld} for this process");
+
+ # Set the request_id and reservation_id environment variables
+ $ENV{request_id} = $request_id;
+ $ENV{reservation_id} = $reservation_id if $reservation_id;
+ $ENV{state} = $state;
+
+ # Create a new VCL state object, passing it the reservation data
+ if (my $state_object = ($state_module)->new({%{$request_data}, data_structure => $data_structure})) {
+ notify($ERRORS{'OK'}, $LOGFILE, "$state_module object created and initialized");
+
+ # Call the state object's process() subroutine
+ $state_object->process();
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, $LOGFILE, "$state_module object could not be created and initialized, $!");
+ switch_state($request_data, 'failed', '', 'failed', 1);
+ }
+
+ exit;
+
+ } ## end elsif (defined $pid) [ if ($pid = fork)
+
+ elsif ($! =~ /No more process/) {
+ sleep 5;
+ redo FORK;
+ }
+
+ else {
+ # strange error
+ die "can't fork: $!\n";
+ }
+ } ## end FORK:
+} ## end sub make_new_child
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 HUNTSMAN
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub HUNTSMAN {
+ # Temporarily override the the SIGCHLD signal handler
+ # Set SIGCHLD handler to IGNORE, meaning nothing happens when a child process exits
+ local ($SIG{CHLD}) = 'IGNORE';
+
+ # Send SIGINT to child processes
+ kill 'INT' => keys %child_pids;
+
+ notify($ERRORS{'OK'}, $LOGFILE, "vcld process exiting, pid=$$");
+ exit;
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 REAPER
+
+ Parameters : None
+ Returns : Undefined
+ Description : The REAPER subroutine gets called whenever a child process
+ stops running or exits. This occurs because the subroutine is
+ configured as the handler for SIGCHLD signals. The system will
+ send a SIGCHLD signal whenever a child process stops running
+ or exits.
+
+ The REAPER subroutine manages the child PID hash when a VCL .
+ state process exits. It also captures the exit code of the
+ child process which died and makes sure the special $?
+ variable is set to this value.
+
+=cut
+
+sub REAPER {
+ # Save the information saved in $? before proceeding
+ # This is done to save the exit status of the child process which died
+ # If you don't save it, wait() will overwrite it
+ my $child_exit_status = $? >> 8;
+ my $signal_number = $? & 127;
+ my $dumped_core = $? & 128;
+
+ # Configure the REAPER() subroutine to handle SIGCHLD signals
+ $SIG{CHLD} = \&REAPER;
+
+ # Wait for a child process to terminate
+ # Should have already happened since this subroutine is only called when CHLD signals are sent
+ my $dead_pid = wait;
+
+ # Check if the child PID hash contains the pid of the process which just died
+ if (exists $child_pids{$dead_pid}) {
+ # Child which died was a VCL state process since its pid is in the hash
+ $child_count--;
+ delete $child_pids{$dead_pid};
+ notify($ERRORS{'OK'}, $LOGFILE, "VCL state process exited, pid=$dead_pid");
+ }
+ else {
+ # Child which died was some other process
+ notify($ERRORS{'DEBUG'}, $LOGFILE, "child process exited, pid=$dead_pid");
+ }
+
+ # Set the special $? variable back to the exit status of the child which died
+ # This is useful when utilities such as SSH are run in other places in the code
+ # The code which called the utility can check the exit status to see if it was successful
+ $? = $child_exit_status;
+
+ return;
+} ## end sub REAPER
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 daemonize
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub daemonize {
+ chdir '/' or die "Can't chdir to /: $!";
+ defined(my $pid = fork) or die "Can't fork $!";
+ exit if $pid;
+ #development
+ #$0 = "vcldev";
+ #production
+ #$0 = "vcld";
+ $0 = $PROCESSNAME;
+ print "Created process $$ renamed to $0 ...\n";
+ setsid or die "Can't start a new session: $!";
+ open STDIN, '/dev/null' or die "Can't read /dev/null $!";
+ open STDOUT, ">>$LOGFILE" or die "Can't write $LOGFILE $!";
+ open STDERR, ">>$LOGFILE" or die "Can't write $LOGFILE $!";
+ setsid or die "Can't start a new session: $!";
+ umask 0;
+ open(PIDFILE, ">" . $PIDFILE) or notify($ERRORS{'WARNING'}, $LOGFILE, "unable to open PID file: $PIDFILE, $!"); # so I can kill myself easily
+ print PIDFILE $$;
+ close(PIDFILE);
+} ## end sub daemonize
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 help
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub help {
+ my $message = <<"END";
+--------------------------------------------
+
+vcld is intented to run in daemon mode.
+
+Please read the INSTALLATION file in the source directory.
+END
+
+ print $message;
+ exit;
+} ## end sub help
diff --git a/managementnode/bin/vcld_cron_check b/managementnode/bin/vcld_cron_check
new file mode 100755
index 0000000..65430cf
--- /dev/null
+++ b/managementnode/bin/vcld_cron_check
@@ -0,0 +1,13 @@
+#!/bin/bash
+##############################################################################
+# $Id: vcld_cron_check 1951 2008-12-12 13:48:10Z arkurth $
+##############################################################################
+
+email=
+if ! /etc/init.d/vcld.start status &> /dev/null; then
+ if /etc/init.d/vcld.start start &> /dev/null; then
+ echo "restarted vcld on `hostname`" |mail -s "vcld restarted" $email
+ else
+ echo "restart of vcld failed on `hostname`" |mail -s "vcld restart failed" $email
+ fi
+fi
diff --git a/managementnode/etc/vcl/vcld.conf b/managementnode/etc/vcl/vcld.conf
new file mode 100644
index 0000000..e06f5d9
--- /dev/null
+++ b/managementnode/etc/vcl/vcld.conf
@@ -0,0 +1,239 @@
+##############################################################################
+# $Id: vcld.conf 1949 2008-12-12 13:35:49Z arkurth $
+##############################################################################
+# NAME
+# vcld.conf
+#
+# AUTHOR
+# Aaron Peeler, aaron_peeler@ncsu.edu
+# Andy Kurth, andy_kurth@ncsu.edu
+#
+# DESCRIPTION
+# This file contains configuration values for a VCL management node daemon.
+# It contains senistive information and should have appropriate permissions.
+# Please read the README file. For use license and copyright information
+# see the LICENSE and COPYRIGHT files.
+#
+# FORMAT
+# The format is assumed to be key=value. Lines should not contain spaces.
+#
+# SEE ALSO
+# http://vcl.ncsu.edu
+# vcl_help@ncsu.edu
+#
+# COPYRIGHT AND LICENSE
+# Copyright (C) 2004-2008 by NC State University. All Rights Reserved.
+#
+# Virtual Computing Laboratory
+# North Carolina State University
+# Raleigh, NC, USA 27695
+#
+# For use license and copyright information see LICENSE and COPYRIGHT files
+# included in the source files.
+
+
+# processname: name to call VCL daemon process
+# Default: vcld
+processname=vcld
+
+# FQDN: DNS name of the management node
+# Example: mgtnode1.hpc.ncsu.edu
+FQDN=
+
+# log: log file location
+# Default: /var/log/vcld.log
+# If left undefined it will be named according to the above processname
+# i.e. /var/log/$PROCESSNAME.log
+log=/var/log/vcld.log
+
+# pidfile: process id file location
+# Default: /var/run/vcld.pid
+# If left undefined it will be named according to the above processname
+# i.e. /var/run/$PROCESSNAME.pid
+pidfile=/var/run/vcld.pid
+
+
+
+# Database connection information
+
+# database: name of MySQL database (required)
+database=vcl
+
+# server: IP address or FQDN of the database server (required)
+server=
+
+# LockerWrtUser: MySQL user account name with write privileges (required)
+LockerWrtUser=vcl-wrt
+
+# wrtPass: MySQL password of the above LockerWrtUser (required)
+# Any length is supported by MySQL
+# Must be a string of characters: A-Z a-z 0-9
+wrtPass=
+
+# LockerRdUser: MySQL user account name with write privileges (optional)
+LockerRdUser=vcl-rd
+
+# rdPass: MySQL password of the above LockerRdUser (optional)
+# Any length is supported by MySQL
+# Must be a string of characters: A-Z a-z 0-9
+rdPass=
+
+
+# enable_mysql_ssl: Determines if SSL is used for MySQL connections
+# Useful in open networks or large distributed configurations
+# Note: Perl's DBD-mysql module must be compiled with the --ssl option
+# It is not turned on by default
+# Values: no|yes
+# Default: no
+enable_mysql_ssl=no
+
+#mysql_ssl_cert: Path to MySQL certificate file
+mysql_ssl_cert=/etc/vcl/cert/my_ca.crt
+
+
+# sysadmin: system administrator email list
+# list of email addresses to be used for critical notices regarding failures or problems
+# optional, but not recommended to leave blank
+# Format: comma delimited list
+# Example: john_doe@ncsu.edu,sysadmins@vcl.ncsu.edu
+sysadmin=
+
+
+# shared mailbox -
+# address of a shared mailbox for copies of all notices sent to users
+# optional
+# leave empty or comment out to disable
+# depending on user base this mailbox can grow quite large
+#
+# users are sent email notices regarding their reservations for new
+# reservations, upcoming timeouts and image creations
+sharedmailbox=
+
+# default url for end-user notifications if not listed in affilation
+# database table - this is usually the core www site address
+DEFAULTURL=http://vcl.your.domain
+
+# default from email address for end-user notifications if not listed in
+# affilation
+# database table - normally this would be a list or a help system - but
+# could be your email address(your address not recommeded for large
+# setups)
+DEFAULTHELPEMAIL=help@your.domain.com
+
+#IM support - jabber only at this time
+#jabber - dependiences on Net::Jabber.pm perl modules
+# for information on how to install Net::Jabber.pm modules see documentation
+jabber=no
+
+# jabber variables
+# ignore if jabber=no
+
+# jabServer - server IP or FQHN of jabber server
+jabServer=your.jabber.com
+
+# jabPort - jabber port - default 5222
+jabPort=5222
+
+# jabUser - registered jabber user
+jabUser=vcl
+
+# jabPass - password for jabber user
+jabPass=
+
+# jabResource - jabbber resource
+jabResource=vcl
+
+
+# path to identity keys used to log into remote resources
+# make sure the premissions are right -- 600
+
+IDENTITY_blade_linux=/etc/vcl/bladelinuxkey_id_rsa
+IDENTITY_solaris_lab=/etc/vcl/solaris_lab.key
+IDENTITY_linux_lab=/etc/vcl/linux_lab.key
+IDENTITY_blade_win=/etc/vcl/winxp_blade.key
+
+# Windows node root password
+WINDOWS_ROOT_PASSWORD=cl0udy
+
+#ip address configuration
+# for sites that use Dynamic DHCP or static address assignment.
+# default is Manual DHCP
+# options are:
+# manualDHCP -- address is statically assigned in dhcp server
+# dynamicDHCP -- address is dynamically assigned from dhcp server
+# static -- when public dhcp server is not available, assigments are made
+
+ipconfiguration=dynamicDHCP
+
+#dependiences for static assignments - required if set to static
+# DNSserver can be comma delimited up to three entries
+#DNSserver=
+#GATEWAY=
+#NETMASK=
+#ETHDEVICE=eth1
+
+# Provisioning systems
+
+# xCAT - xcat.org
+
+XCAT=yes
+
+LINUXIMAGEid=image
+
+#throttle - to limit the number concurrent bare metal loads
+# 0 or commeted out - disabled - no limit
+# any number 1 or more - number of simultanous loads
+THROTTLE=0
+
+# XCATROOT - root files for xcat, default is /opt/xcat
+XCATROOT=/opt/xcat
+
+#xcat repositories and descriptors
+# location of the image files create by partimage
+CORE_IMAGEREPOSITORY=/install/image/x86
+WIN_IMAGEREPOSITORY=/install/image/x86
+LINUX_IMAGEREPOSITORY=/install/image/x86
+
+# - xcat location of template files, this includes both the files for
+# partimage and kickstart files
+# defaults should be fine for most setups.
+# normally thie tmpl files are under the xcatroot path, i.e. # /opt/xcat/install/....
+
+CORE_TMPLREPOSITORY=XCATROOT/install/image/x86
+
+# windows images
+WIN_TMPLREPOSITORY=XCATROOT/install/image/x86
+
+# kick start files
+RHAS3_TMPLREPOSITORY=XCATROOT/install/rhas3/x86
+RHAS4_TMPLREPOSITORY=XCATROOT/install/rhas4/x86
+RHFC5_TMPLREPOSITORY=XCATROOT/install/rhfc5/x86
+
+# linux image - includes image templates for rh4,rhfc5,etc
+LINUXIMAGE_TMPLREPOSITORY=XCATROOT/install/linux_image/x86
+
+#image libraries can exist on other management nodes and hold images that we might need
+#imagelibenable, yes,no enabled,disabled
+imagelibenable=no
+
+#imageservers = comma seperated list of IP addresses of other management nodes or image libraries
+imageservers=
+
+#imagelibuser, user allowed to login via ssh
+# adduser account: useradd -d /home/vclstaff -m vclstaff
+imagelibuser=vclstaff
+
+#imagelibkey, identity key for imagelibuser
+# to setup identity key:
+# as root su - vclstaff
+# generate key: ssh-keygen -t dsa
+# press enter when prompted for passphrase
+# append pub key to authorized_keys: cat id_dsa.pub > authorized_keys
+#exit vclstaff
+#copy /home/vclstaff/.ssh id_dsa /etc/vcl/imagelib.key
+#make sure permissions are 600 chmod 600 /etc/vcl/imagelib.key
+imagelibidkey=/etc/vcl/imagelib.key
+
+# - VMWARE vmdk image files
+# - this can be storage on the management node
+VMWARE_IMAGEREPOSITORY=/install/vmware_images
diff --git a/managementnode/legacy_vcl_vbs_scripts/RandPass.wsf b/managementnode/legacy_vcl_vbs_scripts/RandPass.wsf
new file mode 100755
index 0000000..74cb928
--- /dev/null
+++ b/managementnode/legacy_vcl_vbs_scripts/RandPass.wsf
@@ -0,0 +1,44 @@
+<package>
+ <job id="CreateUser">
+ <script language="VBScript">
+
+ Option Explicit
+ Dim WshNetwork, strPass, oAdminAcct
+ Dim UserAccount
+
+ If WScript.Arguments.Count = 1 Then
+ UserAccount = WScript.Arguments.Item(0)
+ Else
+ WScript.Echo "Usage: RandPass.wsf <user_account>"
+ WScript.Quit
+ End If
+
+ Set WshNetwork = WScript.CreateObject("WScript.Network")
+ Set oAdminAcct = GetObject("WinNT://" & WshNetwork.ComputerName & "/" & UserAccount)
+
+ strPass = generateRandomPassword(15)
+
+ oAdminAcct.SetPassword strPass
+
+ Function generateRandomPassword(strMax)
+ Dim strPass, i, r
+
+ strPass = ""
+ Randomize
+ For i = 1 to strMax
+ r = Rnd
+ If (r < .3) Then
+ strPass = strPass & Chr (Int ((r * 26) + 1) + 64)
+ ElseIf (r > 0.5) Then
+ strPass = strPass & Chr (Int ((r * 26) + 1) + 96)
+ Else
+ strPass = strPass & CStr (Int ((r * 10) + 1))
+ End If
+ Next
+
+ generateRandomPassword = strPass
+
+ End Function
+ </script>
+ </job>
+</package>
diff --git a/managementnode/legacy_vcl_vbs_scripts/VCLprepare1.vbs b/managementnode/legacy_vcl_vbs_scripts/VCLprepare1.vbs
new file mode 100755
index 0000000..35f89fd
--- /dev/null
+++ b/managementnode/legacy_vcl_vbs_scripts/VCLprepare1.vbs
@@ -0,0 +1,396 @@
+On Error Resume Next
+Set oWshShell = CreateObject("WScript.Shell")
+Set oWshEnvironment = oWshShell.Environment("Process")
+sCurrentName = oWshEnvironment("COMPUTERNAME")
+sTempDir = oWshEnvironment("TEMP")
+'WScript.Echo "COMPUTERNAME = " & sCurrentName
+'WScript.Echo "Temp directory = " & sTempDir
+Dim MACLASTNUMDEC
+Dim MACLASTNUMHEX
+Dim oExec
+Const ForWriting = 2
+Const ForAppending = 8
+check = ""
+
+strComputer = "."
+Set objWMIService = GetObject("winmgmts:\\"& strComputer & "\root\cimv2")
+
+' open log file to record all actions taken
+set objFSO = CreateObject("Scripting.FileSystemObject")
+Set objTextFile = objFSO.OpenTextFile _
+ (sTempDir & "\VCLprepare.log", ForAppending, True)
+objTextFile.WriteLine("========================================================================")
+objTextFile.WriteLine(Now & " : VCLprepare1.vbs : script started")
+
+
+
+WScript.Echo "#### This is VCLprepare1.vbs script ####"
+WScript.Echo "Waiting for NTsyslog service..."
+' Wait until NTsyslog service started
+started = 0
+Do While started = 0
+ Set colRunningServices = objWMIService.ExecQuery ("Select * from Win32_Service")
+ For Each objService in colRunningServices
+ If (objService.DisplayName = "NTsyslog") AND (objService.State = "Running") Then
+ started = 1
+ End If
+ Next
+ WScript.Sleep 100
+Loop
+WScript.Sleep 5000
+WScript.Echo "NTsyslog service is up."
+objTextFile.WriteLine(Now & " : VCLprepare1.vbs : NTsyslog service is up")
+
+' Write what happening along the way to Setup Event Log
+strCommand = "eventcreate /T Information /ID 101 /L Setup /SO " & Chr(34) & "VCLprepare1.vbs" & _
+ Chr(34) & " /D " & Chr(34) & "VCLprepare1.vbs script started." & Chr(34)
+Set oExec = oWshShell.Exec(strcommand)
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
+
+' execute one more time to insure it goes to right EventLog
+Set oExec = oWshShell.Exec(strcommand)
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
+
+Set colAdapters = objWMIService.ExecQuery _
+ ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
+
+' wait until both network adapters are available
+WScript.Echo "Waiting on network adapters:"
+objTextFile.WriteLine(Now & " : VCLprepare1.vbs : Waiting on network adapters:")
+
+num_adapters = 0
+currIndex1 = ""
+currIndex2 = ""
+n = 5
+
+Do While num_adapters < 2
+ Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkAdapter",,48)
+ For Each objItem in colItems
+ If Not IsNull(objItem.Index) AND Not IsNull(objItem.MACAddress) AND Not IsNull(objItem.NetConnectionID) Then
+' WScript.Echo "Index = " & objItem.Index
+' WScript.Echo "MACAddress = " & objItem.MACAddress
+' WScript.Echo "NetConnectionID = " & objItem.NetConnectionID
+ If Not currIndex1 = objItem.Index Then
+ If currIndex1 = "" Then
+ currIndex1 = objItem.Index
+' WScript.Echo "currIndex1 = '" & objItem.Index & "'"
+ num_adapters = num_adapters + 1
+ Else
+ currIndex2 = objItem.Index
+' WScript.Echo "currIndex2 = '" & objItem.Index & "'"
+ num_adapters = num_adapters + 1
+ End If
+ End If
+ End If
+ Next
+ If num_adapters < 2 Then
+ WScript.Sleep 5000
+ WScript.Echo n & "sec"
+ n = n + 5
+ End If
+Loop
+
+WScript.Echo "num_adapters = " & num_adapters
+'WScript.Echo "currIndex1 = '" & currIndex1 & "'"
+'WScript.Echo "currIndex2 = '" & currIndex2 & "'"
+objTextFile.WriteLine(Now & " : VCLprepare1.vbs : num_adapters = " & num_adapters & " (should be 2)")
+
+' determine names for network adapters based on their MAC addresses:
+' adapter with even MAC will be FirstAdapter - LAN interface
+' adapter with odd MAC will be SecondAdapter - WAN interface
+
+Set colAdapters = objWMIService.ExecQuery _
+ ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
+For Each objAdapter in colAdapters
+ If objAdapter.Index = currIndex1 OR objAdapter.Index = currIndex2 Then
+' WScript.Echo "Index = " & objAdapter.Index
+ AdapterMAC = objAdapter.MACAddress
+' WScript.Echo "MAC = " & AdapterMAC
+ MACArray = Split(AdapterMAC, ":")
+ MACLASTNUMHEX = Trim(MACArray(5))
+' WScript.Echo "Last MAC number (HEX) = " & MACLASTNUMHEX
+ MACLASTNUMDEC = CInt("&H" & MACLASTNUMHEX)
+' WScript.Echo "Last MAC number (DEC) = " & MACLASTNUMDEC
+ reminder = MACLASTNUMDEC Mod 2
+' WScript.Echo "Reminder of last MAC number = " & reminder
+ If reminder = 0 Then
+ FirstAdapterIndex = objAdapter.Index
+ If Not IsNull(objAdapter.IPAddress) Then
+ For i = 0 To UBound(objAdapter.IPAddress)
+ FirstAdapterIP = objAdapter.IPAddress(i)
+ Next
+ End If
+ Else
+ SecondAdapterIndex = objAdapter.Index
+ If Not IsNull(objAdapter.IPAddress) Then
+ For i = 0 To UBound(objAdapter.IPAddress)
+ SecondAdapterIP = objAdapter.IPAddress(i)
+ Next
+ End If
+ End If
+' WScript.Echo "============================"
+ End If
+Next
+
+Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkAdapter",,48)
+For Each objItem in colItems
+ If objItem.Index = FirstAdapterIndex Then
+ FirstAdapterName = objItem.NetConnectionID
+ End If
+ If objItem.Index = SecondAdapterIndex Then
+ SecondAdapterName = objItem.NetConnectionID
+ End If
+
+Next
+WScript.Echo "First Adapter Name (LAN): " & FirstAdapterName
+WScript.Echo "First Adapter Index (LAN): " & FirstAdapterIndex
+WScript.Echo "First Adapter IP (LAN): " & FirstAdapterIP
+WScript.Echo "Second Adapter Name (WAN): " & SecondAdapterName
+WScript.Echo "Second Adapter Index (WAN): " & SecondAdapterIndex
+WScript.Echo "Second Adapter IP (WAN): " & SecondAdapterIP
+objTextFile.WriteLine(Now & " : VCLprepare1.vbs : First Adapter Name (LAN): " & FirstAdapterName)
+objTextFile.WriteLine(Now & " : VCLprepare1.vbs : First Adapter Index (LAN): " & FirstAdapterIndex)
+objTextFile.WriteLine(Now & " : VCLprepare1.vbs : First Adapter IP (LAN): " & FirstAdapterIP)
+objTextFile.WriteLine(Now & " : VCLprepare1.vbs : Second Adapter Name (WAN): " & SecondAdapterName)
+objTextFile.WriteLine(Now & " : VCLprepare1.vbs : Second Adapter Index (WAN): " & SecondAdapterIndex)
+objTextFile.WriteLine(Now & " : VCLprepare1.vbs : Second Adapter IP (WAN): " & SecondAdapterIP)
+
+' Write Second Adapter Name (WAN) to file in %TEMP% directory
+set objFSO1 = CreateObject("Scripting.FileSystemObject")
+Set objTextFile1 = objFSO1.OpenTextFile _
+ (sTempDir & "\WANname.txt", ForWriting, True)
+objTextFile1.WriteLine(SecondAdapterName)
+objTextFile1.Close
+
+
+' Assign new IP address to "WAN" adapter
+
+IPArray = Split(FirstAdapterIP, ".")
+MYWANIP = Array("152.1.14." & IPArray(3))
+WScript.Echo "MYWANIP = " & MYWANIP(0)
+MYWANSubnetMask = Array("255.255.255.0")
+MYWANGateway = Array("152.1.14.1")
+MYWANGatewayMetric = Array(1)
+
+' Setup static IP address for "WAN" adapter
+
+Set colNetAdapters = objWMIService.ExecQuery _
+ ("Select * from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
+
+For Each objNetAdapter in colNetAdapters
+ If objNetAdapter.Index = SecondAdapterIndex Then
+ errEnable = objNetAdapter.EnableStatic(MYWANIP, MYWANSubnetMask)
+ errGateways = objNetAdapter.SetGateways(MYWANGateway, MYWANGatewaymetric)
+ arrDNSServers = Array("152.1.1.161", "152.1.1.248")
+ errDNS = objNetAdapter.SetDNSServerSearchOrder(arrDNSServers)
+
+ If errEnable = 0 Then
+ WScript.Echo "The IP address has been changed."
+ objTextFile.WriteLine(Now & " : VCLprepare1.vbs : WAN interface was configured successfully.")
+ strCommand = "eventcreate /T Information /ID 102 /L Setup /SO " & Chr(34) & "VCLprepare1.vbs" & _
+ Chr(34) & " /D " & Chr(34) & "WAN interface was configured successfully." & Chr(34)
+ Else
+ WScript.Echo "The IP address could not be changed."
+ WScript.Echo "Error = " & errEnable
+ objTextFile.WriteLine(Now & " : VCLprepare1.vbs : WAN interface could not be configured. Error: " & errEnable)
+ strCommand = "eventcreate /T Error /ID 103 /L Setup /SO " & Chr(34) & "VCLprepare1.vbs" & _
+ Chr(34) & " /D " & Chr(34) & "WAN interface could not be configured. Error: " & errEnable & Chr(34)
+ End If
+ ' Record result in Setup Event Log
+ Set oExec = oWshShell.Exec(strcommand)
+ Do While oExec.Status = 0
+ WScript.Sleep 100
+ Loop
+
+ End If
+Next
+WScript.Sleep 1000
+
+' turn back on pagefile
+objTextFile.WriteLine(Now & " : VCLprepare1.vbs : enable page file")
+strCommand = "reg.exe add " & Chr(34) & _
+ "HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Memory Management" & Chr(34) &_
+ " /v PagingFiles /d " & Chr(34) & "c:\pagefile.sys 2046 4092" & Chr(34) & " /t REG_MULTI_SZ /f"
+Set oExec = oWshShell.Exec(strcommand)
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
+check = oWshShell.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Memory Management\PagingFiles")
+
+objTextFile.WriteLine(Now & " : CHECK (PagingFiles registry entry): '" & check(0) & "' (should be ... 2046 4092)")
+
+
+' to insure proper rename procedure disable WAN interface (adapter with odd MAC address)
+WScript.Echo "Disabling WAN interface..."
+oWshShell.Run "cscript.exe " & sTempDir & "\vcl\disWAN.vbs", 0, TRUE
+WScript.Echo "Done!"
+
+WScript.Echo "Renaming computer... "
+objTextFile.WriteLine(Now & " : VCLprepare1.vbs : Renaming computer using WSName.exe")
+
+Set oExec = oWshShell.Exec(sTempDir & "\vcl\WSName.exe /N:%DNS /MCN /NOREBOOT")
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
+
+If oExec.ExitCode <> 0 Then
+' Could not rename computer - better stop here
+' it could be not bad - simply old and new names match or
+' it could be bad - something else went wrong
+ WScript.Echo "Warning: Non-zero exit code"
+ objTextFile.WriteLine(Now & " : VCLprepare1.vbs : WSName.exe : non-zero exit code")
+
+ If oExec.ExitCode = 7 Then
+ WScript.Echo "Computer's new and old names match! Rename aborted!"
+ strCommand = "eventcreate /T Warning /ID 105 /L Setup /SO " & Chr(34) & "VCLprepare1.vbs" & _
+ Chr(34) & " /D " & Chr(34) & "Computer's name doesn't need to be changed." & Chr(34)
+ objTextFile.WriteLine(Now & " : VCLprepare1.vbs : WSName.exe : new and old names match. Rename aborted.")
+ objTextFile.WriteLine(Now & " : VCLprepare1.vbs : Most likely it's the same computer after creating image")
+' ' Turn off auto-login
+' objTextFile.WriteLine(Now & " : VCLprepare1.vbs : disable Auto-Logon")
+' oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon", "0"
+
+' check = oWshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon")
+
+' objTextFile.WriteLine(Now & " : CHECK (AutoAdminLogon registry entry): " & check & " (should be 0)")
+ ' Record result in Setup Event Log
+ Set oExec = oWshShell.Exec(strcommand)
+ Do While oExec.Status = 0
+ WScript.Sleep 100
+ Loop
+
+ ' Setup to run finish.vbs script after reboot
+ objTextFile.WriteLine(Now & " : VCLprepare1.vbs : setup RunOnce 'finish.vbs' after reboot")
+
+ oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce\step2", "cmd.exe /c cscript.exe " & sTempDir & "\vcl\finish.vbs"
+
+ WScript.Sleep 1000
+
+ check = oWshShell.RegRead("HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce\step2")
+
+ objTextFile.WriteLine(Now & " : CHECK (RunOnce registry entry): " & check)
+
+ strCommand = "eventcreate /T Information /ID 107 /L Setup /SO " & Chr(34) & "VCLprepare1.vbs" & _
+ Chr(34) & " /D " & Chr(34) & "VCLprepare1.vbs script finished." & Chr(34)
+ Set oExec = oWshShell.Exec(strcommand)
+ Do While oExec.Status = 0
+ WScript.Sleep 100
+ Loop
+ objTextFile.WriteLine(Now & " : VCLprepare1.vbs : script finished")
+ objTextFile.WriteLine("========================================================================")
+ 'close log file handler
+ objTextFile.Close
+
+ 'reboot computer to activate page file
+
+ Set objWMIService = GetObject("winmgmts:" _
+ & "{impersonationLevel=impersonate,(Shutdown)}!\\" & strComputer & "\root\cimv2")
+ Set colOperatingSystems = objWMIService.ExecQuery _
+ ("Select * from Win32_OperatingSystem")
+ For Each objOperatingSystem in colOperatingSystems
+ ObjOperatingSystem.Reboot()
+ Next
+
+ WScript.Quit
+
+' strCommand = "eventcreate /T Information /ID 111 /L Setup /SO " & Chr(34) & "VCLprepare1.vbs" & _
+' Chr(34) & " /D " & Chr(34) & lcase(sCurrentName) & " is READY." & Chr(34)
+' Set oExec = oWshShell.Exec(strcommand)
+' Do While oExec.Status = 0
+' WScript.Sleep 100
+' Loop
+' objTextFile.WriteLine(Now & " : VCLprepare1.vbs : " & lcase(sCurrentName) & " is READY.")
+' objTextFile.WriteLine("========================================================================")
+
+ Else
+ WScript.Echo "Something went wrong while renaming computer!"
+ WScript.Echo "Exit code: " & oExec.ExitCode
+ WScript.Echo "Check WSName.log in %TEMP% directory for details."
+ objTextFile.WriteLine(Now & " : VCLprepare1.vbs : WSName.exe : something went wrong while renaming computer.")
+ objTextFile.WriteLine(Now & " : VCLprepare1.vbs : WSName.exe : Exit code: " & oExec.ExitCode)
+ objTextFile.WriteLine(Now & " : VCLprepare1.vbs : WSName.exe : Check WSName.log in %TEMP% directory for details.")
+ strCommand = "eventcreate /T Error /ID 106 /L Setup /SO " & Chr(34) & "VCLprepare1.vbs" & Chr(34) & _
+ " /D " & Chr(34) & "Computer's name could not be changed. WSName.exe Exit code: " & _
+ oExec.ExitCode & " Check WSName.log in %TEMP% directory for details." & Chr(34)
+ ' Record result in Setup Event Log
+ Set oExec = oWshShell.Exec(strcommand)
+ Do While oExec.Status = 0
+ WScript.Sleep 100
+ Loop
+
+ strCommand = "eventcreate /T Information /ID 107 /L Setup /SO " & Chr(34) & "VCLprepare1.vbs" & _
+ Chr(34) & " /D " & Chr(34) & "VCLprepare1.vbs script finished." & Chr(34)
+ Set oExec = oWshShell.Exec(strcommand)
+ Do While oExec.Status = 0
+ WScript.Sleep 100
+ Loop
+ objTextFile.WriteLine(Now & " : VCLprepare1.vbs : script finished")
+ strCommand = "eventcreate /T Error /ID 111 /L Setup /SO " & Chr(34) & "VCLprepare1.vbs" & _
+ Chr(34) & " /D " & Chr(34) & lcase(sCurrentName) & " : rename ERROR." & Chr(34)
+ Set oExec = oWshShell.Exec(strcommand)
+ Do While oExec.Status = 0
+ WScript.Sleep 100
+ Loop
+ objTextFile.WriteLine(Now & " : VCLprepare1.vbs : " & lcase(sCurrentName) & " : rename ERROR.")
+ objTextFile.WriteLine("========================================================================")
+ End If
+
+ 'close log file handler
+ objTextFile.Close
+
+ ' log-off
+ oWshShell.Run "cmd.exe /C " & "C:\WINDOWS\system32\logoff.exe ", 0, TRUE
+ WScript.Quit
+
+Else
+' computer renamed OK - continue with remaining steps
+ strCommand = "eventcreate /T Information /ID 104 /L Setup /SO " & Chr(34) & "VCLprepare1.vbs" & _
+ Chr(34) & " /D " & Chr(34) & "Computer's name changed successfully." & Chr(34)
+ ' Record result in Setup Event Log
+ Set oExec = oWshShell.Exec(strcommand)
+ Do While oExec.Status = 0
+ WScript.Sleep 100
+ Loop
+ WScript.Echo "Computer's name changed successfully!"
+ objTextFile.WriteLine(Now & " : VCLprepare1.vbs : Computer's name changed successfully")
+
+
+ ' Setup to run step2-setup.vbs script after reboot
+ objTextFile.WriteLine(Now & " : VCLprepare1.vbs : setup RunOnce 'VCLprepare2.vbs' after reboot")
+
+ oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce\step2", "cmd.exe /c cscript.exe " & sTempDir & "\vcl\VCLprepare2.vbs"
+
+ WScript.Sleep 1000
+
+ check = oWshShell.RegRead("HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce\step2")
+
+ objTextFile.WriteLine(Now & " : CHECK (RunOnce registry entry): " & check)
+
+
+ ' Assign new unique SID
+ WScript.Echo "Assigning new SID... "
+ objTextFile.WriteLine(Now & " : VCLprepare1.vbs : Assigning new SID using newsid.exe")
+ Set oExec = oWshShell.Exec(sTempDir & "\vcl\newsid.exe /a /d 5")
+ Do While oExec.Status = 0
+ WScript.Sleep 100
+ Loop
+ objTextFile.WriteLine(Now & " : VCLprepare1.vbs : script finished, rebooting computer")
+ objTextFile.WriteLine("========================================================================")
+ 'close log file handler
+ objTextFile.Close
+
+ strCommand = "eventcreate /T Information /ID 107 /L Setup /SO " & Chr(34) & "VCLprepare1.vbs" & _
+ Chr(34) & " /D " & Chr(34) & "VCLprepare1.vbs script finished." & Chr(34)
+ Set oExec = oWshShell.Exec(strcommand)
+ Do While oExec.Status = 0
+ WScript.Sleep 100
+ Loop
+ WScript.Echo "Done!"
+End If
+
+WScript.Quit
+
diff --git a/managementnode/legacy_vcl_vbs_scripts/VCLprepare2.vbs b/managementnode/legacy_vcl_vbs_scripts/VCLprepare2.vbs
new file mode 100755
index 0000000..b5f72a3
--- /dev/null
+++ b/managementnode/legacy_vcl_vbs_scripts/VCLprepare2.vbs
@@ -0,0 +1,124 @@
+Set oWshShell = CreateObject("WScript.Shell")
+Set oWshEnvironment = oWshShell.Environment("Process")
+sCurrentName = oWshEnvironment("COMPUTERNAME")
+sTempDir = oWshEnvironment("TEMP")
+'WScript.Echo "COMPUTERNAME = " & sCurrentName
+'WScript.Echo "Temp directory = " & sTempDir
+On Error Resume Next
+Dim oExec
+Const ForAppending = 8
+check = ""
+
+strComputer = "."
+Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
+
+' open log file to record all actions taken
+set objFSO = CreateObject("Scripting.FileSystemObject")
+Set objTextFile = objFSO.OpenTextFile _
+ (sTempDir & "\VCLprepare.log", ForAppending, True)
+objTextFile.WriteLine("========================================================================")
+objTextFile.WriteLine(Now & " : VCLprepare2.vbs : script started")
+
+WScript.Echo "#### This is VCLprepare2.vbs script ####"
+WScript.Echo "Waiting for NTsyslog service..."
+' Wait until NTsyslog service started
+started = 0
+Do While started = 0
+ Set colRunningServices = objWMIService.ExecQuery ("Select * from Win32_Service")
+ For Each objService in colRunningServices
+ If (objService.DisplayName = "NTsyslog") AND (objService.State = "Running") Then
+ started = 1
+ End If
+ Next
+ WScript.Sleep 100
+Loop
+WScript.Sleep 5000
+WScript.Echo "NTsyslog service is up."
+objTextFile.WriteLine(Now & " : VCLprepare2.vbs : NTsyslog service is up")
+
+' Write what happening along the way to Setup Event Log
+strCommand = "eventcreate /T Information /ID 108 /L Setup /SO " & Chr(34) & "VCLprepare2.vbs" & _
+ Chr(34) & " /D " & Chr(34) & "VCLprepare2.vbs script started." & Chr(34)
+Set oExec = oWshShell.Exec(strcommand)
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
+
+' execute one more time to insure it goes to right EventLog
+Set oExec = oWshShell.Exec(strcommand)
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
+
+
+' create new "passwd" and "group" files for cygwin, because SID was changed by step1-rename.vbs script
+WScript.Echo "Creating new group and passwd files for cygwin..."
+objTextFile.WriteLine(Now & " : VCLprepare2.vbs : Create new group and passwd files for cygwin")
+oWshShell.Run "cmd.exe /C del " & "c:\cygwin\etc\group", 0, TRUE
+WScript.Sleep 1000
+oWshShell.Run "cmd.exe /C del " & "c:\cygwin\etc\passwd", 0, TRUE
+WScript.Sleep 1000
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\mkgroup.exe -l" & " > c:\cygwin\etc\group", 0, TRUE
+WScript.Sleep 1000
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\mkpasswd.exe -l" & " > c:\cygwin\etc\passwd", 0, TRUE
+WScript.Sleep 1000
+oWshShell.Run "C:\WINDOWS\system32\sc.exe start NSClient", 0, TRUE
+WScript.Sleep 1000
+WScript.Echo "Done!"
+
+strCommand = "eventcreate /T Information /ID 109 /L Setup /SO " & Chr(34) & "VCLprepare2.vbs" & Chr(34) & _
+ " /D " & Chr(34) & "passwd and group files for cygwin were created successfully." & Chr(34)
+' Record result in Setup Event Log
+Set oExec = oWshShell.Exec(strcommand)
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
+objTextFile.WriteLine(Now & " : VCLprepare2.vbs : passwd and group files for cygwin were created successfully")
+
+' Turn off auto-login
+objTextFile.WriteLine(Now & " : VCLprepare2.vbs : disable Auto-Logon")
+oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon", "0"
+
+check = oWshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon")
+
+objTextFile.WriteLine(Now & " : CHECK (AutoAdminLogon registry entry): " & check & " (should be 0)")
+
+' Do quick format of volume D:
+Set oExec = oWshShell.Exec("cmd.exe /C echo y | C:\WINDOWS\system32\format.com D: /FS:NTFS /V:Storage /Q ")
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
+
+' if D: drive was NTFS volume before - then just delete everything from it
+Set oExec = oWshShell.Exec("rm -rf D:/* ")
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
+
+strCommand = "eventcreate /T Information /ID 110 /L Setup /SO " & Chr(34) & "VCLprepare2.vbs" & _
+ Chr(34) & " /D " & Chr(34) & "VCLprepare2.vbs script finished." & Chr(34)
+Set oExec = oWshShell.Exec(strcommand)
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
+objTextFile.WriteLine(Now & " : VCLprepare2.vbs : script finished")
+
+'MYNAME=lcase(sCurrentName)
+
+'strCommand = "eventcreate /T Information /ID 111 /L Setup /SO " & Chr(34) & "VCLprepare2.vbs" & _
+' Chr(34) & " /D " & Chr(34) & MYNAME & " is READY." & Chr(34)
+strCommand = "eventcreate /T Information /ID 111 /L Setup /SO " & Chr(34) & "VCLprepare2.vbs" & _
+ Chr(34) & " /D " & Chr(34) & lcase(sCurrentName) & " is READY." & Chr(34)
+Set oExec = oWshShell.Exec(strcommand)
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
+objTextFile.WriteLine(Now & " : VCLprepare2.vbs : " & lcase(sCurrentName) & " is READY.")
+objTextFile.WriteLine("========================================================================")
+'close log file handler
+objTextFile.Close
+
+' Just log-off
+oWshShell.Exec("C:\WINDOWS\system32\logoff.exe")
+
+WScript.Quit
diff --git a/managementnode/legacy_vcl_vbs_scripts/add_user.vbs b/managementnode/legacy_vcl_vbs_scripts/add_user.vbs
new file mode 100755
index 0000000..1acd9f5
--- /dev/null
+++ b/managementnode/legacy_vcl_vbs_scripts/add_user.vbs
@@ -0,0 +1,35 @@
+Dim UserAccount
+Dim UserPasswd
+
+If WScript.Arguments.Count = 2 Then
+ UserAccount = WScript.Arguments.Item(0)
+ UserPasswd = WScript.Arguments.Item(1)
+Else
+ WScript.Echo "Usage: add_user.vbs <user_name> <user_passwd>"
+ WScript.Quit
+End If
+
+strComputer = "."
+Set colAccounts = GetObject("WinNT://" & strComputer & "")
+Set objUser = colAccounts.Create("user", UserAccount)
+objUser.SetPassword UserPasswd
+objUser.SetInfo
+
+Set net = WScript.CreateObject("WScript.Network")
+local = net.ComputerName
+set group = GetObject("WinNT://"& local &"/Administrators")
+set group1 = GetObject("WinNT://"& local &"/Remote Desktop Users")
+on error resume next
+group.Add "WinNT://"& UserAccount &""
+group1.Add "WinNT://"& UserAccount &""
+CheckError
+
+sub CheckError
+ if not err.number=0 then
+ WScript.Echo err.Number
+ vbCritical err.clear
+' else WScript.Echo "Done!"
+ end if
+end sub
+
+WScript.sleep 1000
\ No newline at end of file
diff --git a/managementnode/legacy_vcl_vbs_scripts/auto_create_image.vbs b/managementnode/legacy_vcl_vbs_scripts/auto_create_image.vbs
new file mode 100755
index 0000000..0a7f92f
--- /dev/null
+++ b/managementnode/legacy_vcl_vbs_scripts/auto_create_image.vbs
@@ -0,0 +1,107 @@
+On Error Resume Next
+
+
+Set oWshShell = CreateObject("WScript.Shell")
+
+Set oWshEnvironment = oWshShell.Environment("Process")
+Set oFileSystem = CreateObject("Scripting.FileSystemObject")
+
+sTempDir = oWshEnvironment("TEMP")
+Dim oExec
+Dim GuiAnswer
+strComputer = "."
+Const ForAppending = 8
+
+
+' clean up %TEMP% directory from .log files
+oWshShell.Run "cmd.exe /C del /Q " & sTempDir & "\*.log", 0, TRUE
+
+' open log file to record all actions taken
+set objFSO = CreateObject("Scripting.FileSystemObject")
+Set objTextFile = objFSO.OpenTextFile _
+ (sTempDir & "\VCLprepare.log", ForAppending, True)
+objTextFile.WriteLine("========================================================================")
+objTextFile.WriteLine(Now & " : auto_create_image.vbs : script started")
+
+objTextFile.WriteLine(Now & " : auto_create_image.vbs : cleaned up " & sTempDir & " directory from .log files")
+
+' Precaution: ask user for final approval
+host_name = Wscript.FullName
+'WScript.Echo "full name : " & host_name
+base_name = oFileSystem.GetBaseName(host_name)
+'WScript.Echo "base name : " & base_name
+
+
+
+' check that WAN network interface is enabled, if not - enable it
+WScript.Echo "Enabling WAN interface..."
+objTextFile.WriteLine(Now & " : auto_create_image.vbs : Enable WAN interface")
+oWshShell.Run "cscript.exe " & sTempDir & "\vcl\enWAN.vbs", 0, TRUE
+WScript.Echo "Done!"
+objTextFile.WriteLine(Now & " : auto_create_image.vbs : WAN interface enabled")
+
+
+' setup to run prepare_for_image.vbs script after reboot
+objTextFile.WriteLine(Now & " : auto_create_image.vbs : setup RunOnce 'prepare_for_image.vbs' after reboot")
+oWshShell.RegWrite "HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce\step0", "cmd.exe /c cscript.exe " & sTempDir & "\vcl\auto_prepare_for_image.vbs"
+
+
+check = oWshShell.RegRead("HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce\step0")
+
+objTextFile.WriteLine(Now & " : CHECK (RunOnce registry entry): " & check)
+
+' enable AutoLogon after reboot
+objTextFile.WriteLine(Now & " : auto_create_image.vbs : enable Auto-Logon after reboot")
+oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon", "1"
+
+
+check = oWshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon")
+
+objTextFile.WriteLine(Now & " : CHECK (AutoAdminLogon registry entry): " & check & " (should be 1)")
+
+
+' disable pagefile
+objTextFile.WriteLine(Now & " : auto_create_image.vbs : disable page file")
+strCommand = "reg.exe add " & Chr(34) & _
+ "HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Memory Management" & Chr(34) &_
+ " /v PagingFiles /d " & Chr(34) & "" & Chr(34) & " /t REG_MULTI_SZ /f"
+Set oExec = oWshShell.Exec(strcommand)
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
+strCommand = sTempDir & "\vcl\movefile.exe " & Chr(34) & "c:\pagefile.sys" & Chr(34) & " " & Chr(34) & Chr(34)
+Set oExec = oWshShell.Exec(strcommand)
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
+
+
+'check = oWshShell.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Memory Management\PagingFiles")
+
+'objTextFile.WriteLine(Now & " : CHECK (PagingFiles registry entry): '" & check(0) & "' (should be empty)")
+
+
+objTextFile.WriteLine(Now & " : auto_create_image.vbs : script finished, rebooting computer")
+objTextFile.WriteLine("========================================================================")
+'close log file handler
+objTextFile.Close
+
+
+'reboot computer to make changes effective
+
+Set objWMIService = GetObject("winmgmts:" _
+ & "{impersonationLevel=impersonate,(Shutdown)}!\\" & _
+ strComputer & "\root\cimv2")
+Set colOperatingSystems = objWMIService.ExecQuery _
+ ("Select * from Win32_OperatingSystem")
+for Each objOperatingSystem in colOperatingSystems
+ intreturn = ObjOperatingSystem.Reboot()
+ if intreturn = 0 Then
+ WScript.echo "createimage reboot"
+ Else
+ Wscript.echo "reboot failed error code " & intreturn
+ End If
+Next
+
+WScript.Quit
+
diff --git a/managementnode/legacy_vcl_vbs_scripts/auto_prepare_for_image.vbs b/managementnode/legacy_vcl_vbs_scripts/auto_prepare_for_image.vbs
new file mode 100755
index 0000000..c4b8163
--- /dev/null
+++ b/managementnode/legacy_vcl_vbs_scripts/auto_prepare_for_image.vbs
@@ -0,0 +1,73 @@
+On Error Resume Next
+Set oWshShell = CreateObject("WScript.Shell")
+
+Set oWshEnvironment = oWshShell.Environment("Process")
+
+sCurrentName = oWshEnvironment("COMPUTERNAME")
+sTempDir = oWshEnvironment("TEMP")
+Const ForAppending = 8
+Dim oExec
+MYNAME=lcase(sCurrentName)
+check = ""
+
+' open log file to record all actions taken
+set objFSO = CreateObject("Scripting.FileSystemObject")
+Set objTextFile = objFSO.OpenTextFile _
+ (sTempDir & "\VCLprepare.log", ForAppending, True)
+objTextFile.WriteLine("========================================================================")
+objTextFile.WriteLine(Now & " : auto_prepare_for_image.vbs : script started")
+
+
+' setup to run VCLprepare.vbs script after reboot
+objTextFile.WriteLine(Now & " : auto_prepare_for_image.vbs : setup RunOnce 'VCLprepare1.vbs' after reboot")
+oWshShell.RegWrite "HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce\step1", "cmd.exe /c cscript.exe " & sTempDir & "\vcl\VCLprepare1.vbs"
+
+
+check = oWshShell.RegRead("HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce\step1")
+
+objTextFile.WriteLine(Now & " : CHECK (RunOnce registry entry): " & check)
+
+' enable AutoLogon after reboot
+objTextFile.WriteLine(Now & " : auto_prepare_for_image.vbs : enable Auto-Logon after reboot")
+oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon", "1"
+
+
+check = oWshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon")
+
+objTextFile.WriteLine(Now & " : CHECK (AutoAdminLogon registry entry): " & check & " (should be 1)")
+
+
+'Clear up default Event Logs
+strComputer = "."
+Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
+ strComputer & "\root\cimv2")
+Set colLogFiles = objWMIService.ExecQuery("Select * from Win32_NTEventLogFile")
+For Each objLogfile in colLogFiles
+ objLogFile.ClearEventLog()
+Next
+
+
+' ask to setup "image" mode for computer on management node
+objTextFile.WriteLine(Now & " : auto_prepare_for_image.vbs : setup 'image' mode for computer on management node")
+
+
+
+objTextFile.WriteLine(Now & " : auto_prepare_for_image.vbs : script finished, management reboot computer")
+objTextFile.WriteLine("========================================================================")
+'close log file handler
+objTextFile.Close
+
+''reboot computer to make changes effective
+'' above we are telling the management node to reboot by writing to log file.
+'' no need for the below reboot code
+
+'Set objWMIService = GetObject("winmgmts:" _
+' & "{impersonationLevel=impersonate,(Shutdown)}!\\" & strComputer & "\root\cimv2")
+'Set colOperatingSystems = objWMIService.ExecQuery _
+' ("Select * from Win32_OperatingSystem")
+'For Each objOperatingSystem in colOperatingSystems
+' ObjOperatingSystem.Reboot()
+'Next
+
+WScript.Quit
+
diff --git a/managementnode/legacy_vcl_vbs_scripts/create_image.vbs b/managementnode/legacy_vcl_vbs_scripts/create_image.vbs
new file mode 100755
index 0000000..247b577
--- /dev/null
+++ b/managementnode/legacy_vcl_vbs_scripts/create_image.vbs
@@ -0,0 +1,131 @@
+On Error Resume Next
+
+
+Set oWshShell = CreateObject("WScript.Shell")
+
+Set oWshEnvironment = oWshShell.Environment("Process")
+Set oFileSystem = CreateObject("Scripting.FileSystemObject")
+
+sTempDir = oWshEnvironment("TEMP")
+Dim oExec
+Dim GuiAnswer
+strComputer = "."
+Const ForAppending = 8
+
+
+' clean up %TEMP% directory from .log files
+oWshShell.Run "cmd.exe /C del /Q " & sTempDir & "\*.log", 0, TRUE
+
+' open log file to record all actions taken
+set objFSO = CreateObject("Scripting.FileSystemObject")
+Set objTextFile = objFSO.OpenTextFile _
+ (sTempDir & "\VCLprepare.log", ForAppending, True)
+objTextFile.WriteLine("========================================================================")
+objTextFile.WriteLine(Now & " : create_image.vbs : script started")
+
+objTextFile.WriteLine(Now & " : create_image.vbs : cleaned up " & sTempDir & " directory from .log files")
+
+' Precaution: ask user for final approval
+host_name = Wscript.FullName
+'WScript.Echo "full name : " & host_name
+base_name = oFileSystem.GetBaseName(host_name)
+'WScript.Echo "base name : " & base_name
+
+' How was I called?
+If base_name = "cscript" Then
+' from command line
+ objTextFile.WriteLine(Now & " : create_image.vbs : script was called from command line")
+ WScript.StdOut.WriteLine "##############################"
+ WScript.StdOut.WriteLine "### Ready to create image! ###"
+ WScript.StdOut.WriteLine "### Are you sure? (y or n) ###"
+ WScript.StdOut.WriteLine "##############################"
+ answer = WScript.StdIn.ReadLine
+Else
+' by double-click from Explorer
+ objTextFile.WriteLine(Now & " : create_image.vbs : script was called by double-click from Explorer")
+ If base_name = "WScript" Then
+ GuiAnswer = oWshShell.Popup("Are you sure?",,"Ready to create image!", 4 + 32)
+ Select Case GuiAnswer
+ case 6 answer = "y"
+ case 7 answer = "n"
+' case -1 WScript.Echo "Is there anybody out there?"
+ End Select
+ End If
+End IF
+
+If Not answer = "y" Then
+ WScript.Echo "Well, maybe some other time! ;-)"
+ objTextFile.WriteLine(Now & " : create_image.vbs : script aborted by user request")
+ objTextFile.WriteLine("========================================================================")
+ WScript.Quit
+End If
+
+
+' check that WAN network interface is enabled, if not - enable it
+WScript.Echo "Enabling WAN interface..."
+objTextFile.WriteLine(Now & " : create_image.vbs : Enable WAN interface")
+oWshShell.Run "cscript.exe " & sTempDir & "\vcl\enWAN.vbs", 0, TRUE
+WScript.Echo "Done!"
+objTextFile.WriteLine(Now & " : create_image.vbs : WAN interface enabled")
+
+
+
+
+' setup to run prepare_for_image.vbs script after reboot
+objTextFile.WriteLine(Now & " : create_image.vbs : setup RunOnce 'prepare_for_image.vbs' after reboot")
+oWshShell.RegWrite "HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce\step0", "cmd.exe /c cscript.exe " & sTempDir & "\vcl\prepare_for_image.vbs"
+
+
+check = oWshShell.RegRead("HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce\step0")
+
+objTextFile.WriteLine(Now & " : CHECK (RunOnce registry entry): " & check)
+
+' enable AutoLogon after reboot
+objTextFile.WriteLine(Now & " : create_image.vbs : enable Auto-Logon after reboot")
+oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon", "1"
+
+
+check = oWshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon")
+
+objTextFile.WriteLine(Now & " : CHECK (AutoAdminLogon registry entry): " & check & " (should be 1)")
+
+
+' disable pagefile
+objTextFile.WriteLine(Now & " : create_image.vbs : disable page file")
+strCommand = "reg.exe add " & Chr(34) & _
+ "HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Memory Management" & Chr(34) &_
+ " /v PagingFiles /d " & Chr(34) & "" & Chr(34) & " /t REG_MULTI_SZ /f"
+Set oExec = oWshShell.Exec(strcommand)
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
+strCommand = sTempDir & "\vcl\movefile.exe " & Chr(34) & "c:\pagefile.sys" & Chr(34) & " " & Chr(34) & Chr(34)
+Set oExec = oWshShell.Exec(strcommand)
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
+
+
+'check = oWshShell.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Memory Management\PagingFiles")
+
+'objTextFile.WriteLine(Now & " : CHECK (PagingFiles registry entry): '" & check(0) & "' (should be empty)")
+
+
+objTextFile.WriteLine(Now & " : create_image.vbs : script finished, rebooting computer")
+objTextFile.WriteLine("========================================================================")
+'close log file handler
+objTextFile.Close
+
+
+'reboot computer to make changes effective
+
+Set objWMIService = GetObject("winmgmts:" _
+ & "{impersonationLevel=impersonate,(Shutdown)}!\\" & strComputer & "\root\cimv2")
+Set colOperatingSystems = objWMIService.ExecQuery _
+ ("Select * from Win32_OperatingSystem")
+For Each objOperatingSystem in colOperatingSystems
+ ObjOperatingSystem.Reboot()
+Next
+
+WScript.Quit
+
diff --git a/managementnode/legacy_vcl_vbs_scripts/del_user.vbs b/managementnode/legacy_vcl_vbs_scripts/del_user.vbs
new file mode 100755
index 0000000..50f54f3
--- /dev/null
+++ b/managementnode/legacy_vcl_vbs_scripts/del_user.vbs
@@ -0,0 +1,14 @@
+Dim UserAccount
+
+If WScript.Arguments.Count = 1 Then
+ UserAccount = WScript.Arguments.Item(0)
+Else
+ WScript.Echo "Usage: del_user.vbs <user_name>"
+ WScript.Quit
+End If
+
+strComputer = "."
+Set objComputer = GetObject("WinNT://" & strComputer & ",computer")
+objComputer.Delete "user", UserAccount
+
+WScript.sleep 1000
\ No newline at end of file
diff --git a/managementnode/legacy_vcl_vbs_scripts/disWAN.vbs b/managementnode/legacy_vcl_vbs_scripts/disWAN.vbs
new file mode 100755
index 0000000..536cb8b
--- /dev/null
+++ b/managementnode/legacy_vcl_vbs_scripts/disWAN.vbs
@@ -0,0 +1,106 @@
+Set oWshShell = CreateObject("WScript.Shell")
+Set oWshEnvironment = oWshShell.Environment("Process")
+sTempDir = oWshEnvironment("TEMP")
+Const ForReading = 1
+
+set fso = CreateObject("Scripting.FileSystemObject")
+
+If fso.FileExists(sTempDir & "\WANname.txt") Then
+ set results = fso.GetFile(sTempDir & "\WANname.txt")
+ set ts = results.OpenAsTextStream(ForReading)
+ do while ts.AtEndOfStream <> True
+ retString = ts.ReadLine
+ loop
+ ts.Close
+ sConnectionName = retString
+Else
+ WScript.Echo "File '" & sTempDir & "\WANname.txt" & "' does NOT exists!"
+ WScript.Echo "Cannot continue! Quitting..."
+ WScript.Quit
+End If
+
+Const ssfCONTROLS = 3
+
+WScript.Echo "Disabling '" & sConnectionName & "' (WAN) connection..."
+
+sEnableVerb = "En&able"
+sDisableVerb = "Disa&ble"
+
+set shellApp = createobject("shell.application")
+set oControlPanel = shellApp.Namespace(ssfCONTROLS)
+'Wscript.Echo "oControlPanel: " & oControlPanel
+
+set oNetConnections = nothing
+for each folderitem in oControlPanel.items
+' if folderitem.name = "Network and Dial-up Connections" then
+ if folderitem.name = "Network Connections" then
+ set oNetConnections = folderitem.getfolder: exit for
+ end if
+next
+
+if oNetConnections is nothing then
+' msgbox "Couldn't find 'Network and Dial-up Connections' folder"
+ msgbox "Couldn't find 'Network Connections' folder"
+ wscript.quit
+end if
+
+set oLanConnection = nothing
+for each folderitem in oNetConnections.items
+ if lcase(folderitem.name) = lcase(sConnectionName) then
+ set oLanConnection = folderitem: exit for
+ end if
+next
+
+if oLanConnection is nothing then
+ msgbox "Couldn't find '" & sConnectionName & "' item"
+ wscript.quit
+end if
+
+bEnabled = true
+set oEnableVerb = nothing
+set oDisableVerb = nothing
+s = "Verbs: " & vbcrlf
+for each verb in oLanConnection.verbs
+ s = s & vbcrlf & verb.name
+ if verb.name = sEnableVerb then
+ set oEnableVerb = verb
+ bEnabled = false
+ end if
+ if verb.name = sDisableVerb then
+ set oDisableVerb = verb
+ end if
+next
+
+
+
+'debugging displays left just in case...
+'
+'msgbox s ': wscript.quit
+'msgbox "Enabled: " & bEnabled ': wscript.quit
+
+'not sure why, but invokeverb always seemed to work
+'for enable but not disable.
+'
+'saving a reference to the appropriate verb object
+'and calling the DoIt method always seems to work.
+'
+
+if bEnabled then
+' oLanConnection.invokeverb sDisableVerb
+ oDisableVerb.DoIt
+ wscript.sleep 5000
+ wScript.Echo "Done!"
+' Wscript.Echo sConnectionName & " disabled!"
+else
+' oLanConnection.invokeverb sEnableVerb
+ Wscript.Echo "'" & sConnectionName & "' already disabled!"
+' oEnableVerb.DoIt
+end if
+
+'adjust the sleep duration below as needed...
+'
+'if you let the oLanConnection go out of scope
+'and be destroyed too soon, the action of the verb
+'may not take...
+'
+'wscript.sleep 5000
diff --git a/managementnode/legacy_vcl_vbs_scripts/enWAN.vbs b/managementnode/legacy_vcl_vbs_scripts/enWAN.vbs
new file mode 100755
index 0000000..26ec378
--- /dev/null
+++ b/managementnode/legacy_vcl_vbs_scripts/enWAN.vbs
@@ -0,0 +1,108 @@
+Set oWshShell = CreateObject("WScript.Shell")
+Set oWshEnvironment = oWshShell.Environment("Process")
+sTempDir = oWshEnvironment("TEMP")
+Const ForReading = 1
+
+set fso = CreateObject("Scripting.FileSystemObject")
+
+If fso.FileExists(sTempDir & "\WANname.txt") Then
+ set results = fso.GetFile(sTempDir & "\WANname.txt")
+ set ts = results.OpenAsTextStream(ForReading)
+ do while ts.AtEndOfStream <> True
+ retString = ts.ReadLine
+ loop
+ ts.Close
+ sConnectionName = retString
+Else
+ WScript.Echo "File '" & sTempDir & "\WANname.txt" & "' does NOT exists!"
+ WScript.Echo "Cannot continue! Quitting..."
+ WScript.Quit
+End If
+
+Const ssfCONTROLS = 3
+
+WScript.Echo "Enabling '" & sConnectionName & "' (WAN) connection..."
+
+sEnableVerb = "En&able"
+sDisableVerb = "Disa&ble"
+
+set shellApp = createobject("shell.application")
+set oControlPanel = shellApp.Namespace(ssfCONTROLS)
+'Wscript.Echo "oControlPanel: " & oControlPanel
+
+set oNetConnections = nothing
+for each folderitem in oControlPanel.items
+' if folderitem.name = "Network and Dial-up Connections" then
+ if folderitem.name = "Network Connections" then
+ set oNetConnections = folderitem.getfolder: exit for
+ end if
+next
+
+if oNetConnections is nothing then
+' msgbox "Couldn't find 'Network and Dial-up Connections' folder"
+ msgbox "Couldn't find 'Network Connections' folder"
+ wscript.quit
+end if
+
+set oLanConnection = nothing
+for each folderitem in oNetConnections.items
+ if lcase(folderitem.name) = lcase(sConnectionName) then
+ set oLanConnection = folderitem: exit for
+ end if
+next
+
+if oLanConnection is nothing then
+ msgbox "Couldn't find '" & sConnectionName & "' item"
+ wscript.quit
+end if
+
+
+bEnabled = true
+set oEnableVerb = nothing
+set oDisableVerb = nothing
+s = "Verbs: " & vbcrlf
+for each verb in oLanConnection.verbs
+ s = s & vbcrlf & verb.name
+ if verb.name = sEnableVerb then
+ set oEnableVerb = verb
+ bEnabled = false
+ end if
+ if verb.name = sDisableVerb then
+ set oDisableVerb = verb
+ end if
+next
+
+
+
+'debugging displays left just in case...
+'
+'msgbox s ': wscript.quit
+'msgbox "Enabled: " & bEnabled ': wscript.quit
+
+'not sure why, but invokeverb always seemed to work
+'for enable but not disable.
+'
+'saving a reference to the appropriate verb object
+'and calling the DoIt method always seems to work.
+'
+
+if bEnabled then
+' oLanConnection.invokeverb sDisableVerb
+ Wscript.Echo "'" & sConnectionName & "' already enabled!"
+' oDisableVerb.DoIt
+else
+' oLanConnection.invokeverb sEnableVerb
+ oEnableVerb.DoIt
+ wscript.sleep 5000
+ WScript.Echo "Done!"
+' Wscript.Echo sConnectionName & " enabled!"
+end if
+
+
+'adjust the sleep duration below as needed...
+'
+'if you let the oLanConnection go out of scope
+'and be destroyed too soon, the action of the verb
+'may not take...
+'
+'wscript.sleep 5000
diff --git a/managementnode/legacy_vcl_vbs_scripts/list_users.vbs b/managementnode/legacy_vcl_vbs_scripts/list_users.vbs
new file mode 100755
index 0000000..de0a39a
--- /dev/null
+++ b/managementnode/legacy_vcl_vbs_scripts/list_users.vbs
@@ -0,0 +1,7 @@
+Set objNetwork = CreateObject("Wscript.Network")
+strComputer = objNetwork.ComputerName
+Set colAccounts = GetObject("WinNT://" & strComputer & "")
+colAccounts.Filter = Array("user")
+For Each objUser In colAccounts
+ Wscript.Echo objUser.Name
+Next
\ No newline at end of file
diff --git a/managementnode/legacy_vcl_vbs_scripts/prepare_for_image.vbs b/managementnode/legacy_vcl_vbs_scripts/prepare_for_image.vbs
new file mode 100755
index 0000000..5ff4064
--- /dev/null
+++ b/managementnode/legacy_vcl_vbs_scripts/prepare_for_image.vbs
@@ -0,0 +1,84 @@
+On Error Resume Next
+Set oWshShell = CreateObject("WScript.Shell")
+
+Set oWshEnvironment = oWshShell.Environment("Process")
+
+sCurrentName = oWshEnvironment("COMPUTERNAME")
+sTempDir = oWshEnvironment("TEMP")
+Const ForAppending = 8
+Dim oExec
+MYNAME=lcase(sCurrentName)
+check = ""
+
+' open log file to record all actions taken
+set objFSO = CreateObject("Scripting.FileSystemObject")
+Set objTextFile = objFSO.OpenTextFile _
+ (sTempDir & "\VCLprepare.log", ForAppending, True)
+objTextFile.WriteLine("========================================================================")
+objTextFile.WriteLine(Now & " : prepare_for_image.vbs : script started")
+
+
+' setup to run VCLprepare.vbs script after reboot
+objTextFile.WriteLine(Now & " : prepare_for_image.vbs : setup RunOnce 'VCLprepare1.vbs' after reboot")
+oWshShell.RegWrite "HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce\step1", "cmd.exe /c cscript.exe " & sTempDir & "\vcl\VCLprepare1.vbs"
+
+
+check = oWshShell.RegRead("HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce\step1")
+
+objTextFile.WriteLine(Now & " : CHECK (RunOnce registry entry): " & check)
+
+' enable AutoLogon after reboot
+objTextFile.WriteLine(Now & " : create_image.vbs : enable Auto-Logon after reboot")
+oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon", "1"
+
+
+check = oWshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon")
+
+objTextFile.WriteLine(Now & " : CHECK (AutoAdminLogon registry entry): " & check & " (should be 1)")
+
+
+'Clear up default Event Logs
+strComputer = "."
+Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
+ strComputer & "\root\cimv2")
+Set colLogFiles = objWMIService.ExecQuery("Select * from Win32_NTEventLogFile")
+For Each objLogfile in colLogFiles
+ objLogFile.ClearEventLog()
+Next
+
+
+' ask to setup "image" mode for computer on management node
+objTextFile.WriteLine(Now & " : prepare_for_image.vbs : setup 'image' mode for computer on management node")
+
+WScript.StdOut.WriteLine "######################################"
+'WScript.StdOut.WriteLine "### Setup 'image' mode for vlca1-5 ###"
+WScript.StdOut.WriteLine "### Setup 'image' mode for " & MYNAME & " ###"
+WScript.StdOut.WriteLine "### on management node ###"
+WScript.StdOut.WriteLine "### Is it ready? (y or n) ###"
+WScript.StdOut.WriteLine "######################################"
+answer = WScript.StdIn.ReadLine
+
+If Not answer = "y" Then
+ objTextFile.WriteLine(Now & " : prepare_for_image.vbs : script aborted by user request")
+ objTextFile.WriteLine("========================================================================")
+ WScript.Quit
+End If
+
+
+objTextFile.WriteLine(Now & " : prepare_for_image.vbs : script finished, rebooting computer")
+objTextFile.WriteLine("========================================================================")
+'close log file handler
+objTextFile.Close
+
+'reboot computer to make changes effective
+
+Set objWMIService = GetObject("winmgmts:" _
+ & "{impersonationLevel=impersonate,(Shutdown)}!\\" & strComputer & "\root\cimv2")
+Set colOperatingSystems = objWMIService.ExecQuery _
+ ("Select * from Win32_OperatingSystem")
+For Each objOperatingSystem in colOperatingSystems
+ ObjOperatingSystem.Reboot()
+Next
+
+WScript.Quit
+
diff --git a/managementnode/legacy_vcl_vbs_scripts/reboot.vbs b/managementnode/legacy_vcl_vbs_scripts/reboot.vbs
new file mode 100755
index 0000000..b47cb35
--- /dev/null
+++ b/managementnode/legacy_vcl_vbs_scripts/reboot.vbs
@@ -0,0 +1,28 @@
+On Error Resume Next
+Set oWshShell = CreateObject("WScript.Shell")
+Set oWshEnvironment = oWshShell.Environment("Process")
+sCurrentName = oWshEnvironment("COMPUTERNAME")
+Const ForAppending = 8
+Dim oExec
+MYNAME=lcase(sCurrentName)
+check = ""
+
+strComputer = "."
+Set objWMIService = GetObject("winmgmts:" _
+ & "{impersonationLevel=impersonate,(Shutdown)}!\\" & _
+ strComputer & "\root\cimv2")
+Set colOperatingSystems = objWMIService.ExecQuery _
+ ("Select * from Win32_OperatingSystem")
+for Each objOperatingSystem in colOperatingSystems
+ intret = ObjOperatingSystem.Reboot()
+ If intret = 0 Then
+ Wscript.echo "Computer rebooted"
+ Else
+ Wscript.echo "reboot failed error code " & intret
+ End If
+Next
+
+Set ObjOperatingSystem = Nothing
+Set colOperatingSystems = Nothing
+Set objWMIService = Nothing
+WScript.Quit
diff --git a/managementnode/legacy_vcl_vbs_scripts/release_computer_vcl b/managementnode/legacy_vcl_vbs_scripts/release_computer_vcl
new file mode 100755
index 0000000..444ab23
--- /dev/null
+++ b/managementnode/legacy_vcl_vbs_scripts/release_computer_vcl
@@ -0,0 +1,274 @@
+#! /bin/sh
+if [ "$#" -lt 2 ]
+then
+ echo "Not enough parameters!"
+ echo "Usage: ./release_computer <machine_name> <user_name>"
+ echo " example: ./release_computer vcla1-7 guest"
+ exit 0
+fi
+
+name=$1
+len=`expr length $name`
+pos=`expr index "$name" -`
+num=${name:$pos:$len}
+num=`expr $num + 20`
+wanip=152.1.14.$num
+
+if [ $2 == "root" ]
+then
+ echo -e "\nERROR: CANNOT DELETE USER 'root'!!!"
+ echo -e "Nothing can be done! Exit.\n"
+ exit 1
+fi
+
+echo -e "\nWorking...."
+
+# check if <machine_name> is valid
+if [ -z "`nodels | grep -w $1`" ]
+then
+ echo -e "\nERROR : '$1' - there is no such machine!"
+ echo -e "Nothing can be done! Exit.\n"
+ exit 1
+else
+ echo "Check: Machine '$1' exists. Good!"
+fi
+
+# check if machine is ON
+if [ "`rpower $1 stat | grep -w on`" ]
+then
+ echo "Check: Machine '$1' is ON. Good!"
+else
+ if [ "`rpower $1 stat | grep -w off`" ]
+ then
+ echo -e "\nERROR: Machine '$1' is OFF!"
+ else
+ echo -e "\nERROR: Cannot determine whether '$1' is ON or OFF!"
+ echo "ERROR INFO: (result of 'rpower $1 stat'): `rpower $1 stat`"
+ fi
+ echo -e "Nothing can be done! Exit.\n"
+ exit 1
+fi
+
+# check if machine IS on local network
+if [ "`pping $1 | grep -w noping`" ]
+then
+ echo -e "\nERROR: Machine '$1' is NOT on local network!"
+ echo "ERROR INFO: (result of 'pping $1'): `pping $1`"
+ echo -e "Nothing can be done! Exit.\n"
+ exit 1
+else
+ echo "Check: Machine '$1' IS on local network. Good!"
+fi
+
+# check if machine is available
+# i.e. NOT in the middle of something (like creating image, re-loading OS, etc.)
+
+case $( nodeset $1 stat | gawk 'split($0, a, " ") {print a[2]}' ) in
+install )
+ echo -e "\nERROR: Machine '$1' is in the moddle of re-loading OS!"
+ echo "ERROR INFO: (result of 'nodeset $1 stat'): `nodeset $1 stat`"
+ echo "Please try again later."
+ echo -e "Exit. Nothing was done!\n"
+ exit 1
+ ;;
+image )
+ echo -e "\nERROR: Machine '$1' is in the moddle of creating image of OS!"
+ echo "ERROR INFO: (result of 'nodeset $1 stat'): `nodeset $1 stat`"
+ echo "Please try again later."
+ echo -e "Exit. Nothing was done!\n"
+ exit 1
+ ;;
+boot )
+ echo "Check: Machine '$1' is available. Good!" ;;
+* )
+ echo -e "\nERROR: Machine '$1' is in UKNOWN state!"
+ echo "ERROR INFO: (result of 'nodeset $1 stat'): `nodeset $1 stat`"
+ echo -e "Nothing can be done! Exit.\n"
+ exit 1
+ ;;
+esac
+
+# check if machine is accessible
+if [ -z "`psh $1 uname -r`" ]
+then
+ echo -e "\nERROR: Machine '$1' is NOT accessible!"
+ echo "ERROR INFO: possibly SSH deamon is NOT running on '$1'"
+ echo -e "Nothing can be done! Exit.\n"
+ exit 1
+else
+ echo "Check: Machine '$1' is accessible. Good!"
+fi
+
+# determine what OS
+os=`ssh $1 uname -s`
+if [ $os == "CYGWIN_NT-5.1" ]
+then
+ os="WinXP"
+fi
+if [ $os == "CYGWIN_NT-5.2" ]
+then
+ os="Win2003"
+fi
+ver=`ssh $1 uname -r`
+
+case $os in
+Linux )
+ echo "Check: Machine '$1' is Linux machine ($ver). Good!" ;;
+WinXP )
+ echo "Check: Machine '$1' is WindowsXP machine. Ok." ;;
+Win2003 )
+ echo "Check: Machine '$1' is Windows2003 machine. Ok." ;;
+* )
+ echo "ERROR: Cannot determine OS of '$1'!"
+ echo "ERROR INFO: (result of 'ssh $1 uname -s'): `ssh $1 uname -s`"
+ exit 1
+ ;;
+esac
+
+#if [ $os == "Linux" ]
+#then
+# echo -e "\nThis script temporarily works only with Windows machines. Sorry!"
+# echo -e "Exit. Nothing was done!\n"
+# exit 0
+#fi
+
+# check if <user_name> actually exists on this machine
+if [[ $os == "Win2003" || $os == "WinXP" ]]
+then
+ if [ -z "`ssh $1 ls | grep -w list_users.vbs`" ]
+ then
+ echo -e "\nERROR: missing script: 'list_users.vbs'"
+ echo "ERROR: cannot continue! Exit."
+ exit 1
+ fi
+fi
+
+user_already_exists="yes"
+if [[ $os == "Win2003" || $os == "WinXP" ]]
+then
+# Windows
+ if [ -z "`ssh $1 cscript.exe //Nologo list_users.vbs | grep -w $2`" ]
+ then
+ user_already_exists="no"
+ fi
+else
+# Linux
+ if [ -z "`ssh $1 cat /etc/passwd | grep -w $2`" ]
+ then
+ user_already_exists="no"
+ fi
+fi
+# delete user if exists
+if [ $user_already_exists == "no" ]
+then
+ echo -e "\nWARNING: user '$2' does NOT exists on $1 !"
+ echo "Do you want just disable WAN network interface? (y or n)"
+ read ans
+ if [ $ans != "y" ]
+ then
+ echo -e "Exit. Nothing was done!\n"
+ exit 0
+ fi
+else
+ if [[ $os == "Win2003" || $os == "WinXP" ]]
+ then
+# Windows
+ ssh $1 cscript.exe //Nologo del_user.vbs $2 $3
+ else
+# Linux
+ ssh $1 "userdel $2" > /dev/null
+ fi
+fi
+
+# check if <user_name> DOES NOT exists NOW on this machine
+user_now_exists="no"
+if [[ $os == "Win2003" || $os == "WinXP" ]]
+then
+# Windows
+ if [ -n "`ssh $1 cscript.exe //Nologo list_users.vbs | grep -w $2`" ]
+ then
+ user_now_exists="yes"
+ fi
+else
+# Linux
+ if [ -n "`ssh $1 cat /etc/passwd | grep -w $2`" ]
+ then
+ user_now_exists="yes"
+ fi
+fi
+if [ $user_now_exists == "no" ]
+then
+ echo "Check: User '$2' does NOT exist now. Good!"
+else
+ echo -e "\nERROR: Could NOT delete user '$2'!"
+# echo "ERROR INFO: check 'del_user.vbs' script."
+ echo -e "\n Cannot continue! Exit.\n"
+ exit 1
+fi
+
+# Disable WAN interface
+#echo -n "Disabling WAN interface..."
+if [[ $os == "Win2003" || $os == "WinXP" ]]
+then
+# Windows
+ if [ -z "`ssh $1 ls | grep -w disWAN.vbs`" ]
+ then
+ echo -e "\nERROR: Missing script: 'disWAN.vbs'"
+ echo "ERROR: Cannot continue! Exit."
+ exit 1
+ fi
+ ssh $1 cscript.exe //Nologo disWAN.vbs
+else
+# Linux
+ if [ -z "`ssh $1 ifconfig | grep -w $wanip`" ]
+ then
+ echo "WAN is already disabled!"
+ else
+ touch ifcfg-eth1.tmp
+ for ln in `ssh $1 cat /etc/sysconfig/network-scripts/ifcfg-eth1`
+ do
+ if [ -n "`echo $ln | grep -w ONBOOT`" ]
+ then
+ echo "ONBOOT=no" >> ifcfg-eth1.tmp
+ else
+ echo $ln >> ifcfg-eth1.tmp
+ fi
+ done
+ scp -q ifcfg-eth1.tmp $1:/etc/sysconfig/network-scripts/ifcfg-eth1 > /dev/null
+ psh $1 "service network restart" > /dev/null
+ rm -f ifcfg-eth1.tmp
+ fi
+fi
+#echo ""
+
+# check if WAN was actually disabled
+if [[ $os == "Win2003" || $os == "WinXP" ]]
+then
+ if [ -n "`ssh $1 ipconfig | grep -w $wanip`" ]
+ then
+ echo -e "\nERROR: Can still ping WAN interface ($wanip)!"
+ echo -e "ERROR: Cannot continue! Exit.\n"
+ exit 1
+ fi
+fi
+if [ $os == "Linux" ]
+then
+ if [ -n "`ssh $1 ifconfig | grep -w $wanip`" ]
+ then
+ echo -e "\nERROR: Can still ping WAN interface ($wanip)!"
+ echo -e "ERROR: Cannot continue! Exit.\n"
+ exit 1
+ fi
+fi
+
+echo -e "Check: WAN interface is disabled now. Good!\n"
+
+
+if [ -z $ans ]
+then
+ echo -e "\n User '$2' was DELETED on machine '$1'."
+fi
+echo " Machine '$1' is OFF-LINE now."
+echo " Thank you!"
+echo ""
+
diff --git a/managementnode/legacy_vcl_vbs_scripts/reserve_computer_vcl b/managementnode/legacy_vcl_vbs_scripts/reserve_computer_vcl
new file mode 100755
index 0000000..df520e5
--- /dev/null
+++ b/managementnode/legacy_vcl_vbs_scripts/reserve_computer_vcl
@@ -0,0 +1,275 @@
+#! /bin/sh
+if [ "$#" -lt 3 ]
+then
+ echo "Not enough parameters!"
+ echo "Usage: ./reserve_computer <machine_name> <user_name> <user_password>"
+ echo " example: ./reserve_computer vcla1-7 guest RT56ij"
+ exit 0
+fi
+
+name=$1
+len=`expr length $name`
+pos=`expr index "$name" -`
+num=${name:$pos:$len}
+num=`expr $num + 20`
+wanip=152.1.14.$num
+
+echo -e "\nWorking...."
+
+# check if <machine_name> is valid
+if [ -z "`nodels | grep -w $1`" ]
+then
+ echo -e "\nERROR : '$1' - there is no such machine!"
+ echo -e "Nothing can be done! Exit.\n"
+ exit 1
+else
+ echo "Check: Machine '$1' exists. Good!"
+fi
+
+# check if machine is ON
+if [ "`rpower $1 stat | grep -w on`" ]
+then
+ echo "Check: Machine '$1' is ON. Good!"
+else
+ if [ "`rpower $1 stat | grep -w off`" ]
+ then
+ echo -e "\nERROR: Machine '$1' is OFF!"
+ else
+ echo -e "\nERROR: Cannot determine whether '$1' is ON or OFF!"
+ echo "ERROR INFO: (result of 'rpower $1 stat'): `rpower $1 stat`"
+ fi
+ echo -e "Nothing can be done! Exit.\n"
+ exit 1
+fi
+
+# check if machine IS on local network
+if [ "`pping $1 | grep -w noping`" ]
+then
+ echo -e "\nERROR: Machine '$1' is NOT on local network!"
+ echo "ERROR INFO: (result of 'pping $1'): `pping $1`"
+ echo -e "Nothing can be done! Exit.\n"
+ exit 1
+else
+ echo "Check: Machine '$1' IS on local network. Good!"
+fi
+
+# check if machine is available
+# i.e. NOT in the middle of something (like creating image, re-loading OS, etc.)
+
+case $( nodeset $1 stat | gawk 'split($0, a, " ") {print a[2]}' ) in
+install )
+ echo -e "\nERROR: Machine '$1' is in the middle of re-loading OS!"
+ echo "ERROR INFO: (result of 'nodeset $1 stat'): `nodeset $1 stat`"
+ echo "Please try again later."
+ echo -e "Exit. Nothing was done!\n"
+ exit 1
+ ;;
+image )
+ echo -e "\nERROR: Machine '$1' is in the middle of creating image of OS!"
+ echo "ERROR INFO: (result of 'nodeset $1 stat'): `nodeset $1 stat`"
+ echo "Please try again later."
+ echo -e "Exit. Nothing was done!\n"
+ exit 1
+ ;;
+boot )
+ echo "Check: Machine '$1' is available. Good!" ;;
+* )
+ echo -e "\nERROR: Machine '$1' is in UKNOWN state!"
+ echo "ERROR INFO: (result of 'nodeset $1 stat'): `nodeset $1 stat`"
+ echo -e "Nothing can be done! Exit.\n"
+ exit 1
+ ;;
+esac
+
+# check if machine is accessible
+if [ -z "`psh $1 uname -r`" ]
+then
+ echo -e "\nERROR: Machine '$1' is NOT accessible!"
+ echo "ERROR INFO: possibly SSH deamon is NOT running on '$1'"
+ echo -e "Nothing can be done! Exit.\n"
+ exit 1
+else
+ echo "Check: Machine '$1' is accessible. Good!"
+fi
+
+# determine what OS
+os=`ssh $1 uname -s`
+if [ $os == "CYGWIN_NT-5.1" ]
+then
+ os="WinXP"
+fi
+if [ $os == "CYGWIN_NT-5.2" ]
+then
+ os="Win2003"
+fi
+ver=`ssh $1 uname -r`
+
+case $os in
+Linux )
+ echo "Check: Machine '$1' is Linux machine ($ver). Good" ;;
+WinXP )
+ echo "Check: Machine '$1' is WindowsXP machine. Good." ;;
+Win2003 )
+ echo "Check: Machine '$1' is Windows2003 machine. Good." ;;
+* )
+ echo "ERROR: Cannot determine OS of '$1'!"
+ echo "ERROR INFO: (result of 'ssh $1 uname -s'): `ssh $1 uname -s`"
+ exit 1
+ ;;
+esac
+
+#if [ $os == "Linux" ]
+#then
+# echo -e "\nThis script temporarily works only with Windows machines. Sorry!"
+# echo -e "Exit. Nothing was done!\n"
+# exit 0
+#fi
+
+# check if <user_name> already exists on this machine
+if [[ $os == "Win2003" || $os == "WinXP" ]]
+then
+ if [ -z "`ssh $1 ls | grep -w list_users.vbs`" ]
+ then
+ echo -e "\nERROR: missing script: 'list_users.vbs'"
+ echo "ERROR: cannot continue! Exit."
+ exit 1
+ fi
+fi
+
+user_already_exists="no"
+if [[ $os == "Win2003" || $os == "WinXP" ]]
+then
+# Windows
+ if [ -n "`ssh $1 cscript.exe //Nologo list_users.vbs | grep -w $2`" ]
+ then
+ user_already_exists="yes"
+ fi
+else
+# Linux
+ if [ -n "`ssh $1 cat /etc/passwd | grep -w $2`" ]
+ then
+ user_already_exists="yes"
+ fi
+fi
+# create user if new
+if [ $user_already_exists == "yes" ]
+then
+ echo -e "\nWARNING: user '$2' already exists on $1 !"
+ echo "WARNING: Assuming that password is known."
+ echo "Do you want just enable WAN network interface? (y or n)"
+ read ans
+ if [ $ans != "y" ]
+ then
+ echo -e "Exit. Nothing was done!\n"
+ exit 0
+ fi
+else
+ if [[ $os == "Win2003" || $os == "WinXP" ]]
+ then
+# Windows
+ ssh $1 cscript.exe //Nologo add_user.vbs $2 $3
+ else
+# Linux
+ ssh $1 "adduser $2" > /dev/null
+ ssh $1 "echo $3 | passwd $2 --stdin" > /dev/null
+ fi
+fi
+
+# check if <user_name> exists NOW on this machine
+user_now_exists="yes"
+if [[ $os == "Win2003" || $os == "WinXP" ]]
+then
+# Windows
+ if [ -z "`ssh $1 cscript.exe //Nologo list_users.vbs | grep -w $2`" ]
+ then
+ user_now_exists="no"
+ fi
+else
+# Linux
+ if [ -z "`ssh $1 cat /etc/passwd | grep -w $2`" ]
+ then
+ user_now_exists="no"
+ fi
+fi
+if [ $user_now_exists == "yes" ]
+then
+ echo "Check: User '$2' exists now. Good!"
+else
+ echo -e "\nERROR: Could NOT create user '$2'!"
+# echo "ERROR INFO: check 'add_user.vbs' script."
+ echo -e "\n Cannot continue! Exit.\n"
+ exit 1
+fi
+
+# Enable WAN interface
+#echo -n "Enabling WAN interface..."
+if [[ $os == "Win2003" || $os == "WinXP" ]]
+then
+# Windows
+ if [ -z "`ssh $1 ls | grep -w enWAN.vbs`" ]
+ then
+ echo -e "\nERROR: Missing script: 'enWAN.vbs'"
+ echo "ERROR: Cannot continue! Exit."
+ exit 1
+ fi
+ ssh $1 cscript.exe //Nologo enWAN.vbs
+else
+# Linux
+ if [ -n "`ssh $1 ifconfig | grep -w $wanip`" ]
+ then
+ echo "WAN is already enabled!"
+ else
+ touch ifcfg-eth1.tmp
+ for ln in `ssh $1 cat /etc/sysconfig/network-scripts/ifcfg-eth1`
+ do
+ if [ -n "`echo $ln | grep -w ONBOOT`" ]
+ then
+ echo "ONBOOT=yes" >> ifcfg-eth1.tmp
+ else
+ echo $ln >> ifcfg-eth1.tmp
+ fi
+ done
+ scp -q ifcfg-eth1.tmp $1:/etc/sysconfig/network-scripts/ifcfg-eth1 > /dev/null
+ psh $1 "service network restart" > /dev/null
+ rm -f ifcfg-eth1.tmp
+ fi
+fi
+#echo ""
+
+# check if WAN was actually enabled
+if [[ $os == "Win2003" || $os == "WinXP" ]]
+then
+ if [ -z "`ssh $1 ipconfig | grep -w $wanip`" ]
+ then
+ echo -e "\nERROR: Cannot ping WAN interface ($wanip)!"
+ echo -e "ERROR: Cannot continue! Exit.\n"
+ exit 1
+ fi
+fi
+if [ $os == "Linux" ]
+then
+ if [ -z "`ssh $1 ifconfig | grep -w $wanip`" ]
+ then
+ echo -e "\nERROR: Cannot ping WAN interface ($wanip)!"
+ echo -e "ERROR: Cannot continue! Exit.\n"
+ exit 1
+ fi
+fi
+
+echo -e "Check: WAN interface is enabled now. Good!\n"
+
+if [ -z $ans ]
+then
+ echo -e "\n User '$2' was created on machine '$1'."
+fi
+echo " Machine '$1' is ON-LINE now."
+if [[ $os == "Win2003" || $os == "WinXP" ]]
+then
+ echo " You can access '$1' machine using Remote Desktop client"
+else
+ echo " You can access '$1' machine using SSH client"
+fi
+echo " (use it's name: '$1.hpc.ncsu.edu' OR use it's IP address: '$wanip')."
+echo " NOTE: to log in use your name and password you provided to this script."
+echo ""
+
diff --git a/managementnode/legacy_vcl_vbs_scripts/setpass.vbs b/managementnode/legacy_vcl_vbs_scripts/setpass.vbs
new file mode 100755
index 0000000..18f21b7
--- /dev/null
+++ b/managementnode/legacy_vcl_vbs_scripts/setpass.vbs
@@ -0,0 +1,16 @@
+ Option Explicit
+ Dim WshNetwork, strPass, oAdminAcct
+ Dim UserAccount
+
+ If WScript.Arguments.Count = 2 Then
+ UserAccount = WScript.Arguments.Item(0)
+ strPass = WScript.Arguments.Item(1)
+ Else
+ WScript.Echo "Usage: RandPass.wsf <user_account> <password>"
+ WScript.Quit
+ End If
+
+ Set WshNetwork = WScript.CreateObject("WScript.Network")
+ Set oAdminAcct = GetObject("WinNT://" & WshNetwork.ComputerName & "/" & UserAccount)
+
+ oAdminAcct.SetPassword strPass
diff --git a/managementnode/legacy_vcl_vbs_scripts/virt_lab_status_vcl b/managementnode/legacy_vcl_vbs_scripts/virt_lab_status_vcl
new file mode 100755
index 0000000..fa6782f
--- /dev/null
+++ b/managementnode/legacy_vcl_vbs_scripts/virt_lab_status_vcl
@@ -0,0 +1,186 @@
+#! /bin/sh
+if [ "$#" -lt 1 ]
+then
+# echo "Not enough parameters!"
+ echo ""
+ echo "Usage: ./virt_lab_status all | <blade-range> "
+ echo " examples: ./virt_lab_status all"
+ echo " ./virt_lab_status vcla1-3"
+ echo " ./virt_lab_status vcla1-3,vcla1-5"
+ echo ""
+ exit 0
+fi
+
+group=vcla1
+if [ $1 != "all" ]
+then
+ group=$1
+fi
+
+# initializing data arrays
+for ((i=1; i < 15 ; i++))
+do
+ blade_power_status[$i]="off"
+ blade_status[$i]="N/A"
+ blade_sshd_status[$i]="OFF"
+ blade_os[$i]="N/A "
+ blade_wan_status[$i]="N/A"
+done
+
+#echo -e "Working...\n"
+echo -en "\nCollecting information."
+
+#power_status="`rpower blades1 stat`"
+power_status="`rpower $group stat`"
+for pw in $power_status
+do
+# if [ -n "`echo $pw | grep blade`" ]
+ if [ -n "`echo $pw | grep vcla`" ]
+ then
+ ind="`echo $pw | gawk 'split($0, a, "-") {print a[2]}' | gawk 'split($0, a, ":") {print a[1]}'`"
+# echo -en "$ind "
+ else
+ blade_power_status[$ind]=$pw
+# echo $pw
+ fi
+done
+
+echo -n "."
+
+#status="`nodeset blades1 stat`"
+status="`nodeset $group stat`"
+skip=0
+for st in $status
+do
+# if [ -n "`echo $st | grep blade`" ]
+ if [ -n "`echo $st | grep vcla`" ]
+ then
+ ind="`echo $st | gawk 'split($0, a, "-") {print a[2]}' | gawk 'split($0, a, ":") {print a[1]}'`"
+# echo -en "$ind "
+ skip=0
+ else
+ if [ $skip == "0" ]
+ then
+ blade_status[$ind]=$st
+# echo $st
+ skip=1
+ else
+ skip=0
+ fi
+ fi
+done
+
+echo -n "."
+
+#sshd_status="`psh blades1 uname -s`"
+sshd_status="`psh $group uname -s`"
+for ss in $sshd_status
+do
+# if [ -n "`echo $ss | grep blade`" ]
+ if [ -n "`echo $ss | grep vcla`" ]
+ then
+ ind="`echo $ss | gawk 'split($0, a, "-") {print a[2]}' | gawk 'split($0, a, ":") {print a[1]}'`"
+# echo -en "$ind "
+ else
+ if [ $ss == "noping" ]
+ then
+ blade_sshd_status[$ind]="N/A"
+ else
+ os=$ss
+ case $os in
+ CYGWIN_NT-5.1 )
+ os="WinXP" ;;
+ CYGWIN_NT-5.2 )
+ os="Win2003" ;;
+ Linux )
+ os="Linux" ;;
+ * )
+ os="Unknown" ;;
+ esac
+ blade_os[$ind]=$os
+ blade_sshd_status[$ind]="on"
+ fi
+# echo "ss=$ss"
+ fi
+done
+
+echo -n "."
+
+touch wan.tmp
+#wan_status="`psh $group ipconfig; psh $group ifconfig`"
+psh $group ipconfig >> wan.tmp
+psh $group ifconfig >> wan.tmp
+blade_list="`nodels $group`"
+for bl in $blade_list
+do
+ i="`echo $bl | gawk 'split($0, a, "-") {print a[2]}' | gawk 'split($0, a, ":") {print a[1]}'`"
+ if [ ${blade_sshd_status[$i]} != "OFF" ]
+ then
+ num=`expr $i + 20`
+ wanip=152.1.14.$num
+ wanst="`cat wan.tmp | grep -w $wanip`"
+# if [ -z "`echo $wan_status | grep -w $wanip`" ]
+# echo "wanst = $wanst"
+ if [ -z $wanst ]
+ then
+ if [ ${blade_power_status[$i]} != "off" ]
+ then
+ blade_wan_status[$i]="$wanip:off"
+ fi
+ else
+ blade_wan_status[$i]="$wanip:ON"
+ fi
+ fi
+done
+rm -f wan.tmp
+
+echo -e ".\n"
+
+# for testing only
+#for ((i=1; i < 15 ; i++))
+#do
+# echo "blade_power_status[$i]=${blade_power_status[$i]}"
+# echo "blade_status[$i]=${blade_status[$i]}"
+# echo "blade_sshd_status[$i]=${blade_sshd_status[$i]}"
+# echo "blade_os[$i]=${blade_os[$i]}"
+# echo "blade_wan_status[$i]=${blade_wan_status[$i]}"
+# echo "================="
+#done
+#exit 0
+
+echo -e "Name\t Power Status SSHD OS WAN <IP>:<status>"
+echo "================================================================================="
+#blade_list="`nodels $group`"
+#blade_list="`nodels $group | sort --key=1.8,1.9 -n`" -- good for names "blade"
+blade_list="`nodels $group | sort --key=1.7,1.8 -n`"
+for bl in $blade_list
+do
+ ind="`echo $bl | gawk 'split($0, a, "-") {print a[2]}' | gawk 'split($0, a, ":") {print a[1]}'`"
+ echo -en "$bl"
+# Power?
+ echo -en " \t${blade_power_status[$ind]}"
+# Status?
+ echo -en "\t${blade_status[$ind]}"
+# SSHD is running?
+ echo -en "\t\t${blade_sshd_status[$ind]}"
+# OS?
+ echo -en "\t${blade_os[$ind]} "
+# WAN status?
+ echo -en "\t${blade_wan_status[$ind]}"
+ echo ""
+done
+echo ""
+exit 0
+
+# check if machine IS on local network
+#if [ "`pping $1 | grep -w noping`" ]
+#then
+# echo -e "\nERROR: Machine '$1' is NOT on local network!"
+# echo "ERROR INFO: (result of 'pping $1'): `pping $1`"
+# echo -e "Nothing can be done! Exit.\n"
+# exit 1
+#else
+# echo "Check: Machine '$1' IS on local network. Good!"
+#fi
+
+
diff --git a/managementnode/lib/VCL/.perltidyrc b/managementnode/lib/VCL/.perltidyrc
new file mode 100644
index 0000000..d643162
--- /dev/null
+++ b/managementnode/lib/VCL/.perltidyrc
@@ -0,0 +1,107 @@
+# This is a .perltidyrc configuration file
+# It is used by the perltidy module for formatting source code
+# http://perltidy.sourceforge.net/perltidy.html
+
+# GENERAL CONFIGURATION
+-log # save the .log file
+-se # errors to standard error output
+-w # show all warnings
+-syn # perform Perl syntax check
+-pscf=-c # don't run Perl syntax taint checking
+-b # modify files in place
+
+# INDENTATION
+-et=3 # replace each 3 leading space charaters with 1 tab character
+-i=3 # use 3 columns per indentation level
+-nola # do not outdent labels
+#-naws # don't add whitespace
+
+
+# COMMENTS
+-nbbc # don't add blank lines before a full-line comments
+-nbbs # don't add blank lines before a sub definitions
+-ibc # indent block comments
+-isbc # indent spaced block comments
+
+
+# BLANK LINES AND LINE LENGTH
+-l=0 # don't set a maximum line length, leave long lines alone
+-mbl=3 # set the maximum number of consecutive blank lines
+-ole=win # output line endings for a specific system (Windows)
+
+# TIGHTNESS
+-lp # line up parentheses
+
+-vt=2
+-vtc=2
+# -vt=0 always break a line after opening token (default)
+# -vt=1 do not break unless this would produce more than one step in indentation in a line
+# -vt=2 never break a line after opening token
+# -vtc=0 always break a line before a closing token (default)
+# -vtc=1 do not break before a closing token which is followed by a semicolon or another closing token, and is not in a list environment
+# -vtc=2 never break before a closing token
+
+#-pvt=2 # paren vert tight
+#-pvtc=2 # paren closing vert tight
+
+#-sbvt=2 # square vert tight
+#-sbvtc=2 # square closing vert tight
+
+#-bvt=2 # non-code block braces
+#-bvtc=2 # non-code block closing braces
+
+#-bbvt=2 # just like the -vt=n flag but applies to opening code block braces
+
+#-sot # stack opening tokens when possible to avoid lines with isolated opening tokens
+ # -sot is a synonym for -sop -sohb -sosb
+#-sop # stack opening paren
+#-sohb # stack opening hash brace
+#-sosb # stack opening square bracket
+
+#-sct # stack closing tokens
+ # -sct is a synonym for -scp -schb -scsb
+#-scp # stack closing paren
+#-schb # stack closing hash brace
+#-scsb # stack closing square bracket
+
+-pt=2 # parenthesis tightness, no spaces after ( and before )
+# if ( ( my $len_tab = length( $tabstr ) ) > 0 ) { # -pt=0
+# if ( ( my $len_tab = length($tabstr) ) > 0 ) { # -pt=1 (default)
+# if ((my $len_tab = length($tabstr)) > 0) { # -pt=2
+
+-sbt=2 # square bracket tightness, no spaces after [ and before ]
+# $width = $col[ $j + $k ] - $col[ $j ]; # -sbt=0
+# $width = $col[ $j + $k ] - $col[$j]; # -sbt=1 (default)
+# $width = $col[$j + $k] - $col[$j]; # -sbt=2
+
+-bt=2 # curly brace tightness, no spaces after { and before }
+# $obj->{ $parsed_sql->{ 'table' }[0] }; # -bt=0
+# $obj->{ $parsed_sql->{'table'}[0] }; # -bt=1 (default)
+# $obj->{$parsed_sql->{'table'}[0]}; # -bt=2
+
+-bbt=2 # curly brace tightness which contain blocks of code
+# %bf = map { $_ => -M $_ } grep { /\.deb$/ } dirents '.'; # -bbt=0 (default)
+# %bf = map { $_ => -M $_ } grep {/\.deb$/} dirents '.'; # -bbt=1
+# %bf = map {$_ => -M $_} grep {/\.deb$/} dirents '.'; # -bbt=2
+
+-nsts # no space before semicolons
+# $i = 1 ; # -sts
+# $i = 1; # -nsts (default)
+
+-nsfs # no spaces between special semicolons in for loops
+# for ( @a = @$ap, $u = shift @a ; @a ; $u = $v ) { # -sfs (default)
+# for ( @a = @$ap, $u = shift @a; @a; $u = $v ) { # -nsfs
+
+
+# CLOSING SIDE SCOMMENTS
+-csc # add closing side comments, adds or updates closing side comments
+# sub message {
+# } ## end sub message <-- -csc adds this
+
+#-cscw # enable closing side-comment warnings
+
+-csci=10 # minimum number of lines that a block must have in order for a closing side comment to be added
+
+-csct=40 # closing side comment maximum text
+
+-csce=2 # each elsif is also given the text of the opening if statement
diff --git a/managementnode/lib/VCL/DataStructure.pm b/managementnode/lib/VCL/DataStructure.pm
new file mode 100644
index 0000000..e04e687
--- /dev/null
+++ b/managementnode/lib/VCL/DataStructure.pm
@@ -0,0 +1,962 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: DataStructure.pm 1945 2008-12-11 20:58:08Z fapeeler $
+##############################################################################
+
+=head1 NAME
+
+VCL::DataStructure - VCL data structure module
+
+=head1 SYNOPSIS
+
+ my $data_structure;
+ eval {
+ $data_structure = new VCL::DataStructure({request_id => 66, reservation_id => 65});
+ };
+ if (my $e = Exception::Class::Base->caught()) {
+ die $e->message;
+ }
+
+ # Access data by calling method on the DataStructure object
+ my $user_id = $data_structure->get_user_id;
+
+ # Pass the DataStructure object to a module
+ my $xcat = new VCL::Module::Provisioning::xCAT({data_structure => $data_structure});
+
+ ...
+
+ # Access data from xCAT.pm
+ # Note: the data() subroutine is implented by Provisioning.pm which xCAT.pm is
+ # a subclass of
+ # ->data-> could also be written as ->data()->
+ my $management_node_id = $self->data->get_management_node_id;
+
+=head1 DESCRIPTION
+
+ This module retrieves and stores data from the VCL database. It provides
+ methods to access the data. The database schema and data structures used by
+ core VCL code should not be visible to most modules. This module encapsulates
+ the data and provides an interface to access it.
+
+=cut
+
+##############################################################################
+package VCL::DataStructure;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/..";
+
+# Configure inheritance
+use base qw();
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use Object::InsideOut;
+use List::Util qw(min max);
+use VCL::utils;
+
+##############################################################################
+
+=head1 CLASS ATTRIBUTES
+
+=cut
+
+=head3 %SUBROUTINE_MAPPINGS
+
+ Data type : hash
+ Description : %SUBROUTINE_MAPPINGS hash maps subroutine names to hash keys.
+ It is used by AUTOMETHOD to return the corresponding hash data
+ when an undefined subroutine is called on a DataStructure object.
+
+=cut
+
+my %SUBROUTINE_MAPPINGS;
+
+$SUBROUTINE_MAPPINGS{blockrequest_id} = '$self->blockrequest_data->{BLOCKREQUEST_ID}{id}';
+$SUBROUTINE_MAPPINGS{blockrequest_name} = '$self->blockrequest_data->{BLOCKREQUEST_ID}{name}';
+$SUBROUTINE_MAPPINGS{blockrequest_image_id} = '$self->blockrequest_data->{BLOCKREQUEST_ID}{imageid}';
+$SUBROUTINE_MAPPINGS{blockrequest_number_machines} = '$self->blockrequest_data->{BLOCKREQUEST_ID}{numMachines}';
+$SUBROUTINE_MAPPINGS{blockrequest_group_id} = '$self->blockrequest_data->{BLOCKREQUEST_ID}{groupid}';
+$SUBROUTINE_MAPPINGS{blockrequest_repeating} = '$self->blockrequest_data->{BLOCKREQUEST_ID}{repeating}';
+$SUBROUTINE_MAPPINGS{blockrequest_owner_id} = '$self->blockrequest_data->{BLOCKREQUEST_ID}{ownerid}';
+$SUBROUTINE_MAPPINGS{blockrequest_admin_group_id} = '$self->blockrequest_data->{BLOCKREQUEST_ID}{admingroupid}';
+$SUBROUTINE_MAPPINGS{blockrequest_management_node_id} = '$self->blockrequest_data->{BLOCKREQUEST_ID}{managementnodeid}';
+$SUBROUTINE_MAPPINGS{blockrequest_expire} = '$self->blockrequest_data->{BLOCKREQUEST_ID}{expireTime}';
+$SUBROUTINE_MAPPINGS{blockrequest_processing} = '$self->blockrequest_data->{BLOCKREQUEST_ID}{processing}';
+$SUBROUTINE_MAPPINGS{blockrequest_mode} = '$self->blockrequest_data->{BLOCKREQUEST_ID}{MODE}';
+
+$SUBROUTINE_MAPPINGS{blocktime_id} = '$self->blockrequest_data->{BLOCKREQUEST_ID}{blockTimes}{BLOCKTIME_ID}{id}';
+#$SUBROUTINE_MAPPINGS{blocktime_blockrequest_id} = '$self->blockrequest_data->{BLOCKREQUEST_ID}{blockTimes}{BLOCKTIME_ID}{blockRequestid}';
+$SUBROUTINE_MAPPINGS{blocktime_start} = '$self->blockrequest_data->{BLOCKREQUEST_ID}{blockTimes}{BLOCKTIME_ID}{start}';
+$SUBROUTINE_MAPPINGS{blocktime_end} = '$self->blockrequest_data->{BLOCKREQUEST_ID}{blockTimes}{BLOCKTIME_ID}{end}';
+$SUBROUTINE_MAPPINGS{blocktime_processed} = '$self->blockrequest_data->{BLOCKREQUEST_ID}{blockTimes}{BLOCKTIME_ID}{processed}';
+
+$SUBROUTINE_MAPPINGS{request_check_time} = '$self->request_data->{CHECKTIME}';
+$SUBROUTINE_MAPPINGS{request_modified_time} = '$self->request_data->{datemodified}';
+$SUBROUTINE_MAPPINGS{request_requested_time} = '$self->request_data->{daterequested}';
+$SUBROUTINE_MAPPINGS{request_end_time} = '$self->request_data->{end}';
+$SUBROUTINE_MAPPINGS{request_forimaging} = '$self->request_data->{forimaging}';
+$SUBROUTINE_MAPPINGS{request_id} = '$self->request_data->{id}';
+$SUBROUTINE_MAPPINGS{request_laststate_id} = '$self->request_data->{laststateid}';
+$SUBROUTINE_MAPPINGS{request_log_id} = '$self->request_data->{logid}';
+$SUBROUTINE_MAPPINGS{request_notice_interval} = '$self->request_data->{NOTICEINTERVAL}';
+$SUBROUTINE_MAPPINGS{request_is_cluster_parent} = '$self->request_data->{PARENTIMAGE}';
+$SUBROUTINE_MAPPINGS{request_pid} = '$self->request_data->{PID}';
+$SUBROUTINE_MAPPINGS{request_ppid} = '$self->request_data->{PPID}';
+$SUBROUTINE_MAPPINGS{request_preload} = '$self->request_data->{preload}';
+$SUBROUTINE_MAPPINGS{request_preload_only} = '$self->request_data->{PRELOADONLY}';
+$SUBROUTINE_MAPPINGS{request_reservation_count} = '$self->request_data->{RESERVATIONCOUNT}';
+$SUBROUTINE_MAPPINGS{request_start_time} = '$self->request_data->{start}';
+#$SUBROUTINE_MAPPINGS{request_stateid} = '$self->request_data->{stateid}';
+$SUBROUTINE_MAPPINGS{request_is_cluster_child} = '$self->request_data->{SUBIMAGE}';
+$SUBROUTINE_MAPPINGS{request_test} = '$self->request_data->{test}';
+$SUBROUTINE_MAPPINGS{request_updated} = '$self->request_data->{UPDATED}';
+#$SUBROUTINE_MAPPINGS{request_userid} = '$self->request_data->{userid}';
+$SUBROUTINE_MAPPINGS{request_state_name} = '$self->request_data->{state}{name}';
+$SUBROUTINE_MAPPINGS{request_laststate_name} = '$self->request_data->{laststate}{name}';
+
+#$SUBROUTINE_MAPPINGS{request_reservationid} = '$self->request_data->{RESERVATIONID}';
+$SUBROUTINE_MAPPINGS{reservation_id} = '$self->request_data->{RESERVATIONID}';
+
+#$SUBROUTINE_MAPPINGS{reservation_computerid} = '$self->request_data->{reservation}{RESERVATION_ID}{computerid}';
+#$SUBROUTINE_MAPPINGS{reservation_id} = '$self->request_data->{reservation}{RESERVATION_ID}{id}';
+#$SUBROUTINE_MAPPINGS{reservation_imageid} = '$self->request_data->{reservation}{RESERVATION_ID}{imageid}';
+#$SUBROUTINE_MAPPINGS{reservation_imagerevisionid} = '$self->request_data->{reservation}{RESERVATION_ID}{imagerevisionid}';
+$SUBROUTINE_MAPPINGS{reservation_lastcheck_time} = '$self->request_data->{reservation}{RESERVATION_ID}{lastcheck}';
+$SUBROUTINE_MAPPINGS{reservation_machine_ready} = '$self->request_data->{reservation}{RESERVATION_ID}{MACHINEREADY}';
+#$SUBROUTINE_MAPPINGS{reservation_managementnodeid} = '$self->request_data->{reservation}{RESERVATION_ID}{managementnodeid}';
+$SUBROUTINE_MAPPINGS{reservation_password} = '$self->request_data->{reservation}{RESERVATION_ID}{pw}';
+$SUBROUTINE_MAPPINGS{reservation_remote_ip} = '$self->request_data->{reservation}{RESERVATION_ID}{remoteIP}';
+#$SUBROUTINE_MAPPINGS{reservation_requestid} = '$self->request_data->{reservation}{RESERVATION_ID}{requestid}';
+$SUBROUTINE_MAPPINGS{reservation_ready} = '$self->request_data->{reservation}{RESERVATION_ID}{READY}';
+
+$SUBROUTINE_MAPPINGS{computer_current_image_id} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimageid}';
+$SUBROUTINE_MAPPINGS{computer_deleted} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{deleted}';
+$SUBROUTINE_MAPPINGS{computer_department_id} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{deptid}';
+$SUBROUTINE_MAPPINGS{computer_drive_type} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{drivetype}';
+$SUBROUTINE_MAPPINGS{computer_dsa} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{dsa}';
+$SUBROUTINE_MAPPINGS{computer_dsa_pub} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{dsapub}';
+$SUBROUTINE_MAPPINGS{computer_eth0_mac_address} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{eth0macaddress}';
+$SUBROUTINE_MAPPINGS{computer_eth1_mac_address} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{eth1macaddress}';
+#$SUBROUTINE_MAPPINGS{computer_host} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{host}';
+$SUBROUTINE_MAPPINGS{computer_hostname} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{hostname}';
+$SUBROUTINE_MAPPINGS{computer_host_name} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{hostname}';
+#$SUBROUTINE_MAPPINGS{computer_hostpub} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{hostpub}';
+$SUBROUTINE_MAPPINGS{computer_id} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{id}';
+$SUBROUTINE_MAPPINGS{computer_imagerevision_id} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{imagerevisionid}';
+$SUBROUTINE_MAPPINGS{computer_ip_address} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{IPaddress}';
+$SUBROUTINE_MAPPINGS{computer_lastcheck_time} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{lastcheck}';
+$SUBROUTINE_MAPPINGS{computer_location} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{location}';
+$SUBROUTINE_MAPPINGS{computer_networking_speed} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{network}';
+$SUBROUTINE_MAPPINGS{computer_node_name} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{NODENAME}';
+$SUBROUTINE_MAPPINGS{computer_notes} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{notes}';
+$SUBROUTINE_MAPPINGS{computer_owner_id} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{ownerid}';
+$SUBROUTINE_MAPPINGS{computer_platform_id} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{platformid}';
+$SUBROUTINE_MAPPINGS{computer_preferredimage_id} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimageid}';
+$SUBROUTINE_MAPPINGS{computer_private_ip_address} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{privateIPaddress}';
+$SUBROUTINE_MAPPINGS{computer_processor_count} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{procnumber}';
+$SUBROUTINE_MAPPINGS{computer_processor_speed} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{procspeed}';
+$SUBROUTINE_MAPPINGS{computer_ram} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{RAM}';
+$SUBROUTINE_MAPPINGS{computer_rsa} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{rsa}';
+$SUBROUTINE_MAPPINGS{computer_rsa_pub} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{rsapub}';
+$SUBROUTINE_MAPPINGS{computer_schedule_id} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{scheduleid}';
+$SUBROUTINE_MAPPINGS{computer_short_name} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{SHORTNAME}';
+#$SUBROUTINE_MAPPINGS{computer_state_id} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{stateid}';
+$SUBROUTINE_MAPPINGS{computer_state_name} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{state}{name}';
+$SUBROUTINE_MAPPINGS{computer_type} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{type}';
+$SUBROUTINE_MAPPINGS{computer_provisioning_id} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{provisioningid}';
+#$SUBROUTINE_MAPPINGS{computer_vmhostid} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhostid}';
+
+$SUBROUTINE_MAPPINGS{computer_provisioning_name} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{provisioning}{name}';
+$SUBROUTINE_MAPPINGS{computer_provisioning_pretty_name} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{provisioning}{prettyname}';
+$SUBROUTINE_MAPPINGS{computer_provisioning_module_id} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{provisioning}{moduleid}';
+
+$SUBROUTINE_MAPPINGS{computer_provisioning_module_name} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{provisioning}{module}{name}';
+$SUBROUTINE_MAPPINGS{computer_provisioning_module_pretty_name} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{provisioning}{module}{prettyname}';
+$SUBROUTINE_MAPPINGS{computer_provisioning_module_description} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{provisioning}{module}{description}';
+$SUBROUTINE_MAPPINGS{computer_provisioning_module_perl_package} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{provisioning}{module}{perlpackage}';
+
+#$SUBROUTINE_MAPPINGS{vm_computerid} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhost}{computerid}';
+$SUBROUTINE_MAPPINGS{vmhost_hostname} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhost}{hostname}';
+$SUBROUTINE_MAPPINGS{vmhost_id} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhost}{id}';
+$SUBROUTINE_MAPPINGS{vmhost_image_name} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhost}{imagename}';
+$SUBROUTINE_MAPPINGS{vmhost_ram} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhost}{RAM}';
+$SUBROUTINE_MAPPINGS{vmhost_state} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhost}{state}';
+#$SUBROUTINE_MAPPINGS{vmhost_type} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhost}{type}';
+$SUBROUTINE_MAPPINGS{vmhost_kernal_nic} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhost}{vmkernalnic}';
+$SUBROUTINE_MAPPINGS{vmhost_vm_limit} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhost}{vmlimit}';
+$SUBROUTINE_MAPPINGS{vmhost_profile_id} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhost}{vmprofileid}';
+$SUBROUTINE_MAPPINGS{vmhost_type} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhost}{type}';
+#$SUBROUTINE_MAPPINGS{vmhost_type_id} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhost}{vmtypeid}';
+
+$SUBROUTINE_MAPPINGS{vmhost_profile_datastore_path} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhost}{vmprofile}{datastorepath}';
+$SUBROUTINE_MAPPINGS{vmhost_profile_datastorepath_4vmx} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhost}{vmprofile}{datastorepath4vmx}';
+#$SUBROUTINE_MAPPINGS{vmhost_profile_id} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhost}{vmprofile}{id}';
+$SUBROUTINE_MAPPINGS{vmhost_profile_nas_share} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhost}{vmprofile}{nasshare}';
+$SUBROUTINE_MAPPINGS{vmhost_profile_name} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhost}{vmprofile}{profilename}';
+$SUBROUTINE_MAPPINGS{vmhost_profile_virtualswitch0} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhost}{vmprofile}{virtualswitch0}';
+$SUBROUTINE_MAPPINGS{vmhost_profile_virtualswitch1} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhost}{vmprofile}{virtualswitch1}';
+$SUBROUTINE_MAPPINGS{vmhost_profile_vmdisk} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhost}{vmprofile}{vmdisk}';
+$SUBROUTINE_MAPPINGS{vmhost_profile_vmpath} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhost}{vmprofile}{vmpath}';
+
+#$SUBROUTINE_MAPPINGS{vmhost_typeid} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhost}{vmprofile}{vmtypeid}';
+$SUBROUTINE_MAPPINGS{vmhost_type_id} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhost}{vmprofile}{vmtype}{id}';
+$SUBROUTINE_MAPPINGS{vmhost_type_name} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{vmhost}{vmprofile}{vmtype}{name}';
+
+$SUBROUTINE_MAPPINGS{computer_currentimage_architecture} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimage}{architecture}';
+$SUBROUTINE_MAPPINGS{computer_currentimage_deleted} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimage}{deleted}';
+$SUBROUTINE_MAPPINGS{computer_currentimage_deptid} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimage}{deptid}';
+$SUBROUTINE_MAPPINGS{computer_currentimage_forcheckout} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimage}{forcheckout}';
+$SUBROUTINE_MAPPINGS{computer_currentimage_id} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimage}{id}';
+$SUBROUTINE_MAPPINGS{computer_currentimage_imagemetaid} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimage}{imagemetaid}';
+$SUBROUTINE_MAPPINGS{computer_currentimage_imagetypeid} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimage}{imagetypeid}';
+$SUBROUTINE_MAPPINGS{computer_currentimage_lastupdate} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimage}{lastupdate}';
+$SUBROUTINE_MAPPINGS{computer_currentimage_maxconcurrent} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimage}{maxconcurrent}';
+$SUBROUTINE_MAPPINGS{computer_currentimage_maxinitialtime} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimage}{maxinitialtime}';
+$SUBROUTINE_MAPPINGS{computer_currentimage_minnetwork} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimage}{minnetwork}';
+$SUBROUTINE_MAPPINGS{computer_currentimage_minprocnumber} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimage}{minprocnumber}';
+$SUBROUTINE_MAPPINGS{computer_currentimage_minprocspeed} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimage}{minprocspeed}';
+$SUBROUTINE_MAPPINGS{computer_currentimage_minram} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimage}{minram}';
+$SUBROUTINE_MAPPINGS{computer_currentimage_name} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimage}{name}';
+$SUBROUTINE_MAPPINGS{computer_currentimage_osid} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimage}{OSid}';
+$SUBROUTINE_MAPPINGS{computer_currentimage_ownerid} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimage}{ownerid}';
+$SUBROUTINE_MAPPINGS{computer_currentimage_platformid} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimage}{platformid}';
+$SUBROUTINE_MAPPINGS{computer_currentimage_prettyname} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimage}{prettyname}';
+$SUBROUTINE_MAPPINGS{computer_currentimage_project} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimage}{project}';
+$SUBROUTINE_MAPPINGS{computer_currentimage_reloadtime} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimage}{reloadtime}';
+$SUBROUTINE_MAPPINGS{computer_currentimage_size} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimage}{size}';
+$SUBROUTINE_MAPPINGS{computer_currentimage_test} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimage}{test}';
+$SUBROUTINE_MAPPINGS{computer_currentimagerevision_comments} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimagerevision}{comments}';
+$SUBROUTINE_MAPPINGS{computer_currentimagerevision_datecreated} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimagerevision}{datecreated}';
+$SUBROUTINE_MAPPINGS{computer_currentimagerevision_deleted} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimagerevision}{deleted}';
+$SUBROUTINE_MAPPINGS{computer_currentimagerevision_id} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimagerevision}{id}';
+$SUBROUTINE_MAPPINGS{computer_currentimagerevision_imageid} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimagerevision}{imageid}';
+$SUBROUTINE_MAPPINGS{computer_currentimagerevision_imagename} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimagerevision}{imagename}';
+$SUBROUTINE_MAPPINGS{computer_currentimagerevision_production} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimagerevision}{production}';
+$SUBROUTINE_MAPPINGS{computer_currentimagerevision_revision} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimagerevision}{revision}';
+$SUBROUTINE_MAPPINGS{computer_currentimagerevision_userid} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{currentimagerevision}{userid}';
+
+$SUBROUTINE_MAPPINGS{computer_dept_name} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{dept}{name}';
+$SUBROUTINE_MAPPINGS{computer_dept_prettyname} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{dept}{prettyname}';
+$SUBROUTINE_MAPPINGS{computer_platform_name} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{platform}{name}';
+
+$SUBROUTINE_MAPPINGS{computer_preferredimage_architecture} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimage}{architecture}';
+$SUBROUTINE_MAPPINGS{computer_preferredimage_deleted} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimage}{deleted}';
+$SUBROUTINE_MAPPINGS{computer_preferredimage_deptid} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimage}{deptid}';
+$SUBROUTINE_MAPPINGS{computer_preferredimage_forcheckout} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimage}{forcheckout}';
+$SUBROUTINE_MAPPINGS{computer_preferredimage_id} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimage}{id}';
+$SUBROUTINE_MAPPINGS{computer_preferredimage_imagemetaid} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimage}{imagemetaid}';
+$SUBROUTINE_MAPPINGS{computer_preferredimage_imagetypeid} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimage}{imagetypeid}';
+$SUBROUTINE_MAPPINGS{computer_preferredimage_lastupdate} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimage}{lastupdate}';
+$SUBROUTINE_MAPPINGS{computer_preferredimage_maxconcurrent} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimage}{maxconcurrent}';
+$SUBROUTINE_MAPPINGS{computer_preferredimage_maxinitialtime} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimage}{maxinitialtime}';
+$SUBROUTINE_MAPPINGS{computer_preferredimage_minnetwork} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimage}{minnetwork}';
+$SUBROUTINE_MAPPINGS{computer_preferredimage_minprocnumber} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimage}{minprocnumber}';
+$SUBROUTINE_MAPPINGS{computer_preferredimage_minprocspeed} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimage}{minprocspeed}';
+$SUBROUTINE_MAPPINGS{computer_preferredimage_minram} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimage}{minram}';
+$SUBROUTINE_MAPPINGS{computer_preferredimage_name} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimage}{name}';
+$SUBROUTINE_MAPPINGS{computer_preferredimage_osid} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimage}{OSid}';
+$SUBROUTINE_MAPPINGS{computer_preferredimage_ownerid} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimage}{ownerid}';
+$SUBROUTINE_MAPPINGS{computer_preferredimage_platformid} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimage}{platformid}';
+$SUBROUTINE_MAPPINGS{computer_preferredimage_prettyname} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimage}{prettyname}';
+$SUBROUTINE_MAPPINGS{computer_preferredimage_project} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimage}{project}';
+$SUBROUTINE_MAPPINGS{computer_preferredimage_reloadtime} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimage}{reloadtime}';
+$SUBROUTINE_MAPPINGS{computer_preferredimage_size} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimage}{size}';
+$SUBROUTINE_MAPPINGS{computer_preferredimage_test} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimage}{test}';
+
+$SUBROUTINE_MAPPINGS{computer_preferredimagerevision_comments} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimagerevision}{comments}';
+$SUBROUTINE_MAPPINGS{computer_preferredimagerevision_datecreated} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimagerevision}{datecreated}';
+$SUBROUTINE_MAPPINGS{computer_preferredimagerevision_deleted} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimagerevision}{deleted}';
+$SUBROUTINE_MAPPINGS{computer_preferredimagerevision_id} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimagerevision}{id}';
+$SUBROUTINE_MAPPINGS{computer_preferredimagerevision_imageid} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimagerevision}{imageid}';
+$SUBROUTINE_MAPPINGS{computer_preferredimagerevision_imagename} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimagerevision}{imagename}';
+$SUBROUTINE_MAPPINGS{computer_preferredimagerevision_production} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimagerevision}{production}';
+$SUBROUTINE_MAPPINGS{computer_preferredimagerevision_revision} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimagerevision}{revision}';
+$SUBROUTINE_MAPPINGS{computer_preferredimagerevision_userid} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{preferredimagerevision}{userid}';
+
+$SUBROUTINE_MAPPINGS{computer_schedule_name} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{schedule}{name}';
+$SUBROUTINE_MAPPINGS{computer_state_name} = '$self->request_data->{reservation}{RESERVATION_ID}{computer}{state}{name}';
+
+$SUBROUTINE_MAPPINGS{image_architecture} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{architecture}';
+$SUBROUTINE_MAPPINGS{image_deleted} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{deleted}';
+$SUBROUTINE_MAPPINGS{image_deptid} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{deptid}';
+$SUBROUTINE_MAPPINGS{image_forcheckout} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{forcheckout}';
+$SUBROUTINE_MAPPINGS{image_id} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{id}';
+$SUBROUTINE_MAPPINGS{image_identity} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{IDENTITY}';
+$SUBROUTINE_MAPPINGS{image_imagemetaid} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{imagemetaid}';
+$SUBROUTINE_MAPPINGS{image_lastupdate} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{lastupdate}';
+$SUBROUTINE_MAPPINGS{image_maxconcurrent} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{maxconcurrent}';
+$SUBROUTINE_MAPPINGS{image_maxinitialtime} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{maxinitialtime}';
+$SUBROUTINE_MAPPINGS{image_minnetwork} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{minnetwork}';
+$SUBROUTINE_MAPPINGS{image_minprocnumber} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{minprocnumber}';
+$SUBROUTINE_MAPPINGS{image_minprocspeed} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{minprocspeed}';
+$SUBROUTINE_MAPPINGS{image_minram} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{minram}';
+#$SUBROUTINE_MAPPINGS{image_name} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{name}';
+#$SUBROUTINE_MAPPINGS{image_osid} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{OSid}';
+$SUBROUTINE_MAPPINGS{image_os_id} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{OSid}';
+$SUBROUTINE_MAPPINGS{image_ownerid} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{ownerid}';
+$SUBROUTINE_MAPPINGS{image_platformid} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{platformid}';
+$SUBROUTINE_MAPPINGS{image_prettyname} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{prettyname}';
+$SUBROUTINE_MAPPINGS{image_project} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{project}';
+$SUBROUTINE_MAPPINGS{image_reload_time} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{reloadtime}';
+$SUBROUTINE_MAPPINGS{image_settestflag} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{SETTESTFLAG}';
+$SUBROUTINE_MAPPINGS{image_size} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{size}';
+$SUBROUTINE_MAPPINGS{image_test} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{test}';
+$SUBROUTINE_MAPPINGS{image_updateimagename} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{UPDATEIMAGENAME}';
+
+$SUBROUTINE_MAPPINGS{image_dept_name} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{dept}{name}';
+$SUBROUTINE_MAPPINGS{image_dept_prettyname} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{dept}{prettyname}';
+
+$SUBROUTINE_MAPPINGS{imagemeta_checkuser} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{imagemeta}{checkuser}';
+$SUBROUTINE_MAPPINGS{imagemeta_id} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{imagemeta}{id}';
+$SUBROUTINE_MAPPINGS{imagemeta_postoption} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{imagemeta}{postoption}';
+$SUBROUTINE_MAPPINGS{imagemeta_subimages} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{imagemeta}{subimages}';
+$SUBROUTINE_MAPPINGS{imagemeta_sysprep} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{imagemeta}{sysprep}';
+$SUBROUTINE_MAPPINGS{imagemeta_usergroupid} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{imagemeta}{usergroupid}';
+$SUBROUTINE_MAPPINGS{imagemeta_usergroupmembercount} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{imagemeta}{USERGROUPMEMBERCOUNT}';
+$SUBROUTINE_MAPPINGS{imagemeta_usergroupmembers} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{imagemeta}{USERGROUPMEMBERS}';
+
+$SUBROUTINE_MAPPINGS{image_os_name} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{OS}{name}';
+$SUBROUTINE_MAPPINGS{image_os_prettyname} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{OS}{prettyname}';
+$SUBROUTINE_MAPPINGS{image_os_type} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{OS}{type}';
+$SUBROUTINE_MAPPINGS{image_os_install_type} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{OS}{installtype}';
+$SUBROUTINE_MAPPINGS{image_os_source_path} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{OS}{sourcepath}';
+$SUBROUTINE_MAPPINGS{image_os_moduleid} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{OS}{moduleid}';
+
+$SUBROUTINE_MAPPINGS{image_os_module_name} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{OS}{module}{name}';
+$SUBROUTINE_MAPPINGS{image_os_module_pretty_name} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{OS}{module}{prettyname}';
+$SUBROUTINE_MAPPINGS{image_os_module_description} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{OS}{module}{description}';
+$SUBROUTINE_MAPPINGS{image_os_module_perl_package} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{OS}{module}{perlpackage}';
+
+$SUBROUTINE_MAPPINGS{image_platform_name} = '$self->request_data->{reservation}{RESERVATION_ID}{image}{platform}{name}';
+
+$SUBROUTINE_MAPPINGS{imagerevision_comments} = '$self->request_data->{reservation}{RESERVATION_ID}{imagerevision}{comments}';
+$SUBROUTINE_MAPPINGS{imagerevision_date_created} = '$self->request_data->{reservation}{RESERVATION_ID}{imagerevision}{datecreated}';
+$SUBROUTINE_MAPPINGS{imagerevision_deleted} = '$self->request_data->{reservation}{RESERVATION_ID}{imagerevision}{deleted}';
+$SUBROUTINE_MAPPINGS{imagerevision_id} = '$self->request_data->{reservation}{RESERVATION_ID}{imagerevision}{id}';
+$SUBROUTINE_MAPPINGS{imagerevision_imageid} = '$self->request_data->{reservation}{RESERVATION_ID}{imagerevision}{imageid}';
+#$SUBROUTINE_MAPPINGS{imagerevision_imagename} = '$self->request_data->{reservation}{RESERVATION_ID}{imagerevision}{imagename}';
+$SUBROUTINE_MAPPINGS{image_name} = '$self->request_data->{reservation}{RESERVATION_ID}{imagerevision}{imagename}';
+$SUBROUTINE_MAPPINGS{imagerevision_production} = '$self->request_data->{reservation}{RESERVATION_ID}{imagerevision}{production}';
+$SUBROUTINE_MAPPINGS{imagerevision_revision} = '$self->request_data->{reservation}{RESERVATION_ID}{imagerevision}{revision}';
+$SUBROUTINE_MAPPINGS{imagerevision_userid} = '$self->request_data->{reservation}{RESERVATION_ID}{imagerevision}{userid}';
+
+#$SUBROUTINE_MAPPINGS{management_node_id} = '$self->request_data->{reservation}{RESERVATION_ID}{managementnode}{id}';
+#$SUBROUTINE_MAPPINGS{management_node_ipaddress} = '$self->request_data->{reservation}{RESERVATION_ID}{managementnode}{IPaddress}';
+#$SUBROUTINE_MAPPINGS{management_node_hostname} = '$self->request_data->{reservation}{RESERVATION_ID}{managementnode}{hostname}';
+#$SUBROUTINE_MAPPINGS{management_node_ownerid} = '$self->request_data->{reservation}{RESERVATION_ID}{managementnode}{ownerid}';
+#$SUBROUTINE_MAPPINGS{management_node_stateid} = '$self->request_data->{reservation}{RESERVATION_ID}{managementnode}{stateid}';
+#$SUBROUTINE_MAPPINGS{management_node_lastcheckin} = '$self->request_data->{reservation}{RESERVATION_ID}{managementnode}{lastcheckin}';
+#$SUBROUTINE_MAPPINGS{management_node_checkininterval} = '$self->request_data->{reservation}{RESERVATION_ID}{managementnode}{checkininterval}';
+#$SUBROUTINE_MAPPINGS{management_node_install_path} = '$self->request_data->{reservation}{RESERVATION_ID}{managementnode}{installpath}';
+#$SUBROUTINE_MAPPINGS{management_node_image_lib_enable} = '$self->request_data->{reservation}{RESERVATION_ID}{managementnode}{imagelibenable}';
+#$SUBROUTINE_MAPPINGS{management_node_image_lib_group_id} = '$self->request_data->{reservation}{RESERVATION_ID}{managementnode}{imagelibgroupid}';
+#$SUBROUTINE_MAPPINGS{management_node_image_lib_user} = '$self->request_data->{reservation}{RESERVATION_ID}{managementnode}{imagelibuser}';
+#$SUBROUTINE_MAPPINGS{management_node_image_lib_key} = '$self->request_data->{reservation}{RESERVATION_ID}{managementnode}{imagelibkey}';
+#$SUBROUTINE_MAPPINGS{management_node_image_lib_partners} = '$self->request_data->{reservation}{RESERVATION_ID}{managementnode}{IMAGELIBPARTNERS}';
+#$SUBROUTINE_MAPPINGS{management_node_short_name} = '$self->request_data->{reservation}{RESERVATION_ID}{managementnode}{SHORTNAME}';
+#$SUBROUTINE_MAPPINGS{management_node_state_name} = '$self->request_data->{reservation}{RESERVATION_ID}{managementnode}{state}{name}';
+
+$SUBROUTINE_MAPPINGS{user_adminlevelid} = '$self->request_data->{user}{adminlevelid}';
+$SUBROUTINE_MAPPINGS{user_affiliationid} = '$self->request_data->{user}{affiliationid}';
+$SUBROUTINE_MAPPINGS{user_audiomode} = '$self->request_data->{user}{audiomode}';
+$SUBROUTINE_MAPPINGS{user_bpp} = '$self->request_data->{user}{bpp}';
+$SUBROUTINE_MAPPINGS{user_email} = '$self->request_data->{user}{email}';
+$SUBROUTINE_MAPPINGS{user_emailnotices} = '$self->request_data->{user}{emailnotices}';
+$SUBROUTINE_MAPPINGS{user_firstname} = '$self->request_data->{user}{firstname}';
+$SUBROUTINE_MAPPINGS{user_height} = '$self->request_data->{user}{height}';
+$SUBROUTINE_MAPPINGS{user_id} = '$self->request_data->{user}{id}';
+$SUBROUTINE_MAPPINGS{user_im_id} = '$self->request_data->{user}{IMid}';
+$SUBROUTINE_MAPPINGS{user_imtypeid} = '$self->request_data->{user}{IMtypeid}';
+$SUBROUTINE_MAPPINGS{user_lastname} = '$self->request_data->{user}{lastname}';
+$SUBROUTINE_MAPPINGS{user_lastupdated} = '$self->request_data->{user}{lastupdated}';
+$SUBROUTINE_MAPPINGS{user_mapdrives} = '$self->request_data->{user}{mapdrives}';
+$SUBROUTINE_MAPPINGS{user_mapprinters} = '$self->request_data->{user}{mapprinters}';
+$SUBROUTINE_MAPPINGS{user_mapserial} = '$self->request_data->{user}{mapserial}';
+$SUBROUTINE_MAPPINGS{user_middlename} = '$self->request_data->{user}{middlename}';
+$SUBROUTINE_MAPPINGS{user_preferred_name} = '$self->request_data->{user}{preferredname}';
+$SUBROUTINE_MAPPINGS{user_showallgroups} = '$self->request_data->{user}{showallgroups}';
+$SUBROUTINE_MAPPINGS{user_standalone} = '$self->request_data->{user}{STANDALONE}';
+$SUBROUTINE_MAPPINGS{user_uid} = '$self->request_data->{user}{uid}';
+#$SUBROUTINE_MAPPINGS{user_unityid} = '$self->request_data->{user}{unityid}';
+$SUBROUTINE_MAPPINGS{user_login_id} = '$self->request_data->{user}{unityid}';
+$SUBROUTINE_MAPPINGS{user_width} = '$self->request_data->{user}{width}';
+$SUBROUTINE_MAPPINGS{user_adminlevel_name} = '$self->request_data->{user}{adminlevel}{name}';
+$SUBROUTINE_MAPPINGS{user_affiliation_dataupdatetext} = '$self->request_data->{user}{affiliation}{dataUpdateText}';
+$SUBROUTINE_MAPPINGS{user_affiliation_helpaddress} = '$self->request_data->{user}{affiliation}{helpaddress}';
+$SUBROUTINE_MAPPINGS{user_affiliation_name} = '$self->request_data->{user}{affiliation}{name}';
+$SUBROUTINE_MAPPINGS{user_affiliation_sitewwwaddress} = '$self->request_data->{user}{affiliation}{sitewwwaddress}';
+$SUBROUTINE_MAPPINGS{user_imtype_name} = '$self->request_data->{user}{IMtype}{name}';
+
+
+$SUBROUTINE_MAPPINGS{management_node_id} = '$ENV{management_node_info}{id}';
+$SUBROUTINE_MAPPINGS{management_node_ipaddress} = '$ENV{management_node_info}{IPaddress}';
+$SUBROUTINE_MAPPINGS{management_node_hostname} = '$ENV{management_node_info}{hostname}';
+$SUBROUTINE_MAPPINGS{management_node_ownerid} = '$ENV{management_node_info}{ownerid}';
+$SUBROUTINE_MAPPINGS{management_node_stateid} = '$ENV{management_node_info}{stateid}';
+$SUBROUTINE_MAPPINGS{management_node_lastcheckin} = '$ENV{management_node_info}{lastcheckin}';
+$SUBROUTINE_MAPPINGS{management_node_checkininterval} = '$ENV{management_node_info}{checkininterval}';
+$SUBROUTINE_MAPPINGS{management_node_install_path} = '$ENV{management_node_info}{installpath}';
+$SUBROUTINE_MAPPINGS{management_node_image_lib_enable} = '$ENV{management_node_info}{imagelibenable}';
+$SUBROUTINE_MAPPINGS{management_node_image_lib_group_id} = '$ENV{management_node_info}{imagelibgroupid}';
+$SUBROUTINE_MAPPINGS{management_node_image_lib_user} = '$ENV{management_node_info}{imagelibuser}';
+$SUBROUTINE_MAPPINGS{management_node_image_lib_key} = '$ENV{management_node_info}{imagelibkey}';
+$SUBROUTINE_MAPPINGS{management_node_keys} = '$ENV{management_node_info}{keys}';
+$SUBROUTINE_MAPPINGS{management_node_image_lib_partners} = '$ENV{management_node_info}{IMAGELIBPARTNERS}';
+$SUBROUTINE_MAPPINGS{management_node_short_name} = '$ENV{management_node_info}{SHORTNAME}';
+$SUBROUTINE_MAPPINGS{management_node_state_name} = '$ENV{management_node_info}{state}{name}';
+$SUBROUTINE_MAPPINGS{management_node_os_name} = '$ENV{management_node_info}{OSNAME}';
+$SUBROUTINE_MAPPINGS{management_node_predictive_module_id} = '$ENV{management_node_info}{predictivemoduleid}';
+
+$SUBROUTINE_MAPPINGS{management_node_predictive_module_name} = '$ENV{management_node_info}{predictive_name}';
+$SUBROUTINE_MAPPINGS{management_node_predictive_module_pretty_name} = '$ENV{management_node_info}{predictive_prettyname}';
+$SUBROUTINE_MAPPINGS{management_node_predictive_module_description} = '$ENV{management_node_info}{predictive_description}';
+$SUBROUTINE_MAPPINGS{management_node_predictive_module_perl_package} = '$ENV{management_node_info}{predictive_perlpackage}';
+
+##############################################################################
+
+=head1 OBJECT ATTRIBUTES
+
+=cut
+
+=head3 @request_id
+
+ Data type : array of scalars
+ Description :
+
+=cut
+
+my @request_id : Field : Arg('Name' => 'request_id') : Type(scalar) : Get('Name' => 'request_id', 'Private' => 1);
+
+=head3 @reservation_id
+
+ Data type : array of scalars
+ Description :
+
+=cut
+
+my @reservation_id : Field : Arg('Name' => 'reservation_id') : Type(scalar) : Get('Name' => 'reservation_id', 'Private' => 1);
+
+=head3 @blockrequest_id
+
+ Data type : array of scalars
+ Description :
+
+=cut
+
+my @blockrequest_id : Field : Arg('Name' => 'blockrequest_id') : Type(scalar) : Get('Name' => 'blockrequest_id', 'Private' => 1);
+
+=head3 @blocktime_id
+
+ Data type : array of scalars
+ Description :
+
+=cut
+
+my @blocktime_id : Field : Arg('Name' => 'blocktime_id') : Type(scalar) : Get('Name' => 'blocktime_id', 'Private' => 1);
+
+
+=head3 @request_data
+
+ Data type : array of hashes
+ Description :
+
+=cut
+
+my @request_data : Field : Arg('Name' => 'request_data') : Get('Name' => 'request_data', 'Private' => 1) : Set('Name' => 'refresh_request_data', 'Private' => 1);
+
+=head3 @blockrequest_data
+
+ Data type : array of hashes
+ Description :
+
+=cut
+
+my @blockrequest_data : Field : Arg('Name' => 'blockrequest_data') : Get('Name' => 'blockrequest_data', 'Private' => 1);
+
+##############################################################################
+
+=head1 PRIVATE OBJECT METHODS
+
+=cut
+
+=head2 initialize
+
+ Parameters : None
+ Returns : 1 if successful, 0 if failed
+ Description : This subroutine initializes the DataStructure object. It
+ retrieves the data for the specified request ID from the
+ database and adds the data to the object.
+
+=cut
+
+sub _initialize : Init {
+ my ($self, $args) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ if (!defined($ENV{management_node_info}) || !$ENV{management_node_info}) {
+ my $management_node_info = get_management_node_info();
+ if (!$management_node_info) {
+ notify($ERRORS{'WARNING'}, 0, "unable to obtain management node info for this node");
+ return 0;
+ }
+ $ENV{management_node_info} = $management_node_info;
+ }
+
+ # TODO: add checks to make sure req data is valid if it was passed and rsvp is set
+
+ #notify($ERRORS{'DEBUG'}, 0, "object initialized");
+ return 1;
+} ## end sub _initialize :
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 automethod
+
+ Parameters : None
+ Returns : Data based on the method name, 0 if method was not handled
+ Description : This subroutine is automatically invoked when an class method is
+ called on a DataStructure object but the method isn't explicitly
+ defined. Function names are mapped to data stored in the request
+ data hash. This subroutine returns the requested data.
+
+=cut
+
+sub _automethod : Automethod {
+ my $self = shift;
+ my @args = @_;
+ my $method_name = $_;
+
+ # Make sure the function name begins with get_ or set_
+ my $mode;
+ my $data_identifier;
+ if ($method_name =~ /^(get|set)_(.*)/) {
+ # $mode stores either 'get' or 'set', data stores the requested data
+ $mode = $1;
+ $data_identifier = $2;
+ }
+ else {
+ return;
+ }
+
+ # If set, make sure an argument was passed
+ my $set_data;
+ if ($mode =~ /set/ && defined $args[0]) {
+ $set_data = $args[0];
+ }
+ elsif ($mode =~ /set/) {
+ notify($ERRORS{'WARNING'}, 0, "data structure set function was called without an argument");
+ return;
+ }
+
+ # Check if the sub name is defined in the subroutine mappings hash
+ # Return if it isn't
+ if (!defined $SUBROUTINE_MAPPINGS{$data_identifier}) {
+ notify($ERRORS{'WARNING'}, 0, "unsupported subroutine name: $method_name");
+ return sub { };
+ }
+
+ # Get the hash path out of the subroutine mappings hash
+ my $hash_path = $SUBROUTINE_MAPPINGS{$data_identifier};
+
+ # Replace RESERVATION_ID with the actual reservation ID if it exists in the hash path
+ my $reservation_id = $self->reservation_id;
+ $reservation_id = 'undefined' if !$reservation_id;
+ $hash_path =~ s/RESERVATION_ID/$reservation_id/;
+
+ # Replace BLOCKREQUEST_ID with the actual blockrequest ID if it exists in the hash path
+ my $blockrequest_id = $self->blockrequest_id;
+ $blockrequest_id = 'undefined' if !$blockrequest_id;
+ $hash_path =~ s/BLOCKREQUEST_ID/$blockrequest_id/;
+
+ # Replace BLOCKTIME_ID with the actual blocktime ID if it exists in the hash path
+ my $blocktime_id = $self->blocktime_id;
+ $$blocktime_id = 'undefined' if !$blocktime_id;
+ $hash_path =~ s/BLOCKTIME_ID/$blocktime_id/;
+
+ if ($mode =~ /get/) {
+ # Get the data from the request_data hash
+ # eval is required in order to interpolate the hash path before retrieving the data
+ my $key_defined = eval "defined $hash_path";
+ if (!$key_defined) {
+ notify($ERRORS{'WARNING'}, 0, "corresponding data has not been initialized for $method_name: $hash_path", $self->request_data);
+ return sub { };
+ }
+
+ my $return_value = eval $hash_path;
+
+ if (!defined $return_value) {
+ notify($ERRORS{'WARNING'}, 0, "corresponding data is undefined for $method_name: $hash_path", $self->request_data);
+ return sub { };
+ }
+
+ # Return the data
+ return sub {$return_value;};
+ } ## end if ($mode =~ /get/)
+ elsif ($mode =~ /set/) {
+ eval $hash_path . ' = $set_data';
+
+ # Make sure the value was set in the hash
+ my $check_value = eval $hash_path;
+ if ($check_value eq $set_data) {
+ notify($ERRORS{'DEBUG'}, 0, "data structure updated: $data_identifier = $set_data");
+ return sub {1;};
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "data structure could not be updated: $data_identifier");
+ return sub {0;};
+ }
+ } ## end elsif ($mode =~ /set/) [ if ($mode =~ /get/)
+} ## end sub _automethod :
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_request_data (deprecated)
+
+ Parameters : None
+ Returns : scalar
+ Description : Returns the request data hash.
+
+=cut
+
+sub get_request_data {
+ my $self = shift;
+ return $self->request_data;
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 refresh
+
+ Parameters : None
+ Returns :
+ Description :
+
+=cut
+
+sub refresh {
+ my $self = shift;
+
+ # Save the current state names
+ my $request_id = $self->get_request_id();
+ my $request_state_name = $self->get_request_state_name();
+ my $request_laststate_name = $self->get_request_laststate_name();
+
+ # Get the full set of database data for this request
+ if (my %request_info = get_request_info($request_id)) {
+ notify($ERRORS{'DEBUG'}, 0, "retrieved current request information from database for request $request_id");
+
+ # Set the state names in the newly retrieved hash to their original values
+ $request_info{state}{name} = $request_state_name;
+ $request_info{laststate}{name} = $request_laststate_name;
+
+ # Replace the request data for this DataStructure object
+ $self->refresh_request_data(\%request_info);
+ notify($ERRORS{'DEBUG'}, 0, "updated DataStructure object with current request information from database");
+
+ } ## end if (my %request_info = get_request_info($request_id...
+ else {
+ notify($ERRORS{'WARNING'}, 0, "could not retrieve current request information from database");
+ return;
+ }
+} ## end sub refresh
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_blockrequest_data (deprecated)
+
+ Parameters : None
+ Returns : scalar
+ Description : Returns the block request data hash.
+
+=cut
+
+sub get_blockrequest_data {
+ my $self = shift;
+
+ # Check to make sure block request ID is defined
+ if (!$self->blockrequest_id) {
+ notify($ERRORS{'WARNING'}, 0, "failed to return block request data hash, block request ID is not defined");
+ return;
+ }
+
+ # Check to make sure block request ID is defined
+ if (!$self->blockrequest_data) {
+ notify($ERRORS{'WARNING'}, 0, "block request data hash is not defined");
+ return;
+ }
+
+ # Check to make sure block request data is defined for the ID
+ if (!$self->blockrequest_data->{$self->blockrequest_id}) {
+ notify($ERRORS{'WARNING'}, 0, "block request data hash is not defined for block request $self->blockrequest_id");
+ return;
+ }
+
+ # Data is there, return it
+ return $self->blockrequest_data->{$self->blockrequest_id};
+} ## end sub get_blockrequest_data
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_reservation_count
+
+ Parameters : None
+ Returns : scalar
+ Description : Returns the number of reservations for the request
+ associated with this reservation's DataStructure object.
+
+=cut
+
+sub get_reservation_count {
+ my $self = shift;
+
+ my $reservation_count = scalar keys %{$self->request_data->{reservation}};
+ return $reservation_count;
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_reservation_ids
+
+ Parameters : None
+ Returns : array containing reservation IDs for the request
+ Description : Returns an array containing the reservation IDs for the current request.
+
+=cut
+
+sub get_reservation_ids {
+ my $self = shift;
+
+ my @reservation_ids = sort keys %{$self->request_data->{reservation}};
+ return @reservation_ids;
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 is_parent_reservation
+
+ Parameters : None
+ Returns : scalar, either 1 or 0
+ Description : This subroutine returns 1 if this is the parent reservation for
+ the request or if the request has 1 reservation associated with
+ it. It returns 0 if there are multiple reservations associated
+ with the request and this reservation is a child.
+
+=cut
+
+sub is_parent_reservation {
+ my $self = shift;
+
+ my $reservation_id = $self->get_reservation_id();
+ my @reservation_ids = $self->get_reservation_ids();
+
+ # The parent reservation has the lowest ID
+ my $parent_reservation_id = min @reservation_ids;
+
+ if ($reservation_id == $parent_reservation_id) {
+ notify($ERRORS{'DEBUG'}, 0, "returning true: parent reservation ID for this request: $parent_reservation_id");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'DEBUG'}, 0, "returning false: parent reservation ID for this request: $parent_reservation_id");
+ return 0;
+ }
+} ## end sub is_parent_reservation
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_reservation_data
+
+ Parameters : reservation id
+ Returns : DataStructure object of specific reservation
+ Description :
+
+=cut
+
+sub get_reservation_data {
+ my $self = shift;
+ my $reservation_id = shift;
+
+ # Check to make sure reservation ID was passed
+ if (!$reservation_id) {
+ notify($ERRORS{'WARNING'}, 0, "reservation ID was not specified, useless use of this subroutine, returning self");
+ return $self;
+ }
+
+ # Make sure reservation ID is an integer
+ if ($reservation_id !~ /^\d+$/) {
+ notify($ERRORS{'CRITICAL'}, 0, "reservation ID must be an integer, invalid value was passed: $reservation_id");
+ return;
+ }
+
+ # Check if the reservation ID is the same as the one for this object
+ if ($reservation_id == $self->reservation_id) {
+ notify($ERRORS{'WARNING'}, 0, "reservation ID the same as this object's, useless use of this subroutine, returning self");
+ return $self;
+ }
+
+ # Make sure reservation ID exists for this request
+ my @reservation_ids = $self->get_reservation_ids();
+ if (!grep($reservation_id, @reservation_ids)) {
+ notify($ERRORS{'WARNING'}, 0, "reservation ID does not exist for this request: $reservation_id");
+ return;
+ }
+
+ # Get a new data structure object
+ my $sibling_data_structure;
+ eval {$sibling_data_structure = new VCL::DataStructure({request_data => $self->request_data, reservation_id => $reservation_id});};
+ if (my $e = Exception::Class::Base->caught()) {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to create sibling DataStructure object" . $e->message);
+ return;
+ }
+
+ return $sibling_data_structure;
+} ## end sub get_reservation_data
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_computer_private_ip
+
+ Parameters : None
+ Returns : IP address string if successful, 0 if failed
+ Description :
+
+=cut
+
+sub get_computer_private_ip {
+ my $self = shift;
+
+ # Get the computer short name from this DataStructure
+ my $computer_short_name = $self->get_computer_short_name();
+ if (!$computer_short_name) {
+ notify($ERRORS{'WARNING'}, 0, "computer short name could not be retrieved");
+ return 0;
+ }
+
+ # Get the node's private IP address from the hosts file
+ if (my $computer_private_ip = get_ip_address_from_hosts($computer_short_name)) {
+ return $computer_private_ip;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to locate private IP address for $computer_short_name in hosts file");
+ return 0;
+ }
+} ## end sub get_computer_private_ip
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_state_name
+
+ Parameters : None
+ Returns : string
+ Description : Returns either the request state name or 'blockrequest'. Useful
+ for vcld when make_new_child needs to figure out which module
+ to call. Without this subroutine, it would need to include
+ if statement and then call get_request_state_name or hack the
+ name if it's processing a block request;
+
+=cut
+
+sub get_state_name {
+ my $self = shift;
+
+ if ($self->blockrequest_id) {
+ return 'blockrequest';
+ }
+ elsif ($self->request_data->{state}{name}) {
+ return $self->request_data->{state}{name};
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "blockrequest ID is not set and request state name is undefined");
+ return;
+ }
+} ## end sub get_state_name
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 print_data
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub print_data {
+ my $self = shift;
+
+ my $request_data = format_data($self->request_data, 'request');
+ my $management_node_info = format_data($ENV{management_node_info}, 'management_node');
+
+ notify($ERRORS{'OK'}, 0, "request data:\n$request_data\n\nmanagement node info:\n$management_node_info");
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 print_subroutines
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub print_subroutines {
+ my $self = shift;
+
+ my $output;
+ foreach my $mapping_key (sort keys %SUBROUTINE_MAPPINGS) {
+ my $mapping_value = $SUBROUTINE_MAPPINGS{$mapping_key};
+ $mapping_value =~ s/^\$self->request_data->/\%request/;
+ $mapping_value =~ s/^\$ENV{management_node_info}/\%management_node/;
+ $output .= "get_$mapping_key() : $mapping_value\n";
+ }
+
+ notify($ERRORS{'OK'}, 0, "valid subroutines:\n$output");
+} ## end sub print_subroutines
+#/////////////////////////////////////////////////////////////////////////////
+
+
+1;
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+=cut
diff --git a/managementnode/lib/VCL/Module.pm b/managementnode/lib/VCL/Module.pm
new file mode 100644
index 0000000..e6bffc9
--- /dev/null
+++ b/managementnode/lib/VCL/Module.pm
@@ -0,0 +1,165 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: Module.pm 1953 2008-12-12 14:23:17Z arkurth $
+##############################################################################
+
+=head1 NAME
+
+VCL::Module - VCL base module
+
+=head1 SYNOPSIS
+
+ use base qw(VCL::Module);
+
+=head1 DESCRIPTION
+
+ Needs to be written.
+
+=cut
+
+##############################################################################
+package VCL::Module;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/..";
+
+# Configure inheritance
+use base qw();
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use VCL::utils qw($VERBOSE %ERRORS ¬ify &getnewdbh);
+use VCL::DataStructure;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 new
+
+ Parameters : {data_structure} - reference to a VCL::DataStructure object
+ Returns : New object which inherits from VCL::Provisioning
+ Description : Constructor for classes of objects derived from
+ VCL::Module::Provisioning.
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $args = shift;
+
+ notify($ERRORS{'DEBUG'}, 0, "constructor called, class=$class");
+
+ # Create a variable to store the newly created class object
+ my $class_object;
+
+ # Make sure the data structure was passed as an argument called 'data_structure'
+ if (!defined $args->{data_structure}) {
+ notify($ERRORS{'CRITICAL'}, 0, "required 'data_structure' argument was not passed");
+ return 0;
+ }
+
+ # Make sure the 'data_structure' argument contains a VCL::DataStructure object
+ if (ref $args->{data_structure} ne 'VCL::DataStructure') {
+ notify($ERRORS{'CRITICAL'}, 0, "'data_structure' argument passed is not a reference to a VCL::DataStructure object");
+ return 0;
+ }
+
+ # Add the DataStructure reference to the class object
+ $class_object->{data} = $args->{data_structure};
+
+ # Bless the object as the class which new was called with
+ bless $class_object, $class;
+ notify($ERRORS{'DEBUG'}, 0, "$class object created");
+
+ # Check if an initialize() subroutine is defined for this module
+ if ($class_object->can("initialize")) {
+ # Call the initialize() subroutine, if it returns 0, return 0
+ # If it doesn't return 0, return the object reference
+ return 0 if (!$class_object->initialize());
+ }
+
+ return $class_object;
+} ## end sub new
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 data
+
+ Parameters : None
+ Returns : Reference to the DataStructure object belonging to the class
+ instance
+ Description : This data() subroutine allows derived instances to easily
+ retrieve data from the DataStructure as follows:
+ my $image_id = $self->data->get_image_id;
+
+=cut
+
+sub data {
+ my $self = shift;
+
+ # If this was called as a class method, return the DataStructure object stored in the class object
+ return $self->{data} if ref($self);
+
+ # Not called as a class method, check to see if $ENV{data} is defined
+ return $ENV{data} if (defined($ENV{data}) && $ENV{data});
+
+ # $ENV{data} is not set, set it
+ $ENV{data} = new VCL::DataStructure();
+
+ # Return the new DataStructure if got created successfully
+ return $ENV{data} if (defined($ENV{data}) && $ENV{data});
+
+ notify($ERRORS{'CRITICAL'}, 0, "unable to create DataStructure object");
+ return 0;
+} ## end sub data
+
+#/////////////////////////////////////////////////////////////////////////////
+
+1;
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+=cut
diff --git a/managementnode/lib/VCL/Module/OS.pm b/managementnode/lib/VCL/Module/OS.pm
new file mode 100644
index 0000000..f30f8c0
--- /dev/null
+++ b/managementnode/lib/VCL/Module/OS.pm
@@ -0,0 +1,84 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: OS.pm 1953 2008-12-12 14:23:17Z arkurth $
+##############################################################################
+
+=head1 NAME
+
+VCL::Module::OS.pm - VCL base operating system module
+
+=head1 SYNOPSIS
+
+ Needs to be written
+
+=head1 DESCRIPTION
+
+ This module provides VCL support operating systems.
+
+=cut
+
+##############################################################################
+package VCL::Module::OS;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/../..";
+
+# Configure inheritance
+use base qw(VCL::Module);
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use VCL::utils;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+1;
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+
+=cut
diff --git a/managementnode/lib/VCL/Module/OS/Linux.pm b/managementnode/lib/VCL/Module/OS/Linux.pm
new file mode 100644
index 0000000..20ec94c
--- /dev/null
+++ b/managementnode/lib/VCL/Module/OS/Linux.pm
@@ -0,0 +1,294 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: Linux.pm 1945 2008-12-11 20:58:08Z fapeeler $
+##############################################################################
+
+=head1 NAME
+
+VCL::Module::OS::Linux.pm - VCL module to support Linux operating systems
+
+=head1 SYNOPSIS
+
+ Needs to be written
+
+=head1 DESCRIPTION
+
+ This module provides VCL support for Linux operating systems.
+
+=cut
+
+##############################################################################
+package VCL::Module::OS::Linux;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/../../..";
+
+# Configure inheritance
+use base qw(VCL::Module::OS);
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use VCL::utils;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 capture_prepare
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub capture_prepare {
+ my $self = shift;
+ if (ref($self) !~ /linux/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+ return 0;
+ }
+
+ my $request_id = $self->data->get_request_id();
+ my $reservation_id = $self->data->get_reservation_id();
+ my $image_id = $self->data->get_image_id();
+ my $image_os_name = $self->data->get_image_os_name();
+ my $management_node_keys = $self->data->get_management_node_keys();
+ my $image_os_type = $self->data->get_image_os_type();
+ my $image_name = $self->data->get_image_name();
+ my $imagemeta_sysprep = $self->data->get_imagemeta_sysprep();
+ my $computer_id = $self->data->get_computer_id();
+ my $computer_short_name = $self->data->get_computer_short_name();
+ my $computer_node_name = $self->data->get_computer_node_name();
+ my $computer_type = $self->data->get_computer_type();
+ my $user_id = $self->data->get_user_id();
+ my $user_unityid = $self->data->get_user_login_id();
+ my $managementnode_shortname = $self->data->get_management_node_short_name();
+ my $computer_private_ip = $self->data->get_computer_private_ip();
+
+ notify($ERRORS{'OK'}, 0, "beginning Linux-specific image capture preparation tasks: $image_name on $computer_short_name");
+
+ my @sshcmd;
+
+ # Remove user and clean external ssh file
+ if ($self->delete_user()) {
+ notify($ERRORS{'OK'}, 0, "$user_unityid deleted from $computer_node_name");
+ }
+ if ($IPCONFIGURATION eq "static") {
+ #so we don't have conflicts we should set the public adapter back to dhcp
+ # reset ifcfg-eth1 back to dhcp
+ # when boot strap it will be set to dhcp
+ my @ifcfg;
+ my $tmpfile = "/tmp/createifcfg$computer_node_name";
+ push(@ifcfg, "DEVICE=eth1\n");
+ push(@ifcfg, "BOOTPROTO=dhcp\n");
+ push(@ifcfg, "STARTMODE=onboot\n");
+ push(@ifcfg, "ONBOOT=yes\n");
+ #write to tmpfile
+ if (open(TMP, ">$tmpfile")) {
+ print TMP @ifcfg;
+ close(TMP);
+ }
+ else {
+ #print "could not write $tmpfile $!\n";
+ notify($ERRORS{'OK'}, 0, "could not write $tmpfile $!");
+ }
+ #copy to node
+ if (run_scp_command($tmpfile, "$computer_node_name:/etc/sysconfig/network-scripts/ifcfg-$ETHDEVICE", $management_node_keys)) {
+ }
+ if (unlink($tmpfile)) {
+ }
+ } ## end if ($IPCONFIGURATION eq "static")
+
+ notify($ERRORS{'OK'}, 0, "returning 1");
+ return 1;
+} ## end sub capture_prepare
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 capture_start
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub capture_start {
+ my $self = shift;
+ if (ref($self) !~ /linux/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+ return 0;
+ }
+
+ my $management_node_keys = $self->data->get_management_node_keys();
+ my $image_name = $self->data->get_image_name();
+ my $computer_short_name = $self->data->get_computer_short_name();
+ my $computer_node_name = $self->data->get_computer_node_name();
+
+ notify($ERRORS{'OK'}, 0, "initiating Linux image capture: $image_name on $computer_short_name");
+
+ notify($ERRORS{'OK'}, 0, "initating reboot for Linux imaging sequence");
+ run_ssh_command($computer_node_name, $management_node_keys, "/sbin/shutdown -r now", "root");
+ notify($ERRORS{'OK'}, 0, "sleeping for 90 seconds while machine shuts down and reboots");
+ sleep 90;
+
+ notify($ERRORS{'OK'}, 0, "returning 1");
+ return 1;
+} ## end sub capture_start
+
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 delete_user
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub delete_user {
+ my $self = shift;
+ if (ref($self) !~ /linux/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+ return 0;
+ }
+
+ # Make sure the user login ID was passed
+ my $user_login_id = shift;
+ $user_login_id = $self->data->get_user_login_id() if (!$user_login_id);
+ if (!$user_login_id) {
+ notify($ERRORS{'WARNING'}, 0, "user could not be determined");
+ return 0;
+ }
+
+ # Make sure the user login ID was passed
+ my $computer_node_name = shift;
+ $computer_node_name = $self->data->get_computer_node_name() if (!$computer_node_name);
+ if (!$computer_node_name) {
+ notify($ERRORS{'WARNING'}, 0, "computer node name could not be determined");
+ return 0;
+ }
+
+ # Use userdel to delete the user
+ # Do not use userdel -r, it will affect HPC user storage for HPC installs
+ my $user_delete_command = "/usr/sbin/userdel $user_login_id";
+ my @user_delete_results = run_ssh_command($computer_node_name, $IDENTITY_bladerhel, $user_delete_command, "root");
+ foreach my $user_delete_line (@{$user_delete_results[1]}) {
+ if ($user_delete_line =~ /currently logged in/) {
+ notify($ERRORS{'WARNING'}, 0, "user not deleted, $user_login_id currently logged in");
+ return 0;
+ }
+ }
+
+ # User successfully deleted
+ # Remove user from sshd config
+ my $external_sshd_config_path = "$computer_node_name:/etc/ssh/external_sshd_config";
+ my $external_sshd_config_temp_path = "/tmp/$computer_node_name.sshd";
+
+ # Retrieve the node's external_sshd_config file
+ if (run_scp_command($external_sshd_config_path, $external_sshd_config_temp_path, $IDENTITY_bladerhel)) {
+ notify($ERRORS{'DEBUG'}, 0, "retrieved $external_sshd_config_path");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "sshd config not cleaned up, failed to retrieve $external_sshd_config_path");
+ return 0;
+ }
+
+ # Remove user from sshd config file
+ # Get the contents of the sshd config file
+ if (open(SSHD_CFG_TEMP, $external_sshd_config_temp_path)) {
+ my @external_sshd_config_lines = <SSHD_CFG_TEMP>;
+ close SSHD_CFG_TEMP;
+
+ # Loop through the lines, clear out AllowUsers lines
+ foreach my $external_sshd_config_line (@external_sshd_config_lines) {
+ $external_sshd_config_line = "" if ($external_sshd_config_line =~ /AllowUsers/);
+ }
+
+ # Rewrite the temp sshd config file with the modified contents
+ if (open(SSHD_CFG_TEMP, ">$external_sshd_config_temp_path")) {
+ print SSHD_CFG_TEMP @external_sshd_config_lines;
+ close SSHD_CFG_TEMP;
+ }
+
+ # Copy the modified file back to the node
+ if (run_scp_command($external_sshd_config_temp_path, $external_sshd_config_path, $IDENTITY_bladerhel)) {
+ notify($ERRORS{'DEBUG'}, 0, "modified file copied back to node: $external_sshd_config_path");
+
+ # Delete the temp file
+ unlink $external_sshd_config_temp_path;
+
+ # Restart external sshd
+ if (run_ssh_command($computer_node_name, $IDENTITY_bladerhel, "/etc/init.d/ext_sshd restart")) {
+ notify($ERRORS{'DEBUG'}, 0, "restarted ext_sshd on $computer_node_name");
+ }
+
+ return 1;
+ } ## end if (run_scp_command($external_sshd_config_temp_path...
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to copy modified file back to node: $external_sshd_config_path");
+
+ # Delete the temp file
+ unlink $external_sshd_config_temp_path;
+
+ return 0;
+ }
+ } ## end if (open(SSHD_CFG_TEMP, $external_sshd_config_temp_path...
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to open temporary sshd config file: $external_sshd_config_temp_path");
+ return 0;
+ }
+} ## end sub delete_user
+
+#/////////////////////////////////////////////////////////////////////////////
+
+1;
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+
+=cut
diff --git a/managementnode/lib/VCL/Module/OS/Windows.pm b/managementnode/lib/VCL/Module/OS/Windows.pm
new file mode 100644
index 0000000..f0ce5cd
--- /dev/null
+++ b/managementnode/lib/VCL/Module/OS/Windows.pm
@@ -0,0 +1,798 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: Windows.pm 1953 2008-12-12 14:23:17Z arkurth $
+##############################################################################
+
+=head1 NAME
+
+VCL::Module::OS::Windows.pm - VCL module to support Windows operating systems
+
+=head1 SYNOPSIS
+
+ Needs to be written
+
+=head1 DESCRIPTION
+
+ This module provides VCL support for Windows operating systems.
+
+=cut
+
+##############################################################################
+package VCL::Module::OS::Windows;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/../../..";
+
+# Configure inheritance
+use base qw(VCL::Module::OS);
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use VCL::utils;
+use VCL::Module::Utils::Logging;
+use VCL::Module::Utils::SCP;
+use VCL::Module::Utils::SSH;
+use File::Basename;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 run_command
+
+ Parameters : String containing the Windows command to be run
+ Returns : Array:
+ - first index contains the return code of the command
+ - indices > 0 contain the lines of output generated by running
+ the command
+ Description : Runs a command on a Windows node. The command is executed by
+ by passing it through SSH. The command passed to this subroutine
+ is formatted so that it runs as a Windows command would normally
+ run by using the Windows command shell instead of Cygwin's bash
+ shell.
+
+=cut
+
+sub run_command {
+ my $self = shift;
+ my ($command) = @_;
+
+ # Get the computer node name
+ my $computer_node_name = $self->data->get_computer_node_name();
+
+ # Passing Windows-style commands through SSH/Cygwin causes problems
+ # Encapsulate the command in a 'cmd.exe /q /v:on /k' command and call exit afterwards
+ # First replace % with !, the /v:on switch allows this so the variables aren't interpolated
+ # /q turns echo off
+ $command =~ s/\%/\!/g;
+
+ # This causes the command to be run in a normal Windows command shell rather than Cygwin's bash shell
+ $command = "cmd.exe /q /v:on /c '$command'";
+
+ # Replace line breaks with &&
+ $command =~ s/\n/ && /g;
+
+ # Run the SSH command
+ my @ssh_results = ssh($computer_node_name, $IDENTITY_wxp, $command);
+
+ return @ssh_results;
+} ## end sub run_command
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 run_remote_script
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub run_remote_script {
+ my $self = shift;
+ my ($script_path) = @_;
+
+ # Take the script path apart
+ my ($filename, $directory, $extension) = fileparse($script_path, qr/\.[^.]*$/);
+
+ # Remove the leading period from the extension
+ $extension =~ s/^\.//;
+
+ # Assemble the remote script path
+ my $remote_script_scp_path = "\$TEMP/$filename.$extension";
+ my $remote_script_ssh_path = "\%TEMP\%\\$filename.$extension";
+
+ # Copy the script to the node
+ if (!$self->copy_file($script_path, $remote_script_scp_path)) {
+ log_warning("failed to execute script, unable to copy $script_path to $remote_script_scp_path");
+ return 0;
+ }
+
+ # Assemble a script execution command based on the extension
+ my $command;
+ if ($extension =~ /ws|js|vbs|vbe|wsf|wsh/i) {
+ # Call cscript.exe for vbs and similar files
+ $command = "%SystemRoot%/System32/cscript.exe $remote_script_ssh_path //NoLogo";
+ }
+ elsif ($extension !~ /bat|cmd/i) {
+ # Attempt to run other types of files in the Windows command interpreter
+ log_warning("unsupported script extension: $filename.$extension, attempting to run file in Windows command interpreter");
+ $command = $remote_script_ssh_path;
+ }
+ else {
+ $command = $remote_script_ssh_path;
+ }
+
+ # Attempt to run the script
+ my ($command_exit_status, @command_output) = $self->run_command($command);
+ if ($command_exit_status) {
+ log_warning("failed to execute script: $script_path");
+ }
+
+ return ($command_exit_status, @command_output);
+} ## end sub run_remote_script
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 copy_file
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub copy_file {
+ my $self = shift;
+ my ($source_file_path, $destination_file_path) = @_;
+
+ # Get the computer node name
+ my $computer_node_name = $self->data->get_computer_node_name();
+
+ my %scp_options = (options => 'v',
+ identity_file => $IDENTITY_wxp,
+ source_path => $source_file_path,
+ destination_host => $computer_node_name,
+ destination_path => $destination_file_path,);
+
+ # Run the SCP command
+ if (!scp(\%scp_options)) {
+ log_warning("failed to copy file using SCP");
+ return 0;
+ }
+
+ log_info("file copied using SCP: $source_file_path --> $computer_node_name:$destination_file_path");
+ return 1;
+} ## end sub copy_file
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 capture_prepare
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub capture_prepare {
+ my $self = shift;
+ if (ref($self) !~ /windows/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+ return 0;
+ }
+
+ my $request_id = $self->data->get_request_id();
+ my $reservation_id = $self->data->get_reservation_id();
+ my $image_id = $self->data->get_image_id();
+ my $image_os_name = $self->data->get_image_os_name();
+ my $management_node_keys = $self->data->get_management_node_keys();
+ my $image_os_type = $self->data->get_image_os_type();
+ my $image_name = $self->data->get_image_name();
+ my $imagemeta_sysprep = $self->data->get_imagemeta_sysprep();
+ my $computer_id = $self->data->get_computer_id();
+ my $computer_short_name = $self->data->get_computer_short_name();
+ my $computer_node_name = $self->data->get_computer_node_name();
+ my $computer_type = $self->data->get_computer_type();
+ my $user_id = $self->data->get_user_id();
+ my $user_unityid = $self->data->get_user_login_id();
+ my $managementnode_shortname = $self->data->get_management_node_short_name();
+ my $computer_private_ip = $self->data->get_computer_private_ip();
+
+ notify($ERRORS{'OK'}, 0, "beginning Windows-specific image capture preparation tasks: $image_name on $computer_short_name");
+
+ my @sshcmd;
+
+ # Change password of root and sshd service back to default
+ # Needed only for sshd service on windows OS's
+ my $p = $WINDOWS_ROOT_PASSWORD;
+ if (changewindowspasswd($computer_short_name, "root", $p)) {
+ notify($ERRORS{'OK'}, 0, "changed Windows password on $computer_short_name, root, $p");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "failed to change windows password $computer_short_name,root,$p");
+ }
+
+
+ # Check for user account and clean out if listed
+ if (_is_user_added($computer_node_name, $user_unityid, $computer_type, $image_os_name)) {
+ # Make sure user is logged off
+ my @QA = run_ssh_command($computer_node_name, $IDENTITY_wxp, "cmd /c qwinsta.exe", "root");
+ foreach my $r (@{$QA[1]}) {
+ if ($r =~ /([>]?)([-a-zA-Z0-9]*)\s+([a-zA-Z0-9]*)\s+ ([0-9]*)\s+([a-zA-Z]*)/) {
+ my $state = $5;
+ my $session = $2;
+ my $user = $3;
+ if ($5 =~ /Active/) {
+ notify($ERRORS{'OK'}, 0, "detected $user on $session still logged on $computer_node_name $r, sleeping 7 before logging off");
+ sleep 7;
+ my @LF = run_ssh_command($computer_node_name, $IDENTITY_wxp, "cmd /c logoff.exe $session");
+ foreach my $l (@{$LF[1]}) {
+ notify($ERRORS{'OK'}, 0, "output from attempt to logoff $user on $session");
+ }
+
+ }
+ } ## end if ($r =~ /([>]?)([-a-zA-Z0-9]*)\s+([a-zA-Z0-9]*)\s+ ([0-9]*)\s+([a-zA-Z]*)/)
+ } ## end foreach my $r (@{$QA[1]})
+ #delete user
+ if (del_user($computer_node_name, $user_unityid, $computer_type, $image_os_name)) {
+ notify($ERRORS{'OK'}, 0, "$user_unityid account deleted from $computer_node_name");
+ }
+ } ## end if (_is_user_added($computer_node_name, $user_unityid...
+
+ # Determine if machine has static private IP address
+ # If so we need to change back to DHCP
+ if ($image_name =~ /^win2003/) {
+ notify($ERRORS{'OK'}, 0, "Windows Server 2003 image detected, private adapter will be changed from DHCP to static on $computer_short_name");
+
+ my %ip;
+ my $myadapter;
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($computer_node_name, $management_node_keys, "ipconfig -all", "root");
+ # build hash of needed info and set the correct private adapter.
+ foreach my $a (@{$sshcmd[1]}) {
+ if ($a =~ /Ethernet adapter (.*):/) {
+ #print "$1\n";
+ $myadapter = $1;
+ }
+ if ($a =~ /IP Address([\s.]*): $computer_private_ip/) {
+ $ip{$myadapter}{"private"} = 1;
+ notify($ERRORS{'OK'}, 0, "privateIP found $computer_private_ip");
+ }
+ if ($a =~ /DHCP Enabled([\s.]*): (No|Yes)/) {
+ $ip{$myadapter}{"DHCPenabled"} = $2;
+ notify($ERRORS{'OK'}, 0, "DHCP enabled $2");
+ }
+ } ## end foreach my $a (@{$sshcmd[1]})
+ my $privateadapter;
+ foreach my $key (keys %ip) {
+ if (defined($ip{$key}{private})) {
+ if ($ip{$key}{private}) {
+ $privateadapter = $key;
+ }
+ }
+ }
+
+ if ($ip{$privateadapter}{"DHCPenabled"} =~ /No/) {
+ notify($ERRORS{'OK'}, 0, "DHCP disabled for $privateadapter on $computer_node_name - reseting to dhcp");
+ if (open(NETSH, "/usr/bin/ssh -q -i $management_node_keys $computer_node_name \"netsh interface ip set address name=\\\"$privateadapter\\\" source=dhcp\" & 2>&1 |")) {
+ #losing connection
+ my $go = 1;
+ while ($go) {
+ #print "hi\n";
+ sleep 4;
+ if (open(PS, "ps -ef |")) {
+ my @ps = <PS>;
+ close(PS);
+ sleep 4;
+ foreach my $p (@ps) {
+ if ($p =~ /$computer_node_name netsh interface/) {
+ if ($p =~ /(root)\s+([0-9]*)/) {
+ if (open(KILLIT, "kill -9 $2 |")) {
+ close(KILLIT);
+ close(NETSH);
+ notify($ERRORS{'OK'}, 0, "killing ssh $computer_node_name netsh process");
+ }
+ }
+ }
+ } ## end foreach my $p (@ps)
+ } ## end if (open(PS, "ps -ef |"))
+ $go = 0;
+ } ## end while ($go)
+ } # Close open netsh SSH handle
+
+ #make sure it came back confirm is was reset to dhcp
+ sleep 5;
+ my $sshd_status = _sshd_status($computer_node_name, $image_name);
+ if ($sshd_status eq "on") {
+ notify($ERRORS{'OK'}, 0, "successful $computer_node_name is accessible after dhcp assignment");
+ my $myadapter;
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($computer_node_name, $management_node_keys, "ipconfig -all", "root");
+ # build hash of needed info and set the correct private adapter.
+ foreach my $a (@{$sshcmd[1]}) {
+ if ($a =~ /Ethernet adapter (.*):/) {
+ #print "$1\n";
+ $myadapter = $1;
+ }
+ if ($a =~ /IP Address([\s.]*): $computer_private_ip/) {
+ $ip{$myadapter}{"private"} = 1;
+ }
+ if ($a =~ /DHCP Enabled([\s.]*): (No|Yes)/) {
+ $ip{$myadapter}{"DHCPenabled"} = $2;
+ }
+ } ## end foreach my $a (@{$sshcmd[1]})
+ if ($ip{$privateadapter}{"DHCPenabled"} =~ /Yes/) {
+ notify($ERRORS{'OK'}, 0, "successful $computer_node_name is correctly assigned to use dhcp");
+ }
+ elsif ($ip{$privateadapter}{"DHCPenabled"} =~ /No/) {
+ notify($ERRORS{'CRITICAL'}, 0, "could not change $privateadapter on $computer_node_name back to dhcp");
+
+ return 0;
+ }
+ } ## end if ($sshd_status eq "on")
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "sshd_status set to off, can not reconnect to $computer_node_name");
+ return 0;
+ }
+ } # Close if DHCP == no
+
+ else {
+ notify($ERRORS{'OK'}, 0, "dhcp for $privateadapter is set to Yes on $computer_node_name $ip{$privateadapter}{DHCPenabled} - no change needed");
+ }
+ } ## end if ($image_name =~ /^win2003/)
+
+ if ($IPCONFIGURATION eq "static") {
+ #so we don't have conflicts we should set the public adapter back to dhcp
+ #this change is immediate
+ #figure out which adapter it public
+ my $myadapter;
+ my %ip;
+ my ($privateadapter, $publicadapter);
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($computer_node_name, $management_node_keys, "ipconfig -all", "root");
+ # build hash of needed info and set the correct private adapter.
+ my $id = 1;
+ foreach my $a (@{$sshcmd[1]}) {
+ if ($a =~ /Ethernet adapter (.*):/) {
+ $myadapter = $1;
+ $ip{$myadapter}{"id"} = $id;
+ $ip{$myadapter}{"private"} = 0;
+ }
+ if ($a =~ /IP Address([\s.]*): $computer_private_ip/) {
+ $ip{$myadapter}{"private"} = 1;
+ }
+ if ($a =~ /Physical Address([\s.]*): ([-0-9]*)/) {
+ $ip{$myadapter}{"MACaddress"} = $2;
+ }
+ $id++;
+ } ## end foreach my $a (@{$sshcmd[1]})
+
+ foreach my $key (keys %ip) {
+ if (defined($ip{$key}{private})) {
+ if (!($ip{$key}{private})) {
+ $publicadapter = "\"$key\"";
+ }
+ }
+ }
+
+ undef @sshcmd;
+ my $netshcmd = "netsh interface ip set address name=\\\"$publicadapter\\\" source=dhcp";
+ @sshcmd = run_ssh_command($computer_node_name, $management_node_keys, $netshcmd, "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /Ok/) {
+ notify($ERRORS{'OK'}, 0, "successfully set $publicadapter to dhcp");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "problem setting $publicadapter to dhcp on $computer_node_name @{ $sshcmd[1] }");
+ }
+ }
+ } ## end if ($IPCONFIGURATION eq "static")
+
+ # Defrag before removing pagefile
+ # we do this to speed up the process
+ # defraging without a page file takes a little longer
+ notify($ERRORS{'OK'}, 0, "starting defrag on $computer_node_name");
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($computer_node_name, $management_node_keys, "cmd.exe /c defrag C: -f", "root");
+ my $defragged = 0;
+ foreach my $d (@{$sshcmd[1]}) {
+ if ($d =~ /Defragmentation Report/) {
+ notify($ERRORS{'OK'}, 0, "successfully defragmented $computer_node_name");
+ $defragged = 1;
+ }
+ }
+ if (!$defragged) {
+ notify($ERRORS{'WARNING'}, 0, "problem occurred while defragmenting $computer_node_name: @{ $sshcmd[1] }");
+ }
+
+
+ # Copy new auto_create_image.vbs and auto_prepare_for_image.vbs
+ # This moves(sometimes) the pagefile and reboots the box
+ # It actually checks for a removes the pagefile.sys
+ my @scp;
+ if (run_scp_command("$TOOLS/auto_create_image.vbs", "$computer_node_name:auto_create_image.vbs", $management_node_keys)) {
+ notify($ERRORS{'OK'}, 0, "successfully copied auto_create_image.vbs to $computer_node_name");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "failed to copy auto_create_image.vbs to $computer_node_name ");
+ return 0;
+ }
+
+
+ # Make sure sshd service is set to auto
+ if (_set_sshd_startmode($computer_node_name, "auto")) {
+ notify($ERRORS{'OK'}, 0, "successfully set auto mode for sshd start");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "failed to set auto mode for sshd on $computer_node_name");
+ return 0;
+ }
+
+ my @list;
+ my $l;
+ #execute the vbs script to disable the pagefile and reboot
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($computer_node_name, $management_node_keys, "cscript.exe //Nologo auto_create_image.vbs", "root");
+ foreach $l (@{$sshcmd[1]}) {
+ if ($l =~ /createimage reboot/) {
+ notify($ERRORS{'OK'}, 0, "auto_create_image.vbs initiated, $computer_node_name rebooting, sleeping 50");
+ sleep 50;
+ next;
+ }
+ elsif ($l =~ /failed error/) {
+ notify($ERRORS{'WARNING'}, 0, "auto_create_image.vbs failed, @{ $sshcmd[1] }");
+ #legacy code for a bug in xcat, now fixed
+ # force a reboot, or really a power cycle.
+ #crap hate to do this.
+ notify($ERRORS{'WARNING'}, 0, "forcing a power cycle");
+ if (_rpower($computer_node_name, "boot")) {
+ notify($ERRORS{'WARNING'}, 0, "forced power cycle complete");
+ next;
+ }
+ } ## end elsif ($l =~ /failed error/) [ if ($l =~ /createimage reboot/)
+ } ## end foreach $l (@{$sshcmd[1]})
+
+
+ #Set up simple ping loop to determine if machine is actually rebooting
+ my $online = 1;
+ my $pingloop = 0;
+ notify($ERRORS{'OK'}, 0, "checking for pingable $computer_node_name");
+ while ($online) {
+ if (!(_pingnode($computer_node_name))) {
+ notify($ERRORS{'OK'}, 0, "Success $computer_node_name is not pingable");
+ $online = 0;
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "$computer_node_name is still pingable - loop $pingloop");
+ sleep 10;
+ $pingloop++;
+ }
+ if ($pingloop > 10) {
+ notify($ERRORS{'CRITICAL'}, 0, "$computer_node_name should have rebooted by now, trying to force it");
+ if (_rpower($computer_node_name, "boot")) {
+ notify($ERRORS{'WARNING'}, 0, "forced power cycle complete");
+ sleep 25;
+ next;
+ }
+ }
+ } ## end while ($online)
+
+
+ # Wait until the reboot process has started to shutdown services
+ notify($ERRORS{'OK'}, 0, "$computer_node_name rebooting, waiting");
+ my $socketflag = 0;
+
+
+ REBOOTED:
+ my $rebooted = 1;
+ my $reboot_wait_count = 0;
+ while ($rebooted) {
+ if ($reboot_wait_count > 55) {
+ notify($ERRORS{'CRITICAL'}, 0, "waited $reboot_wait_count on reboot after auto_create_image on $computer_node_name");
+ return 0;
+ }
+ notify($ERRORS{'OK'}, 0, "$computer_node_name not completed reboot sleeping for 25");
+ sleep 25;
+ if (_pingnode($computer_node_name)) {
+ #it pingable check if sshd is open
+ notify($ERRORS{'OK'}, 0, "$computer_node_name is pingable, checking sshd port");
+ my $sshd = _sshd_status($computer_node_name, $image_name);
+ if ($sshd =~ /on/) {
+ $rebooted = 0;
+ notify($ERRORS{'OK'}, 0, "$computer_node_name sshd is open");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "$computer_node_name sshd NOT open yet,sleep 5");
+ sleep 5;
+ }
+ } ## end if (_pingnode($computer_node_name))
+ $reboot_wait_count++;
+ } # Close while rebooted
+
+
+ # Check for recent bug
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($computer_node_name, $IDENTITY_wxp, "uname -s");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /^Warning:/) {
+ #if (makesshgkh($computer_node_name)) {
+ #}
+ }
+ if ($l =~ /^Read from socket failed:/) {
+ if ($socketflag) {
+ notify($ERRORS{'CRITICAL'}, 0, "could not login $computer_node_name via ssh socket failure");
+ return 0;
+ }
+ notify($ERRORS{'CRITICAL'}, 0, "discovered ssh read from socket failure on $computer_node_name, attempting to repair");
+ #power cycle node
+ if (_rpower($computer_node_name, "cycle")) {
+ notify($ERRORS{'CRITICAL'}, 0, "$computer_node_name power cycled going to reboot check routine");
+ sleep 40;
+ $socketflag = 1;
+ goto REBOOTED;
+ }
+ } ## end if ($l =~ /^Read from socket failed:/)
+ } ## end foreach my $l (@{$sshcmd[1]})
+
+ notify($ERRORS{'OK'}, 0, "proceeding to CIMONITOR");
+ #monitor for signal to set node to image and then reboot
+ my $sshd_status;
+ my ($loop, $rebootsignal, $reboot_copied) = 0;
+ CIMONITOR:
+ #check ssh port in case we finish above steps before first reboot completes
+ # while ssh port is off sleep few seconds then loop
+ # this section is useless for linux images
+ my $ping_result = _pingnode($computer_node_name);
+ #check our loop
+ if ($loop > 200) {
+ notify($ERRORS{'CRITICAL'}, 0, "CIMONITOR $computer_node_name taking longer to reboot than expected, check it");
+ return 0;
+ }
+ notify($ERRORS{'OK'}, 0, "CIMONITOR ping check");
+ if (!$ping_result) {
+ sleep 5;
+ notify($ERRORS{'OK'}, 0, "CIMONITOR ping is off waiting for $computer_node_name to complete reboot");
+ $loop++;
+ goto CIMONITOR;
+ }
+ # is port 22 open yet
+ if (!nmap_port($computer_node_name, 22)) {
+ notify($ERRORS{'OK'}, 0, "port 22 not open on $computer_node_name yet, looping");
+ $loop++;
+ sleep 3;
+ goto CIMONITOR;
+ }
+
+ # Remove old Sysprep files if they exist
+ if (run_ssh_command($computer_node_name, $IDENTITY_wxp, "/usr/bin/rm.exe -rf C:\/Sysprep", "root")) {
+ notify($ERRORS{'OK'}, 0, "removed any existing Sysprep files");
+ }
+
+ # Copy Sysprep files
+ COPY_SYSPREP:
+ if ($imagemeta_sysprep) {
+ #cp sysprep to C:
+ #chmod C:\Sysprep\*
+ # which sysprep to use
+ my $sysprep_files;
+ if ($image_name =~ /^winxp/) {
+ $sysprep_files = $SYSPREP;
+ }
+ elsif ($image_name =~ /^win2003/) {
+ $sysprep_files = $SYSPREP_2003;
+ }
+
+ notify($ERRORS{'OK'}, 0, "copying Sysprep files to $computer_short_name");
+ if (run_scp_command($sysprep_files, "$computer_node_name:C:\/Sysprep", $IDENTITY_wxp)) {
+ notify($ERRORS{'OK'}, 0, "copied Sysprep directory $sysprep_files to $computer_node_name C:");
+
+ if (run_ssh_command($computer_node_name, $IDENTITY_wxp, "/usr/bin/chmod.exe -R 755 C:\/Sysprep", "root")) {
+ notify($ERRORS{'OK'}, 0, "chmoded -R 755 C:\/Sysprep files ");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not chmod -R 755 on $computer_node_name $!");
+ }
+ } ## end if (run_scp_command($sysprep_files, "$computer_node_name:C:\/Sysprep"...
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not copy $sysprep_files to $computer_node_name, $!");
+ return 0;
+ }
+ } ## end if ($imagemeta_sysprep)
+
+ # Set sshd service startup to manual
+ if (_set_sshd_startmode($computer_node_name, "manual")) {
+ notify($ERRORS{'OK'}, 0, "successfully set manual mode for sshd start");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "failed to set manual mode for sshd on $computer_node_name");
+ return 0;
+ }
+
+
+ #actually remove the pagefile.sys sometimes movefile.exe does not work
+ if (run_ssh_command($computer_node_name, $IDENTITY_wxp, "/usr/bin/rm -v C:\/pagefile.sys", "root")) {
+ notify($ERRORS{'OK'}, 0, "removed pagefile.sys ");
+ }
+
+ notify($ERRORS{'OK'}, 0, "returning 1");
+ return 1;
+} ## end sub capture_prepare
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 capture_start
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub capture_start {
+
+ my $self = shift;
+ if (ref($self) !~ /windows/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+ return 0;
+ }
+
+ my $request_id = $self->data->get_request_id();
+ my $reservation_id = $self->data->get_reservation_id();
+ my $image_id = $self->data->get_image_id();
+ my $image_os_name = $self->data->get_image_os_name();
+ my $management_node_keys = $self->data->get_management_node_keys();
+ my $image_os_type = $self->data->get_image_os_type();
+ my $image_name = $self->data->get_image_name();
+ my $imagemeta_sysprep = $self->data->get_imagemeta_sysprep();
+ my $computer_id = $self->data->get_computer_id();
+ my $computer_short_name = $self->data->get_computer_short_name();
+ my $computer_node_name = $self->data->get_computer_node_name();
+ my $computer_type = $self->data->get_computer_type();
+ my $user_id = $self->data->get_user_id();
+ my $user_unityid = $self->data->get_user_login_id();
+ my $managementnode_shortname = $self->data->get_management_node_short_name();
+ my $computer_private_ip = $self->data->get_computer_private_ip();
+
+ notify($ERRORS{'OK'}, 0, "initiating Windows image capture: $image_name on $computer_short_name");
+
+ my @sshcmd;
+
+ if ($imagemeta_sysprep) {
+ notify($ERRORS{'OK'}, 0, "starting sysprep on $computer_node_name");
+ if (open(SSH, "/usr/bin/ssh -q -i $IDENTITY_wxp $computer_node_name \"C:\/Sysprep\/sysprep.cmd\" 2>&1 |")) {
+ my $notstop = 1;
+ my $loop = 0;
+ while ($notstop) {
+ my $l = <SSH>;
+ $loop++;
+ #notify($ERRORS{'DEBUG'}, 0, "sysprep.cmd loop count: $loop");
+ #notify($ERRORS{'DEBUG'}, 0, "$l");
+ if ($l =~ /sysprep/) {
+ notify($ERRORS{'OK'}, 0, "sysprep.exe has started, $l");
+
+ notify($ERRORS{'DEBUG'}, 0, "attempting to kill management node sysprep.cmd SSH process in 60 seconds");
+ sleep 60;
+
+ notify($ERRORS{'DEBUG'}, 0, "attempting to kill management node sysprep.cmd SSH process");
+ if (_killsysprep($computer_node_name)) {
+ notify($ERRORS{'OK'}, 0, "killed sshd process for sysprep command");
+ }
+
+ notify($ERRORS{'DEBUG'}, 0, "closing SSH filehandle");
+ close(SSH);
+ notify($ERRORS{'DEBUG'}, 0, "SSH filehandle closed");
+
+ $notstop = 0;
+ } ## end if ($l =~ /sysprep/)
+ elsif ($l =~ /sysprep.cmd: Permission denied/) {
+ notify($ERRORS{'CRITICAL'}, 0, "chmod 755 failed to correctly set execute on sysprep.cmd output $l");
+ close(SSH);
+ return 0;
+ }
+
+ #avoid infinite loop
+ if ($loop > 1000) {
+ notify($ERRORS{'DEBUG'}, 0, "sysprep executed in loop control condition, exceeded limit");
+
+ notify($ERRORS{'DEBUG'}, 0, "attempting to kill management node sysprep.cmd SSH process in 60 seconds");
+ sleep 60;
+
+ notify($ERRORS{'DEBUG'}, 0, "attempting to kill management node sysprep.cmd SSH process");
+ if (_killsysprep($computer_node_name)) {
+ notify($ERRORS{'OK'}, 0, "killed sshd process for sysprep command");
+ }
+
+ notify($ERRORS{'DEBUG'}, 0, "closing SSH filehandle");
+ close(SSH);
+ notify($ERRORS{'DEBUG'}, 0, "SSH filehandle closed");
+
+ $notstop = 0;
+ } ## end if ($loop > 1000)
+
+ } ## end while ($notstop)
+ } # Close open handle for SSH sysprep.cmd command
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "failed to start sysprep on $computer_node_name $!");
+ return 0;
+ } # Close sysprep.cmd could not be launched
+ } # Close if Sysprep
+
+ else {
+ #non sysprep option
+ #
+ #just reboot machine -- future expansion of additional methods newsid, custom scripts, etc.
+ notify($ERRORS{'OK'}, 0, "starting custom script VCLprep1.vbs on $computer_node_name");
+ if (run_scp_command("$TOOLS/VCLprep1.vbs", "$computer_node_name:VCLprep1.vbs", $IDENTITY_wxp)) {
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($computer_node_name, $IDENTITY_wxp, "cscript //Nologo VCLprep1.vbs", "root");
+ foreach my $s (@{$sshcmd[1]}) {
+ chomp($s);
+ if ($s =~ /copied VCLprepare/) {
+ notify($ERRORS{'OK'}, 0, "$s");
+ }
+ if ($s =~ /rebooting/) {
+ notify($ERRORS{'OK'}, 0, "SUCCESS started image procedure on $computer_node_name");
+ last;
+ }
+ } ## end foreach my $s (@{$sshcmd[1]})
+ } # Close SCP VCLPrep1.vbs
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "failed to copy $TOOLS/VCLprep1.vbs to $computer_node_name ");
+ return 0;
+ }
+ } # Close if not Sysprep
+
+ notify($ERRORS{'OK'}, 0, "returning 1");
+ return 1;
+} ## end sub capture_start
+
+#/////////////////////////////////////////////////////////////////////////////
+
+1;
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+
+=cut
diff --git a/managementnode/lib/VCL/Module/OS/Windows/Desktop.pm b/managementnode/lib/VCL/Module/OS/Windows/Desktop.pm
new file mode 100644
index 0000000..7d0d741
--- /dev/null
+++ b/managementnode/lib/VCL/Module/OS/Windows/Desktop.pm
@@ -0,0 +1,84 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: Desktop.pm 1953 2008-12-12 14:23:17Z arkurth $
+##############################################################################
+
+=head1 NAME
+
+VCL::Module::OS::Windows::Desktop
+
+=head1 SYNOPSIS
+
+ Needs to be written
+
+=head1 DESCRIPTION
+
+ This module provides...
+
+=cut
+
+##############################################################################
+package VCL::Module::OS::Windows::Desktop;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/../../../..";
+
+# Configure inheritance
+use base qw(VCL::Module::OS::Windows);
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use VCL::utils;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+1;
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+
+=cut
diff --git a/managementnode/lib/VCL/Module/OS/Windows/Desktop/Vista.pm b/managementnode/lib/VCL/Module/OS/Windows/Desktop/Vista.pm
new file mode 100644
index 0000000..a4c03c0
--- /dev/null
+++ b/managementnode/lib/VCL/Module/OS/Windows/Desktop/Vista.pm
@@ -0,0 +1,1508 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: Vista.pm 1953 2008-12-12 14:23:17Z arkurth $
+##############################################################################
+
+=head1 NAME
+
+VCL::Module::OS::Windows::Desktop::Vista.pm - VCL module to support Windows Vista operating system
+
+=head1 SYNOPSIS
+
+ Needs to be written
+
+=head1 DESCRIPTION
+
+ This module provides VCL support for Windows Vista.
+
+=cut
+
+##############################################################################
+package VCL::Module::OS::Windows::Desktop::Vista;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/../../../../..";
+
+# Configure inheritance
+use base qw(VCL::Module::OS::Windows::Desktop);
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use VCL::utils;
+use VCL::Module::Provisioning::xCAT;
+use File::Basename;
+
+##############################################################################
+
+=head1 CLASS VARIABLES
+
+=cut
+
+=head2 $CONFIGURATION_FILES
+
+ Data type : Scalar
+ Description : Location of script/utilty/configuration files needed to
+ configure the OS. This is normally the directory under
+ the 'tools' directory specific to this OS.
+
+=cut
+
+our $CONFIGURATION_DIRECTORY = "$TOOLS/Sysprep_Vista";
+
+=head2 $ROOT_PASSWORD
+
+ Data type : Scalar
+ Description : Password for the node's root account.
+
+=cut
+
+our $ROOT_PASSWORD = $WINDOWS_ROOT_PASSWORD;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 capture_prepare
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub capture_prepare {
+ my $self = shift;
+ if (ref($self) !~ /windows/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+ return 0;
+ }
+
+ my $request_id = $self->data->get_request_id();
+ my $reservation_id = $self->data->get_reservation_id();
+ my $image_id = $self->data->get_image_id();
+ my $image_os_name = $self->data->get_image_os_name();
+ my $management_node_keys = $self->data->get_management_node_keys();
+ my $image_os_type = $self->data->get_image_os_type();
+ my $image_name = $self->data->get_image_name();
+ my $imagemeta_sysprep = $self->data->get_imagemeta_sysprep();
+ my $computer_id = $self->data->get_computer_id();
+ my $computer_short_name = $self->data->get_computer_short_name();
+ my $computer_node_name = $self->data->get_computer_node_name();
+ my $computer_type = $self->data->get_computer_type();
+ my $user_id = $self->data->get_user_id();
+ my $user_unityid = $self->data->get_user_login_id();
+ my $managementnode_shortname = $self->data->get_management_node_short_name();
+ my $computer_private_ip = $self->data->get_computer_private_ip();
+
+ notify($ERRORS{'OK'}, 0, "beginning Windows Vista image capture preparation tasks: $image_name on $computer_short_name");
+
+ $self->disable_autoadminlogon();
+ #$self->import_registry_file("$CONFIGURATION_DIRECTORY/Scripts/test.reg");
+ #$self->disable_pagefile();
+ #$self->firewall_disable_rdp();
+ #$self->firewall_enable_rdp('152.1.0.0/16');
+ exit;
+
+ # Node variables
+ my $local_configuration_directory = 'C:/VCL';
+ my $local_scripts_directory = 'C:/VCL/Scripts';
+
+
+ # Remove old configuration files if they exist
+ notify($ERRORS{'OK'}, 0, "attempting to remove old configuration directory if it exists: $local_configuration_directory");
+ my ($remove_old_status, $remove_old_output) = run_ssh_command($computer_node_name, $management_node_keys, "/usr/bin/rm.exe -rf $local_configuration_directory");
+ if (defined($remove_old_status) && $remove_old_status == 0) {
+ notify($ERRORS{'OK'}, 0, "removed existing configuration directory: $local_configuration_directory");
+ }
+ elsif (defined($remove_old_status)) {
+ notify($ERRORS{'OK'}, 0, "unable to remove existing configuration directory: $local_configuration_directory, exit status: $remove_old_status, output:\n@{$remove_old_output}");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to run ssh command to remove existing configuration directory: $local_configuration_directory");
+ return 0;
+ }
+
+
+ # Copy configuration files
+ notify($ERRORS{'OK'}, 0, "copying Sysprep and other configuration files to $computer_short_name");
+ if (run_scp_command($CONFIGURATION_DIRECTORY, "$computer_node_name:$local_configuration_directory", $IDENTITY_wxp)) {
+ notify($ERRORS{'OK'}, 0, "copied $CONFIGURATION_DIRECTORY directory to $computer_node_name:$local_configuration_directory");
+
+ notify($ERRORS{'OK'}, 0, "attempting to set permissions on $computer_node_name:$local_configuration_directory");
+ if (run_ssh_command($computer_node_name, $IDENTITY_wxp, "/usr/bin/chmod.exe -R 755 $local_configuration_directory")) {
+ notify($ERRORS{'OK'}, 0, "chmoded -R 755 $computer_node_name:$local_configuration_directory");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "could not chmod -R 755 $computer_node_name:$local_configuration_directory");
+ }
+ } ## end if (run_scp_command($CONFIGURATION_DIRECTORY, "$computer_node_name:C:\/Sysprep"...
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to copy $CONFIGURATION_DIRECTORY to $computer_node_name");
+ return 0;
+ }
+
+
+ # Set root account password
+ notify($ERRORS{'OK'}, 0, "changing root password on $computer_short_name");
+ my ($root_password_exit_status, $root_password_output) = run_ssh_command($computer_node_name, $management_node_keys, "net user root '$ROOT_PASSWORD'");
+ if ($root_password_exit_status == 0) {
+ notify($ERRORS{'OK'}, 0, "root password changed to $ROOT_PASSWORD");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to change root password to $ROOT_PASSWORD, exit status: $root_password_exit_status, output:\n@{$root_password_output}");
+ return 0;
+ }
+
+ # Log off all currently logged in users
+ notify($ERRORS{'OK'}, 0, "logging off all currently logged in users");
+ logoff_users($computer_node_name);
+
+ # Wait to allow any files in use by users justed logged out to close
+ notify($ERRORS{'OK'}, 0, "waiting for 5 seconds after any users were logged off to allow files to close");
+ sleep 5;
+
+ # Delete the user assigned to this reservation
+ notify($ERRORS{'OK'}, 0, "attempting to delete user $user_unityid from $computer_node_name");
+ delete_user($computer_node_name, $user_id);
+
+
+ my @sshcmd;
+ if ($IPCONFIGURATION eq "static") {
+ #so we don't have conflicts we should set the public adapter back to dhcp
+ #this change is immediate
+ #figure out which adapter it public
+ my $myadapter;
+ my %ip;
+ my ($privateadapter, $publicadapter);
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($computer_node_name, $management_node_keys, "ipconfig -all", "root");
+ # build hash of needed info and set the correct private adapter.
+ my $id = 1;
+ foreach my $a (@{$sshcmd[1]}) {
+ if ($a =~ /Ethernet adapter (.*):/) {
+ $myadapter = $1;
+ $ip{$myadapter}{"id"} = $id;
+ $ip{$myadapter}{"private"} = 0;
+ }
+ if ($a =~ /IP Address([\s.]*): $computer_private_ip/) {
+ $ip{$myadapter}{"private"} = 1;
+ }
+ if ($a =~ /Physical Address([\s.]*): ([-0-9]*)/) {
+ $ip{$myadapter}{"MACaddress"} = $2;
+ }
+ $id++;
+ } ## end foreach my $a (@{$sshcmd[1]})
+
+ foreach my $key (keys %ip) {
+ if (defined($ip{$key}{private})) {
+ if (!($ip{$key}{private})) {
+ $publicadapter = "\"$key\"";
+ }
+ }
+ }
+
+ undef @sshcmd;
+ my $netshcmd = "netsh interface ip set address name=\\\"$publicadapter\\\" source=dhcp";
+ @sshcmd = run_ssh_command($computer_node_name, $management_node_keys, $netshcmd, "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /Ok/) {
+ notify($ERRORS{'OK'}, 0, "successfully set $publicadapter to dhcp");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "problem setting $publicadapter to dhcp on $computer_node_name @{ $sshcmd[1] }");
+ }
+ }
+ } ## end if ($IPCONFIGURATION eq "static")
+
+ # Defrag before removing pagefile
+ # we do this to speed up the process
+ # defraging without a page file takes a little longer
+ #DEFRAG: notify($ERRORS{'OK'}, 0, "starting defrag on $computer_node_name");
+ #my ($defrag_exit_status, $defrag_output) = run_ssh_command($computer_node_name, $management_node_keys, "defrag.exe C: -v");
+ #if (defined($defrag_exit_status)) {
+ # notify($ERRORS{'OK'}, 0, "defrag exit status: $defrag_exit_status, defrag output:\n$defrag_output");
+ #}
+ #else {
+ # notify($ERRORS{'WARNING'}, 0, "defrag failed");
+ #}
+
+
+
+ my @list;
+ my $l;
+ #execute the vbs script to disable the pagefile and reboot
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($computer_node_name, $management_node_keys, "cscript.exe //Nologo $local_scripts_directory/auto_create_image.vbs");
+ foreach $l (@{$sshcmd[1]}) {
+ if ($l =~ /createimage reboot/) {
+ notify($ERRORS{'OK'}, 0, "auto_create_image.vbs initiated, $computer_node_name rebooting, sleeping 50");
+ sleep 50;
+ next;
+ }
+ elsif ($l =~ /failed error/) {
+ notify($ERRORS{'WARNING'}, 0, "auto_create_image.vbs failed, @{ $sshcmd[1] }");
+ #legacy code for a bug in xcat, now fixed
+ # force a reboot, or really a power cycle.
+ #crap hate to do this.
+ notify($ERRORS{'WARNING'}, 0, "forcing a power cycle");
+ if (VCL::Module::Provisioning::xCAT::_rpower($computer_node_name, "cycle")) {
+ notify($ERRORS{'WARNING'}, 0, "forced power cycle complete");
+ next;
+ }
+ } ## end elsif ($l =~ /failed error/) [ if ($l =~ /createimage reboot/)
+ } ## end foreach $l (@{$sshcmd[1]})
+
+
+ #Set up simple ping loop to determine if machine is actually rebooting
+ my $online = 1;
+ my $pingloop = 0;
+ notify($ERRORS{'OK'}, 0, "checking for pingable $computer_node_name");
+ while ($online) {
+ if (!(_pingnode($computer_node_name))) {
+ notify($ERRORS{'OK'}, 0, "Success $computer_node_name is not pingable");
+ $online = 0;
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "$computer_node_name is still pingable - loop $pingloop");
+ sleep 10;
+ $pingloop++;
+ }
+ if ($pingloop > 10) {
+ notify($ERRORS{'CRITICAL'}, 0, "$computer_node_name should have rebooted by now, trying to force it");
+ if (VCL::Module::Provisioning::xCAT::_rpower($computer_node_name, "boot")) {
+ notify($ERRORS{'WARNING'}, 0, "forced power cycle complete");
+ sleep 25;
+ next;
+ }
+ }
+ } ## end while ($online)
+
+
+ # Wait until the reboot process has started to shutdown services
+ notify($ERRORS{'OK'}, 0, "$computer_node_name rebooting, waiting");
+ my $socketflag = 0;
+
+
+ REBOOTED:
+ my $rebooted = 1;
+ my $reboot_wait_count = 0;
+ while ($rebooted) {
+ if ($reboot_wait_count > 55) {
+ notify($ERRORS{'CRITICAL'}, 0, "waited $reboot_wait_count on reboot after auto_create_image on $computer_node_name");
+ return 0;
+ }
+ notify($ERRORS{'OK'}, 0, "$computer_node_name not completed reboot sleeping for 25");
+ sleep 25;
+ if (_pingnode($computer_node_name)) {
+ #it pingable check if sshd is open
+ notify($ERRORS{'OK'}, 0, "$computer_node_name is pingable, checking sshd port");
+ my $sshd = _sshd_status($computer_node_name, $image_name);
+ if ($sshd =~ /on/) {
+ $rebooted = 0;
+ notify($ERRORS{'OK'}, 0, "$computer_node_name sshd is open");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "$computer_node_name sshd NOT open yet,sleep 5");
+ sleep 5;
+ }
+ } ## end if (_pingnode($computer_node_name))
+ $reboot_wait_count++;
+ } # Close while rebooted
+
+
+ # Check for recent bug
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($computer_node_name, $IDENTITY_wxp, "uname -s");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /^Warning:/) {
+ #if (makesshgkh($computer_node_name)) {
+ #}
+ }
+ if ($l =~ /^Read from socket failed:/) {
+ if ($socketflag) {
+ notify($ERRORS{'CRITICAL'}, 0, "could not login $computer_node_name via ssh socket failure");
+ return 0;
+ }
+ notify($ERRORS{'CRITICAL'}, 0, "discovered ssh read from socket failure on $computer_node_name, attempting to repair");
+ #power cycle node
+ if (VCL::Module::Provisioning::xCAT::_rpower($computer_node_name, "cycle")) {
+ notify($ERRORS{'CRITICAL'}, 0, "$computer_node_name power cycled going to reboot check routine");
+ sleep 40;
+ $socketflag = 1;
+ goto REBOOTED;
+ }
+ } ## end if ($l =~ /^Read from socket failed:/)
+ } ## end foreach my $l (@{$sshcmd[1]})
+
+ notify($ERRORS{'OK'}, 0, "proceeding to CIMONITOR");
+ #monitor for signal to set node to image and then reboot
+ my $sshd_status;
+ my ($loop, $rebootsignal, $reboot_copied) = 0;
+ CIMONITOR:
+ #check ssh port in case we finish above steps before first reboot completes
+ # while ssh port is off sleep few seconds then loop
+ # this section is useless for linux images
+ my $ping_result = _pingnode($computer_node_name);
+ #check our loop
+ if ($loop > 200) {
+ notify($ERRORS{'CRITICAL'}, 0, "CIMONITOR $computer_node_name taking longer to reboot than expected, check it");
+ return 0;
+ }
+ notify($ERRORS{'OK'}, 0, "CIMONITOR ping check");
+ if (!$ping_result) {
+ sleep 5;
+ notify($ERRORS{'OK'}, 0, "CIMONITOR ping is off waiting for $computer_node_name to complete reboot");
+ $loop++;
+ goto CIMONITOR;
+ }
+ # is port 22 open yet
+ if (!nmap_port($computer_node_name, 22)) {
+ notify($ERRORS{'OK'}, 0, "port 22 not open on $computer_node_name yet, looping");
+ $loop++;
+ sleep 3;
+ goto CIMONITOR;
+ }
+
+ ## Set sshd service startup to manual
+ #if (_set_sshd_startmode($computer_node_name, "manual")) {
+ # notify($ERRORS{'OK'}, 0, "successfully set manual mode for sshd start");
+ #}
+ #else {
+ # notify($ERRORS{'CRITICAL'}, 0, "failed to set manual mode for sshd on $computer_node_name");
+ # return 0;
+ #}
+
+
+ #actually remove the pagefile.sys sometimes movefile.exe does not work
+ if (run_ssh_command($computer_node_name, $IDENTITY_wxp, "/usr/bin/rm -fv C:\/pagefile.sys")) {
+ notify($ERRORS{'OK'}, 0, "removed pagefile.sys ");
+ }
+
+ notify($ERRORS{'OK'}, 0, "returning 1");
+ return 1;
+} ## end sub capture_prepare
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 capture_start
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub capture_start {
+ my $self = shift;
+ if (ref($self) !~ /windows/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+ return 0;
+ }
+
+ my $request_id = $self->data->get_request_id();
+ my $reservation_id = $self->data->get_reservation_id();
+ my $image_id = $self->data->get_image_id();
+ my $image_os_name = $self->data->get_image_os_name();
+ my $management_node_keys = $self->data->get_management_node_keys();
+ my $image_os_type = $self->data->get_image_os_type();
+ my $image_name = $self->data->get_image_name();
+ my $imagemeta_sysprep = $self->data->get_imagemeta_sysprep();
+ my $computer_id = $self->data->get_computer_id();
+ my $computer_short_name = $self->data->get_computer_short_name();
+ my $computer_node_name = $self->data->get_computer_node_name();
+ my $computer_type = $self->data->get_computer_type();
+ my $user_id = $self->data->get_user_id();
+ my $user_unityid = $self->data->get_user_login_id();
+ my $managementnode_shortname = $self->data->get_management_node_short_name();
+ my $computer_private_ip = $self->data->get_computer_private_ip();
+
+ notify($ERRORS{'OK'}, 0, "initiating Windows image capture: $image_name on $computer_short_name");
+
+ my @sshcmd;
+
+ if ($imagemeta_sysprep) {
+ notify($ERRORS{'OK'}, 0, "starting sysprep on $computer_node_name");
+ if (open(SSH, "/usr/bin/ssh -q -i $IDENTITY_wxp $computer_node_name \"C:\/Sysprep\/sysprep.cmd\" 2>&1 |")) {
+ my $notstop = 1;
+ my $loop = 0;
+ while ($notstop) {
+ my $l = <SSH>;
+ $loop++;
+ #notify($ERRORS{'DEBUG'}, 0, "sysprep.cmd loop count: $loop");
+ #notify($ERRORS{'DEBUG'}, 0, "$l");
+ if ($l =~ /sysprep/) {
+ notify($ERRORS{'OK'}, 0, "sysprep.exe has started, $l");
+
+ notify($ERRORS{'DEBUG'}, 0, "attempting to kill management node sysprep.cmd SSH process in 60 seconds");
+ sleep 60;
+
+ notify($ERRORS{'DEBUG'}, 0, "attempting to kill management node sysprep.cmd SSH process");
+ if (_killsysprep($computer_node_name)) {
+ notify($ERRORS{'OK'}, 0, "killed sshd process for sysprep command");
+ }
+
+ notify($ERRORS{'DEBUG'}, 0, "closing SSH filehandle");
+ close(SSH);
+ notify($ERRORS{'DEBUG'}, 0, "SSH filehandle closed");
+
+ $notstop = 0;
+ } ## end if ($l =~ /sysprep/)
+ elsif ($l =~ /sysprep.cmd: Permission denied/) {
+ notify($ERRORS{'CRITICAL'}, 0, "chmod 755 failed to correctly set execute on sysprep.cmd output $l");
+ close(SSH);
+ return 0;
+ }
+
+ #avoid infinite loop
+ if ($loop > 1000) {
+ notify($ERRORS{'DEBUG'}, 0, "sysprep executed in loop control condition, exceeded limit");
+
+ notify($ERRORS{'DEBUG'}, 0, "attempting to kill management node sysprep.cmd SSH process in 60 seconds");
+ sleep 60;
+
+ notify($ERRORS{'DEBUG'}, 0, "attempting to kill management node sysprep.cmd SSH process");
+ if (_killsysprep($computer_node_name)) {
+ notify($ERRORS{'OK'}, 0, "killed sshd process for sysprep command");
+ }
+
+ notify($ERRORS{'DEBUG'}, 0, "closing SSH filehandle");
+ close(SSH);
+ notify($ERRORS{'DEBUG'}, 0, "SSH filehandle closed");
+
+ $notstop = 0;
+ } ## end if ($loop > 1000)
+
+ } ## end while ($notstop)
+ } # Close open handle for SSH sysprep.cmd command
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "failed to start sysprep on $computer_node_name $!");
+ return 0;
+ } # Close sysprep.cmd could not be launched
+ } # Close if Sysprep
+
+ else {
+ #non sysprep option
+ #
+ #just reboot machine -- future expansion of additional methods newsid, custom scripts, etc.
+ notify($ERRORS{'OK'}, 0, "starting custom script VCLprep1.vbs on $computer_node_name");
+ if (run_scp_command("$TOOLS/VCLprep1.vbs", "$computer_node_name:VCLprep1.vbs", $IDENTITY_wxp)) {
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($computer_node_name, $IDENTITY_wxp, "cscript //Nologo VCLprep1.vbs", "root");
+ foreach my $s (@{$sshcmd[1]}) {
+ chomp($s);
+ if ($s =~ /copied VCLprepare/) {
+ notify($ERRORS{'OK'}, 0, "$s");
+ }
+ if ($s =~ /rebooting/) {
+ notify($ERRORS{'OK'}, 0, "SUCCESS started image procedure on $computer_node_name");
+ last;
+ }
+ } ## end foreach my $s (@{$sshcmd[1]})
+ } # Close SCP VCLPrep1.vbs
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "failed to copy $TOOLS/VCLprep1.vbs to $computer_node_name ");
+ return 0;
+ }
+ } # Close if not Sysprep
+
+ notify($ERRORS{'OK'}, 0, "returning 1");
+ return 1;
+} ## end sub capture_start
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 user_exists
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub user_exists {
+ my ($node, $user) = @_;
+ notify($ERRORS{'WARNING'}, 0, "node is not defined") if (!(defined($node)));
+ notify($ERRORS{'WARNING'}, 0, "user is not defined") if (!(defined($user)));
+
+ my ($net_user_exit_status, $net_user_output) = run_ssh_command($node, $IDENTITY_wxp, "net user $user");
+ if ($net_user_exit_status == 0) {
+ notify($ERRORS{'OK'}, 0, "user $user exists on $node");
+ return 1;
+ }
+ elsif ($net_user_exit_status == 2) {
+ notify($ERRORS{'OK'}, 0, "user $user does NOT exist on $node");
+ return 0;
+ }
+ elsif ($net_user_exit_status) {
+ notify($ERRORS{'WARNING'}, 0, "failed to determine if user $user exists on $node, exit status: $net_user_exit_status, output:\n@{$net_user_output}");
+ return;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to run SSH command to determine if user $user exists on $node");
+ return;
+ }
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 logoff_users
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub logoff_users {
+ my $self = shift;
+ my $management_node_keys = $self->data->get_management_node_keys();
+ my $computer_node_name = $self->data->get_computer_node_name();
+
+
+ my ($exit_status, $output) = run_ssh_command($computer_node_name, $management_node_keys, "qwinsta.exe");
+ if ($exit_status > 0) {
+ notify($ERRORS{'WARNING'}, 0, "failed to run qwinsta.exe on $computer_node_name, exit status: $exit_status, output:\n@{$output}");
+ return;
+ }
+ elsif (!defined($exit_status)) {
+ notify($ERRORS{'WARNING'}, 0, "failed to run qwinsta.exe SSH command on $computer_node_name");
+ return;
+ }
+
+ my @active_user_lines = grep(/Active/, @{$output});
+
+ notify($ERRORS{'OK'}, 0, "users are currently logged in on $computer_node_name: " . @active_user_lines);
+
+ foreach my $active_user_line (@active_user_lines) {
+ $active_user_line =~ /\s+(\S+)\s+(.*\w)\s*(\d+)\s+Active.*/;
+ my $session_name = $1;
+ my $username = $2;
+ my $session_id = $3;
+
+ notify($ERRORS{'DEBUG'}, 0, "user logged in: $username, session name: $session_name, session id: $session_id");
+
+ my ($logoff_exit_status, $logoff_output) = run_ssh_command($computer_node_name, $management_node_keys, "logoff.exe /v $session_id");
+ if ($logoff_exit_status == 0) {
+ notify($ERRORS{'OK'}, 0, "logged off user: $username, exit status: $logoff_exit_status, output:\n@{$logoff_output}");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to log off user: $username, exit status: $logoff_exit_status, output:\n@{$logoff_output}");
+ }
+
+ }
+
+ return 1;
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 delete_user
+
+ Parameters : $node, $user, $type, $osname
+ Returns : 1 success 0 failure
+ Description : removes user account and profile directory from specificed node
+
+=cut
+
+sub delete_user {
+ my $self = shift;
+ my $management_node_keys = $self->data->get_management_node_keys();
+ my $computer_node_name = $self->data->get_computer_node_name();
+
+ # Attempt to get the username from the arguments
+ # If no argument was supplied, use the user specified in the DataStructure
+ my $username = shift;
+ if (!(defined($username))) {
+ $username = $self->data->get_user_logon_id();
+ }
+
+ notify($ERRORS{'OK'}, 0, "attempting to delete user $username from $computer_node_name");
+
+ # Attempt to delete the user account
+ my $delete_user_command = "net user $username /DELETE";
+ my ($delete_user_exit_status, $delete_user_output) = run_ssh_command($computer_node_name, $management_node_keys, $delete_user_command);
+ if (defined($delete_user_exit_status) && $delete_user_exit_status == 0) {
+ notify($ERRORS{'OK'}, 0, "deleted user $username from $computer_node_name");
+ }
+ elsif (defined($delete_user_exit_status)) {
+ notify($ERRORS{'WARNING'}, 0, "failed to delete user $username from $computer_node_name, exit status: $delete_user_exit_status, output:\n@{$delete_user_output}");
+ return 0;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to run ssh command delete user $username from $computer_node_name");
+ return;
+ }
+
+ # Delete the user's home directory
+ my $delete_profile_command = "/bin/rm -rf /cygdrive/c/Users/$username";
+ my ($delete_profile_exit_status, $delete_profile_output) = run_ssh_command($computer_node_name, $management_node_keys, $delete_profile_command);
+ if (defined($delete_profile_exit_status) && $delete_profile_exit_status == 0) {
+ notify($ERRORS{'OK'}, 0, "deleted profile for user $username from $computer_node_name");
+ }
+ elsif (defined($delete_profile_exit_status)) {
+ notify($ERRORS{'WARNING'}, 0, "failed to delete profile for user $username from $computer_node_name, exit status: $delete_profile_exit_status, output:\n@{$delete_profile_output}");
+ return 0;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to run ssh command delete profile for user $username from $computer_node_name");
+ return;
+ }
+
+ return 1;
+} ## end sub del_user
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 disable_pagefile
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub disable_pagefile {
+ my $self = shift;
+ my $management_node_keys = $self->data->get_management_node_keys();
+ my $computer_node_name = $self->data->get_computer_node_name();
+
+ my $disable_pagefile_key = "HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Control\\Session Manager\\Memory Management";
+ my $disable_pagefile_command = "reg.exe add \"$disable_pagefile_key\" /v \"PagingFiles\" /t REG_SZ /d \"\" /f";
+ my ($disable_pagefile_exit_status, $disable_pagefile_output) = run_ssh_command($computer_node_name, $management_node_keys, $disable_pagefile_command);
+ if ($disable_pagefile_exit_status == 0) {
+ notify($ERRORS{'OK'}, 0, "registry key set to disable pagefile");
+ }
+ elsif ($disable_pagefile_exit_status) {
+ notify($ERRORS{'WARNING'}, 0, "failed to set registry key to disable pagefile, exit status: $disable_pagefile_exit_status, output:\n@{$disable_pagefile_output}");
+ return;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to run SSH command to set registry key to disable pagefile");
+ return;
+ }
+
+ # Attempt to reboot the computer in order to delete the pagefile
+ if ($self->reboot()) {
+ notify($ERRORS{'OK'}, 0, "computer was rebooted after disabling pagefile in the registry");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to reboot computer after disabling pagefile");
+ return;
+ }
+
+ # Attempt to delete the pagefile
+ my $delete_pagefile_command = "attrib.exe -S -H -R C:/pagefile.sys";
+ $delete_pagefile_command .= " && /usr/bin/rm.exe -rfv C:/pagefile.sys";
+ my ($delete_pagefile_exit_status, $delete_pagefile_output) = run_ssh_command($computer_node_name, $management_node_keys, $delete_pagefile_command);
+ if ($delete_pagefile_exit_status == 0) {
+ notify($ERRORS{'OK'}, 0, "pagefile.sys was deleted");
+ return 1;
+ }
+ elsif ($delete_pagefile_exit_status) {
+ notify($ERRORS{'WARNING'}, 0, "failed to delete pagefile.sys, exit status: $delete_pagefile_exit_status, output:\n@{$delete_pagefile_output}");
+ return;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to run SSH command to delete pagefile.sys");
+ return;
+ }
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 import_registry_file
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub import_registry_file {
+ my $self = shift;
+ my $management_node_keys = $self->data->get_management_node_keys();
+ my $computer_node_name = $self->data->get_computer_node_name();
+
+ my $registry_file_path = shift;
+ if (!defined($registry_file_path) || !$registry_file_path) {
+ notify($ERRORS{'WARNING'}, 0, "registry file path was not passed correctly as an argument");
+ return;
+ }
+
+ my $registry_file_contents = `cat $registry_file_path`;
+ notify($ERRORS{'DEBUG'}, 0, "registry file contents:\n$registry_file_contents");
+ $registry_file_contents =~ s/([\"])/\\$1/gs;
+
+ my $import_registry_command = "/usr/bin/echo.exe -E \"$registry_file_contents\" > tmp.reg";
+ $import_registry_command .= " && reg.exe IMPORT tmp.reg";
+ my ($import_registry_exit_status, $import_registry_output) = run_ssh_command($computer_node_name, $management_node_keys, $import_registry_command);
+ if ($import_registry_exit_status == 0) {
+ notify($ERRORS{'OK'}, 0, "registry file contents imported");
+ }
+ elsif ($import_registry_exit_status) {
+ notify($ERRORS{'WARNING'}, 0, "failed to import registry file contents, exit status: $import_registry_exit_status, output:\n@{$import_registry_output}");
+ return;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to run SSH command to import registry file contents");
+ return;
+ }
+
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 import_registry_string
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub import_registry_string {
+ my $self = shift;
+ my $management_node_keys = $self->data->get_management_node_keys();
+ my $computer_node_name = $self->data->get_computer_node_name();
+
+ my $registry_string = shift;
+ if (!defined($registry_string) || !$registry_string) {
+ notify($ERRORS{'WARNING'}, 0, "registry file path was not passed correctly as an argument");
+ return;
+ }
+
+ notify($ERRORS{'DEBUG'}, 0, "registry string:\n$registry_string");
+ $registry_string =~ s/([\"])/\\$1/gs;
+
+ my $import_registry_command = "/usr/bin/echo.exe -E \"$registry_string\" > tmp.reg";
+ $import_registry_command .= " && reg.exe IMPORT tmp.reg";
+ my ($import_registry_exit_status, $import_registry_output) = run_ssh_command($computer_node_name, $management_node_keys, $import_registry_command);
+ if ($import_registry_exit_status == 0) {
+ notify($ERRORS{'OK'}, 0, "registry string contents imported");
+ }
+ elsif ($import_registry_exit_status) {
+ notify($ERRORS{'WARNING'}, 0, "failed to import registry string contents, exit status: $import_registry_exit_status, output:\n@{$import_registry_output}");
+ return;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to run SSH command to import registry string contents");
+ return;
+ }
+
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 enable_autoadminlogon
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub enable_autoadminlogon {
+ my $self = shift;
+ my $management_node_keys = $self->data->get_management_node_keys();
+ my $computer_node_name = $self->data->get_computer_node_name();
+
+ my $registry_string .= <<"EOF";
+Windows Registry Editor Version 5.00
+
+; This file enables autoadminlogon for the root account
+
+[HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Winlogon]
+"AutoAdminLogon"="1"
+"DefaultUserName"="root"
+"DefaultPassword"= "$ROOT_PASSWORD"
+EOF
+
+ # Import the string into the registry
+ if ($self->import_registry_string($registry_string)) {
+ notify($ERRORS{'WARNING'}, 0, "successfully enabled autoadminlogon");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to enable autoadminlogon");
+ return 0;
+ }
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 disable_autoadminlogon
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub disable_autoadminlogon {
+ my $self = shift;
+ my $management_node_keys = $self->data->get_management_node_keys();
+ my $computer_node_name = $self->data->get_computer_node_name();
+
+ my $registry_string .= <<EOF;
+Windows Registry Editor Version 5.00
+
+; This file disables autoadminlogon for the root account
+
+[HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Winlogon]
+"AutoAdminLogon"="0"
+"DefaultUserName"=""
+"DefaultPassword"= ""
+EOF
+
+ # Import the string into the registry
+ if ($self->import_registry_string($registry_string)) {
+ notify($ERRORS{'WARNING'}, 0, "successfully disabled autoadminlogon");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to disable autoadminlogon");
+ return 0;
+ }
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 reboot
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub reboot {
+ my $self = shift;
+ my $management_node_keys = $self->data->get_management_node_keys();
+ my $computer_node_name = $self->data->get_computer_node_name();
+
+ my $reboot_start_time = time();
+ notify($ERRORS{'DEBUG'}, 0, "reboot will be attempted on $computer_node_name");
+
+ # Make sure sshd service is set to auto
+ notify($ERRORS{'DEBUG'}, 0, "attempting to make sure sshd service startup is set to auto");
+ if (_set_sshd_startmode($computer_node_name, "auto")) {
+ notify($ERRORS{'OK'}, 0, "successfully set sshd service startup mode to auto on $computer_node_name");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to set sshd service startup mode to auto on $computer_node_name");
+ }
+
+
+ # Initiate the shutdown.exe command to reboot the computer
+ my $shutdown_command = "C:/Windows/system32/shutdown.exe -r -t 0 -f";
+ my ($shutdown_exit_status, $shutdown_output) = run_ssh_command($computer_node_name, $management_node_keys, $shutdown_command);
+ if (defined($shutdown_exit_status) && $shutdown_exit_status == 0) {
+ notify($ERRORS{'OK'}, 0, "successfully executed reboot command on $computer_node_name");
+ }
+ elsif (defined($shutdown_exit_status)) {
+ notify($ERRORS{'WARNING'}, 0, "failed to execute reboot command on $computer_node_name, exit status: $shutdown_exit_status, output:\n@{$shutdown_output}");
+ return 0;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to execute ssh command to reboot $computer_node_name");
+ return;
+ }
+
+ notify($ERRORS{'OK'}, 0, "sleeping for 30 seconds while $computer_node_name begins reboot");
+ sleep 30;
+
+ # Wait maximum of 4 minutes for the computer to go offline then come back up
+ if (!$self->wait_for_ping(4)) {
+ # Check if the computer was ever offline, it should have been or else reboot never happened
+ notify($ERRORS{'WARNING'}, 0, "$computer_node_name never responded to ping, attempting hard power reset");
+
+ # Just explicitly call xCAT's _rpower for now
+ # TODO: implement public reset() subroutines in all of the provisioning modules
+ # TODO: allow provisioning and OS modules access to each other's subroutines
+ if (VCL::Module::Provisioning::xCAT::_rpower($computer_node_name, "cycle")) {
+ notify($ERRORS{'OK'}, 0, "initiated hard power reset on $computer_node_name");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "reboot failed, failed to initiate hard power reset on $computer_node_name");
+ return 0;
+ }
+
+ # Wait for computer to respond to ping after initiating hard reset
+ # Wait longer than the first attempt
+ if (!$self->wait_for_ping(6)) {
+ # Check if the computer was ever offline, it should have been or else reboot never happened
+ notify($ERRORS{'WARNING'}, 0, "reboot failed, $computer_node_name never responded to ping even after hard power reset");
+ return 0;
+ }
+ }
+
+ notify($ERRORS{'OK'}, 0, "sleeping for 15 seconds while $computer_node_name initializes");
+ sleep 15;
+
+ # Ping successful, try ssh
+ notify($ERRORS{'OK'}, 0, "waiting for ssh to respond on $computer_node_name");
+ if ($self->wait_for_ssh(3)) {
+ my $reboot_end_time = time();
+ my $reboot_duration = ($reboot_end_time - $reboot_start_time);
+ notify($ERRORS{'OK'}, 0, "reboot succeeded on $computer_node_name, took $reboot_duration seconds");\
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "reboot failed, ssh never became available on $computer_node_name");
+ return 0;
+ }
+
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 wait_for_ping
+
+ Parameters : Maximum number of minutes to wait (optional)
+ Returns : 1 if computer is pingable, 0 otherwise
+ Description : Attempts to ping the computer specified in the DataStructure
+ for the current reservation. It will wait up to a maximum number
+ of minutes. This can be specified by passing the subroutine an
+ integer value or the default value of 5 minutes will be used.
+
+=cut
+
+sub wait_for_ping {
+ my $self = shift;
+ my $computer_node_name = $self->data->get_computer_node_name();
+
+ # Attempt to get the total number of minutes to wait from the command line
+ my $total_wait_minutes = shift;
+ if (!defined($total_wait_minutes) || $total_wait_minutes !~ /^\d+$/) {
+ $total_wait_minutes = 5;
+ }
+
+ # Looping configuration variables
+ # Seconds to wait in between loop attempts
+ my $attempt_delay = 30;
+ # Total loop attempts made
+ # Add 1 to the number of attempts because if you're waiting for x intervals, you check x+1 times including at 0
+ my $attempts = ($total_wait_minutes * 2) + 1;
+
+ notify($ERRORS{'OK'}, 0, "waiting for $computer_node_name to respond to ping, maximum of $total_wait_minutes minutes");
+
+ # Loop until computer is online
+ my $computer_was_offline = 0;
+ my $computer_pingable = 0;
+ for (my $attempt = 1; $attempt <= $attempts; $attempt++) {
+ notify($ERRORS{'OK'}, 0, "attempt $attempt/$attempts: checking if computer is pingable: $computer_node_name");
+ $computer_pingable = _pingnode($computer_node_name);
+
+ if ($computer_pingable && $computer_was_offline) {
+ notify($ERRORS{'OK'}, 0, "$computer_node_name is pingable, reboot is nearly complete");
+ last;
+ }
+ elsif ($computer_pingable && !$computer_was_offline) {
+ notify($ERRORS{'OK'}, 0, "$computer_node_name is still pingable, reboot has not begun");
+ }
+ else {
+ $computer_was_offline = 1;
+ notify($ERRORS{'OK'}, 0, "$computer_node_name is not pingable, reboot is not complete");
+ }
+
+ notify($ERRORS{'OK'}, 0, "sleeping for $attempt_delay seconds before next ping attempt");
+ sleep $attempt_delay;
+ }
+
+ # Check if the computer ever went offline and if it is now pingable
+ if ($computer_pingable && $computer_was_offline) {
+ notify($ERRORS{'OK'}, 0, "$computer_node_name was offline and is now pingable");
+ return 1;
+ }
+ elsif ($computer_pingable && !$computer_was_offline) {
+ notify($ERRORS{'WARNING'}, 0, "$computer_node_name was never offline and is still pingable");
+ return 0;
+ }
+ else {
+ my $total_wait = ($attempts * $attempt_delay);
+ notify($ERRORS{'WARNING'}, 0, "$computer_node_name is not pingable after waiting for $total_wait seconds");
+ return 0;
+ }
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 wait_for_ssh
+
+ Parameters : Maximum number of minutes to wait (optional)
+ Returns : 1 if ssh succeeded to computer, 0 otherwise
+ Description : Attempts to communicate to the computer specified in the
+ DataStructure for the current reservation via SSH. It will wait
+ up to a maximum number of minutes. This can be specified by
+ passing the subroutine an integer value or the default value
+ of 5 minutes will be used.
+
+=cut
+
+sub wait_for_ssh {
+ my $self = shift;
+ my $management_node_keys = $self->data->get_management_node_keys();
+ my $computer_node_name = $self->data->get_computer_node_name();
+
+ # Attempt to get the total number of minutes to wait from the arguments
+ # If not specified, use default value
+ my $total_wait_minutes = shift;
+ if (!defined($total_wait_minutes) || $total_wait_minutes !~ /^\d+$/) {
+ $total_wait_minutes = 5;
+ }
+
+ # Looping configuration variables
+ # Seconds to wait in between loop attempts
+ my $attempt_delay = 15;
+ # Total loop attempts made
+ # Add 1 to the number of attempts because if you're waiting for x intervals, you check x+1 times including at 0
+ my $attempts = ($total_wait_minutes * 4) + 1;
+
+ notify($ERRORS{'OK'}, 0, "waiting for $computer_node_name to respond to ssh, maximum of $total_wait_minutes minutes");
+
+ # Loop until ssh is available
+ my $ssh_result = 0;
+ for (my $attempt = 1; $attempt <= $attempts; $attempt++) {
+ notify($ERRORS{'OK'}, 0, "attempt $attempt/$attempts: checking ssh on computer: $computer_node_name");
+
+ # Run a test SSH command
+ my ($exit_status, $output) = run_ssh_command($computer_node_name, $management_node_keys, "echo testing ssh on $computer_node_name");
+
+ # The exit status will be 0 if the command succeeded
+ if (defined($exit_status) && $exit_status == 0) {
+ notify($ERRORS{'OK'}, 0, "test ssh command succeeded on $computer_node_name");
+ return 1;
+ }
+
+ notify($ERRORS{'OK'}, 0, "sleeping for $attempt_delay seconds before next ssh attempt");
+ sleep $attempt_delay;
+ }
+
+ notify($ERRORS{'WARNING'}, 0, "$computer_node_name is not available via ssh");
+ return 0;
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 firewall_enable_ping_private
+
+ Parameters :
+ Returns : 1 if succeeded, 0 otherwise
+ Description :
+
+=cut
+
+sub firewall_enable_ping_private {
+ my $self = shift;
+
+ my %firewall_parameters = (
+ name => 'VCL: allow ping from private network',
+ dir => 'in',
+ action => 'allow',
+ description => 'Allows incoming ping (ICMP type 8) messages from 10.x.x.x addresses',
+ enable => 'yes',
+ localip => '10.0.0.0/8',
+ remoteip => '10.0.0.0/8',
+ protocol => 'icmpv4:8,any',
+ );
+
+ # Call the configure firewall subroutine, pass it the necessary parameters
+ if ($self->firewall_configure(\%firewall_parameters)) {
+ notify($ERRORS{'OK'}, 0, "successfully opened firewall for incoming ping on private network");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to open firewall for incoming ping on private network");
+ return 0;
+ }
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 firewall_enable_ssh_private
+
+ Parameters :
+ Returns : 1 if succeeded, 0 otherwise
+ Description :
+
+=cut
+
+sub firewall_enable_ssh_private {
+ my $self = shift;
+
+ my %firewall_parameters = (
+ name => 'VCL: allow ssh port 22 from private network',
+ dir => 'in',
+ action => 'allow',
+ description => 'Allows incoming TCP port 22 traffic from 10.x.x.x addresses',
+ enable => 'yes',
+ localip => '10.0.0.0/8',
+ remoteip => '10.0.0.0/8',
+ localport => '22',
+ protocol => 'TCP',
+ );
+
+ # Call the configure firewall subroutine, pass it the necessary parameters
+ if ($self->firewall_configure(\%firewall_parameters)) {
+ notify($ERRORS{'OK'}, 0, "successfully opened firewall for incoming ssh via TCP port 22 on private network");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to open firewall for incoming ssh via TCP port 22 on private network");
+ return 0;
+ }
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 firewall_enable_rdp
+
+ Parameters :
+ Returns : 1 if succeeded, 0 otherwise
+ Description :
+
+=cut
+
+sub firewall_enable_rdp {
+ my $self = shift;
+
+ # Check if the remote IP was passed correctly as an argument
+ my $remote_ip = shift;
+ if (!defined($remote_ip) || $remote_ip !~ /[\d\.\/]/) {
+ $remote_ip = 'any';
+ }
+
+ my %firewall_parameters = (
+ name => "VCL: allow RDP port 3389 from $remote_ip",
+ dir => 'in',
+ action => 'allow',
+ description => "Allows incoming TCP port 3389 traffic from $remote_ip",
+ enable => 'yes',
+ remoteip => $remote_ip,
+ localport => '3389',
+ protocol => 'TCP',
+ );
+
+ # Call the configure firewall subroutine, pass it the necessary parameters
+ if ($self->firewall_configure(\%firewall_parameters)) {
+ notify($ERRORS{'OK'}, 0, "successfully opened firewall for incoming RDP via TCP port 3389 from $remote_ip");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to open firewall for incoming RDP via TCP port 3389 from $remote_ip");
+ return 0;
+ }
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 firewall_disable_rdp
+
+ Parameters :
+ Returns : 1 if succeeded, 0 otherwise
+ Description :
+
+=cut
+
+sub firewall_disable_rdp {
+ my $self = shift;
+
+ #"\netsh.exe advfirewall firewall delete rule name=RDP protocol=TCP localport=3389"
+
+ my %firewall_parameters = (
+ name => 'all',
+ localport => '3389',
+ protocol => 'TCP',
+ );
+
+ # Call the configure firewall subroutine, pass it the necessary parameters
+ if ($self->firewall_close(\%firewall_parameters)) {
+ notify($ERRORS{'OK'}, 0, "successfully closed firewall for incoming RDP via TCP port 3389");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to close firewall for incoming RDP via TCP port 3389");
+ return 0;
+ }
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 firewall_configure
+
+ Parameters :
+ Returns : 1 if succeeded, 0 otherwise
+ Description :
+
+=cut
+
+sub firewall_configure {
+ my $self = shift;
+ my $management_node_keys = $self->data->get_management_node_keys();
+ my $computer_node_name = $self->data->get_computer_node_name();
+
+ # Check the arguments
+ my $firewall_parameters = shift;
+ if (!defined($firewall_parameters) || !$firewall_parameters) {
+ notify($ERRORS{'WARNING'}, 0, "failed to open firewall on $computer_node_name, parameters hash reference was not passed");
+ return;
+ }
+ if (!defined($firewall_parameters->{name}) || !$firewall_parameters->{name}) {
+ notify($ERRORS{'WARNING'}, 0, "failed to open firewall on $computer_node_name, 'name' hash key was not passed");
+ return;
+ }
+ if (!defined($firewall_parameters->{dir}) || !$firewall_parameters->{dir}) {
+ notify($ERRORS{'WARNING'}, 0, "failed to open firewall on $computer_node_name, 'dir' hash key was not passed");
+ return;
+ }
+ if (!defined($firewall_parameters->{action}) || !$firewall_parameters->{action}) {
+ notify($ERRORS{'WARNING'}, 0, "failed to open firewall on $computer_node_name, 'action' hash key was not passed");
+ return;
+ }
+
+ # Add quotes around anything with a space in the parameters hash which isn't already enclosed in quotes
+ foreach my $rule_property (sort keys(%{$firewall_parameters})) {
+ $firewall_parameters->{$rule_property} =~ s/^(.*\s.*)$/\"$1\"/g;
+ notify($ERRORS{'DEBUG'}, 0, "enclosing property in quotes: $firewall_parameters->{$rule_property}");
+ }
+
+ # Attempt to run the command to set existing firewall rule
+
+ # Usage: set rule
+ # group=<string> | name=<string>
+ # [dir=in|out]
+ # [profile=public|private|domain|any[,...]]
+ # [program=<program path>]
+ # [service=service short name|any]
+ # [localip=any|<IPv4 address>|<IPv6 address>|<subnet>|<range>|<list>]
+ # [remoteip=any|localsubnet|dns|dhcp|wins|defaultgateway|
+ # <IPv4 address>|<IPv6 address>|<subnet>|<range>|<list>]
+ # [localport=0-65535|RPC|RPC-EPMap|any[,...]]
+ # [remoteport=0-65535|any[,...]]
+ # [protocol=0-255|icmpv4|icmpv6|icmpv4:type,code|icmpv6:type,code|
+ # tcp|udp|any]
+ # new
+ # [name=<string>]
+ # [dir=in|out]
+ # [program=<program path>
+ # [service=<service short name>|any]
+ # [action=allow|block|bypass]
+ # [description=<string>]
+ # [enable=yes|no]
+ # [profile=public|private|domain|any[,...]]
+ # [localip=any|<IPv4 address>|<IPv6 address>|<subnet>|<range>|<list>]
+ # [remoteip=any|localsubnet|dns|dhcp|wins|defaultgateway|
+ # <IPv4 address>|<IPv6 address>|<subnet>|<range>|<list>]
+ # [localport=0-65535|RPC|RPC-EPMap|any[,...]]
+ # [remoteport=0-65535|any[,...]]
+ # [protocol=0-255|icmpv4|icmpv6|icmpv4:type,code|icmpv6:type,code|
+ # tcp|udp|any]
+ # [interfacetype=wireless|lan|ras|any]
+ # [rmtcomputergrp=<SDDL string>]
+ # [rmtusrgrp=<SDDL string>]
+ # [edge=yes|no]
+ # [security=authenticate|authenc|notrequired]
+
+ # Assemble the command based on the keys populated in the hash
+ my $set_rule_command = "netsh.exe advfirewall firewall set rule";
+ $set_rule_command .= " name=$firewall_parameters->{name}";
+ $set_rule_command .= " new";
+ foreach my $rule_property (sort keys(%{$firewall_parameters})) {
+ next if $rule_property eq 'name';
+ $set_rule_command .= " $rule_property=$firewall_parameters->{$rule_property}";
+ }
+
+ # Attempt to set properties of existing rule
+ notify($ERRORS{'DEBUG'}, 0, "attempting to set matching firewall rules on $computer_node_name, command:\n$set_rule_command");
+ my ($set_rule_exit_status, $set_rule_output) = run_ssh_command($computer_node_name, $management_node_keys, $set_rule_command);
+ if (defined($set_rule_exit_status) && ($set_rule_exit_status == 0)) {
+ notify($ERRORS{'OK'}, 0, "successfully set matching firewall rules");
+ return 1;
+ }
+ elsif (defined($set_rule_exit_status) && ($set_rule_exit_status == 1)) {
+ notify($ERRORS{'OK'}, 0, "unable to set matching firewall rules, rule does not exist");
+ }
+ elsif (defined($set_rule_exit_status)) {
+ notify($ERRORS{'WARNING'}, 0, "failed to set matching firewall rules on $computer_node_name, exit status: $set_rule_exit_status, output:\n@{$set_rule_output}");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to run ssh command to set matching firewall rules on $computer_node_name");
+ }
+
+
+ # Attempt to run the command to add the firewall rule
+
+ # Usage: add rule name=<string>
+ # dir=in|out
+ # action=allow|block|bypass
+ # [program=<program path>]
+ # [service=<service short name>|any]
+ # [description=<string>]
+ # [enable=yes|no (default=yes)]
+ # [profile=public|private|domain|any[,...]]
+ # [localip=any|<IPv4 address>|<IPv6 address>|<subnet>|<range>|<list>]
+ # [remoteip=any|localsubnet|dns|dhcp|wins|defaultgateway|
+ # <IPv4 address>|<IPv6 address>|<subnet>|<range>|<list>]
+ # [localport=0-65535|RPC|RPC-EPMap|any[,...] (default=any)]
+ # [remoteport=0-65535|any[,...] (default=any)]
+ # [protocol=0-255|icmpv4|icmpv6|icmpv4:type,code|icmpv6:type,code|
+ # tcp|udp|any (default=any)]
+ # [interfacetype=wireless|lan|ras|any]
+ # [rmtcomputergrp=<SDDL string>]
+ # [rmtusrgrp=<SDDL string>]
+ # [edge=yes|no (default=no)]
+ # [security=authenticate|authenc|notrequired (default=notrequired)]
+
+ # Assemble the command based on the keys populated in the hash
+ my $add_rule_command = "netsh.exe advfirewall firewall add rule";
+ $add_rule_command .= " name=$firewall_parameters->{name}";
+ foreach my $rule_property (sort keys(%{$firewall_parameters})) {
+ next if $rule_property eq 'name';
+ $add_rule_command .= " $rule_property=$firewall_parameters->{$rule_property}";
+ }
+
+ # Add the firewall rule
+ my ($add_rule_exit_status, $add_rule_output) = run_ssh_command($computer_node_name, $management_node_keys, $add_rule_command);
+ if (defined($add_rule_exit_status) && $add_rule_exit_status == 0) {
+ notify($ERRORS{'OK'}, 0, "successfully added firewall rule");
+ }
+ elsif (defined($add_rule_exit_status)) {
+ notify($ERRORS{'WARNING'}, 0, "failed to add firewall rule on $computer_node_name, exit status: $add_rule_exit_status, output:\n@{$add_rule_output}");
+ return 0;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to add firewall rule on $computer_node_name");
+ return;
+ }
+
+ return 1;
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 firewall_close
+
+ Parameters :
+ Returns : 1 if succeeded, 0 otherwise
+ Description :
+
+=cut
+
+sub firewall_close {
+ my $self = shift;
+ my $management_node_keys = $self->data->get_management_node_keys();
+ my $computer_node_name = $self->data->get_computer_node_name();
+
+ # Make sure firewall parameters hash was passed
+ my $firewall_parameters = shift;
+ if (!defined($firewall_parameters) || !$firewall_parameters) {
+ notify($ERRORS{'WARNING'}, 0, "failed to close firewall on $computer_node_name, parameters hash reference was not passed");
+ return;
+ }
+
+ # Add quotes around anything with a space in the parameters hash which isn't already enclosed in quotes
+ foreach my $rule_property (sort keys(%{$firewall_parameters})) {
+ $firewall_parameters->{$rule_property} =~ s/^(.*\s.*)$/\"$1\"/g;
+ notify($ERRORS{'DEBUG'}, 0, "enclosing '$rule_property' property in quotes: $firewall_parameters->{$rule_property}");
+ }
+
+ # Usage: delete rule name=<string>
+ # [dir=in|out]
+ # [profile=public|private|domain|any[,...]]
+ # [program=<program path>]
+ # [service=<service short name>|any]
+ # [localip=any|<IPv4 address>|<IPv6 address>|<subnet>|<range>|<list>]
+ # [remoteip=any|localsubnet|dns|dhcp|wins|defaultgateway|
+ # <IPv4 address>|<IPv6 address>|<subnet>|<range>|<list>]
+ # [localport=0-65535|RPC|RPC-EPMap|any[,...]]
+ # [remoteport=0-65535|any[,...]]
+ # [protocol=0-255|icmpv4|icmpv6|icmpv4:type,code|icmpv6:type,code|
+ # tcp|udp|any]
+
+ # Assemble the command based on the keys populated in the hash
+ my $delete_rule_command = "netsh.exe advfirewall firewall delete rule";
+ foreach my $rule_property (sort keys(%{$firewall_parameters})) {
+ $delete_rule_command .= " $rule_property=$firewall_parameters->{$rule_property}";
+ }
+
+ # Attempt to delete existing rules
+ notify($ERRORS{'DEBUG'}, 0, "attempting to delete matching firewall rules on $computer_node_name, command:\n$delete_rule_command");
+ my ($delete_rule_exit_status, $delete_rule_output) = run_ssh_command($computer_node_name, $management_node_keys, $delete_rule_command);
+ if (defined($delete_rule_exit_status) && ($delete_rule_exit_status == 0)) {
+ notify($ERRORS{'OK'}, 0, "successfully deleted matching firewall rules");
+ return 1;
+ }
+ elsif (defined($delete_rule_exit_status) && ($delete_rule_exit_status == 1)) {
+ notify($ERRORS{'OK'}, 0, "unable to delete matching firewall rules, rule does not exist");
+ return 1;
+ }
+ elsif (defined($delete_rule_exit_status)) {
+ notify($ERRORS{'WARNING'}, 0, "failed to delete matching firewall rules on $computer_node_name, exit status: $delete_rule_exit_status, output:\n@{$delete_rule_output}");
+ return 0;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to run ssh command to delete matching firewall rules on $computer_node_name");
+ return 0;
+ }
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+1;
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+=head1 COPYRIGHT AND LICENSE
+
+ Copyright (C) 2004-2008 by NC State University. All Rights Reserved.
+
+ Virtual Computing Laboratory
+ North Carolina State University
+ Raleigh, NC, USA 27695
+
+ For use license and copyright information see LICENSE and COPYRIGHT files
+ included in the source files.
+
+=cut
diff --git a/managementnode/lib/VCL/Module/OS/Windows/Desktop/XP.pm b/managementnode/lib/VCL/Module/OS/Windows/Desktop/XP.pm
new file mode 100755
index 0000000..2cf7538
--- /dev/null
+++ b/managementnode/lib/VCL/Module/OS/Windows/Desktop/XP.pm
@@ -0,0 +1,78 @@
+#!/usr/bin/perl -w
+##############################################################################
+# $Id: XP.pm 1953 2008-12-12 14:23:17Z arkurth $
+##############################################################################
+
+=head1 NAME
+
+VCL::Module::OS::Windows::Desktop::XP
+
+=head1 SYNOPSIS
+
+ Needs to be written
+
+=head1 DESCRIPTION
+
+ This module provides...
+
+=cut
+
+##############################################################################
+package VCL::Module::OS::Windows::Desktop::XP;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/../../../../..";
+
+# Configure inheritance
+use base qw(VCL::Module::OS::Windows::Desktop);
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use VCL::utils;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+1;
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+=head1 COPYRIGHT AND LICENSE
+
+ Copyright (C) 2004-2008 by NC State University. All Rights Reserved.
+
+ Virtual Computing Laboratory
+ North Carolina State University
+ Raleigh, NC, USA 27695
+
+ For use license and copyright information see LICENSE and COPYRIGHT files
+ included in the source files.
+
+=cut
diff --git a/managementnode/lib/VCL/Module/Predictive.pm b/managementnode/lib/VCL/Module/Predictive.pm
new file mode 100644
index 0000000..ff158c1
--- /dev/null
+++ b/managementnode/lib/VCL/Module/Predictive.pm
@@ -0,0 +1,84 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: Predictive.pm 1945 2008-12-11 20:58:08Z fapeeler $
+##############################################################################
+
+=head1 NAME
+
+VCL::Module::Predictive - VCL predictive loading base module
+
+=head1 SYNOPSIS
+
+ use base qw(VCL::Module::Predictive);
+
+=head1 DESCRIPTION
+
+ Needs to be written.
+
+=cut
+
+##############################################################################
+package VCL::Module::Predictive;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/../..";
+
+# Configure inheritance
+use base qw(VCL::Module);
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use VCL::utils;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+1;
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+
+=cut
diff --git a/managementnode/lib/VCL/Module/Predictive/Level_0.pm b/managementnode/lib/VCL/Module/Predictive/Level_0.pm
new file mode 100644
index 0000000..8bb02e2
--- /dev/null
+++ b/managementnode/lib/VCL/Module/Predictive/Level_0.pm
@@ -0,0 +1,201 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: Level_0.pm 1945 2008-12-11 20:58:08Z fapeeler $
+##############################################################################
+
+=head1 NAME
+
+VCL::Module::Predictive::Level_0 - VCL predictive loading module for "Level 0" algorithm
+
+=head1 SYNOPSIS
+
+ use base qw(VCL::Module::Predictive::Level_0);
+
+=head1 DESCRIPTION
+
+ Needs to be written.
+
+=cut
+
+##############################################################################
+package VCL::Module::Predictive::Level_0;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/../../..";
+
+# Configure inheritance
+use base qw(VCL::Module::Predictive);
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+use English '-no_match_vars';
+
+use VCL::utils;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_next_image
+
+ Parameters : None. Must be called as an object method.
+ Returns :
+ Description :
+
+=cut
+
+sub get_next_image {
+ my $self = shift;
+ if (ref($self) !~ /Level_0/) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method, process exiting");
+ exit 1;
+ }
+ #notify($ERRORS{'WARNING'}, 0, "get_next_image_revision works!");
+
+ # Retrieve variables from the DataStructure
+ my $request_id = $self->data->get_request_id();
+ my $reservation_id = $self->data->get_reservation_id();
+ my $computer_id = $self->data->get_computer_id();
+ my $computer_short_name = $self->data->get_computer_short_name();
+
+ my $notify_prefix = "predictive_reload_Level_0: ";
+
+ notify($ERRORS{'OK'}, 0, "$notify_prefix for $computer_id");
+
+ my $select_statement = "
+ SELECT DISTINCT
+ req.start AS starttime,
+ ir.imagename AS imagename,
+ res.imagerevisionid AS imagerevisionid,
+ res.imageid AS imageid
+ FROM
+ reservation res,
+ request req,
+ image i,
+ state s,
+ imagerevision ir
+ WHERE
+ res.requestid = req.id
+ AND req.stateid = s.id
+ AND i.id = res.imageid
+ AND ir.id = res.imagerevisionid
+ AND res.computerid = $computer_id
+ AND (s.name = \'new\' OR s.name = \'reload\' OR s.name = \'imageprep\')
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @selected_rows = database_select($select_statement);
+ my @ret_array;
+
+ # Check to make sure 1 or more rows were returned
+ if (scalar @selected_rows > 0) {
+ # Loop through list of upcoming reservations
+ # Based on the start time load the next one
+
+ my $now = time();
+
+ # It contains a hash
+ for (@selected_rows) {
+ my %reservation_row = %{$_};
+ # $reservation_row{starttime}
+ # $reservation_row{imagename}
+ # $reservation_row{imagerevisionid}
+ # $reservation_row{imageid}
+ my $epoch_start = convert_to_epoch_seconds($reservation_row{starttime});
+ my $diff = $epoch_start - $now;
+ # If start time is less than 50 minutes from now return this image
+ notify($ERRORS{'OK'}, 0, "$notify_prefix diff= $diff image= $reservation_row{imagename} imageid=$reservation_row{imageid}");
+ if ($diff < (50 * 60)) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix future reservation detected diff= $diff image= $reservation_row{imagename} imageid=$reservation_row{imageid}");
+ push(@ret_array, $reservation_row{imagename}, $reservation_row{imageid}, $reservation_row{imagerevisionid});
+ return @ret_array;
+ }
+ } ## end for (@selected_rows)
+ } ## end if (scalar @selected_rows > 0)
+
+ # No upcoming reservations - fetch preferred image information
+ my $select_preferredimage = "
+ SELECT DISTINCT
+ imagerevision.imagename AS imagename,
+ imagerevision.id AS imagerevisionid,
+ image.id AS imageid
+ FROM
+ image,
+ computer,
+ imagerevision
+ WHERE
+ imagerevision.imageid = computer.preferredimageid
+ AND imagerevision.production = 1
+ AND computer.preferredimageid = image.id
+ AND computer.id = $computer_id
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @preferred_selected_rows = database_select($select_preferredimage);
+
+ # Check to make sure at least 1 row were returned
+ if (scalar @preferred_selected_rows == 0) {
+ notify($ERRORS{'WARNING'}, 0, "$notify_prefix failed to fetch preferred image for computerid $computer_id");
+ return 0;
+ }
+ elsif (scalar @preferred_selected_rows > 1) {
+ notify($ERRORS{'WARNING'}, 0, "" . scalar @preferred_selected_rows . " rows were returned from database select");
+ return 0;
+ }
+ notify($ERRORS{'OK'}, 0, "$notify_prefix returning preferredimage image=$preferred_selected_rows[0]{imagename} imageid=$preferred_selected_rows[0]{imageid}");
+ push(@ret_array, $preferred_selected_rows[0]{imagename}, $preferred_selected_rows[0]{imageid}, $preferred_selected_rows[0]{imagerevisionid});
+ return @ret_array;
+
+} ## end sub get_next_image_revision
+
+#/////////////////////////////////////////////////////////////////////////////
+
+1;
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+
+=cut
diff --git a/managementnode/lib/VCL/Module/Predictive/Level_1.pm b/managementnode/lib/VCL/Module/Predictive/Level_1.pm
new file mode 100644
index 0000000..bcf599a
--- /dev/null
+++ b/managementnode/lib/VCL/Module/Predictive/Level_1.pm
@@ -0,0 +1,402 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: Level_1.pm 1945 2008-12-11 20:58:08Z fapeeler $
+##############################################################################
+
+=head1 NAME
+
+VCL::Module::Predictive::Level_1 - VCL predictive loading module for "Level 1" algorithm
+
+=head1 SYNOPSIS
+
+ use base qw(VCL::Module::Predictive::Level_1);
+
+=head1 DESCRIPTION
+
+ Needs to be written.
+
+=cut
+
+##############################################################################
+package VCL::Module::Predictive::Level_1;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/../../..";
+
+# Configure inheritance
+use base qw(VCL::Module::Predictive);
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+use English '-no_match_vars';
+
+use VCL::utils;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_next_image
+
+ Parameters : None. Must be called as an object method.
+ Returns :
+ Description :
+
+=cut
+
+sub get_next_image {
+ my $self = shift;
+ if (ref($self) !~ /Level_1/) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method, process exiting");
+ exit 1;
+ }
+ #notify($ERRORS{'WARNING'}, 0, "get_next_image_revision works!");
+
+ # Retrieve variables from the DataStructure
+ my $request_id = $self->data->get_request_id();
+ my $reservation_id = $self->data->get_reservation_id();
+ my $computer_id = $self->data->get_computer_id();
+ my $computer_short_name = $self->data->get_computer_short_name();
+
+ my $notify_prefix = "predictive_reload_Level_1 :";
+
+ notify($ERRORS{'OK'}, 0, "$notify_prefix starting predictive_reload_level_1 for $computer_id");
+
+ my $select_statement = "
+ SELECT DISTINCT
+ req.start AS starttime,
+ ir.imagename AS imagename,
+ res.imagerevisionid AS imagerevisionid,
+ res.imageid AS imageid
+ FROM
+ reservation res,
+ request req,
+ image i,
+ state s,
+ imagerevision ir
+ WHERE
+ res.requestid = req.id
+ AND req.stateid = s.id
+ AND i.id = res.imageid
+ AND ir.id = res.imagerevisionid
+ AND res.computerid = $computer_id
+ AND (s.name = \'new\' OR s.name = \'reload\' OR s.name = \'imageprep\')
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @selected_rows = database_select($select_statement);
+ my @ret_array;
+
+ # Check to make sure 1 or more rows were returned
+ if (scalar @selected_rows > 0) {
+ # Loop through list of upcoming reservations
+ # Based on the start time load the next one
+
+ my $now = time();
+
+ # It contains a hash
+ for (@selected_rows) {
+ my %reservation_row = %{$_};
+ # $reservation_row{starttime}
+ # $reservation_row{imagename}
+ # $reservation_row{imagerevisionid}
+ # $reservation_row{imageid}
+ my $epoch_start = convert_to_epoch_seconds($reservation_row{starttime});
+ my $diff = $epoch_start - $now;
+ # If start time is less than 50 minutes from now return this image
+ notify($ERRORS{'OK'}, 0, "$notify_prefix diff= $diff image= $reservation_row{imagename} imageid=$reservation_row{imageid}");
+ if ($diff < (50 * 60)) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix future reservation detected diff= $diff image= $reservation_row{imagename} imageid=$reservation_row{imageid}");
+ push(@ret_array, $reservation_row{imagename}, $reservation_row{imageid}, $reservation_row{imagerevisionid});
+ return @ret_array;
+ }
+ } ## end for (@selected_rows)
+ } ## end if (scalar @selected_rows > 0)
+
+ # No upcoming reservations - determine most popular, unloaded image
+
+ # determine state of system
+
+ # get machine type
+ my $select_type = "
+ SELECT
+ type
+ FROM
+ computer
+ WHERE
+ id = $computer_id
+ ";
+ my @data = database_select($select_type);
+ if (scalar @data == 0) {
+ notify($ERRORS{'WARNING'}, 0, "$notify_prefix failed to fetch preferred image for computer_id $computer_id");
+ return 0;
+ }
+ my $type = $data[0]{type};
+
+ # online machines
+ my $select_online = "
+ SELECT
+ COUNT(id) as cnt
+ FROM
+ computer
+ WHERE
+ stateid IN (2, 3, 6, 8, 11)
+ AND type = '$type'
+ ";
+ @data = database_select($select_online);
+ if (scalar @data == 0) {
+ notify($ERRORS{'WARNING'}, 0, "$notify_prefix failed to fetch preferred image for computer_id $computer_id");
+ return 0;
+ }
+ my $online = $data[0]{cnt};
+
+ # available machines
+ my $select_available = "
+ SELECT
+ COUNT(id) AS cnt
+ FROM
+ computer
+ WHERE
+ stateid = 2
+ AND type = '$type'
+ ";
+ @data = database_select($select_available);
+ if (scalar @data == 0) {
+ notify($ERRORS{'WARNING'}, 0, "$notify_prefix failed to fetch preferred image for computer_id $computer_id");
+ return 0;
+ }
+ my $avail = $data[0]{cnt};
+
+ # check if > 75% usage, look at past 2 days, otherwise, look at past 6 months
+ my $timeframe;
+ if (($avail / $online) > 0.75) {
+ $timeframe = '2 DAY';
+ }
+ else {
+ $timeframe = '6 MONTH';
+ }
+
+ # what images map to this computer
+ my $select_mapped_images = "
+ SELECT
+ id
+ FROM
+ resource
+ WHERE
+ resourcetypeid = 12
+ AND subid = $computer_id
+ ";
+ @data = database_select($select_mapped_images);
+ if (scalar @data == 0) {
+ notify($ERRORS{'WARNING'}, 0, "$notify_prefix failed to fetch preferred image for computer_id $computer_id");
+ return 0;
+ }
+ my $resourceid = $data[0]{id};
+
+ my $select_compgrps1 = "
+ SELECT
+ resourcegroupid
+ FROM
+ resourcegroupmembers
+ WHERE
+ resourceid = $resourceid
+ ";
+ @data = database_select($select_compgrps1);
+ if (scalar @data == 0) {
+ notify($ERRORS{'WARNING'}, 0, "$notify_prefix failed to fetch preferred image for computer_id $computer_id");
+ return 0;
+ }
+ my @compgroups;
+ foreach (@data) {
+ my %row = %{$_};
+ push(@compgroups, $row{resourcegroupid});
+ }
+
+ my $inlist = join(',', @compgroups);
+ my $select_imggrps1 = "
+ SELECT
+ resourcegroupid2
+ FROM
+ resourcemap
+ WHERE
+ resourcetypeid1 = 12
+ AND resourcegroupid1 IN ($inlist)
+ AND resourcetypeid2 = 13
+ ";
+ @data = database_select($select_imggrps1);
+ my @imggroups;
+ foreach (@data) {
+ my %row = %{$_};
+ push(@imggroups, $row{resourcegroupid2});
+ }
+ my $select_imggrps2 = "
+ SELECT
+ resourcegroupid1
+ FROM
+ resourcemap
+ WHERE
+ resourcetypeid2 = 12
+ AND resourcegroupid2 IN ($inlist)
+ AND resourcetypeid1 = 13
+ ";
+ @data = database_select($select_imggrps2);
+ foreach (@data) {
+ my %row = %{$_};
+ push(@imggroups, $row{resourcegroupid1});
+ }
+ if (scalar @imggroups == 0) {
+ notify($ERRORS{'WARNING'}, 0, "$notify_prefix failed to fetch preferred image for computer_id $computer_id");
+ return 0;
+ }
+
+ $inlist = join(',', @imggroups);
+ my $select_imageids = "
+ SELECT
+ DISTINCT(r.subid)
+ FROM
+ image i,
+ resource r,
+ resourcegroupmembers rgm
+ WHERE
+ rgm.resourceid = r.id
+ AND r.resourcetypeid = 13
+ AND rgm.resourcegroupid IN ($inlist)
+ AND r.subid = i.id
+ AND i.deleted = 0
+ ";
+ my @imgids;
+ @data = database_select($select_imageids);
+ if (scalar @data == 0) {
+ notify($ERRORS{'WARNING'}, 0, "$notify_prefix failed to fetch preferred image for computer_id $computer_id");
+ return 0;
+ }
+ foreach (@data) {
+ my %row = %{$_};
+ push(@imgids, $row{subid});
+ }
+
+ # which of those are loaded
+ $inlist = join(',', @imgids);
+ my $select_loaded = "
+ SELECT
+ DISTINCT(currentimageid)
+ FROM
+ computer
+ WHERE
+ currentimageid IN ($inlist)
+ AND stateid = 2";
+ @data = database_select($select_loaded);
+ my @loaded;
+ foreach (@data) {
+ my %row = %{$_};
+ push(@loaded, $row{currentimageid});
+ }
+
+ # which of those are not loaded (find difference of @imagids and @loaded)
+ my (@intersection, @notloaded, $element);
+ @intersection = @notloaded = ();
+ my %count = ();
+ foreach $element (@imgids, @loaded) {$count{$element}++}
+ foreach $element (keys %count) {
+ push @{$count{$element} > 1 ? \@intersection : \@notloaded}, $element;
+ }
+
+ # get the most popular in $timeframe
+ $inlist = join(',', @notloaded);
+ my $select_imageid = "
+ SELECT
+ COUNT(imageid) AS cnt,
+ imageid
+ FROM
+ log
+ WHERE
+ imageid IN ($inlist)
+ AND start > (NOW() - INTERVAL $timeframe)
+ GROUP BY imageid
+ ORDER BY cnt DESC
+ LIMIT 1
+ ";
+ @data = database_select($select_imageid);
+ if (scalar @data == 0) {
+ notify($ERRORS{'WARNING'}, 0, "$notify_prefix failed to fetch preferred image for computer_id $computer_id");
+ return 0;
+ }
+ my $imageid = $data[0]{imageid};
+
+ # get extra data about the image
+ my $select_extra = "
+ SELECT
+ i.name,
+ r.id
+ FROM
+ image i,
+ imagerevision r
+ WHERE
+ i.id = $imageid
+ AND r.imageid = $imageid
+ AND r.production = 1
+ ";
+ @data = database_select($select_extra);
+ if (scalar @data == 0) {
+ notify($ERRORS{'WARNING'}, 0, "$notify_prefix failed to fetch preferred image for computer_id $computer_id");
+ return 0;
+ }
+
+
+ notify($ERRORS{'OK'}, 0, "$notify_prefix $computer_id $data[0]{name}, $imageid, $data[0]{id}");
+ push(@ret_array, $data[0]{name}, $imageid, $data[0]{id});
+ return @ret_array;
+
+
+} ## end sub get_next_image_revision
+
+#/////////////////////////////////////////////////////////////////////////////
+
+1;
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+
+=cut
diff --git a/managementnode/lib/VCL/Module/Provisioning.pm b/managementnode/lib/VCL/Module/Provisioning.pm
new file mode 100644
index 0000000..3be1bad
--- /dev/null
+++ b/managementnode/lib/VCL/Module/Provisioning.pm
@@ -0,0 +1,84 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: Provisioning.pm 1953 2008-12-12 14:23:17Z arkurth $
+##############################################################################
+
+=head1 NAME
+
+VCL::Module::Provisioning - VCL provisioning base module
+
+=head1 SYNOPSIS
+
+ use base qw(VCL::Module::Provisioning);
+
+=head1 DESCRIPTION
+
+ Needs to be written.
+
+=cut
+
+##############################################################################
+package VCL::Module::Provisioning;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/../..";
+
+# Configure inheritance
+use base qw(VCL::Module);
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use VCL::utils;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+1;
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+
+=cut
diff --git a/managementnode/lib/VCL/Module/Provisioning/Lab.pm b/managementnode/lib/VCL/Module/Provisioning/Lab.pm
new file mode 100644
index 0000000..bc2c226
--- /dev/null
+++ b/managementnode/lib/VCL/Module/Provisioning/Lab.pm
@@ -0,0 +1,311 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: Lab.pm 1953 2008-12-12 14:23:17Z arkurth $
+##############################################################################
+
+=head1 NAME
+
+VCL::Provisioning::Lab - VCL module to support povisioning of lab machines
+
+=head1 SYNOPSIS
+
+ Needs to be written
+
+=head1 DESCRIPTION
+
+ This module provides...
+
+=cut
+
+##############################################################################
+package VCL::Module::Provisioning::Lab;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/../../..";
+
+# Configure inheritance
+use base qw(VCL::Module::Provisioning);
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use VCL::utils;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 initialize
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub initialize {
+ my $self = shift;
+ my $request_id = $self->data->get_request_id();
+ my $reservation_id = $self->data->get_reservation_id();
+ my $reservation_is_parent = $self->data->is_parent_reservation;
+ my $request_check_time = $self->data->get_request_check_time();
+ my $computer_id = $self->data->get_computer_id();
+
+ notify($ERRORS{'OK'}, 0, "initializing Lab module, computer id: $computer_id, is parent reservation: $reservation_is_parent");
+
+ # Check if this is a preload request
+ # Nothing needs to be done for lab preloads
+ if ($request_check_time eq 'preload') {
+ notify($ERRORS{'OK'}, 0, "check_time result is $request_check_time, nothing needs to be done for lab preloads");
+
+ insertloadlog($reservation_id, $computer_id, "info", "lab preload does not need to be processed");
+
+ # Only the parent reservation should update the preload flag
+ if ($reservation_is_parent) {
+ # Set the preload flag back to 1 so it will be processed again
+ if (update_preload_flag($request_id, 1)) {
+ notify($ERRORS{'OK'}, 0, "parent reservation: updated preload flag to 1");
+ insertloadlog($reservation_id, $computer_id, "info", "request preload flag updated to 1");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "parent reservation: failed to update preload flag to 1");
+ insertloadlog($reservation_id, $computer_id, "info", "failed to update request preload flag to 1");
+ }
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "child reservation: request preload flag will be changed by the parent reservation");
+ }
+ notify($ERRORS{'OK'}, 0, "preload lab reservation process exiting");
+ exit;
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "check_time result is $request_check_time, reservation will be processed");
+ }
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 node_status
+
+ Parameters : [0]: computer node name (optional)
+ [1]: log file path (optional)
+ Returns : Depends on the context which node_status was called:
+ default: string containing "READY" or "FAIL"
+ boolean: true if ping, SSH, and VCL client checks are successful
+ false if any checks fail
+ list: array, values are 1 for SUCCESS, 0 for FAIL
+ [0]: Node status ("READY" or "FAIL")
+ [1]: Ping status (0 or 1)
+ [2]: SSH status (0 or 1)
+ [3]: VCL client daemon status (0 ir 1)
+ arrayref: reference to array described above
+ hashref: reference to hash with keys/values:
+ {status} => <"READY","FAIL">
+ {ping} => <0,1>
+ {ssh} => <0,1>
+ {vcl_client} => <0,1>
+ Description : Checks the status of a lab machine. Checks if the machine is
+ pingable, can be accessed via SSH, and the VCL client is running.
+
+=cut
+
+sub node_status {
+ my $self = shift;
+ my ($computer_node_name, $log);
+
+ my ($management_node_os_name, $management_node_keys, $computer_host_name, $computer_short_name, $computer_ip_address, $image_os_name);
+
+ # Check if subroutine was called as a class method
+ if (ref($self) !~ /lab/i) {
+ #$cidhash->{hostname}, $cidhash->{OSname}, $cidhash->{MNos}, $cidhash->{IPaddress}, $identity, $LOG)
+ $computer_node_name = $self;
+ $image_os_name = shift;
+ $management_node_os_name = shift;
+ $computer_ip_address = shift;
+ $management_node_keys = shift;
+ $log = shift;
+
+ $log = 0 if !$log;
+ $computer_short_name = $1 if ($computer_node_name =~ /([-_a-zA-Z0-9]*)(\.?)/);
+ } ## end if (ref($self) !~ /lab/i)
+ else {
+ # Get the computer name from the DataStructure
+ $computer_node_name = $self->data->get_computer_node_name();
+
+ # Check if this was called as a class method, but a node name was also specified as an argument
+ my $node_name_argument = shift;
+ $computer_node_name = $node_name_argument if $node_name_argument;
+ $management_node_os_name = $self->data->get_management_node_os_name();
+ $management_node_keys = $self->data->get_management_node_keys();
+ $computer_host_name = $self->data->get_computer_host_name();
+ $computer_short_name = $self->data->get_computer_short_name();
+ $computer_ip_address = $self->data->get_computer_ip_address();
+ $image_os_name = $self->data->get_image_os_name();
+ $log = 0;
+ } ## end else [ if (ref($self) !~ /lab/i)
+
+ notify($ERRORS{'OK'}, $log, "computer_short_name= $computer_short_name ");
+ notify($ERRORS{'OK'}, $log, "computer_node_name= $computer_node_name ");
+ notify($ERRORS{'OK'}, $log, "image_os_name= $image_os_name");
+ notify($ERRORS{'OK'}, $log, "management_node_os_name= $management_node_os_name");
+ notify($ERRORS{'OK'}, $log, "computer_ip_address= $computer_ip_address");
+ notify($ERRORS{'OK'}, $log, "management_node_keys= $management_node_keys");
+
+
+ # Check the node name variable
+ if (!$computer_node_name) {
+ notify($ERRORS{'WARNING'}, 0, "node name could not be determined");
+ return 0;
+ }
+ notify($ERRORS{'DEBUG'}, $log, "checking status of node: $computer_node_name");
+
+ $computer_host_name = $computer_node_name;
+
+ # Create a hash to store status components
+ my %status;
+
+ # Initialize all hash keys here to make sure they're defined
+ $status{status} = 0;
+ $status{ping} = 0;
+ $status{ssh} = 0;
+ $status{vcl_client} = 0;
+
+ # Check if host is listed in management node's known_hosts file
+ notify($ERRORS{'DEBUG'}, $log, "checking if $computer_host_name in management node known_hosts file");
+ if (known_hosts($computer_host_name, $management_node_os_name, $computer_ip_address)) {
+ notify($ERRORS{'OK'}, $log, "$computer_host_name public key added to management node known_hosts file");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, $log, "failed to add $computer_host_name public key to management node known_hosts");
+ }
+
+
+ # Check if node is pingable
+ notify($ERRORS{'DEBUG'}, $log, "checking if $computer_ip_address is pingable");
+ if (_pingnode($computer_ip_address)) {
+ notify($ERRORS{'OK'}, $log, "$computer_ip_address is pingable");
+ $status{ping} = 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, $log, "$computer_ip_address is not pingable");
+ $status{ping} = 0;
+ }
+
+
+ # Check if sshd is open on the admin port (24)
+ notify($ERRORS{'DEBUG'}, $log, "checking if $computer_ip_address sshd admin port 24 is accessible");
+ if (check_ssh($computer_ip_address, 24, $log)) {
+ notify($ERRORS{'OK'}, $log, "$computer_ip_address admin sshd port 24 is accessible");
+
+ # Run uname -n to make sure ssh is usable
+ notify($ERRORS{'OK'}, $log, "checking if ssh command can be run on $computer_ip_address");
+ my ($uname_exit_status, $uname_output) = run_ssh_command($computer_ip_address, $management_node_keys, "uname -n", "vclstaff", 24);
+ if (!defined($uname_output) || !$uname_output) {
+ notify($ERRORS{'WARNING'}, $log, "unable to run 'uname -n' ssh command on $computer_ip_address");
+ $status{ssh} = 0;
+ }
+ else {
+ notify($ERRORS{'OK'}, $log, "successfully ran 'uname -n' ssh command on $computer_ip_address");
+ $status{ssh} = 1;
+ }
+
+ ## Check the uname -n output lines, make sure computer name is listed
+ #if (grep /$computer_short_name/, @{$uname_output}) {
+ # notify($ERRORS{'OK'}, $log, "found computer name in ssh 'uname -n' output");
+ # #$status{ssh} = 1;
+ #}
+ #else {
+ # my $uname_output_string = join("\n", @{$uname_output});
+ # notify($ERRORS{'WARNING'}, $log, "unable to find computer name in ssh 'uname -n' output output:\n$uname_output_string");
+ # #$status{ssh} = 0;
+ #}
+
+ # Check if is VCL client daemon is running
+ notify($ERRORS{'OK'}, $log, "checking if VCL client daemon is running on $computer_ip_address");
+ my ($pgrep_exit_status, $pgrep_output) = run_ssh_command($computer_ip_address, $management_node_keys, "pgrep vclclient", "vclstaff", 24);
+ if (!defined($pgrep_output) || !$pgrep_output) {
+ notify($ERRORS{'WARNING'}, $log, "unable to run 'pgrep vclclient' command on $computer_ip_address");
+ $status{vcl_client} = 0;
+ }
+
+ # Check the pgrep output lines, make sure process is listed
+ if (grep /[0-9]+/, @{$pgrep_output}) {
+ notify($ERRORS{'DEBUG'}, $log, "VCL client daemon is running");
+ $status{vcl_client} = 1;
+ }
+ else {
+ my $pgrep_output_string = join("\n", @{$pgrep_output});
+ notify($ERRORS{'WARNING'}, $log, "VCL client daemon is not running, unable to find running process in 'pgrep vclclient' output:\n$pgrep_output_string");
+ $status{vcl_client} = 0;
+ }
+ } ## end if (check_ssh($computer_ip_address, 24, $log...
+ else {
+ notify($ERRORS{'WARNING'}, $log, "$computer_ip_address sshd admin port 24 is not accessible");
+ $status{ssh} = 0;
+ $status{vcl_client} = 0;
+ }
+
+ # Determine the overall machine status based on the individual status results
+ if ($status{ping} && $status{ssh} && $status{vcl_client}) {
+ $status{status} = 'READY';
+ }
+ else {
+ # Lab machine is not available, return undefined to indicate error occurred
+ notify($ERRORS{'WARNING'}, 0, "lab machine $computer_host_name ($computer_ip_address) is not available");
+ return;
+ }
+
+ notify($ERRORS{'OK'}, 0, "returning node status hash reference with {status}=$status{status}");
+ return \%status;
+} ## end sub node_status
+
+1;
+
+#/////////////////////////////////////////////////////////////////////////////
+
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+
+=cut
diff --git a/managementnode/lib/VCL/Module/Provisioning/vmware.pm b/managementnode/lib/VCL/Module/Provisioning/vmware.pm
new file mode 100644
index 0000000..f0e8ab0
--- /dev/null
+++ b/managementnode/lib/VCL/Module/Provisioning/vmware.pm
@@ -0,0 +1,2400 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: vmware.pm 1953 2008-12-12 14:23:17Z arkurth $
+##############################################################################
+
+=head1 NAME
+
+VCL::Provisioning::vmware - VCL module to support the vmware provisioning engine
+
+=head1 SYNOPSIS
+
+ Needs to be written
+
+=head1 DESCRIPTION
+
+ This module provides VCL support for vmware server
+ http://www.vmware.com
+
+=cut
+
+##############################################################################
+package VCL::Module::Provisioning::vmware;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/../../..";
+
+# Configure inheritance
+use base qw(VCL::Module::Provisioning);
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use VCL::utils;
+use Fcntl qw(:DEFAULT :flock);
+
+##############################################################################
+
+=head1 CLASS ATTRIBUTES
+
+=cut
+
+=head2 %VMWARE_CONFIG
+
+ Data type : hash
+ Description : %VMWARE_CONFIG is a hash containing the general VMWARE configuration
+ for the management node this code is running on. Since the data is
+ the same for every instance of the VMWARE class, a class attribute
+ is used and the hash is shared among all instances. This also
+ means that the data only needs to be retrieved from the database
+ once.
+
+=cut
+
+#my %VMWARE_CONFIG;
+
+# Class attributes to store VMWWARE configuration details
+# This data also resides in the %VMWARE_CONFIG hash
+# Extract hash data to scalars for ease of use
+my $IMAGE_LIB_ENABLE = $IMAGELIBENABLE;
+my $IMAGE_LIB_USER = $IMAGELIBUSER;
+my $IMAGE_LIB_KEY = $IMAGELIBKEY;
+my $IMAGE_LIB_SERVERS = $IMAGESERVERS;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 initialize
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub initialize {
+ notify($ERRORS{'DEBUG'}, 0, "vmware module initialized");
+ return 1;
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 provision
+
+ Parameters : hash
+ Returns : 1(success) or 0(failure)
+ Description : loads node with provided image
+
+=cut
+
+sub load {
+ my $self = shift;
+ if (ref($self) !~ /vmware/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+ return 0;
+ }
+
+ my $request_data = shift;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # preform cleanup
+ if ($self->control_VM("remove")) {
+ }
+
+ # Store some hash variables into local variables
+ my $request_id = $self->data->get_request_id;
+ my $reservation_id = $self->data->get_reservation_id;
+ my $persistent = $self->data->get_request_forimaging;
+
+ my $image_id = $self->data->get_image_id;
+ my $image_os_name = $self->data->get_image_os_name;
+ my $image_identity = $self->data->get_image_identity;
+ my $image_os_type = $self->data->get_image_os_type;
+
+ my $vmclient_computerid = $self->data->get_computer_id;
+ my $computer_shortname = $self->data->get_computer_short_name;
+ my $computer_nodename = $computer_shortname;
+ my $computer_hostname = $self->data->get_computer_hostname;
+ my $computer_type = $self->data->get_computer_type;
+
+ my $vmtype_name = $self->data->get_vmhost_type_name;
+ my $vmhost_vmpath = $self->data->get_vmhost_profile_vmpath;
+ my $vmprofile_vmdisk = $self->data->get_vmhost_profile_vmdisk;
+ my $datastorepath = $self->data->get_vmhost_profile_datastore_path;
+ my $datastorepath4vmx = $self->data->get_vmhost_profile_datastorepath_4vmx;
+ my $virtualswitch0 = $self->data->get_vmhost_profile_virtualswitch0;
+ my $virtualswitch1 = $self->data->get_vmhost_profile_virtualswitch1;
+ my $vmtype = $vmtype_name;
+
+ my $requestedimagename = $self->data->get_image_name;
+ my $shortname = $computer_shortname;
+
+ my $vmhost_imagename = $self->data->get_vmhost_image_name;
+ my $vmhost_hostname = $self->data->get_vmhost_hostname;
+ my $host_type = $self->data->get_vmhost_type;
+ my $project = $self->data->get_image_project;
+ my $vmclient_eth0MAC = $self->data->get_computer_eth0_mac_address;
+ my $vmclient_eth1MAC = $self->data->get_computer_eth1_mac_address;
+ my $vmclient_imageminram = $self->data->get_image_minram;
+ my $vmhost_RAM = $self->data->get_vmhost_ram;
+ my $vmclient_drivetype = $self->data->get_computer_drive_type;
+ my $vmclient_privateIPaddress = $self->data->get_computer_ip_address;
+ my $vmclient_publicIPaddress = $self->data->get_computer_private_ip_address;
+ my $vmclient_OSname = $self->data->get_image_os_name;
+ # Assemble a consistent prefix for notify messages
+ my $notify_prefix = "req=$request_id, res=$reservation_id:";
+
+ #$VMWARErepository
+ #if (!($vm{vmhost}{ok})) {
+ #not ok to proceed
+ #do we need to provide another resource?
+ #fill in code to submit a request for another vmhost
+ #}
+ my @sshcmd;
+
+ insertloadlog($reservation_id, $vmclient_computerid, "startload", "$computer_shortname $requestedimagename");
+ my $starttime = convert_to_epoch_seconds;
+ #proceed
+ #$vm{"vmclient"}{"project"} = "vcl" if (!defined($vm{"vmclient"}{"project"}));
+
+
+ my ($hostnode, $identity);
+ if ($host_type eq "blade") {
+ $hostnode = $1 if ($vmhost_hostname =~ /([-_a-zA-Z0-9]*)(\.?)/);
+ $identity = $IDENTITY_bladerhel if ($vmhost_imagename =~ /^(rh[0-9]image|rhel[0-9]|fc[0-9]image|rhfc[0-9]|rhas[0-9]|esx[0-9]*)/);
+
+ # assign2project is only for blades - and not all blades
+ #if (VCL::Module::Provisioning::xCAT::_assign2project($hostnode, $project)) {
+ # notify($ERRORS{'OK'}, 0, "$hostnode assign2project return successful");
+ #}
+ #else {
+ # notify($ERRORS{'CRITICAL'}, 0, "$hostnode could not assign2project to $project");
+ # #return to get another machine
+ # return 0;
+ #}
+ } ## end if ($host_type eq "blade")
+ else {
+ #using FQHN
+ $hostnode = $vmhost_hostname;
+ $identity = $IDENTITY_linux_lab if ($vmhost_imagename =~ /^(realmrhel)/);
+ }
+
+ if (!(defined($identity))) {
+ notify($ERRORS{'CRITICAL'}, 0, "identity variiable not definted, setting to blade identity file vmhost variable set to $vmhost_imagename");
+ $identity = $IDENTITY_bladerhel;
+ }
+
+ notify($ERRORS{'OK'}, 0, "identity file set $identity vmhost imagename $vmhost_imagename bladekey $IDENTITY_bladerhel");
+ #setup flags
+ my $baseexists = 0;
+ my $dirstructure = 0;
+
+ #for convienence
+ my ($myimagename, $myvmx, $myvmdir, $mybasedirname, $requestedimagenamebase);
+ if ($persistent) {
+ #either in imaging mode or special use
+ $myvmdir = "$reservation_id$computer_shortname";
+ $myvmx = "$vmhost_vmpath/$reservation_id$computer_shortname/$reservation_id$computer_shortname.vmx";
+ $mybasedirname = "$reservation_id$computer_shortname";
+
+ #if GSX use requested imagename
+ $myimagename = $requestedimagename if ($vmtype =~ /(vmware|vmwareGSX)$/);
+ #if ESX use requestid+shortname
+ $myimagename = "$reservation_id$computer_shortname" if ($vmtype =~ /(vmwareESX3)/);
+
+ #base directory should not exist for image creation
+ } ## end if ($persistent)
+ else {
+ #standard use
+ $myvmdir = "$requestedimagename$computer_shortname";
+ $myvmx = "$vmhost_vmpath/$requestedimagename$computer_shortname/$requestedimagename$computer_shortname.vmx";
+ $mybasedirname = $requestedimagename;
+ $myimagename = $requestedimagename;
+ }
+
+ notify($ERRORS{'DEBUG'}, 0, "persistent= $persistent");
+ notify($ERRORS{'DEBUG'}, 0, "myvmdir= $myvmdir");
+ notify($ERRORS{'DEBUG'}, 0, "myvmx= $myvmx");
+ notify($ERRORS{'DEBUG'}, 0, "mybasedirname= $mybasedirname");
+ notify($ERRORS{'DEBUG'}, 0, "myimagename= $myimagename");
+
+ #does the requested base vmware image files already existed on the vmhost
+ notify($ERRORS{'OK'}, 0, "checking for base image $myvmdir on $hostnode ");
+ insertloadlog($reservation_id, $vmclient_computerid, "vmround1", "checking host for requested image files");
+
+ #check for lock file - another process might be copying the same image files to the same host server
+ my $tmplockfile = "/tmp/$hostnode" . "$requestedimagename" . "lock";
+ notify($ERRORS{'OK'}, 0, "trying to create exclusive lock on $tmplockfile while checking if image files exist on host");
+ if (sysopen(TMPLOCK, $tmplockfile, O_RDONLY | O_CREAT)) {
+ if (flock(TMPLOCK, LOCK_EX)) {
+ notify($ERRORS{'OK'}, 0, "owning exclusive lock on $tmplockfile");
+ notify($ERRORS{'OK'}, 0, "listing datestore $datastorepath ");
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($hostnode, $identity, "ls -1 $datastorepath", "root");
+ notify($ERRORS{'OK'}, 0, "@{ $sshcmd[1] }");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /denied|No such/) {
+ notify($ERRORS{'CRITICAL'}, 0, "node $hostnode output @{ $sshcmd[1] }");
+ insertloadlog($reservation_id, $vmclient_computerid, "failed", "could not log into vmhost $hostnode @{ $sshcmd[1] }");
+ close(TMPLOCK);
+ unlink($tmplockfile);
+ return 0;
+ }
+ if ($l =~ /Warning: Permanently/) {
+ #ignore
+ }
+ if ($l =~ /(\s*?)$mybasedirname$/) {
+ notify($ERRORS{'OK'}, 0, "base image exists");
+ $baseexists = 1;
+ }
+ #For persistent images - we rename the mybasedirname
+ #If base really does exists and not inuse just rename directory for localdisk
+ if ($l =~ /(\s*?)$requestedimagename$/) {
+ notify($ERRORS{'OK'}, 0, "requestedimagenamebase image exists") if ($persistent);
+ $requestedimagenamebase = 1;
+ }
+ if ($l eq "$myvmdir") {
+ notify($ERRORS{'OK'}, 0, "directory structure $myvmdir image exists");
+ $dirstructure = 1;
+ }
+ } ## end foreach my $l (@{$sshcmd[1]})
+
+ if ($requestedimagenamebase && $persistent) {
+ notify($ERRORS{'DEBUG'}, 0, "requestedimagenamebase and persistent are both true, attempting to detect status for move of base image instead of full copy");
+ #Confirm base is not inuse then simply rename the directory to match our needs
+ my $okforMOVE = 0;
+ my @sshcmd = run_ssh_command($hostnode, $identity, "vmware-cmd -l", "root");
+ foreach my $vm (@{$sshcmd[1]}) {
+ chomp($vm);
+ next if ($vm =~ /Warning:/);
+ notify($ERRORS{'OK'}, 0, "$vm");
+ if ($vm =~ /(.*)(\/)(.*)(\/)($requestedimagename[-_a-zA-Z0-9]*.vmx)/) {
+ # do within this loop in case there is more than one
+ my $localmyvmx = "$1/$3/$5";
+ my $localmyvmdir = "$1/$3";
+ $localmyvmx =~ s/(\s+)/\\ /g;
+ $localmyvmdir =~ s/(\s+)/\\ /g;
+
+ notify($ERRORS{'OK'}, 0, "my vmx $localmyvmx");
+ my @sshcmd_1 = run_ssh_command($hostnode, $identity, "vmware-cmd $localmyvmx getstate");
+ foreach my $l (@{$sshcmd_1[1]}) {
+ if ($l =~ /= off/) {
+ #Good
+ $okforMOVE = 1;
+ }
+ elsif ($l =~ /= on/) {
+ $baseexists = 0;
+ }
+ }
+
+ } ## end if ($vm =~ /(.*)(\/)(.*)(\/)($requestedimagename[-_a-zA-Z0-9]*.vmx)/)
+ } ## end foreach my $vm (@{$sshcmd[1]})
+ if ($okforMOVE) {
+ #use the mv command to rename the directory of the base image files
+ notify($ERRORS{'DEBUG'}, 0, "simulating move of directory cmd= mv $vmhost_vmpath/$requestedimagename $myvmdir");
+
+ }
+
+ } ## end if ($requestedimagenamebase && $persistent)
+ if (!($baseexists)) {
+ #check available disk space -- clean up if needed
+ #copy vm files from local repository to vmhost
+ #this could take a few minutes
+ #get size of vmdl files
+
+ insertloadlog($reservation_id, $vmclient_computerid, "info", "image files do not exist on host server, preparing to copy");
+ my $myvmdkfilesize = 0;
+ if (open(SIZE, "du -k $VMWAREREPOSITORY/$requestedimagename 2>&1 |")) {
+ my @du = <SIZE>;
+ close(SIZE);
+ foreach my $d (@du) {
+ if ($d =~ /No such file or directory/) {
+ insertloadlog($reservation_id, $vmclient_computerid, "failed", "could not collect size of local image files");
+ notify($ERRORS{'CRITICAL'}, 0, "problem checking local vm file size on $VMWAREREPOSITORY/$requestedimagename");
+ close(TMPLOCK);
+ unlink($tmplockfile);
+ return 0;
+ }
+ if ($d =~ /^([0-9]*)/) {
+ $myvmdkfilesize += $1;
+ }
+ } ## end foreach my $d (@du)
+ } ## end if (open(SIZE, "du -k $VMWAREREPOSITORY/$requestedimagename 2>&1 |"...
+
+ notify($ERRORS{'DEBUG'}, 0, "file size $myvmdkfilesize of $requestedimagename");
+ notify($ERRORS{'OK'}, 0, "checking space on $hostnode $vmhost_vmpath");
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($hostnode, $identity, "df -k $vmhost_vmpath", "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ next if ($l =~ /Warning: Permanently/);
+ next if ($l =~ /^Filesystem/);
+ if ($l =~ /\/dev\//) {
+ #in k blocks
+ my ($d, $s, $u, $a, $p, $m) = split(" ", $l);
+ notify($ERRORS{'OK'}, 0, "datastore space available on remote machine $a ");
+ #lets give ourselves at least double what the image needs for some buffer
+ if ($a < ($myvmdkfilesize * 1.5)) {
+ #free up space if possible only if $vm{vmhost}{vmware_disk} eq "localdisk"
+ if ($vmprofile_vmdisk eq "localdisk") {
+ notify($ERRORS{'OK'}, 0, "detected space issue on $hostnode, attempting to free up space");
+ #remove stuff
+ my %vmlist = ();
+ my @sshcmd_1 = run_ssh_command($hostnode, $identity, "vmware-cmd -l", "root");
+ my $i;
+ foreach my $r (@{$sshcmd_1[1]}) {
+ $i++;
+ next if ($r =~ /^Warning: /);
+ #if($r =~ /\/var\/lib\/vmware/){
+ if ($r =~ /.vmx/) {
+ chomp($r);
+ notify($ERRORS{'OK'}, 0, "disk cleanup - pushing $r on array");
+ $vmlist{$i}{"path"} = $r;
+ }
+ } ## end foreach my $r (@{$sshcmd_1[1]})
+
+ foreach my $v (keys %vmlist) {
+ #handle any spaces in the path
+ $vmlist{$v}{path} =~ s/(\s+)/\\\\ /g;
+ my @sshcmd_2 = run_ssh_command($hostnode, $identity, "vmware-cmd -q $vmlist{$v}{path} getstate", "root");
+ foreach $a (@{$sshcmd_2[1]}) {
+ next if ($a =~ /^Warning: /);
+ chomp($a);
+ if ($a =~ /^on/i) {
+ $vmlist{$v}{"state"} = $a;
+ }
+ }
+ } ## end foreach my $v (keys %vmlist)
+ notify($ERRORS{'OK'}, 0, "ls datastorepath $datastorepath ");
+ my @sshcmd_3 = run_ssh_command($hostnode, $identity, "ls -1 $datastorepath", "root");
+ foreach my $d (@{$sshcmd_3[1]}) {
+ next if ($d =~ /Warning: /);
+ chomp($d);
+ my $save = 0;
+ foreach my $v (%vmlist) {
+ #print "checking if $d is part of a running vm of $v\n";
+ if ($vmlist{$v}{path} =~ /$d/) {
+ if ($vmlist{$v}{state} eq "on") {
+ $save = 1;
+ }
+ elsif ($vmlist{$v}{state} eq "off") {
+ $save = 0;
+ if (defined(run_ssh_command($hostnode, $identity, "vmware-cmd -s unregister $vmlist{$v}{path}", "root"))) {
+ notify($ERRORS{'DEBUG'}, 0, "unregistered $vmlist{$v}{path}");
+ }
+ }
+ else {
+ notify($ERRORS{'DEBUG'}, 0, "$vmlist{$v}{path} is in strange state $vmlist{$v}{state}");
+ }
+ } ## end if ($vmlist{$v}{path} =~ /$d/)
+ } ## end foreach my $v (%vmlist)
+ if ($save) {
+ notify($ERRORS{'OK'}, 0, "disk cleanup - SAVING $datastorepath/$d");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "disk cleanup - REMOVING $datastorepath/$d");
+ if (defined(run_ssh_command($hostnode, $identity, "/bin/rm -rf $datastorepath/$d\*", "root"))) {
+ notify($ERRORS{'DEBUG'}, 0, "disk cleanup - REMOVED $datastorepath/$d\*");
+ }
+ } #else not save
+ } #foreach vmdir
+ } #locadisk,
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "detected space issues from $hostnode this management node is configured to use network storage, not removing any data");
+ return 0;
+ }
+ } #start myvmdkfilesize comparsion
+ } # start if /dev
+ } # start foreach df -k
+ if ($vmprofile_vmdisk eq "localdisk") {
+ notify($ERRORS{'OK'}, 0, "copying base image files $requestedimagename to $hostnode");
+ if (run_scp_command("$VMWAREREPOSITORY/$requestedimagename", "$hostnode:\"$datastorepath/$mybasedirname\"", $identity)) {
+ #recheck host server for files - the scp output is not being captured
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($hostnode, $identity, "ls -1 $datastorepath", "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /denied|No such/) {
+ notify($ERRORS{'CRITICAL'}, 0, "node $hostnode output @{ $sshcmd[1] }");
+ insertloadlog($reservation_id, $vmclient_computerid, "failed", "could not log into vmhost $hostnode @{ $sshcmd[1] }");
+ close(TMPLOCK);
+ unlink($tmplockfile);
+ return 0;
+ }
+ if ($l =~ /(\s*?)$mybasedirname$/) {
+ notify($ERRORS{'OK'}, 0, "base image exists");
+ $baseexists = 1;
+ insertloadlog($reservation_id, $vmclient_computerid, "transfervm", "copying base image files");
+ }
+ } ## end foreach my $l (@{$sshcmd[1]})
+
+ } ## end if (run_scp_command("$VMWAREREPOSITORY/$requestedimagename"...
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "problems scp vm files to $hostnode $!");
+ close(TMPLOCK);
+ unlink($tmplockfile);
+ return 0;
+ }
+ } ## end if ($vmprofile_vmdisk eq "localdisk")
+ elsif ($vmprofile_vmdisk eq "networkdisk") {
+ if ($persistent) {
+ #imaging mode -
+ my $srcDisk = "$datastorepath/$requestedimagename/$requestedimagename" . ".vmdk";
+ my $dstDisk = "$datastorepath/$mybasedirname/$myimagename" . ".vmdk";
+ my $dstDir = "$datastorepath/$mybasedirname";
+
+ #create a clone -
+ if (_vmwareclone($hostnode, $identity, $srcDisk, $dstDisk, $dstDir)) {
+ $baseexists = 1;
+ insertloadlog($reservation_id, $vmclient_computerid, "transfervm", "cloning base image files");
+ }
+ else {
+ insertloadlog($reservation_id, $vmclient_computerid, "failed", "cloning base image failed");
+ notify($ERRORS{'CRITICAL'}, 0, "problem cloning failed $srcDisk to $dstDisk");
+ close(TMPLOCK);
+ unlink($tmplockfile);
+ return 0;
+ }
+ } ## end if ($persistent)
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "problems vmware disk set to network disk can not find image in $datastorepath");
+ close(TMPLOCK);
+ unlink($tmplockfile);
+ return 0;
+ }
+ } ## end elsif ($vmprofile_vmdisk eq "networkdisk") [ if ($vmprofile_vmdisk eq "localdisk")
+ notify($ERRORS{'OK'}, 0, "confirm image exist process complete removing lock on $tmplockfile");
+ close(TMPLOCK);
+ unlink($tmplockfile);
+
+ } # start if base not exists
+ else {
+ #base exists
+ notify($ERRORS{'OK'}, 0, "confirm image exist process complete removing lock on $tmplockfile");
+ close(TMPLOCK);
+ unlink($tmplockfile);
+ }
+ } #flock
+ } #sysopen
+ #ok good base vm files exist on hostnode
+ #if guest dirstructure exists check state of vm, else create sturcture and new vmx file
+ if (($dirstructure)) {
+ #clean-up
+ #make sure vm is off, it should be
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($hostnode, $identity, "vmware-cmd $myvmx getstate", "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /= off/) {
+ #good
+ }
+ elsif ($l =~ /= on/) {
+ my @sshcmd_1 = run_ssh_command($hostnode, $identity, "vmware-cmd $myvmx stop hard", "root");
+ foreach my $a (@{$sshcmd_1[1]}) {
+ next if ($a =~ /Warning:/);
+ if ($a =~ /= 1/) {
+ #turn off or killpid -- of course it should be off by this point but kill
+ }
+ else {
+ # FIX-ME add better error checking
+ notify($ERRORS{'OK'}, 0, "@{ $sshcmd[1] }");
+ }
+ } ## end foreach my $a (@{$sshcmd_1[1]})
+ } ## end elsif ($l =~ /= on/) [ if ($l =~ /= off/)
+ } ## end foreach my $l (@{$sshcmd[1]})
+ #if registered - unregister vm
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($hostnode, $identity, "vmware-cmd -s unregister $myvmx", "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /No such virtual machine/) {
+ #not registered
+ notify($ERRORS{'OK'}, 0, "vm $myvmx not registered");
+ }
+ if ($l =~ /= 1/) {
+ notify($ERRORS{'OK'}, 0, "vm $myvmx unregistered");
+ }
+ }
+ #delete directory -- clean slate
+ # if in persistent mode - imaging or otherwise we may not want to rm this directory
+ if (defined(run_ssh_command($hostnode, $identity, "/bin/rm -rf $vmhost_vmpath/$myvmdir", "root"))) {
+ notify($ERRORS{'OK'}, 0, "success rm -rf $vmhost_vmpath/$myvmdir on $hostnode ");
+ }
+
+ } ## end if (($dirstructure))
+
+ #setup new vmx file and directory for this request
+ #create local directory
+ #customize a vmx file
+ # copy to vmhost
+ # unlink local directory
+ if (open(MKDIR, "/bin/mkdir /tmp/$myvmdir 2>&1 |")) {
+ my @a = <MKDIR>;
+ close(MKDIR);
+ for my $l (@a) {
+ notify($ERRORS{'OK'}, 0, "possible error @a");
+ }
+ notify($ERRORS{'OK'}, 0, "created tmp directory /tmp/$myvmdir");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "could not create tmp directory $myvmdir $!");
+ }
+
+ #check for dependent settings ethX
+ if (!(defined($vmclient_eth0MAC))) {
+ #complain
+ notify($ERRORS{'CRITICAL'}, 0, "eth0MAC is not defined for $computer_shortname can not continue");
+ insertloadlog($reservation_id, $vmclient_computerid, "failed", "eth0MAC address is not defined");
+ return 0;
+
+ }
+
+ #check for memory settings
+ my $dynamicmemvalue = "512";
+ if (defined($vmclient_imageminram)) {
+ #preform some sanity check
+ if (($dynamicmemvalue < $vmclient_imageminram) && ($vmclient_imageminram < $vmhost_RAM)) {
+ $dynamicmemvalue = $vmclient_imageminram;
+ notify($ERRORS{'OK'}, 0, "setting memory to $dynamicmemvalue");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "image memory value $vmclient_imageminram out of the expected range in host machine $vmhost_RAM setting to 512");
+ }
+ } ## end if (defined($vmclient_imageminram))
+ my $adapter = "ide";
+ # database could be out of date
+ if ($vmclient_drivetype =~ /hda/) {
+ $adapter = "ide";
+ notify($ERRORS{'OK'}, 0, "hda flag set, setting adapter to ide");
+ }
+ elsif ($vmclient_drivetype =~ /sda/) {
+ $adapter = "buslogic";
+ notify($ERRORS{'OK'}, 0, "sda flag set, setting adapter to buslogic");
+ }
+
+ my $listedadapter = 0;
+ #scan vmdk file
+ if (open(RE, "grep adapterType $VMWAREREPOSITORY/$requestedimagename/$requestedimagename.vmdk 2>&1 |")) {
+ my @LIST = <RE>;
+ close(RE);
+ foreach my $a (@LIST) {
+ if ($a =~ /(ide|buslogic|lsilogic)/) {
+ $listedadapter = $1;
+ notify($ERRORS{'OK'}, 0, "listedadapter= $1 ");
+ }
+ }
+ } ## end if (open(RE, "grep adapterType $VMWAREREPOSITORY/$requestedimagename/$requestedimagename.vmdk 2>&1 |"...
+
+ if ($listedadapter) {
+ $adapter = $listedadapter;
+ }
+
+ notify($ERRORS{'OK'}, 0, "adapter= $adapter drivetype $vmclient_drivetype");
+ my $guestOS;
+ $guestOS = "winxppro" if ($requestedimagename =~ /(winxp)/i);
+ $guestOS = "win2003" if ($requestedimagename =~ /(win2003)/i);
+ $guestOS = "ubuntu" if ($requestedimagename =~ /(ubuntu)/i);
+
+
+ my @vmxfile;
+ my $tmpfile = "/tmp/$myvmdir/$myvmdir.vmx";
+ my $tmpdir = "/tmp/$myvmdir";
+
+ push(@vmxfile, "#!/usr/bin/vmware\n");
+ push(@vmxfile, "config.version = \"8\"\n");
+ push(@vmxfile, "virtualHW.version = \"4\"\n");
+ push(@vmxfile, "memsize = \"$dynamicmemvalue\"\n");
+ push(@vmxfile, "displayName = \"$myvmdir\"\n");
+ push(@vmxfile, "guestOS = \"$guestOS\"\n");
+ push(@vmxfile, "uuid.location = \"56 4d 25 b7 07 18 f4 b6-25 d1 77 1e 10 bd 9e 99\"\n");
+ push(@vmxfile, "uuid.bios = \"56 4d a8 df fb 38 d0 c5-25 73 d4 01 16 06 4e c0\"\n");
+ push(@vmxfile, "Ethernet0.present = \"TRUE\"\n");
+ push(@vmxfile, "Ethernet1.present = \"TRUE\"\n");
+
+ if ($vmtype eq "vmwareESX3") {
+ push(@vmxfile, "Ethernet0.networkName = \"$virtualswitch0\"\n");
+ push(@vmxfile, "Ethernet1.networkName = \"$virtualswitch1\"\n");
+ push(@vmxfile, "ethernet0.wakeOnPcktRcv = \"false\"\n");
+ push(@vmxfile, "ethernet1.wakeOnPcktRcv = \"false\"\n");
+ }
+ elsif ($vmtype =~ /freeserver|gsx|vmwareGSX/) {
+ push(@vmxfile, "Ethernet1.connectionType = \"custom\"\n");
+ push(@vmxfile, "Ethernet1.vnet = \"$virtualswitch1\"\n");
+ }
+
+ push(@vmxfile, "ethernet0.address = \"$vmclient_eth0MAC\"\n");
+ push(@vmxfile, "ethernet1.address = \"$vmclient_eth1MAC\"\n");
+ push(@vmxfile, "ethernet0.addressType = \"static\"\n");
+ push(@vmxfile, "ethernet1.addressType = \"static\"\n");
+ push(@vmxfile, "gui.exitOnCLIHLT = \"FALSE\"\n");
+ push(@vmxfile, "uuid.action = \"keep\"\n");
+ push(@vmxfile, "snapshot.disabled = \"TRUE\"\n");
+ push(@vmxfile, "floppy0.present = \"FALSE\"\n");
+ push(@vmxfile, "priority.grabbed = \"normal\"\n");
+ push(@vmxfile, "priority.ungrabbed = \"normal\"\n");
+ push(@vmxfile, "checkpoint.vmState = \"\"\n");
+
+ if ($adapter eq "ide") {
+ push(@vmxfile, "scsi0.present = \"TRUE\"\n");
+ push(@vmxfile, "ide0:0.present = \"TRUE\"\n");
+ push(@vmxfile, "ide0:0.fileName =\"$datastorepath4vmx/$mybasedirname/$myimagename.vmdk\"\n");
+ push(@vmxfile, "ide0:0.mode = \"independent-nonpersistent\"\n") if (!($persistent));
+ push(@vmxfile, "ide0:0.mode = \"independent-persistent\"\n") if (($persistent));
+ push(@vmxfile, "ide0:0.redo = \"./$myvmdir.vmdk.REDO_Y7VUab\"\n");
+ push(@vmxfile, "ide1:0.autodetect = \"TRUE\"\n");
+ push(@vmxfile, "ide1:0.startConnected = \"FALSE\"\n");
+ } ## end if ($adapter eq "ide")
+ elsif ($adapter =~ /buslogic|lsilogic/) {
+ push(@vmxfile, "scsi0:0.present = \"TRUE\"\n");
+ push(@vmxfile, "scsi0.present = \"TRUE\"\n");
+ push(@vmxfile, "scsi0.sharedBus = \"none\"\n");
+ push(@vmxfile, "scsi0:0.deviceType = \"scsi-hardDisk\"\n");
+ push(@vmxfile, "scsi0.virtualDev = \"$adapter\"\n");
+ push(@vmxfile, "scsi0:0.fileName =\"$datastorepath4vmx/$mybasedirname/$myimagename.vmdk\"\n");
+ push(@vmxfile, "scsi0:0.mode = \"independent-nonpersistent\"\n") if (!($persistent));
+ push(@vmxfile, "scsi0:0.mode = \"independent-persistent\"\n") if (($persistent));
+ push(@vmxfile, "scsi0:0.redo = \"./$myvmdir.vmdk.REDO_Y7VUab\"\n");
+ } ## end elsif ($adapter =~ /buslogic|lsilogic/) [ if ($adapter eq "ide")
+
+ #write to tmpfile
+ if (open(TMP, ">$tmpfile")) {
+ print TMP @vmxfile;
+ close(TMP);
+ notify($ERRORS{'OK'}, 0, "wrote vmxarray to $tmpfile");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not write vmxarray to $tmpfile");
+ insertloadlog($reservation_id, $vmclient_computerid, "failed", "could not write vmx file to local tmp file");
+ return 0;
+ }
+
+ #scp vmx file to vmdir on vmhost
+ insertloadlog($reservation_id, $vmclient_computerid, "vmconfigcopy", "transferring vmx file to $hostnode");
+ if (run_scp_command($tmpdir, "$hostnode:\"$vmhost_vmpath\"", $identity)) {
+ my $copied = 0;
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($hostnode, $identity, "ls -1 $vmhost_vmpath/$myvmdir;chmod 755 $myvmx", "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /$myvmdir.vmx/) {
+ notify($ERRORS{'OK'}, 0, "successfully copied vmx file to $hostnode");
+ $copied = 1;
+ insertloadlog($reservation_id, $vmclient_computerid, "vmsetupconfig", "setting up vmx file");
+ }
+ }
+ if (!($copied)) {
+ #not good
+ notify($ERRORS{'CRITICAL'}, 0, "failed to copy $tmpfile to $hostnode \noutput= @{ $sshcmd[1] }");
+ insertloadlog($reservation_id, $vmclient_computerid, "failed", "failure to transfer vmx file to $hostnode");
+ return 0;
+ }
+
+ } #scp vmx tmpfile to host node
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "failed to copy $tmpfile to $hostnode ");
+ insertloadlog($reservation_id, $vmclient_computerid, "failed", "failure to transfer vmx file to $hostnode");
+ return 0;
+ }
+
+ #remove tmpfile and tmpdirectory
+ if (unlink($tmpfile)) {
+ notify($ERRORS{'OK'}, 0, "successfully removed $tmpfile");
+ notify($ERRORS{'OK'}, 0, "successfully removed tmp directory") if (rmdir("$tmpdir"));
+ }
+
+
+ #register vmx on vmhost
+ my $registered = 0;
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($hostnode, $identity, "vmware-cmd -s register $myvmx", "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /No such virtual machine/) {
+ #not registered
+ notify($ERRORS{'CRITICAL'}, 0, "vm $myvmx vmx does not exist on $hostnode");
+ }
+ if ($l =~ /= 1/) {
+ notify($ERRORS{'OK'}, 0, "vm $myvmx registered");
+ $registered = 1;
+ }
+ if ($l =~ /Virtual machine already exists|VMControl error -999/) {
+ notify($ERRORS{'WARNING'}, 0, "vm $myvmx already registered");
+ $registered = 1;
+ }
+ } ## end foreach my $l (@{$sshcmd[1]})
+ if (!($registered)) {
+ #now what - complain
+ notify($ERRORS{'CRITICAL'}, 0, "could not register vm $myvmx on $hostnode\n @{ $sshcmd[1] }");
+ return 0;
+ }
+
+
+ #turn on vm
+ #set loop control
+ my $vmware_starts = 0;
+
+ VMWARESTART:
+
+ $vmware_starts++;
+ notify($ERRORS{'OK'}, 0, "starting vm $myvmx - pass $vmware_starts");
+ if ($vmware_starts > 2) {
+ notify($ERRORS{'CRITICAL'}, 0, "vmware starts exceeded limit vmware_starts= $vmware_starts hostnode= $hostnode vm= $computer_shortname myvmx= $myvmx");
+ insertloadlog($reservation_id, $vmclient_computerid, "failed", "could not load machine on $hostnode exceeded attempts");
+ return 0;
+ }
+
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($hostnode, $identity, "vmware-cmd $myvmx start", "root");
+ for my $l (@{$sshcmd[1]}) {
+ next if ($l =~ /Warning:/);
+ #if successful -- this cmd does not appear to return any ouput so anything could be a failure
+ if ($l =~ /= 1/) {
+ notify($ERRORS{'OK'}, 0, "started $myvmx on $hostnode");
+ }
+ elsif ($l =~ /VMControl error/) {
+ notify($ERRORS{'OK'}, 0, "vmware-cmd start failed \n@{ $sshcmd[1] }");
+ return 0;
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "vmware-cmd cmd gave this output when trying to start $myvmx on $hostnode \n@{ $sshcmd[1] }");
+ }
+ } ## end for my $l (@{$sshcmd[1]})
+ insertloadlog($reservation_id, $vmclient_computerid, "startvm", "started vm on $hostnode");
+
+ #start monitoring
+ # check state of vm
+ # check messages log for boot info, DHCP requests, etc.A
+ # s1 = stage1 -- vm turned on
+ # s2 = stage2 -- DHCPDISCOVER on private mac
+ # s3 = stage3 --
+ sleep 20;
+ my ($s1, $s2, $s3, $s4, $s5) = 0; #setup stage flags
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($hostnode, $identity, "vmware-cmd $myvmx getstate", "root");
+ notify($ERRORS{'OK'}, 0, "checking state of vm $computer_shortname");
+ for my $l (@{$sshcmd[1]}) {
+ next if ($l =~ /Warning:/);
+ if ($l =~ /= on/) {
+ #good stage 1
+ $s1 = 1;
+ insertloadlog($reservation_id, $vmclient_computerid, "vmstage1", "node has been turned on");
+ notify($ERRORS{'OK'}, 0, "stage1 completed vm $computer_shortname has been turned on");
+ notify($ERRORS{'OK'}, 0, "eth0MAC $vmclient_eth0MAC privateIPaddress $vmclient_privateIPaddress");
+ }
+ } ## end for my $l (@{$sshcmd[1]})
+ my $sloop = 0;
+ if ($s1) {
+ #stage1 complete monitor local messages log for boot up info
+ if (open(TAIL, "</var/log/messages")) {
+ seek TAIL, -1, 2; #
+ for (;;) {
+ notify($ERRORS{'OK'}, 0, "$computer_shortname ROUND 1 checks loop $sloop of 40");
+
+ # re-check state of vm
+ my @vmstate = run_ssh_command($hostnode, $identity, "vmware-cmd $myvmx getstate", "root");
+ notify($ERRORS{'OK'}, 0, "rechecking state of vm $computer_shortname $myvmx");
+ for my $l (@{$vmstate[1]}) {
+ next if ($l =~ /Warning:/);
+ if ($l =~ /= on/) {
+ #good vm still on
+ notify($ERRORS{'OK'}, 0, "vm $computer_shortname reports on");
+ }
+ elsif ($l =~ /= off/) {
+ #good vm still on
+ notify($ERRORS{'CRITICAL'}, 0, "state of vm $computer_shortname reports off after pass number $sloop attempting to restart: start attempts $vmware_starts");
+ close(TAIL);
+ goto VMWARESTART;
+ }
+ elsif ($l =~ /= stuck/) {
+ notify($ERRORS{'CRITICAL'}, 0, "vm $computer_shortname reports stuck on pass $sloop attempting to kill pid and restart: restart attempts $vmware_starts");
+ close(TAIL);
+ #kill stuck process
+ #list processes for vmx and kill pid
+ notify($ERRORS{'OK'}, 0, "vm reported in stuck state, attempting to kill process");
+ my @ssh_pid = run_ssh_command($hostnode, $identity, "vmware-cmd -q $myvmx getpid");
+ foreach my $p (@{$ssh_pid[1]}) {
+ if ($p =~ /(\D*)(\s*)([0-9]*)/) {
+ my $vmpid = $3;
+ if (defined(run_ssh_command($hostnode, $identity, "kill -9 $vmpid"))) {
+ notify($ERRORS{'OK'}, 0, "killed $vmpid $myvmx");
+ }
+ }
+ }
+ } ## end elsif ($l =~ /= stuck/) [ if ($l =~ /= on/)
+ } ## end for my $l (@{$vmstate[1]})
+
+ while (<TAIL>) {
+ if ($_ =~ /$vmclient_eth0MAC|$vmclient_privateIPaddress|$computer_shortname/) {
+ notify($ERRORS{'DEBUG'}, 0, "DEBUG output for $computer_shortname $_");
+ }
+ if (!$s2) {
+ if ($_ =~ /dhcpd: DHCPDISCOVER from $vmclient_eth0MAC/) {
+ $s2 = 1;
+ insertloadlog($reservation_id, $vmclient_computerid, "vmstage2", "detected DHCP request for node");
+ notify($ERRORS{'OK'}, 0, "$computer_shortname STAGE 2 set DHCPDISCOVER from $vmclient_eth0MAC");
+ }
+ }
+ if (!$s3) {
+ if ($_ =~ /dhcpd: DHCPACK on $vmclient_privateIPaddress to $vmclient_eth0MAC/) {
+ $s3 = 1;
+ insertloadlog($reservation_id, $vmclient_computerid, "vmstage3", "detected DHCPACK for node");
+ notify($ERRORS{'OK'}, 0, "$computer_shortname STAGE 3 set DHCPACK on $vmclient_privateIPaddress to $vmclient_eth0MAC}");
+ }
+ }
+ if (!$s4) {
+ if ($_ =~ /dhcpd: DHCPACK on $vmclient_privateIPaddress to $vmclient_eth0MAC/) {
+ $s4 = 1;
+ insertloadlog($reservation_id, $vmclient_computerid, "vmstage4", "detected 2nd DHCPACK for node");
+ notify($ERRORS{'OK'}, 0, "$computer_shortname STAGE 4 set another DHCPACK on $vmclient_privateIPaddress to $vmclient_eth0MAC");
+ }
+ }
+ if (!$s5) {
+ if ($_ =~ /$computer_shortname (.*) READY/i) {
+ $s5 = 1;
+ notify($ERRORS{'OK'}, 0, "$computer_shortname STAGE 5 set found READY flag");
+ insertloadlog($reservation_id, $vmclient_computerid, "vmstage5", "detected READY flag proceeding to post configuration");
+ #speed this up a bit
+ close(TAIL);
+ goto VMWAREROUND2;
+ }
+
+ } ## end if (!$s5)
+ if ($sloop > 20) {
+ #are we getting close
+ if ($_ =~ /DHCPACK on $vmclient_privateIPaddress to $vmclient_eth0MAC}/) {
+ #getting close -- extend it a bit
+ notify($ERRORS{'OK'}, 0, "$computer_shortname is getting close extending wait time");
+ insertloadlog($reservation_id, $vmclient_computerid, "info", "getting close node is booting");
+ $sloop = $sloop - 8;
+ }
+ if ($_ =~ /$computer_shortname sshd/) {
+ #getting close -- extend it a bit
+ notify($ERRORS{'OK'}, 0, "$computer_shortname is getting close sshd is starting extending wait time");
+ insertloadlog($reservation_id, $vmclient_computerid, "info", "getting close services are starting on node");
+ $sloop = $sloop - 5;
+ }
+
+ my $sshd_status = _sshd_status($computer_shortname, $requestedimagename);
+ if ($sshd_status eq "on") {
+ notify($ERRORS{'OK'}, 0, "$computer_shortname now has active sshd running, maybe we missed the READY flag setting STAGE5 flag");
+ $s5 = 1;
+ #speed this up a bit
+ close(TAIL);
+ goto VMWAREROUND2;
+ }
+ } ## end if ($sloop > 20)
+
+ } #while
+
+ if ($s5) {
+ #good
+ close(TAIL);
+ goto VMWAREROUND2;
+ }
+ elsif ($sloop > 65) {
+ #taken too long -- do something different or fail it
+
+ notify($ERRORS{'CRITICAL'}, 0, "could not load $myvmx on $computer_shortname on host $hostnode");
+ insertloadlog($reservation_id, $vmclient_computerid, "failed", "could not load vmx on $hostnode");
+ close(TAIL);
+ return 0;
+
+ }
+ else {
+ #keep check the log
+ $sloop++;
+ sleep 10;
+ seek TAIL, 0, 1;
+ }
+ } # for loop
+ } #if tail
+ } #if stage1
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "stage1 not confirmed, could not determine if $computer_shortname was turned on on host $hostnode");
+ insertloadlog($reservation_id, $vmclient_computerid, "failed", "could not determine if node was turned on on $hostnode");
+ return 0;
+ }
+ my $sshd_attempts = 0;
+
+ VMWAREROUND2:
+
+ #READY flag set
+ #attempt to login via ssh
+ insertloadlog($reservation_id, $vmclient_computerid, "vmround2", "waiting for ssh to become active");
+ notify($ERRORS{'OK'}, 0, "READY flag set for $myvmx, proceeding");
+ my $sshdstatus = 0;
+ my $wait_loops = 0;
+ $sshd_attempts++;
+ my $sshd_status = "off";
+ while (!$sshdstatus) {
+ my $sshd_status = _sshd_status($computer_shortname, $requestedimagename);
+ if ($sshd_status eq "on") {
+ $sshdstatus = 1;
+ notify($ERRORS{'OK'}, 0, "$computer_shortname now has active sshd running, ok to proceed to sync ssh keys");
+ }
+ else {
+ #either sshd is off or N/A, we wait
+ if ($wait_loops > 5) {
+ if ($sshd_attempts < 3) {
+ goto VMWAREROUND2;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "waited acceptable amount of time for sshd to become active, please check $computer_shortname on $hostnode");
+ insertloadlog($reservation_id, $vmclient_computerid, "failed", "waited acceptable amout of time for core services to start on $hostnode");
+ #need to check power, maybe reboot it. for now fail it
+ return 0;
+ }
+ } ## end if ($wait_loops > 5)
+ else {
+ $wait_loops++;
+ # to give post config a chance
+ notify($ERRORS{'OK'}, 0, "going to sleep 5 seconds, waiting for post config to finish");
+ sleep 5;
+ }
+ } # else
+ } #while
+
+ #clear ssh public keys from /root/.ssh/known_hosts
+ my $known_hosts = "/root/.ssh/known_hosts";
+ my $ssh_keyscan = "/usr/bin/ssh-keyscan";
+ my $port = "22";
+ my @file;
+ if (open(FILE, $known_hosts)) {
+ @file = <FILE>;
+ close FILE;
+
+ foreach my $line (@file) {
+ if ($line =~ s/$computer_shortname.*\n//) {
+ notify($ERRORS{'OK'}, 0, "removing $computer_shortname ssh public key from $known_hosts");
+ }
+ if ($line =~ s/$vmclient_privateIPaddress}.*\n//) {
+ notify($ERRORS{'OK'}, 0, "removing $vmclient_privateIPaddress ssh public key from $known_hosts");
+ }
+ }
+
+ if (open(FILE, ">$known_hosts")) {
+ print FILE @file;
+ close FILE;
+ }
+ #sync new keys
+ if (open(KEYSCAN, "$ssh_keyscan -t rsa -p $port $computer_shortname >> $known_hosts 2>&1 |")) {
+ my @ret = <KEYSCAN>;
+ close(KEYSCAN);
+ foreach my $r (@ret) {
+ notify($ERRORS{'OK'}, 0, "$r");
+ }
+ }
+ } ## end if (open(FILE, $known_hosts))
+ else {
+ notify($ERRORS{'OK'}, 0, "could not open $known_hosts for editing the $computer_shortname public ssh key");
+ }
+
+ insertloadlog($reservation_id, $vmclient_computerid, "info", "starting post configurations on node");
+ if ($vmclient_OSname =~ /vmwarewin|vmwareesxwin/) {
+ if (changewindowspasswd($computer_shortname, "root")) {
+ notify($ERRORS{'OK'}, 0, "Successfully changed password, account $computer_shortname,root");
+ }
+
+ if (changewindowspasswd($computer_shortname, "administrator")) {
+ notify($ERRORS{'OK'}, 0, "Successfully changed password, account $computer_shortname,administrator");
+ }
+ #disable remote desktop port
+ if (remotedesktopport($computer_shortname, "DISABLE")) {
+ notify($ERRORS{'OK'}, 0, "remote desktop disabled on $computer_shortname");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "remote desktop not disable on $computer_shortname");
+ }
+
+ # set sshd to auto
+ if (_set_sshd_startmode($computer_shortname, "auto")) {
+ notify($ERRORS{'OK'}, 0, "successfully set sshd service on $computer_shortname to start auto");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to set sshd service on $computer_shortname to start auto");
+ }
+
+ #check for root logged in on console and then logoff
+ notify($ERRORS{'OK'}, 0, "checking for any console users $computer_shortname");
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($computer_shortname, $IDENTITY_wxp, "cmd /c qwinsta.exe", "root");
+ foreach my $r (@{$sshcmd[1]}) {
+ if ($r =~ /([>]?)([-a-zA-Z0-9]*)\s+([a-zA-Z0-9]*)\s+ ([0-9]*)\s+([a-zA-Z]*)/) {
+ my $state = $5;
+ my $session = $2;
+ my $user = $3;
+ if ($5 =~ /Active/) {
+ #give it sometime to finish - just in case
+ sleep 7;
+ notify($ERRORS{'OK'}, 0, "detected $user on $session still logged on $computer_shortname $r");
+ if (defined(run_ssh_command($computer_shortname, $IDENTITY_wxp, "cmd /c logoff.exe $session", "root"))) {
+ notify($ERRORS{'OK'}, 0, "logged off $user on $session on $computer_shortname $r");
+ }
+ }
+ } ## end if ($r =~ /([>]?)([-a-zA-Z0-9]*)\s+([a-zA-Z0-9]*)\s+ ([0-9]*)\s+([a-zA-Z]*)/)
+ } ## end foreach my $r (@{$sshcmd[1]})
+ } ## end if ($vmclient_OSname =~ /vmwarewin|vmwareesxwin/)
+ #ipconfiguration
+ if ($IPCONFIGURATION ne "manualDHCP") {
+ #not default setting
+ if ($IPCONFIGURATION eq "dynamicDHCP") {
+ insertloadlog($reservation_id, $vmclient_computerid, "dynamicDHCPaddress", "collecting dynamic IP address for node");
+ my $assignedIPaddress = getdynamicaddress($computer_shortname, $vmclient_OSname);
+ if ($assignedIPaddress) {
+ #update computer table
+ if (update_computer_address($vmclient_computerid, $assignedIPaddress)) {
+ notify($ERRORS{'DEBUG'}, 0, " succesfully updated IPaddress of node $computer_shortname");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not update dynamic address $assignedIPaddress for $computer_shortname $requestedimagename");
+ return 0;
+ }
+ } ## end if ($assignedIPaddress)
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not fetch dynamic address from $computer_shortname $requestedimagename");
+ insertloadlog($reservation_id, $vmclient_computerid, "failed", "could not collect dynamic IP address for node");
+ return 0;
+ }
+ } ## end if ($IPCONFIGURATION eq "dynamicDHCP")
+ elsif ($IPCONFIGURATION eq "static") {
+ insertloadlog($reservation_id, $vmclient_computerid, "staticIPaddress", "setting static IP address for node");
+ if (setstaticaddress($computer_shortname, $vmclient_OSname, $vmclient_publicIPaddress)) {
+ # good set static address
+ }
+ }
+ } ## end if ($IPCONFIGURATION ne "manualDHCP")
+ #
+ insertloadlog($reservation_id, $vmclient_computerid, "vmwareready", "preformed post config on node");
+ return 1;
+
+} ## end sub load
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 capture
+
+ Parameters : $request_data_hash_reference
+ Returns : 1 if sucessful, 0 if failed
+ Description : Creates a new vmware image.
+
+=cut
+
+sub capture {
+ my $self = shift;
+ if (ref($self) !~ /vmware/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+ return 0;
+ }
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Store some hash variables into local variables
+ # to pass to write_current_image routine
+ my $request_data = $self->data->get_request_data;
+
+ if (!$request_data) {
+ notify($ERRORS{'WARNING'}, 0, "unable to retrieve request data hash");
+ return 0;
+ }
+
+ # Store some hash variables into local variables
+ my $request_id = $self->data->get_request_id;
+ my $reservation_id = $self->data->get_reservation_id;
+
+ my $image_id = $self->data->get_image_id;
+ my $image_os_name = $self->data->get_image_os_name;
+ my $image_identity = $self->data->get_image_identity;
+ my $image_os_type = $self->data->get_image_os_type;
+ my $image_name = $self->data->get_image_name();
+
+
+ my $imagemeta_sysprep = $self->data->get_imagemeta_sysprep;
+
+ my $computer_id = $self->data->get_computer_id;
+ my $computer_shortname = $self->data->get_computer_short_name;
+ my $computer_nodename = $computer_shortname;
+ my $computer_hostname = $self->data->get_computer_hostname;
+ my $computer_type = $self->data->get_computer_type;
+
+ my $vmtype_name = $self->data->get_vmhost_type_name;
+ my $vmhost_vmpath = $self->data->get_vmhost_profile_vmpath;
+ my $vmprofile_vmdisk = $self->data->get_vmhost_profile_vmdisk;
+ my $vmprofile_datastorepath = $self->data->get_vmhost_profile_datastore_path;
+ my $vmhost_hostname = $self->data->get_vmhost_hostname;
+ my $host_type = $self->data->get_vmhost_type;
+ my $vmhost_imagename = $self->data->get_vmhost_image_name;
+
+ my ($hostIdentity, $hostnodename);
+ if ($host_type eq "blade") {
+ $hostnodename = $1 if ($vmhost_hostname =~ /([-_a-zA-Z0-9]*)(\.?)/);
+ $hostIdentity = $IDENTITY_bladerhel if ($vmhost_imagename =~ /^(rh[0-9]image|rhel[0-9]|fc[0-9]image|rhfc[0-9]|rhas[0-9]|esx[0-9]*)/);
+ }
+ else {
+ #using FQHN
+ $hostnodename = $vmhost_hostname;
+ $hostIdentity = $IDENTITY_linux_lab if ($vmhost_imagename =~ /^(realmrhel)/);
+ }
+ # Assemble a consistent prefix for notify messages
+ my $notify_prefix = "req=$request_id, res=$reservation_id:";
+
+
+ # Print some preliminary information
+ notify($ERRORS{'OK'}, 0, "$notify_prefix new name: $image_name");
+ notify($ERRORS{'OK'}, 0, "$notify_prefix computer_name: $computer_shortname");
+ notify($ERRORS{'OK'}, 0, "$notify_prefix vmhost_hostname: $vmhost_hostname");
+ notify($ERRORS{'OK'}, 0, "$notify_prefix vmtype_name: $vmtype_name");
+
+ # Modify currentimage.txt
+ if (write_currentimage_txt($self->data)) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix currentimage.txt updated on $computer_shortname");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "$notify_prefix unable to update currentimage.txt on $computer_shortname");
+ }
+
+ # Set some vm paths and names
+ my $vmx_directory = "$reservation_id$computer_shortname";
+ my $vmx_image_name = "$reservation_id$computer_shortname";
+ my $vmx_path = "$vmhost_vmpath/$vmx_directory/$vmx_image_name.vmx";
+
+ my @sshcmd;
+
+ # Check the vm type
+ if ($vmtype_name =~ /vmware|vmwareESX/) {
+
+ #if windows
+ #set sshd to mode= demand
+ # disable pagefile
+ # reboot
+ # check for and remove pagefile
+ # if sysprep-- copy sysprep files and start
+ # delay 15 secs turn vm off
+ # if not sysprep i.e. newsid
+ # copy appropriate files, execute and wait for shutdown signal
+ #
+ # is os windows
+ if ($image_name =~ /^(vmwarewinxp|vmwarewin2003|vmwareesxwin)/) {
+ #change password of root and sshd service back to default
+ # only useful on win platforms
+ # changewindowspasswd($node,$account,$passwd)
+ # needed only for sshd service on windows OS's
+ my $p = $WINDOWS_ROOT_PASSWORD;
+ if (changewindowspasswd($computer_shortname, "root", $p)) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix changed windows password $computer_shortname,root,$p");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix failed to change windows password $computer_shortname,root,$p");
+ return 0;
+ }
+
+ #defrag before removing pagefile
+ # we do this to speed up the process
+ # defraging without a page file takes a little longer
+ notify($ERRORS{'OK'}, 0, "starting defrag on $computer_nodename");
+ @sshcmd = run_ssh_command($computer_nodename, $IDENTITY_wxp, "cmd.exe /c defrag C: -f", "root");
+ my $defragged = 0;
+ foreach my $d (@{$sshcmd[1]}) {
+ if ($d =~ /Defragmentation Report/) {
+ notify($ERRORS{'OK'}, 0, "successfully defraged $computer_nodename");
+ $defragged = 1;
+ }
+ }
+ if (!$defragged) {
+ notify($ERRORS{'WARNING'}, 0, "defrag problem @{ $sshcmd[1] }");
+ }
+
+ #copy new auto_create_image.vbs and auto_prepare_for_image.vbs
+ #this moves(sometimes) the pagefile and reboots the box
+ #actually checks for a removes the pagefile.sys
+ my @scp;
+ if (run_scp_command("$TOOLS/auto_create_image.vbs", "$computer_nodename:auto_create_image.vbs", $IDENTITY_wxp)) {
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "failed to scp $TOOLS/auto_create_image.vbs to $computer_nodename");
+ return 0;
+ }
+
+ if (_set_sshd_startmode($computer_nodename, "auto")) {
+ notify($ERRORS{'OK'}, 0, "successfully set auto mode for sshd start");
+ }
+
+ my @list;
+ my $l;
+#execute the vbs script to disable the pagefil and reboot
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($computer_nodename, $IDENTITY_wxp, "cscript.exe //Nologo auto_create_image.vbs", "root");
+ #starting process
+ foreach $l (@{$sshcmd[1]}) {
+ if ($l =~ /createimage reboot|rebooting/) {
+ notify($ERRORS{'OK'}, 0, "auto_create_image.vbs initiated, $computer_nodename rebooting, sleeping 90");
+ sleep 90;
+ next;
+ }
+ elsif ($l =~ /failed error/) {
+ notify($ERRORS{'CRITICAL'}, 0, "auto_create_image.vbs failed, @{ $sshcmd[1] }");
+ return 0;
+ }
+ } ## end foreach $l (@{$sshcmd[1]})
+ #wait until the reboot process has started to shutdown services.
+ notify($ERRORS{'OK'}, 0, "$computer_nodename rebooting, waiting");
+ my $socketflag = 0;
+ REBOOTEDVMWARE:
+ my $rebooted = 1;
+ my $reboot_wait_count = 0;
+ while ($rebooted) {
+
+ if ($reboot_wait_count > 55) {
+ notify($ERRORS{'CRITICAL'}, 0, "waited $reboot_wait_count on reboot after auto_create_image on $computer_nodename");
+ return 0;
+ }
+ notify($ERRORS{'OK'}, 0, "$computer_nodename not completed reboot sleeping for 25");
+ sleep 15;
+ if (_pingnode($computer_nodename)) {
+ #it pingable check if sshd is open
+ notify($ERRORS{'OK'}, 0, "$computer_nodename is pingable, checking sshd port");
+ my $sshd = _sshd_status($computer_nodename, $image_name);
+ if ($sshd =~ /on/) {
+ $rebooted = 0;
+ notify($ERRORS{'OK'}, 0, "$computer_nodename sshd is open");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "$computer_nodename sshd NOT open yet,sleep 5");
+ sleep 5;
+ }
+ } ## end if (_pingnode($computer_nodename))
+ $reboot_wait_count++;
+ } ## end while ($rebooted)
+ #check for recent bug
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($computer_nodename, $IDENTITY_wxp, "uname -s", "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /^Warning:/) {
+ }
+ if ($l =~ /^Read from socket failed:/) {
+ if ($socketflag) {
+ notify($ERRORS{'CRITICAL'}, 0, "could not login $computer_nodename via ssh socket failure");
+ return 0;
+ }
+ notify($ERRORS{'CRITICAL'}, 0, "discovered ssh read from socket failure on $computer_nodename, attempting to repair");
+ #power cycle node
+ if (defined(run_ssh_command($computer_nodename, $image_identity, "vmware-cmd $vmx_path reset hard", "root"))) {
+ notify($ERRORS{'CRITICAL'}, 0, "$computer_nodename reset cycled going to reboot check routine");
+ sleep 30;
+ $socketflag = 1;
+ goto REBOOTEDVMWARE;
+ }
+ } ## end if ($l =~ /^Read from socket failed:/)
+ } ## end foreach my $l (@{$sshcmd[1]})
+
+ #
+ #actually remove the pagefile.sys sometimes movefile.exe does not work
+ if (defined(run_ssh_command($computer_nodename, $IDENTITY_wxp, "/usr/bin/rm -v C:\/pagefile.sys", "root"))) {
+ notify($ERRORS{'OK'}, 0, "removed pagefile.sys");
+ }
+
+ # which sysprep to use
+ #TODO - store volume license keys in database
+ my $sysprep_files;
+ if ($image_name =~ /(^vmwarewinxp|vmwareesxwinxp)/) {
+ $sysprep_files = "$SYSPREP_VMWARE";
+ }
+ elsif ($image_name =~ /(^vmwarewin2003|vmwareesxwin2003)/) {
+ $sysprep_files = "$SYSPREP_VMWARE2003";
+ }
+
+ #cp sysprep to C:
+ #chmod C:\Sysprep\*
+ if (defined(run_scp_command($sysprep_files, "$computer_nodename:\"C:\/Sysprep\"", $IDENTITY_wxp))) {
+ notify($ERRORS{'OK'}, 0, "copied Sysprep directory $sysprep_files to $computer_nodename C:");
+ if (defined(run_ssh_command($computer_nodename, $IDENTITY_wxp, "/usr/bin/chmod -R 755 C:\/Sysprep", "root"))) {
+ notify($ERRORS{'OK'}, 0, "chmoded -R C:/Sysprep/ files ");
+ }
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not copy $sysprep_files to $computer_nodename");
+ return 0;
+ }
+
+ #set sshd to manual
+ if (_set_sshd_startmode($computer_nodename, "manual")) {
+ notify($ERRORS{'OK'}, 0, "successfully set manual mode for sshd start");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "failed to set manual mode for sshd on $computer_nodename");
+ return 0;
+ }
+ #start sysprep
+ #after 15 time units -- kill sysprep process
+ # in this case also stop vm using vmware-cmd
+
+ notify($ERRORS{'OK'}, 0, "starting sysprep on $computer_nodename");
+
+ my $vmisoff = 0;
+
+ if (open(SSH, "/usr/bin/ssh -x -i $IDENTITY_wxp $computer_nodename \"C:\/Sysprep\/sysprep.cmd\" & |")) {
+ my $notstop = 1;
+ my $loop = 0;
+ while ($notstop) {
+ notify($ERRORS{'DEBUG'}, 0, "$notify_prefix sysprep.cmd loop count: $loop");
+ $loop++;
+ my $l = <SSH>;
+ if ($l =~ /sysprep/) {
+ notify($ERRORS{'OK'}, 0, "sysprep started, sleep 45 before disconecting");
+ sleep 45;
+
+ notify($ERRORS{'DEBUG'}, 0, "attempting to kill sysprep");
+ if (_killsysprep($computer_nodename)) {
+ notify($ERRORS{'OK'}, 0, "killed sshd process for sysprep command");
+ }
+
+ $notstop = 0;
+ notify($ERRORS{'DEBUG'}, 0, "closing SSH filehandle");
+ close(SSH);
+ notify($ERRORS{'DEBUG'}, 0, "SSH filehandle closed");
+
+ $notstop = 0;
+ } ## end if ($l =~ /sysprep/)
+ elsif ($l =~ /sysprep.cmd: Permission denied/) {
+ notify($ERRORS{'CRITICAL'}, 0, "chmod 755 failed to correctly set execute on sysprep.cmd output $l");
+ close(SSH);
+ return 0;
+ }
+
+ notify($ERRORS{'DEBUG'}, 0, "sysprep cmd output: $l");
+
+ #avoid infinite loop
+ if ($loop > 80) {
+ notify($ERRORS{'OK'}, 0, "sysprep executed, sleep 20 before disconecting");
+ notify($ERRORS{'DEBUG'}, 0, "sysprep executed in loop control condition, exceeded limit");
+ sleep 20;
+ notify($ERRORS{'DEBUG'}, 0, "attempting to kill sysprep");
+ if (_killsysprep($computer_nodename)) {
+ notify($ERRORS{'OK'}, 0, "killed sshd process for sysprep command");
+ }
+ notify($ERRORS{'DEBUG'}, 0, "closing SSH filehandle");
+ close(SSH);
+ notify($ERRORS{'DEBUG'}, 0, "SSH filehandle closed");
+
+ $notstop = 0;
+ } ## end if ($loop > 80)
+
+ } ## end while ($notstop)
+ #stop vm
+ #ping to make sure host is offline
+ my $online = 1;
+ my $pingloop = 0;
+ notify($ERRORS{'OK'}, 0, "checking for pingable $computer_nodename");
+ while ($online) {
+ if (!(_pingnode($computer_nodename))) {
+ notify($ERRORS{'OK'}, 0, "$computer_nodename is not pingable");
+ $online = 0;
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "$computer_nodename is still pingable");
+ sleep 10;
+ $pingloop++;
+ }
+ if ($pingloop > 10) {
+ notify($ERRORS{'CRITICAL'}, 0, "failed on sysprep process for $computer_nodename");
+ return 0;
+ }
+ } ## end while ($online)
+ # we have to stop the vm due to sysprep not shutting down the machine -- even with the forceshutdown option
+ notify($ERRORS{'OK'}, 0, "stopping vm $vmx_path on $hostnodename");
+ notify($ERRORS{'DEBUG'}, 0, "stopping vm $vmx_path on hostnodename $hostnodename identity= $hostIdentity ");
+ my @vmstop = run_ssh_command($hostnodename, $hostIdentity, "vmware-cmd $vmx_path stop hard", "root");
+ foreach my $l (@{$vmstop[1]}) {
+ next if ($l =~ /Warning: Permanently/);
+ if ($l =~ /= 1/) {
+ notify($ERRORS{'OK'}, 0, "SUCCESS vmware-cmd stop worked");
+ }
+ }
+ #sleep a bit to let it shutdown
+ sleep 15;
+ #confirm
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($hostnodename, $hostIdentity, "vmware-cmd $vmx_path getstate", "root");
+
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /= off/) {
+ #good
+ notify($ERRORS{'OK'}, 0, "SUCCESS turned off $vmx_path");
+ $vmisoff = 1;
+ }
+ }
+ if (!$vmisoff) {
+ notify($ERRORS{'CRITICAL'}, 0, "$vmx_path still reported on");
+ return 0;
+ }
+ } #start sysprep command
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "failed to start sysprep on $computer_nodename $!");
+ return 0;
+ }
+
+ } #if windows
+ #this only applies to localdisk settings
+ if ($vmprofile_vmdisk eq "localdisk") {
+ #only copy vmdk files back to management node -- into correct directory
+ if (open(MKDIR, "/bin/mkdir $VMWAREREPOSITORY/$image_name 2>&1 |")) {
+ my @a = <MKDIR>;
+ close(MKDIR);
+ for my $l (@a) {
+ notify($ERRORS{'OK'}, 0, "possible error @a");
+ }
+ notify($ERRORS{'OK'}, 0, "created tmp directory $VMWAREREPOSITORY/$image_name");
+ }
+ if (-d "$VMWAREREPOSITORY/$image_name") {
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not create tmp directory $VMWAREREPOSITORY/$image_name for $vmx_directory $!");
+ return 0;
+ }
+ #copy vmdk files
+ # confirm they were copied
+ notify($ERRORS{'OK'}, 0, "attemping to copy vmdk files to $VMWAREREPOSITORY");
+ if (run_scp_command("$hostnodename:\"$vmhost_vmpath/$vmx_directory/*.vmdk\"", "$VMWAREREPOSITORY/$image_name", $hostIdentity)) {
+ if (open(LISTFILES, "ls -s1 $VMWAREREPOSITORY/$image_name |")) {
+ my @list = <LISTFILES>;
+ close(LISTFILES);
+ my $numfiles = @list;
+ my $imagesize = getimagesize($image_name);
+ if ($imagesize) {
+ notify($ERRORS{'OK'}, 0, "copied $numfiles vmdk files imagesize= $imagesize");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "vmdk files are not copied");
+ return 0;
+ }
+ #renaming local vmdk files
+ notify($ERRORS{'OK'}, 0, "begin rename local disk image files to newname");
+ my $oldname;
+ if (open(LISTFILES, "ls -1 $VMWAREREPOSITORY/$image_name 2>&1 |")) {
+ my @list = <LISTFILES>;
+ close(LISTFILES);
+ my $numfiles = @list;
+ #figure out old name
+ foreach my $a (@list) {
+ chomp($a);
+ if ($a =~ /([a-z]*)-([_0-9a-zA-Z]*)-(v[0-9]*)\.vmdk/) {
+ #print "old name $1-$2-$3\n";
+ $oldname = "$1-$2-$3";
+ notify($ERRORS{'OK'}, 0, "found previous name= $oldname");
+ }
+ }
+ foreach my $b (@list) {
+ chomp($b);
+ if ($b =~ /($oldname)-(s[0-9]*)\.vmdk/) {
+ notify($ERRORS{'OK'}, 0, "moving $b to $image_name-$2.vmdk");
+ if (open(MV, "mv $VMWAREREPOSITORY/$image_name/$b $VMWAREREPOSITORY/$image_name/$image_name-$2.vmdk 2>&1 |")) {
+ my @mv = <MV>;
+ close(MV);
+ if (@mv) {
+ notify($ERRORS{'CRITICAL'}, 0, "could not move $b to $VMWAREREPOSITORY/$image_name/$image_name-$2.vmdk \n@mv");
+ return 0;
+ }
+ }
+ notify($ERRORS{'OK'}, 0, "moved $b $VMWAREREPOSITORY/$image_name/$image_name-$2.vmdk");
+ } ## end if ($b =~ /($oldname)-(s[0-9]*)\.vmdk/)
+ } ## end foreach my $b (@list)
+
+ if (open(FILE, "$VMWAREREPOSITORY/$image_name/$oldname.vmdk")) {
+ my @file = <FILE>;
+ close(FILE);
+ for my $l (@file) {
+ #RW 4192256 SPARSE "vmwarewinxp-base10009-v1-s001.vmdk"
+ if ($l =~ /([0-9A-Z\s]*)\"$oldname-(s[0-9]*).vmdk\"/) {
+ #print "$l\n";
+ $l = "$1\"$image_name-$2.vmdk\"\n";
+ #print "$l\n";
+ }
+ }
+
+ if (open(FILE, ">$VMWAREREPOSITORY/$image_name/$oldname.vmdk")) {
+ print FILE @file;
+ close(FILE);
+ if (open(MV, "mv $VMWAREREPOSITORY/$image_name/$oldname.vmdk $VMWAREREPOSITORY/$image_name/$image_name.vmdk 2>&1 |")) {
+ my @mv = <MV>;
+ close(MV);
+ if (@mv) {
+ notify($ERRORS{'CRITICAL'}, 0, "old $oldname move to new $image_name error: @mv\n");
+ }
+ notify($ERRORS{'OK'}, 0, "moved $VMWAREREPOSITORY/$image_name/$oldname.vmdk $VMWAREREPOSITORY/$image_name/$image_name.vmdk");
+ }
+ } # write file array back to vmdk file
+ } #read main vmdk file
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not read $VMWAREREPOSITORY/$image_name/$oldname.vmdk $! ");
+ return 0;
+ }
+ } ## end if (open(LISTFILES, "ls -1 $VMWAREREPOSITORY/$image_name 2>&1 |"...
+ #remove dir from vmhost
+ #everything appears to have worked
+ #remove image files from vmhost
+ if (defined(run_ssh_command($hostnodename, $hostIdentity, "vmware-cmd -s unregister $vmx_path"))) {
+ notify($ERRORS{'OK'}, 0, "unregistered $vmx_path");
+ }
+
+ if (defined(run_ssh_command($hostnodename, $hostIdentity, "/bin/rm -rf $vmhost_vmpath/$vmx_directory", "root"))) {
+ notify($ERRORS{'OK'}, 0, "removed vmhost_vmpath/$vmx_directory");
+ }
+ #set file premissions on images to 644
+ # to allow for other management nodes to fetch image if neccessary
+ # useful in a large distributed framework
+ if (open(CHMOD, "/bin/chmod -R 644 $VMWAREREPOSITORY/$image_name/\*.vmdk 2>&1 |")) {
+ close(CHMOD);
+ notify($ERRORS{'DEBUG'}, 0, "$notify_prefix recursive update file permssions 644 on $VMWAREREPOSITORY/$image_name");
+ }
+
+ return 1;
+ } ## end if (open(LISTFILES, "ls -s1 $VMWAREREPOSITORY/$image_name |"...
+ } ## end if (run_scp_command("$hostnodename:\"$vmhost_vmpath/$vmx_directory/*.vmdk\""...
+ } ## end if ($vmprofile_vmdisk eq "localdisk")
+ elsif ($vmprofile_vmdisk eq "networkdisk") {
+ #rename vmdk files
+
+ #FIXME - making local directory in our repository so does_image_exists succeeds
+ # does_image_exists needs to figure out the datastores and search them
+ if (mkdir("$VMWAREREPOSITORY/$image_name")) {
+ notify($ERRORS{'OK'}, 0, "creating local dir for $image_name");
+ }
+
+
+ # create directory
+ my @mvdir = run_ssh_command($hostnodename, $hostIdentity, "/bin/mv $vmprofile_datastorepath/$vmx_directory $vmprofile_datastorepath/$image_name", "root");
+ for my $l (@{$mvdir[1]}) {
+ notify($ERRORS{'OK'}, 0, "possible error @{ $mvdir[1] }");
+ }
+ notify($ERRORS{'OK'}, 0, "renamed directory $vmx_directory to $image_name");
+ #if ESX user vmkfstools to rename the image
+ if ($vmtype_name =~ /vmwareESX/) {
+ my $cmd = "vmkfstools -E $vmprofile_datastorepath/$image_name/$vmx_directory.vmdk $vmprofile_datastorepath/$image_name/$image_name.vmdk";
+ my @retarr = run_ssh_command($hostnodename, $hostIdentity, $cmd, "root");
+ foreach my $r (@{$retarr[1]}) {
+ #if any output could mean trouble - this command provides no no response if successful
+ notify($ERRORS{'OK'}, 0, "possible problem renaming vm @{ $retarr[1] }") if ($r);
+ }
+ }
+ #success
+ #TODO add check to confirm
+ notify($ERRORS{'OK'}, 0, "looks like vm is renamed");
+ #cleanup - unregister, and remove vm dir on vmhost local disk
+ my @cleanup = run_ssh_command($hostnodename, $hostIdentity, "vmware-cmd -s unregister $vmx_path", "root");
+ foreach my $c (@{$cleanup[1]}) {
+ notify($ERRORS{'OK'}, 0, "vm successfully unregistered") if ($c =~ /1/);
+ }
+ #remove vmx directoy from our local datastore
+ if (defined(run_ssh_command($hostnodename, $hostIdentity, "/bin/rm -rf $vmhost_vmpath/$vmx_directory", "root"))) {
+ notify($ERRORS{'OK'}, 0, "success removed $vmhost_vmpath/$vmx_directory from $hostnodename");
+
+ }
+ } ## end elsif ($vmprofile_vmdisk eq "networkdisk") [ if ($vmprofile_vmdisk eq "localdisk")
+ return 1;
+
+ } #if vmware
+ elsif ($vmtype_name eq "xen") {
+
+ }
+
+} ## end sub capture
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _vmwareclone
+
+ Parameters : $hostnode, $identity, $srcDisk, $dstDisk, $dstDir
+ Returns : 1 if successful, 0 if error occurred
+ Description : using vm tools clone srcdisk to dstdisk
+ currently using builtin vmkfstools
+
+=cut
+
+sub _vmwareclone {
+ my ($hostnode, $identity, $srcDisk, $dstDisk, $dstDir) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ #TODO - add checks for VI toolkit - then use vmclone.pl instead
+ #vmclone.pl would need additional parameters
+
+ my @list = run_ssh_command($hostnode, $identity, "ls -1 $srcDisk", "root");
+ my $srcDiskexist = 0;
+
+ foreach my $l (@{$list[1]}) {
+ $srcDiskexist = 1 if ($l =~ /($srcDisk)$/);
+ $srcDiskexist = 0 if ($l =~ /No such file or directory/);
+ notify($ERRORS{'OK'}, 0, "$l");
+ }
+ my @ssh;
+ if ($srcDiskexist) {
+ #make dir for dstdisk
+ my @mkdir = run_ssh_command($hostnode, $identity, "mkdir -m 755 $dstDir", "root");
+ notify($ERRORS{'OK'}, 0, "srcDisk is exists $srcDisk ");
+ notify($ERRORS{'OK'}, 0, "starting clone process vmkfstools -d thin -i $srcDisk $dstDisk");
+ if (open(SSH, "/usr/bin/ssh -x -q -i $identity -l root $hostnode \"vmkfstools -i $srcDisk -d thin $dstDisk\" 2>&1 |")) {
+ #@ssh=<SSH>;
+ #close(SSH);
+ #foreach my $l (@ssh) {
+ # notify($ERRORS{'OK'},0,"$l");
+ #}
+ while (<SSH>) {
+ notify($ERRORS{'OK'}, 0, "started $_") if ($_ =~ /Destination/);
+ notify($ERRORS{'OK'}, 0, "started $_") if ($_ =~ /Cloning disk/);
+ notify($ERRORS{'OK'}, 0, "status $_") if ($_ =~ /Clone:/);
+ }
+ close(SSH);
+ } ## end if (open(SSH, "/usr/bin/ssh -x -q -i $identity -l root $hostnode \"vmkfstools -i $srcDisk -d thin $dstDisk\" 2>&1 |"...
+ } ## end if ($srcDiskexist)
+ else {
+ notify($ERRORS{'OK'}, 0, "srcDisk $srcDisk does not exists");
+ }
+ #confirm
+ @list = 0;
+ @list = run_ssh_command($hostnode, $identity, "ls -1 $dstDisk", "root");
+ my $dstDiskexist = 0;
+ foreach my $l (@{$list[1]}) {
+ $dstDiskexist = 1 if ($l =~ /($dstDisk)$/);
+ $dstDiskexist = 0 if ($l =~ /No such file or directory/);
+ }
+ if ($dstDiskexist) {
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "clone process failed dstDisk $dstDisk does not exist");
+ return 0;
+ }
+} ## end sub _vmwareclone
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 vmrun_cmd
+
+ Parameters : hostnode, hostnode type,full vmx path,cmd
+ Returns : 0 or 1
+ Description : execute specific vmware-cmd cmd
+
+=cut
+
+sub _vmrun_cmd {
+ my ($hostnode, $hosttype, $hostidentity, $vmx, $cmd) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "hostnode is not defined") if (!(defined($hostnode)));
+ notify($ERRORS{'WARNING'}, 0, "hosttype is not defined") if (!(defined($hosttype)));
+ notify($ERRORS{'WARNING'}, 0, "hostidentity is not defined") if (!(defined($hostidentity)));
+ notify($ERRORS{'WARNING'}, 0, "vmx is not defined") if (!(defined($vmx)));
+ notify($ERRORS{'WARNING'}, 0, "cmd is not defined") if (!(defined($cmd)));
+
+ if ($hosttype eq "blade") {
+
+ if ($cmd eq "off") {
+ notify($ERRORS{'OK'}, 0, "$hostnode,$hosttype,$hostidentity,$vmx,$cmd");
+ my @sshcmd = run_ssh_command($hostnode, $hostidentity, "vmware-cmd $vmx stop hard", "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ next if ($l =~ /Warning: Permanently added/);
+ if ($l =~ /Error/) {
+ notify($ERRORS{'CRITICAL'}, 0, "$l output for $hostnode,$hosttype,$hostidentity,$vmx,$cmd");
+ return 0;
+ }
+ }
+ } ## end if ($cmd eq "off")
+ } ## end if ($hosttype eq "blade")
+ return 1;
+} ## end sub _vmrun_cmd
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 controlVM
+
+ Parameters : control command hash
+ Returns : 0 or 1
+ Description : controls VM, stop,remove, etc
+
+=cut
+
+sub control_VM {
+ my $self = shift;
+
+ # Check if subroutine was called as a class method
+ if (ref($self) !~ /vmware/i) {
+ notify($ERRORS{'DEBUG'}, 0, "subroutine was called as a function, it must be called as a class method");
+ }
+
+ my $control = shift;
+ #my (%vm) = shift;
+ #notify($ERRORS{'CRITICAL'}, 0, "debugging", %vm);
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ if (!(defined($control))) {
+ notify($ERRORS{'WARNING'}, 0, "control is not defined");
+ return 0;
+ }
+ else {
+ notify($ERRORS{'DEBUG'}, 0, "control $control is defined ");
+ }
+
+ # Store hash var into local var
+
+ my $vmpath = $self->data->get_vmhost_profile_vmpath;
+ my $datastorepath = $self->data->get_vmhost_profile_datastore_path;
+ my $currentimage = $self->data->get_computer_currentimage_name;
+ my $reservation_id = $self->data->get_reservation_id;
+ my $vmtype = $self->data->get_vmhost_type_name;
+ my $persistent = $self->data->get_request_forimaging;
+ my $vmclient_shortname = $self->data->get_computer_short_name;
+ my $vmhost_fullhostname = $self->data->get_vmhost_hostname;
+ my $vmhost_shortname = $1 if ($vmhost_fullhostname =~ /([-_a-zA-Z0-9]*)(\.?)/);
+ my $vmhost_imagename = $self->data->get_vmhost_image_name;
+ my $vmhost_type = $self->data->get_vmhost_type;
+
+ my ($myvmdir, $myvmx, $mybasedirname, $myimagename);
+
+ #if persistent flag set -- special case or imaging mode
+ if ($persistent) {
+ #either in imaging mode or special use
+ $myvmdir = "$reservation_id$vmclient_shortname";
+ $myvmx = "$vmpath/$reservation_id$vmclient_shortname/$reservation_id$vmclient_shortname.vmx";
+ $mybasedirname = "$reservation_id$vmclient_shortname";
+ $myimagename = "$reservation_id$vmclient_shortname";
+ #base directory will not be used for image creation
+ }
+ else {
+ #standard use
+ $myvmdir = "$currentimage$vmclient_shortname";
+ $myvmx = "$vmpath/$currentimage$vmclient_shortname/$currentimage$vmclient_shortname.vmx";
+ $mybasedirname = $currentimage;
+ $myimagename = $currentimage;
+ }
+
+ my ($hostnode, $identity);
+ if ($vmhost_type eq "blade") {
+
+ if (defined($vmhost_shortname)) {
+ $hostnode = $vmhost_shortname;
+ }
+ else {
+ $hostnode = $1 if ($vmhost_shortname =~ /([-_a-zA-Z0-9]*)(\.?)/);
+ }
+ $identity = $IDENTITY_bladerhel if ($vmhost_imagename =~ /^(rh[0-9]image|rhel[0-9]|fc[0-9]image|rhfc[0-9]|rhas[0-9]|esx[0-9]*)/);
+ } ## end if ($vmhost_type eq "blade")
+ else {
+ #using FQHN
+ $hostnode = $vmhost_fullhostname;
+ $identity = $IDENTITY_linux_lab if ($vmhost_imagename =~ /^(realmrhel)/);
+ }
+ if (!$identity) {
+ notify($ERRORS{'WARNING'}, 0, "could not set ssh identity variable for image $vmhost_imagename type= $vmhost_type host= $vmhost_fullhostname");
+ notify($ERRORS{'OK'}, 0, "setting to default identity key");
+ $identity = $IDENTITY_bladerhel;
+ }
+ #setup flags
+ my $baseexists = 0;
+ my $dirstructure = 0;
+ my $vmison = 0;
+ my @sshcmd;
+ if ($vmtype =~ /vmware|vmwareGSX|vmwareESX/) {
+ #common checks
+ notify($ERRORS{'OK'}, 0, "checking for base image on $hostnode $datastorepath");
+ @sshcmd = run_ssh_command($hostnode, $identity, "ls -1 $datastorepath", "root");
+ notify($ERRORS{'OK'}, 0, "@{ $sshcmd[1] }");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /denied|No such/) {
+ notify($ERRORS{'CRITICAL'}, 0, "node $hostnode output @{ $sshcmd[1] } $identity $hostnode");
+ return 0;
+ }
+ if ($l =~ /Warning: Permanently/) {
+ #ignore
+ }
+ if ($l =~ /(\s*?)$mybasedirname$/) {
+ notify($ERRORS{'OK'}, 0, "base image exists");
+ $baseexists = 1;
+ }
+ if ($l =~ /(\s*?)$myvmdir$/) {
+ notify($ERRORS{'OK'}, 0, "directory structure $myvmdir image exists");
+ $dirstructure = 1;
+ }
+ } ## end foreach my $l (@{$sshcmd[1]})
+
+ if (($dirstructure)) {
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "$myvmx directory structure for $myvmdir did not exist ");
+ }
+ if ($control =~ /off|remove/) {
+ #simply remove any vm's running on that hostname
+
+ my $l_myvmx = 0;
+ my $l_myvmdir = 0;
+
+ ##find the correct vmx file for this node -- if running
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($hostnode, $identity, "vmware-cmd -l", "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ chomp($l);
+ next if ($l =~ /Warning:/);
+ notify($ERRORS{'OK'}, 0, "$l");
+ if ($l =~ /(.*)(\/)([-_a-zA-Z0-9]*$vmclient_shortname)(\/)([-_a-zA-Z0-9\/]*$vmclient_shortname.vmx)/) {
+ # do within this loop in case there is more than one
+ $l_myvmx = "$1/$3/$5";
+ $l_myvmdir = "$1/$3";
+ $l_myvmx =~ s/(\s+)/\\ /g;
+ $l_myvmdir =~ s/(\s+)/\\ /g;
+
+ notify($ERRORS{'OK'}, 0, "my vmx $l_myvmx");
+ my @sshcmd_1 = run_ssh_command($hostnode, $identity, "vmware-cmd $l_myvmx getstate");
+ foreach my $l (@{$sshcmd_1[1]}) {
+ if ($l =~ /= off/) {
+ #good - move on
+ }
+ elsif ($l =~ /= on/) {
+ my @sshcmd_2 = run_ssh_command($hostnode, $identity, "vmware-cmd $l_myvmx stop hard");
+ foreach my $l (@{$sshcmd_2[1]}) {
+ next if ($l =~ /Warning:/);
+ if ($l =~ /= 1/) {
+ #turn off or killpid -- of course it should be off by this point but kill
+ notify($ERRORS{'OK'}, 0, "turned off $l_myvmx");
+ }
+ else {
+ # FIX-ME add better error checking
+ notify($ERRORS{'OK'}, 0, "@{ $sshcmd_2[1] }");
+ }
+ } ## end foreach my $l (@{$sshcmd_2[1]})
+ } ## end elsif ($l =~ /= on/) [ if ($l =~ /= off/)
+ elsif ($l =~ /= stuck/) {
+ #list processes for vmx and kill pid
+ notify($ERRORS{'OK'}, 0, "vm reported in stuck state, attempting to kill process");
+ my @ssh_pid = run_ssh_command($hostnode, $identity, "vmware-cmd -q $l_myvmx getpid");
+ foreach my $p (@{$ssh_pid[1]}) {
+ if ($p =~ /(\D*)(\s*)([0-9]*)/) {
+ notify($ERRORS{'OK'}, 0, "vm pid= $3");
+ my $vmpid = $3;
+ if (defined(run_ssh_command($hostnode, $identity, "kill -9 $vmpid"))) {
+ notify($ERRORS{'OK'}, 0, "killed $vmpid $l_myvmx");
+ }
+ }
+ }
+ } ## end elsif ($l =~ /= stuck/) [ if ($l =~ /= off/)
+ else {
+ notify($ERRORS{'OK'}, 0, "@{ $sshcmd_1[1] }");
+ }
+ } ## end foreach my $l (@{$sshcmd_1[1]})
+ #unregister
+ undef @sshcmd_1;
+ @sshcmd_1 = run_ssh_command($hostnode, $identity, "vmware-cmd -s unregister $l_myvmx ");
+ foreach my $l (@{$sshcmd_1[1]}) {
+ notify($ERRORS{'OK'}, 0, "vm $l_myvmx unregistered") if ($l =~ /= 1/);
+ }
+ } ## end if ($l =~ /(.*)(\/)([-_a-zA-Z0-9]*$vmclient_shortname)(\/)([-_a-zA-Z0-9\/]*$vmclient_shortname.vmx)/)
+ } ## end foreach my $l (@{$sshcmd[1]})
+ if ($control eq "remove") {
+ #delete directory -- clean slate
+ if (defined(run_ssh_command($hostnode, $identity, "/bin/rm -rf $l_myvmdir", "root"))) {
+ notify($ERRORS{'OK'}, 0, "removed $l_myvmdir from $hostnode");
+ return 1;
+ }
+
+ }
+ } ## end if ($control =~ /off|remove/)
+ #restart
+ if ($control eq "restart") {
+ #turn vm off
+ notify($ERRORS{'OK'}, 0, "restarting $myvmx");
+ if ($vmison) {
+ notify($ERRORS{'OK'}, 0, "turning off $myvmx");
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($hostnode, $identity, "vmware-cmd $myvmx stop hard", "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l) {
+ notify($ERRORS{'OK'}, 0, "$myvmx strange output $l");
+ }
+ }
+ #sleep a bit to let it shutdown
+ sleep 15;
+ #confirm
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($hostnode, $identity, "vmware-cmd $myvmx getstate", "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /= off/) {
+ #good
+ return 1;
+ }
+ }
+ } ## end if ($vmison)
+ else {
+ notify($ERRORS{'OK'}, 0, "$myvmx reported off");
+ return 1;
+ }
+ } ## end if ($control eq "restart")
+ #suspend
+ if ($control eq "suspend") {
+ #suspend machine
+ #could copy to managment node storage
+ #under different name and store for later use
+ }
+ } ## end if ($vmtype =~ /vmware|vmwareGSX|vmwareESX/)
+ return 1;
+} ## end sub control_VM
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 getimagesize
+
+ Parameters : imagename
+ Returns : 0 failure or size of image
+ Description : in size of Kilobytes
+
+=cut
+
+sub get_image_size {
+ my $self = shift;
+ if (ref($self) !~ /vmware/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+ return 0;
+ }
+
+# Either use a passed parameter as the image name or use the one stored in this object's DataStructure
+ my $image_name = shift;
+ $image_name = $self->data->get_image_name() if !$image_name;
+ if (!$image_name) {
+ notify($ERRORS{'CRITICAL'}, 0, "image name could not be determined");
+ return 0;
+ }
+ notify($ERRORS{'DEBUG'}, 0, "getting size of image: $image_name");
+
+ #my $imagename = $_[0];
+ #my ($package, $filename, $line, $sub) = caller(0);
+ #notify($ERRORS{'WARNING'}, 0, "imagename is not defined") if (!(defined($imagename)));
+
+ #if (!(defined($imagename))) {
+ # return 0;
+ #}
+ my $IMAGEREPOSITORY = "$VMWAREREPOSITORY/$image_name";
+
+ #list files in image directory, account for main .gz file and any .gz.00X files
+ if (open(FILELIST, "/bin/ls -s1 $IMAGEREPOSITORY 2>&1 |")) {
+ my @filelist = <FILELIST>;
+ close(FILELIST);
+ my $size = 0;
+ foreach my $f (@filelist) {
+ if ($f =~ /$image_name.vmdk/) {
+ my ($presize, $blah) = split(" ", $f);
+ $size += $presize;
+ }
+ }
+ if ($size == 0) {
+ #strange imagename not found
+ return 0;
+ }
+ return int($size / 1024);
+ } ## end if (open(FILELIST, "/bin/ls -s1 $IMAGEREPOSITORY 2>&1 |"...
+
+ return 0;
+} ## end sub get_image_size
+
+
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 node_status
+
+ Parameters : $nodename, $log
+ Returns : array of related status checks
+ Description : checks on ping,sshd, currentimage, OS
+
+=cut
+
+sub node_status {
+ my $self = shift;
+
+ # Check if subroutine was called as a class method
+ if (ref($self) !~ /vmware/i) {
+ notify($ERRORS{'DEBUG'}, 0, "subroutine was called as a function, it must be called as a class method");
+ }
+
+ #my ($vmhash) = shift;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # try to contact vm
+ # $self->data->get_request_data;
+ # get state of vm
+ my $vmpath = $self->data->get_vmhost_profile_vmpath;
+ my $datastorepath = $self->data->get_vmhost_profile_datastore_path;
+ my $requestedimagename = $self->data->get_image_name;
+ my $vmhost_type = $self->data->get_vmhost_type;
+ my $vmhost_hostname = $self->data->get_vmhost_hostname;
+ my $vmhost_imagename = $self->data->get_vmhost_image_name;
+ my $vmclient_shortname = $self->data->get_computer_short_name;
+
+ my ($hostnode, $identity);
+
+ # Create a hash to store status components
+ my %status;
+
+ # Initialize all hash keys here to make sure they're defined
+ $status{status} = 0;
+ $status{currentimage} = 0;
+ $status{ping} = 0;
+ $status{ssh} = 0;
+ $status{vmstate} = 0; #on or off
+ $status{image_match} = 0;
+
+ if ($vmhost_type eq "blade") {
+ $hostnode = $1 if ($vmhost_hostname =~ /([-_a-zA-Z0-9]*)(\.?)/);
+ $identity = $IDENTITY_bladerhel; #if($vm{vmhost}{imagename} =~ /^(rhel|rh3image|rh4image|fc|rhfc)/);
+ }
+ else {
+ #using FQHN
+ $hostnode = $vmhost_hostname;
+ $identity = $IDENTITY_linux_lab if ($vmhost_imagename =~ /^(realmrhel)/);
+ }
+
+ if (!$identity) {
+ notify($ERRORS{'CRITICAL'}, 0, "could not set ssh identity variable for image $vmhost_imagename type= $vmhost_type host= $vmhost_hostname");
+ }
+
+ # Check if node is pingable
+ notify($ERRORS{'DEBUG'}, 0, "checking if $vmclient_shortname is pingable");
+ if (_pingnode($vmclient_shortname)) {
+ $status{ping} = 1;
+ notify($ERRORS{'OK'}, 0, "$vmclient_shortname is pingable ($status{ping})");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "$vmclient_shortname is not pingable ($status{ping})");
+ $status{status} = 'RELOAD';
+ return $status{status};
+ }
+
+ #
+ my $vmx_directory = "$requestedimagename$vmclient_shortname";
+ my $myvmx = "$vmpath/$requestedimagename$vmclient_shortname/$requestedimagename$vmclient_shortname.vmx";
+ my $mybasedirname = $requestedimagename;
+ my $myimagename = $requestedimagename;
+
+
+ #can I ssh into it
+ my $sshd = _sshd_status($vmclient_shortname, $requestedimagename);
+
+
+ #is it running the requested image
+ if ($sshd eq "on") {
+
+ $status{ssh} = 1;
+ $status{currentimage} = _getcurrentimage($vmclient_shortname);
+
+ if ($status{currentimage}) {
+ chomp($status{currentimage});
+ if ($status{currentimage} =~ /$requestedimagename/) {
+ $status{image_match} = 1;
+ notify($ERRORS{'OK'}, 0, "$vmclient_shortname is loaded with requestedimagename $requestedimagename");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "$vmclient_shortname reports current image is currentimage= $status{currentimage} requestedimagename= $requestedimagename");
+ }
+ } ## end if ($status{currentimage})
+ } ## end if ($sshd eq "on")
+
+ # #vm running
+ if ($status{image_match}) {
+ my @sshcmd = run_ssh_command($hostnode, $identity, "vmware-cmd $myvmx getstate", "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ notify($ERRORS{'OK'}, 0, "$l");
+ $status{vmstate} = 1 if ($l =~ /^getstate\(\) = on/);
+ $status{vmstate} = 0 if ($l =~ /= off/);
+
+ if ($l =~ /No such virtual machine/) {
+ #ok wait something is using that hostname
+ #reset $status{image_match} controlVM will detect and remove it
+ $status{image_match} = 0;
+ }
+ } ## end foreach my $l (@{$sshcmd[1]})
+ } ## end if ($status{image_match})
+
+ # Determine the overall machine status based on the individual status results
+ if ($status{ssh} && $status{image_match}) {
+ $status{status} = 'READY';
+ }
+ else {
+ $status{status} = 'RELOAD';
+ }
+
+ notify($ERRORS{'OK'}, 0, "returning node status hash reference (\$node_status->{status}=$status{status})");
+ return \%status;
+
+} ## end sub node_status
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 does_image_exist
+
+ Parameters : imagename
+ Returns : 0 or 1
+ Description : scans our image local image library for requested image
+ returns 1 if found or 0 if not
+ attempts to scp image files from peer management nodes
+
+=cut
+
+sub does_image_exist {
+ my $self = shift;
+ if (ref($self) !~ /vmware/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+ return 0;
+ }
+
+ my $image_name = $self->data->get_image_name();
+ if (!$image_name) {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to determine if image exists, unable to determine image name");
+ return 0;
+ }
+
+ my $IMAGEREPOSITORY;
+
+ if ($image_name =~ /^(vmware)/) {
+ $IMAGEREPOSITORY = "$VMWAREREPOSITORY";
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to determine if image exists, image name is not vmware image_name= $image_name");
+ return 0;
+ }
+
+ if (open(IMAGES, "/bin/ls -1 $IMAGEREPOSITORY 2>&1 |")) {
+ my @images = <IMAGES>;
+ close(IMAGES);
+ foreach my $i (@images) {
+ if ($i =~ /$image_name/) {
+ notify($ERRORS{'OK'}, 0, "image $image_name exists");
+ return 1;
+ }
+ }
+ } ## end if (open(IMAGES, "/bin/ls -1 $IMAGEREPOSITORY 2>&1 |"...
+
+ notify($ERRORS{'WARNING'}, 0, "image $IMAGEREPOSITORY/$image_name does NOT exists");
+ return 0;
+
+} ## end sub does_image_exist
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 retrieve_image
+
+ Parameters :
+ Returns :
+ Description : Attempts to retrieve an image from an image library partner
+
+=cut
+
+sub retrieve_image {
+ my $self = shift;
+ if (ref($self) !~ /vmware/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+ return;
+ }
+
+ # Make sure imag library functions are enabled
+ my $image_lib_enable = $self->data->get_management_node_image_lib_enable();
+ if (!$image_lib_enable) {
+ notify($ERRORS{'OK'}, 0, "image library functions are disabled");
+ return;
+ }
+
+ # Get the image name
+ my $image_name = shift;
+ $image_name = $self->data->get_image_name() if !$image_name;
+ if (!$image_name) {
+ notify($ERRORS{'WARNING'}, 0, "unable to determine image name");
+ return;
+ }
+
+ # Get the other image library variables
+ my $image_lib_user = $self->data->get_management_node_image_lib_user() || 'undefined';
+ my $image_lib_key = $self->data->get_management_node_image_lib_key() || 'undefined';
+ my $image_lib_partners = $self->data->get_management_node_image_lib_partners() || 'undefined';
+ if ("$image_lib_user $image_lib_key $image_lib_partners" =~ /undefined/) {
+ notify($ERRORS{'WARNING'}, 0, "image library configuration data is missing: user=$image_lib_user, key=$image_lib_key, partners=$image_lib_partners");
+ return;
+ }
+
+ # Get the image repository path
+ my $image_repository_path = $self->_get_image_repository_path();
+ if (!$image_repository_path) {
+ notify($ERRORS{'WARNING'}, 0, "image repository path could not be determined");
+ return;
+ }
+
+ # Attempt to copy image from other management nodes
+ notify($ERRORS{'OK'}, 0, "attempting to copy $image_name from other management nodes");
+
+ # Split up the partner list
+ my @partner_list = split(/,/, $image_lib_partners);
+ if ((scalar @partner_list) == 0) {
+ notify($ERRORS{'WARNING'}, 0, "image lib partners variable is not listed correctly or does not contain any information: $image_lib_partners");
+ return;
+ }
+
+ # Loop through the partners, attempt to copy
+ foreach my $partner (@partner_list) {
+ notify($ERRORS{'OK'}, 0, "checking if $partner has $image_name");
+
+ # Use ssh to call ls on the partner management node
+ my ($ls_exit_status, $ls_output_array_ref) = run_ssh_command($partner, $image_lib_key, "ls -1 $image_repository_path", $image_lib_user);
+
+ # Check if the ssh command failed
+ if (!$ls_output_array_ref) {
+ notify($ERRORS{'WARNING'}, 0, "unable to run ls command via ssh on $partner");
+ next;
+ }
+
+ # Convert the output array to a string
+ my $ls_output = join("\n", @{$ls_output_array_ref});
+
+ # Check the ls output for permission denied
+ if ($ls_output =~ /permission denied/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "permission denied when checking if $partner has $image_name, exit status=$ls_exit_status, output:\n$ls_output");
+ next;
+ }
+
+ # Check the ls output for the image name
+ if ($ls_output !~ /$image_name/i) {
+ notify($ERRORS{'OK'}, 0, "$image_name does not exist on $partner");
+ next;
+ }
+
+ # Image exists
+ notify($ERRORS{'OK'}, 0, "$image_name exists on $partner, attempting to copy");
+
+ #set lockfile - prevent process from loading while a copy is in progress
+
+ my $lock = "$image_repository_path/$image_name.copylock";
+ if (sysopen(SEM, $lock, O_RDONLY | O_CREAT)) {
+ if (flock(SEM, LOCK_EX)) {
+ notify($ERRORS{'OK'}, 0, "set Exclusive lock on $lock");
+ # Attempt copy
+ if (run_scp_command("$image_lib_user\@$partner:$image_repository_path/$image_name*", $image_repository_path, $image_lib_key)) {
+ notify($ERRORS{'OK'}, 0, "$image_name files copied via SCP");
+ close(SEM);
+ notify($ERRORS{'OK'}, 0, "releasing exclusive lock on $lock, proceeding");
+ unlink($lock);
+ last;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to copy $image_name files via SCP");
+ close(SEM);
+ notify($ERRORS{'OK'}, 0, "releasing exclusive lock on $lock, proceeding");
+ unlink($lock);
+ next;
+ }
+ } ## end if (flock(SEM, LOCK_EX))
+ } ## end if (sysopen(SEM, $lock, O_RDONLY | O_CREAT...
+
+
+ } ## end foreach my $partner (@partner_list)
+
+ # Make sure image was copied
+ if ($self->does_image_exist($image_name)) {
+ notify($ERRORS{'OK'}, 0, "$image_name was copied to this management node");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "$image_name was not copied to this management node");
+ return 0;
+ }
+} ## end sub retrieve_image
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _get_image_repository_path
+
+ Parameters : none, must be called as an object method
+ Returns :
+ Description :
+
+=cut
+
+sub _get_image_repository_path {
+ my $self = shift;
+
+ if (ref($self) !~ /vmware/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+ return 0;
+ }
+
+ my $return_path = "/install/vmware_images";
+ return $return_path;
+} ## end sub _get_image_repository_path
+
+#/////////////////////////////////////////////////////////////////////////////
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 put_node_in_maintenance
+
+ Parameters : none, must be called as an object method
+ Returns : 1,0
+ Description : preforms any actions on node before putting in maintenance state
+
+=cut
+
+sub post_maintenance_action {
+ my $self = shift;
+
+ if (ref($self) !~ /vmware/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+ return 0;
+ }
+
+ #steps putting vm into maintenance
+ # check state of vm
+ # turn off if needed
+ # unregister
+ # remove vm machine directory from vmx path
+ # set vmhostid to null in computer table - handled in new.pm
+
+ my $computer_name = $self->data->get_computer_short_name;
+ my $vmhost_hostname = $self->data->get_vmhost_hostname;
+
+ if ($self->control_VM("remove")) {
+ notify($ERRORS{'OK'}, 0, "removed node $computer_name from vmhost $vmhost_hostname");
+ }
+
+ return 1;
+
+} ## end sub post_maintenance_action
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+=cut
+
diff --git a/managementnode/lib/VCL/Module/Provisioning/xCAT.pm b/managementnode/lib/VCL/Module/Provisioning/xCAT.pm
new file mode 100644
index 0000000..1d73f63
--- /dev/null
+++ b/managementnode/lib/VCL/Module/Provisioning/xCAT.pm
@@ -0,0 +1,2830 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: xCAT.pm 1953 2008-12-12 14:23:17Z arkurth $
+##############################################################################
+
+=head1 NAME
+
+VCL::Provisioning::xCAT - VCL module to support the xCAT provisioning engine
+
+=head1 SYNOPSIS
+
+ Needs to be written
+
+=head1 DESCRIPTION
+
+ This module provides VCL support for xCAT (Extreme Cluster Administration
+ Toolkit). xCAT is a scalable distributed computing management and
+ provisioning tool that provides a unified interface for hardware control,
+ discovery, and OS diskful/diskfree deployment.
+ http://xcat.sourceforge.net
+
+=cut
+
+##############################################################################
+package VCL::Module::Provisioning::xCAT;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/../../..";
+
+# Configure inheritance
+use base qw(VCL::Module::Provisioning);
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use VCL::utils;
+use Fcntl qw(:DEFAULT :flock);
+use File::Copy;
+
+##############################################################################
+
+=head1 CLASS ATTRIBUTES
+
+=cut
+
+=head2 $XCAT_ROOT
+
+ Data type : scalar
+ Description : $XCAT_ROOT stores the location of the xCAT binary files. xCAT
+ should set the XCATROOT environment variable. This is used if
+ it is set. If XCATROOT is not set, /opt/xcat is used.
+
+=cut
+
+# Class attributes to store xCAT configuration details
+my $XCAT_ROOT;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 initialize
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub initialize {
+ my $self = shift;
+
+ # Check the XCAT_ROOT environment variable, it should be defined
+ if (defined($ENV{XCATROOT}) && $ENV{XCATROOT}) {
+ $XCAT_ROOT = $ENV{XCATROOT};
+ }
+ elsif (defined($ENV{XCATROOT})) {
+ notify($ERRORS{'WARNING'}, 0, "XCATROOT environment variable is not defined, using /opt/xcat");
+ $XCAT_ROOT = '/opt/xcat';
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "XCATROOT environment variable is not set, using /opt/xcat");
+ $XCAT_ROOT = '/opt/xcat';
+ }
+
+ # Remove trailing / from $XCAT_ROOT if exists
+ $XCAT_ROOT =~ s/\/$//;
+
+ # Make sure the xCAT root path is valid
+ if (!-d $XCAT_ROOT) {
+ notify($ERRORS{'WARNING'}, 0, "unable to initialize xCAT module, $XCAT_ROOT directory does not exist");
+ return 0;
+ }
+
+ # Check to make sure one of the expected executables is where it should be
+ if (!-x "$XCAT_ROOT/bin/rpower") {
+ notify($ERRORS{'WARNING'}, 0, "unable to initialize xCAT module, expected executable was not found: $XCAT_ROOT/bin/rpower");
+ return 0;
+ }
+ notify($ERRORS{'DEBUG'}, 0, "xCAT root path found: $XCAT_ROOT");
+
+ notify($ERRORS{'DEBUG'}, 0, "xCAT module initialized");
+ return 1;
+} ## end sub initialize
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 load
+
+ Parameters : hash
+ Returns : 1(success) or 0(failure)
+ Description : loads node with provided image
+
+=cut
+
+sub load {
+ my $self = shift;
+ if (ref($self) !~ /xCAT/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+ return 0;
+ }
+
+ # Get the data
+ my $reservation_id = $self->data->get_reservation_id();
+ my $image_name = $self->data->get_image_name();
+ my $image_os_name = $self->data->get_image_os_name();
+ my $image_project = $self->data->get_image_project();
+ my $image_reload_time = $self->data->get_image_reload_time();
+ my $imagemeta_postoption = $self->data->get_imagemeta_postoption();
+ my $image_architecture = $self->data->get_image_architecture();
+ my $computer_id = $self->data->get_computer_id();
+ my $computer_node_name = $self->data->get_computer_node_name();
+ my $computer_ip_address = $self->data->get_computer_ip_address();
+
+ notify($ERRORS{'OK'}, 0, "nodename not set")
+ if (!defined($computer_node_name));
+ notify($ERRORS{'OK'}, 0, "imagename not set")
+ if (!defined($image_name));
+ notify($ERRORS{'OK'}, 0, "project not set")
+ if (!defined($image_project));
+ notify($ERRORS{'OK'}, 0, "estimated reload time not set")
+ if (!defined($image_reload_time));
+ notify($ERRORS{'OK'}, 0, "osname not set")
+ if (!defined($image_os_name));
+ notify($ERRORS{'OK'}, 0, "computerid not set")
+ if (!defined($computer_id));
+ notify($ERRORS{'OK'}, 0, "reservationid not set")
+ if (!defined($reservation_id));
+ notify($ERRORS{'OK'}, 0, "architecture not set")
+ if (!defined($image_architecture));
+
+ # Initialize some timer variables
+ # Do this here in case goto passes over the declaration
+ my $sshd_start_time;
+ my $sshd_end_time;
+
+ insertloadlog($reservation_id, $computer_id, "startload", "$computer_node_name $image_name");
+
+ #make sure the following services are running on management node
+ # dhcpd named xcatd
+ # start them if they are not actively running
+ $image_project = "vcl" if (!defined($image_project));
+
+ $image_architecture = "x86" if (!defined($image_architecture));
+
+ # Run xCAT's assign2project utility
+ if (_assign2project($computer_node_name, $image_project)) {
+ notify($ERRORS{'OK'}, 0, "$computer_node_name _assign2project return successful");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "$computer_node_name could not _assign2project to $image_project");
+ return 0;
+ }
+
+ # Make sure dhcpd is started on management node
+ if (!(_checknstartservice("dhcpd"))) {
+ notify($ERRORS{'CRITICAL'}, 0, "dhcpd is not running or failed to restart");
+ }
+
+ # Make sure named is started on management node
+ if (!(_checknstartservice("named"))) {
+ notify($ERRORS{'CRITICAL'}, 0, "named is not running or failed to restart");
+ }
+
+ # Make sure xcatd is started on management node
+ if (!(_checknstartservice("xcatd"))) {
+ notify($ERRORS{'CRITICAL'}, 0, "xcatd is not running or failed to restart");
+ }
+
+ # Make sure atftpd is started on management node
+ if (!(_checknstartservice("atftpd"))) {
+ notify($ERRORS{'CRITICAL'}, 0, "atftpd is not running or failed to restart");
+ }
+
+ # Insert a computerloadlog record and edit nodetype.tab
+ insertloadlog($reservation_id, $computer_id, "editnodetype", "updating nodetype file");
+ if ($self->_edit_nodetype($computer_node_name, $image_name, $image_os_name, $image_architecture)) {
+ notify($ERRORS{'OK'}, 0, "nodetype updated for $computer_node_name with $image_name");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not edit nodetype for $computer_node_name with $image_name");
+ }
+
+ # Begin reinstallation using xCAT's rinstall
+ # Loop and continue checking
+
+ # Set flags and counters
+ my $rinstall_attempts = 0;
+ my $rpower_fixes = 0;
+ my $bootstatus = 0;
+ my $wait_loops = 0;
+ my @status;
+
+ # Check to see if management node throttle is configured
+ if ($THROTTLE) {
+ notify($ERRORS{'DEBUG'}, 0, "throttle is set to $THROTTLE");
+
+ my $lckloadfile = "/tmp/nodeloading.lockfile";
+ notify($ERRORS{'DEBUG'}, 0, "attempting to open node loading lockfile for throttling: $lckloadfile");
+ if (sysopen(SEM, $lckloadfile, O_RDONLY | O_CREAT)) {
+ notify($ERRORS{'DEBUG'}, 0, "opened lockfile, attempting to obtain lock");
+
+ if (flock(SEM, LOCK_EX)) {
+ notify($ERRORS{'DEBUG'}, 0, "obtained exclusive lock on $lckloadfile, checking for concurrent loads");
+ my $maxload = 1;
+ while ($maxload) {
+ notify($ERRORS{'DEBUG'}, 0, "running 'nodeset all stat' to determine number of nodes currently being loaded");
+ if (open(NODESET, "$XCAT_ROOT/bin/nodeset all stat \| grep install 2>&1 | ")) {
+ my @nodesetout = <NODESET>;
+ close(NODESET);
+ my $ld = @nodesetout;
+ notify($ERRORS{'DEBUG'}, 0, "current number of nodes loading: $ld");
+
+ if ($ld < $THROTTLE) {
+ notify($ERRORS{'OK'}, 0, "current nodes loading is less than throttle, ok to proceed");
+ $maxload = 0;
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "current nodes loading=$ld, throttle=$THROTTLE, must wait, sleeping for 10 seconds");
+ sleep 10;
+ }
+ } ## end if (open(NODESET, "$XCAT_ROOT/bin/nodeset all stat \| grep install 2>&1 | "...
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to run 'nodeset all stat' to determine number of nodes currently being loaded");
+ }
+ } ## end while ($maxload)
+ } ## end if (flock(SEM, LOCK_EX))
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to obtain exclusive lock on $lckloadfile");
+ }
+
+ notify($ERRORS{'OK'}, 0, "releasing exclusive lock on $lckloadfile, proceeding to install");
+ close(SEM);
+
+ } ## end if (sysopen(SEM, $lckloadfile, O_RDONLY | ...
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to open node loading lockfile");
+ }
+
+ } ## end if ($THROTTLE)
+ else {
+ notify($ERRORS{'DEBUG'}, 0, "throttle is NOT set");
+ }
+
+ XCATRINSTALL:
+
+ # Reset sshd wait start time, used only for diagnostic purposes
+ $sshd_start_time = 0;
+
+ # Make use of semaphore files to control the flow
+ # xCAT's rinstall does not handle locking of files
+ my $lckfile = "/tmp/rinstall.lockfile";
+ notify($ERRORS{'DEBUG'}, 0, "attempting to open rinstall lockfile: $lckfile");
+ if (sysopen(SEM, $lckfile, O_RDONLY | O_CREAT)) {
+ notify($ERRORS{'DEBUG'}, 0, "opened lockfile, attempting to obtain lock");
+
+ if (flock(SEM, LOCK_EX)) {
+ notify($ERRORS{'DEBUG'}, 0, "obtained exclusive lock on $lckfile");
+
+ # Safe to run rinstall command
+ insertloadlog($reservation_id, $computer_id, "rinstall", "starting install process");
+ notify($ERRORS{'OK'}, 0, "executing rinstall $computer_node_name");
+ if (open(RINSTALL, "$XCAT_ROOT/bin/rinstall $computer_node_name 2>&1 |")) {
+ $rinstall_attempts++;
+ notify($ERRORS{'OK'}, 0, "beginning rinstall attempt $rinstall_attempts");
+ while (<RINSTALL>) {
+ chomp($_);
+
+ #notify($ERRORS{'OK'},0,"$_");
+ if ($_ =~ /not in bay/) {
+ notify($ERRORS{'WARNING'}, 0, "rpower not in bay issue, will attempt to correct, calling rinv");
+ if (_fix_rpower($computer_node_name)) {
+
+ #try xcatrinstall again
+ close(RINSTALL);
+ close(SEM); # remove lock
+ # loop control
+ if ($rpower_fixes < 10) {
+ $rpower_fixes++;
+ sleep 1;
+ goto XCATRINSTALL;
+ }
+ else {
+ notify($ERRORS{'CRITCAL'}, 0, "rpower failed $rpower_fixes times on $computer_node_name");
+ return 0;
+ }
+ } ## end if (_fix_rpower($computer_node_name))
+ } ## end if ($_ =~ /not in bay/)
+ if ($_ =~ /Invalid login|does not exist/) {
+ notify($ERRORS{'CRITCAL'}, 0, "failed to initate rinstall on $computer_node_name - $_");
+ close(RINSTALL);
+ close(SEM);
+ insertloadlog($reservation_id, $computer_id, "failed", "failed to start load process on $computer_node_name");
+ return 0;
+ }
+
+ } #while RINSTALL
+ close(RINSTALL);
+
+ notify($ERRORS{'OK'}, 0, "releasing exclusive lock on $lckfile");
+ close(SEM);
+ } ## end if (open(RINSTALL, "$XCAT_ROOT/bin/rinstall $computer_node_name 2>&1 |"...
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not execute $XCAT_ROOT/bin/rinstall $computer_node_name $!");
+ close(SEM);
+ return 0;
+ }
+ } ## end if (flock(SEM, LOCK_EX))
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to obtain exclusive lock on $lckfile, error: $!, returning");
+ return;
+ }
+ } ## end if (sysopen(SEM, $lckfile, O_RDONLY | O_CREAT...
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to open node loading lockfile, error: $!, returning");
+ return;
+ }
+
+# Check progress, locate MAC and IP address for this node, monitor /var/log/messages for communication from node
+# dhcp req/ack, xcat calls, etc
+ my ($eth0MACaddress, $privateIP);
+ if (open(MACTAB, "$XCAT_ROOT/etc/mac.tab")) {
+ my @mactab = <MACTAB>;
+ close(MACTAB);
+ foreach my $line (@mactab) {
+ if ($line =~ /(^$computer_node_name(-eth[0-9])?)(\s+)([:0-9a-f]*)/) {
+ $eth0MACaddress = $4;
+ notify($ERRORS{'OK'}, 0, "MAC address for $computer_node_name collected $eth0MACaddress");
+ }
+ }
+ } ## end if (open(MACTAB, "$XCAT_ROOT/etc/mac.tab"))
+ if (!defined($eth0MACaddress)) {
+ notify($ERRORS{'WARNING'}, 0, "MAC address not found for $computer_node_name , possible issue with regex");
+ }
+
+ #should also store/pull private address from the database
+ if (open(HOSTS, "/etc/hosts")) {
+ my @hosts = <HOSTS>;
+ close(HOSTS);
+ foreach my $line (@hosts) {
+ if ($line =~ /([0-9]*.[0-9]*.[0-9]*.[0-9]*)\s+($computer_node_name)/) {
+ $privateIP = $1;
+ notify($ERRORS{'OK'}, 0, "PrivateIP address for $computer_node_name collected $privateIP");
+ last;
+ }
+ }
+ } ## end if (open(HOSTS, "/etc/hosts"))
+ if (!defined($privateIP)) {
+ notify($ERRORS{'WARNING'}, 0, "private IP address not found for $computer_node_name, possible issue with regex");
+ }
+ my ($s1, $s2, $s3, $s4, $s5) = 0;
+ my $sloop = 0;
+
+ #insertloadlog($reservation_id,$computer_id,"info","SUCCESS initiated install process");
+ #sleep for boot process to happen takes anywhere from 60-90 seconds
+ notify($ERRORS{'OK'}, 0, "sleeping 65 to allow bootstrap of $computer_node_name");
+ sleep 65;
+ my @TAILLOG;
+ my $t;
+
+ if ($eth0MACaddress && $privateIP) {
+ @TAILLOG = 0;
+ $t = 0;
+ if (open(TAIL, "</var/log/messages")) {
+ seek TAIL, -1, 2; #
+ for (;;) {
+ notify($ERRORS{'OK'}, 0, "$computer_node_name ROUND 1 checks loop $sloop of 45");
+ while (<TAIL>) {
+ if (!$s1) {
+ if ($_ =~ /dhcpd: DHCPDISCOVER from $eth0MACaddress/) {
+ $s1 = 1;
+ notify($ERRORS{'OK'}, 0, "$computer_node_name STAGE 1 set DHCPDISCOVER from $eth0MACaddress");
+ insertloadlog($reservation_id, $computer_id, "xcatstage1", "SUCCESS stage1 detected dhcp request for node");
+ }
+ }
+ if (!$s2) {
+ if ($_ =~ /dhcpd: DHCPACK on $privateIP to $eth0MACaddress/) {
+ $s2 = 1;
+ notify($ERRORS{'OK'}, 0, "$computer_node_name STAGE 2 set DHCPACK on $privateIP to $eth0MACaddress");
+ insertloadlog($reservation_id, $computer_id, "xcatstage2", "SUCCESS stage2 detected dhcp ack for node");
+ }
+ }
+ if (!$s3) {
+ if ($_ =~ /Serving \/tftpboot\/pxelinux.0 to $privateIP:/) {
+ $s3 = 1;
+ chomp($_);
+ notify($ERRORS{'OK'}, 0, "$computer_node_name STAGE 3 set $_");
+ insertloadlog($reservation_id, $computer_id, "xcatstage3", "SUCCESS stage3 node received pxe");
+ }
+ }
+ if (!$s4) {
+ if ($_ =~ /Serving \/tftpboot\/xcat\/(rhfc|linux_image|image|rhas.)\/x86\/install.gz to $privateIP:/) {
+ $s4 = 1;
+ chomp($_);
+ notify($ERRORS{'OK'}, 0, "$computer_node_name STAGE 4 set $_");
+ insertloadlog($reservation_id, $computer_id, "xcatstage4", "SUCCESS stage4 node received pxe install instructions");
+ }
+ }
+
+ #stage5 is where images and rhas(KS) are different
+ if (!$s5) {
+
+ #here we look for rpc.mountd
+ if ($_ =~ /authenticated mount request from $computer_node_name:(\d+) for/) {
+ $s5 = 1;
+ chomp($_);
+ notify($ERRORS{'OK'}, 0, "$computer_node_name STAGE 5 set $_");
+ insertloadlog($reservation_id, $computer_id, "xcatstage5", "SUCCESS stage5 node started installing via partimage");
+ }
+
+ #in case we miss the above statement
+ if ($image_os_name =~ /^(rhel|rhfc|fc|esx)/) {
+ if ($_ =~ /xcat: xcatd: $computer_node_name installing/) {
+ $s5 = 1;
+ chomp($_);
+ notify($ERRORS{'OK'}, 0, "$computer_node_name STAGE 5 set $_");
+ insertloadlog($reservation_id, $computer_id, "xcatstage5", "SUCCESS stage5 node started installing via kickstart");
+ }
+ }
+ } ## end if (!$s5)
+ } #while
+ #either stages are set or we loop or we rinstall again
+ #check s5 and counter for loop control
+ if ($s5) {
+ notify($ERRORS{'OK'}, 0, "$computer_node_name ROUND1 stages are set proceeding to next round");
+ close(TAIL);
+ goto ROUND2;
+ }
+ elsif ($sloop > 45) {
+ insertloadlog($reservation_id, $computer_id, "WARNING", "potential problem started $rinstall_attempts install attempt");
+
+ #hrmm this is taking too long
+ #have we been here before? if less than 3 attempts continue on the 3rd try fail
+ #whats the problem, chck known locations
+ # /tftpboot/xcat/image/x86
+ # look for tmpl file (in does_image_exist routine)
+ # does the machine need to reboot, premission to reboot issue
+ if (_check_pxe_grub_files($image_name)) {
+ notify($ERRORS{'OK'}, 0, "checkpxe_grub_file checked");
+ }
+
+ if ($rinstall_attempts < 3) {
+ close(TAIL);
+ insertloadlog($reservation_id, $computer_id, "repeat", "starting install process");
+ goto XCATRINSTALL;
+ }
+ else {
+
+ #fail this one and let whoever called me get another machine
+ notify($ERRORS{'CRITICAL'}, 0, "rinstall made $rinstall_attempts in ROUND1 on $computer_node_name with no success, admin needs to check it out");
+ insertloadlog($reservation_id, $computer_id, "failed", "FAILED problem made $rinstall_attempts install attempts failing reservation");
+ if (_nodeset_option($computer_node_name, "boot")) {
+ notify($ERRORS{'OK'}, 0, "due to failure reseting state of blade to boot");
+ }
+ close(TAIL);
+ return 0;
+ } ## end else [ if ($rinstall_attempts < 3)
+ } ## end elsif ($sloop > 45) [ if ($s5)
+ else {
+
+ #keep checking the messages log
+ $sloop++;
+ sleep 7;
+ seek TAIL, 0, 1;
+ }
+ } #for loop
+ } #if Tail
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could open /var/log/messages to $!");
+ }
+ } ## end if ($eth0MACaddress && $privateIP)
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "eth0MACaddress $eth0MACaddress && privateIP $privateIP are not set not able to use these checks");
+ insertloadlog($reservation_id, $computer_id, "failed", "FAILED could not locate private IP and MAC addresses in XCAT files failing reservation");
+ return 0;
+ }
+
+ ROUND2:
+
+ #begin second round of checks reset $sX
+ ($s1, $s2, $s3, $s4, $s5) = 0;
+ $sloop = 0;
+
+ # start time for loading
+ my $R2starttime = convert_to_epoch_seconds();
+
+ #during loading we need to wait based on some precentage of the estimated reload time (50%?)
+ #times range from 4-10 minutes perhaps longer for a large image
+ my $TM2waittime = int($image_reload_time / 2);
+ insertloadlog($reservation_id, $computer_id, "xcatround2", "starting ROUND2 checks - waiting for boot flag");
+
+ notify($ERRORS{'OK'}, 0, "Round 2 TM2waittime set to $TM2waittime on $computer_node_name");
+ if (open(TAIL, "</var/log/messages")) {
+ seek TAIL, -1, 2;
+ my $gettingclose = 0;
+ for (;;) {
+ notify($ERRORS{'OK'}, 0, "$computer_node_name round2 log checks 30sec loop count is $sloop of $image_reload_time TM2waittime= $TM2waittime");
+ while (<TAIL>) {
+ if (!$s1) {
+ if ($_ =~ /xcat: xcatd: set boot request from $computer_node_name/) {
+
+ insertloadlog($reservation_id, $computer_id, "bootstate", "node in boot state completed imaging process - proceeding to next round");
+ $s1 = 1;
+ notify($ERRORS{'OK'}, 0, "Round 2 STAGE 1 set $computer_node_name in boot state");
+ }
+
+ #is it even near completion only checking rhel installs
+ #not really useful for linux_images
+ if ($image_os_name =~ /^(rhel|rhfc|fc|esx)/) {
+ if (!$gettingclose) {
+ if ($_ =~ /rpc.mountd: authenticated mount request from $computer_node_name:(\d+) for \/install\/post/) {
+ $gettingclose = 1;
+ notify($ERRORS{'OK'}, 0, "Round 2 STAGE 1 install nearing completion on node $computer_node_name");
+ }
+ }
+ else {
+ if (!$s4) {
+ if ($sloop == $image_reload_time) {
+ notify($ERRORS{'OK'}, 0, "$computer_node_name Round 2 getting close, loop eq $image_reload_time, substracting 6 from loop count");
+ $sloop = ($sloop - 8);
+ $s4 = 1; #loop control, don't set this we loop forever
+ notify($ERRORS{'WARNING'}, 0, "ert estimated reload time may be too low\n $computer_node_name\nimagename $image_name\n current ert = $image_reload_time");
+ }
+ }
+ } ## end else [ if (!$gettingclose)
+ } ## end if ($image_os_name =~ /^(rhel|rhfc|fc|esx)/)
+ } ## end if (!$s1)
+ } #while
+ if ($s1) {
+
+ #good, move on
+ close(TAIL);
+ goto ROUND3;
+ }
+ else {
+ if ($sloop > $image_reload_time) {
+ notify($ERRORS{'OK'}, 0, "exceeded TM2waittime of $TM2waittime minutes sloop= $sloop ert= $image_reload_time");
+
+ # check delta from when we started actual loading till now
+ my $rtime = convert_to_epoch_seconds();
+ my $delta = $rtime - $R2starttime;
+ if ($delta < ($image_reload_time * 60)) {
+
+ #ok delta is actually less then ert, we don't need to stop it yet.
+ notify($ERRORS{'OK'}, 0, "loading delta is less than ert, not stopping yet delta is $delta/60 ");
+ sleep 35;
+ $sloop = ($sloop - 8); #decrement loop control
+ seek TAIL, 0, 1;
+
+ }
+ elsif ($rinstall_attempts < 2) {
+ notify($ERRORS{'WARNING'}, 0, "starting rinstall again");
+ insertloadlog($reservation_id, $computer_id, "WARNING", "potential problem restarting rinstall current attemp $rinstall_attempts");
+ close(TAIL);
+ insertloadlog($reservation_id, $computer_id, "repeat", "starting install process");
+ goto XCATRINSTALL;
+ }
+ else {
+
+ #fail this one and let whoever called me get another machine
+ notify($ERRORS{'CRITICAL'}, 0, "rinstall made $rinstall_attempts in ROUND2 on $computer_node_name with no success, admin needs to check it out");
+ insertloadlog($reservation_id, $computer_id, "failed", "rinstall made $rinstall_attempts failing request");
+ close(TAIL);
+ return 0;
+ }
+ } ## end if ($sloop > $image_reload_time)
+ else {
+ sleep 35;
+ $sloop++; #loop control
+ insertloadlog($reservation_id, $computer_id, "info", "node in load process waiting for signal");
+ seek TAIL, 0, 1;
+
+ #goto TAILMESSAGES2;
+ }
+ } ## end else [ if ($s1)
+ } #for
+ } ## end if (open(TAIL, "</var/log/messages"))
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could open /var/log/messages to $!");
+ return 0;
+ }
+
+ ROUND3:
+
+ my $nodeset_status;
+
+ # Round 3 checks, machine has been installed we wait here for boot process which could include sysprep
+ # we are checking for the boot state in the OS status
+ insertloadlog($reservation_id, $computer_id, "xcatround3", "starting round 3 checks - finishing post configuration");
+ $wait_loops = 0;
+ while (!$bootstatus) {
+ my $nodeset_status = _nodeset($computer_node_name);
+
+ if ($nodeset_status =~ /boot/) {
+ $bootstatus = 1;
+ notify($ERRORS{'OK'}, 0, "$computer_node_name has been reinstalled with $image_name");
+ notify($ERRORS{'OK'}, 0, "xcat has set the boot flag");
+ if ($image_os_name =~ /win|wxp|2003/) {
+ notify($ERRORS{'OK'}, 0, "waiting 3 minutes to allow OS to reboot and initialize machine");
+ sleep 180;
+ }
+
+ #elsif($osname =~ /^(rhel|rh3image|fc|rhfc|rh4image)/){
+ elsif ($image_os_name =~ /^(rh[0-9]image|rhel[0-9]|fc[0-9]image|rhfc[0-9]|rhas[0-9]|esx[0-9]+)/) {
+ notify($ERRORS{'OK'}, 0, "waiting 65 sec to allow OS to reboot and initialize machine");
+ sleep 65;
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "waiting 3 minutes to allow OS to reboot and initialize machine");
+ sleep 180;
+ }
+ my ($readycount, $ready) = 0;
+ READYFLAG:
+
+ #check /var/log/messages file for READY
+
+ if (open(TAIL, "</var/log/messages")) {
+ seek TAIL, -1, 2;
+ for (;;) {
+ notify($ERRORS{'OK'}, 0, "$computer_node_name checking for READY FLAG loop count is $readycount of 10");
+ while (<TAIL>) {
+ if ($_ =~ /READY|ready|Starting firstboot: succeeded/) {
+ $ready = 1 if ($_ =~ /$computer_node_name/);
+ }
+ if ($image_os_name =~ /^(rh|fc|esx)/) {
+ if ($_ =~ /$computer_node_name|$computer_node_name kernel/) {
+ notify($ERRORS{'OK'}, 0, "$computer_node_name booting up");
+ sleep 5;
+ $ready = 1;
+ close(TAIL);
+ goto SSHDATTEMPT;
+ }
+ }
+ } #while
+
+ if ($readycount > 10) {
+ notify($ERRORS{'OK'}, 0, "taking longer than expected, readycount==$readycount moving to next set of checks");
+ $ready = 1;
+ close(TAIL);
+ goto SSHDATTEMPT;
+ }
+ if ($readycount > 2) {
+
+ #check ssh status just in case we missed the flag
+ my $sshd = _sshd_status($computer_node_name, $image_name);
+ if ($sshd eq "on") {
+ $ready = 1;
+ notify($ERRORS{'OK'}, 0, "we may have missed start flag going next stage");
+ close(TAIL);
+ goto SSHDATTEMPT;
+ }
+ } ## end if ($readycount > 2)
+ if (!$ready) {
+ notify($ERRORS{'OK'}, 0, "$computer_node_name not ready yet, sleeping for 40 seconds");
+ sleep 40;
+ seek TAIL, 0, 1;
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "/var/log/messages reports $computer_node_name is ready");
+ insertloadlog($reservation_id, $computer_id, "xcatREADY", "detected ready signal from node - proceeding");
+ close(TAIL);
+ goto SSHDATTEMPT;
+ }
+
+ #placing out side of if statements for loop control
+ $readycount++;
+ } #for
+ } ## end if (open(TAIL, "</var/log/messages"))
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not open messages at READYFLAG $!");
+ }
+ notify($ERRORS{'OK'}, 0, "proceeding for sync sshd active");
+ } ## end if ($nodeset_status =~ /boot/)
+ else {
+
+ # check for strange states
+
+ }
+ } ## end while (!$bootstatus)
+
+ # we need to wait for sshd to become active
+ my $sshd_attempts = 0;
+ SSHDATTEMPT:
+ my $sshdstatus = 0;
+ $wait_loops = 0;
+ $sshd_attempts++;
+ my $sshd_status = "off";
+
+ # Set the sshd start time to now if it hasn't been set already
+ # This is used to report how long sshd took to become active
+ $sshd_start_time = time() if !$sshd_start_time;
+
+ while (!$sshdstatus) {
+ my $sshd_status = _sshd_status($computer_node_name, $image_name);
+ if ($sshd_status eq "on") {
+
+ # Set the sshd end time to now to capture how long it took sshd to become active
+ $sshd_end_time = time();
+ my $sshd_duration = $sshd_end_time - $sshd_start_time;
+
+ $sshdstatus = 1;
+ notify($ERRORS{'OK'}, 0, "$computer_node_name sshd has become active, took $sshd_duration secs, ok to proceed to sync ssh keys");
+ insertloadlog($reservation_id, $computer_id, "info", "synchronizing keys");
+ } ## end if ($sshd_status eq "on")
+ else {
+
+ #either sshd is off or N/A, we wait
+ if ($wait_loops >= 7) {
+ if ($sshd_attempts < 3) {
+ goto SSHDATTEMPT;
+ }
+ else {
+
+ # Waited long enough for sshd to become active
+
+ # Set the sshd end time to now to capture how long process waited for sshd to become active
+ $sshd_end_time = time();
+ my $sshd_duration = $sshd_end_time - $sshd_start_time;
+
+ notify($ERRORS{'WARNING'}, 0, "$computer_node_name waited acceptable amount of time for sshd to become active, $sshd_duration secs");
+
+ #need to check power, maybe reboot it. for now fail it
+ #try to reinstall it once
+ if ($rinstall_attempts < 2) {
+ notify($ERRORS{'WARNING'}, 0, "$computer_node_name starting rinstall again");
+ insertloadlog($reservation_id, $computer_id, "repeat", "starting install process");
+ close(TAIL);
+ goto XCATRINSTALL;
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "$computer_node_name: sshd never became active after 2 rinstall attempts");
+ insertloadlog($reservation_id, $computer_id, "failed", "exceeded maximum install attempts");
+ return 0;
+ }
+ } ## end else [ if ($sshd_attempts < 3)
+ } ## end if ($wait_loops >= 7)
+ else {
+ $wait_loops++;
+
+ # to give post config a chance
+ notify($ERRORS{'OK'}, 0, "going to sleep 15 seconds, waiting for post config to finish");
+ sleep 15;
+ }
+ } # else
+ } #while
+
+ # Clear ssh public keys from /root/.ssh/known_hosts
+ my $known_hosts = "/root/.ssh/known_hosts";
+ my @file;
+ if (open(FILE, $known_hosts)) {
+ @file = <FILE>;
+ close FILE;
+
+ foreach my $line (@file) {
+ if ($line =~ s/$computer_node_name.*\n//) {
+ notify($ERRORS{'OK'}, 0, "removing $computer_node_name ssh public key from $known_hosts");
+ }
+ }
+
+ if (open(FILE, ">$known_hosts")) {
+ print FILE @file;
+ close FILE;
+ }
+ } ## end if (open(FILE, $known_hosts))
+ else {
+ notify($ERRORS{'OK'}, 0, "could not open $known_hosts for editing the $computer_node_name public ssh key");
+ }
+
+ # Synchronize ssh keys using xCAT's makesshgkh
+ my $makessygkh_attempts = 0;
+ MAKESSH:
+ notify($ERRORS{'OK'}, 0, " resting 1sec before executing makesshgkh");
+ sleep 1;
+ if (open(MAKESSHGKH, "$XCAT_ROOT/sbin/makesshgkh $computer_node_name |")) {
+ $makessygkh_attempts++;
+ notify($ERRORS{'OK'}, 0, " makesshgkh attempt $makessygkh_attempts ");
+ while (<MAKESSHGKH>) {
+ chomp($_);
+ if ($_ =~ /Scanning keys/) {
+ notify($ERRORS{'OK'}, 0, "$_");
+ }
+ }
+ close MAKESSHGKH;
+ my $keysync = 0;
+ my $keysynccheck = 0;
+
+ while (!$keysync) {
+ $keysynccheck++;
+ my $sshd = _sshd_status($computer_node_name, $image_name);
+ if ($sshd =~ /on/) {
+ $keysync = 1;
+ notify($ERRORS{'OK'}, 0, "keys synced");
+ insertloadlog($reservation_id, $computer_id, "info", "SUCCESS keys synchronized");
+ last;
+ }
+ if ($keysynccheck > 3) {
+ if ($makessygkh_attempts < 1) {
+ notify($ERRORS{'OK'}, 0, "keysynccheck exceeded 5 minutes, there might be a problem running makesshgkh again");
+ goto MAKESSH;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "makesshgkh exceeded 2 attempts to create new ssh keys there appears to be a problem with $computer_node_name moving on");
+
+ #move on-
+ $keysync = 1;
+ last;
+ }
+ } ## end if ($keysynccheck > 3)
+ notify($ERRORS{'OK'}, 0, "waiting for ssh keys to be updated");
+ sleep 5;
+ } ## end while (!$keysync)
+ } ## end if (open(MAKESSHGKH, "$XCAT_ROOT/sbin/makesshgkh $computer_node_name |"...
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not execute $XCAT_ROOT/sbin/makesshgkh $computer_node_name $!");
+ }
+
+ # Perform post load tasks
+
+ # Windows specific routines
+ if ($image_os_name =~ /winxp|wxp|win2003/) {
+
+ insertloadlog($reservation_id, $computer_id, "info", "randomizing system level passwords");
+
+ #change passwords for root and administrator account
+ #skip changing root password for imageprep loads
+ if (changewindowspasswd($computer_node_name, "root")) {
+ notify($ERRORS{'OK'}, 0, "Successfully changed password, account $computer_node_name,root");
+ }
+
+ if (changewindowspasswd($computer_node_name, "administrator")) {
+ notify($ERRORS{'OK'}, 0, "Successfully changed password, account $computer_node_name,administrator");
+ }
+
+ #disable remote desktop port
+ if (remotedesktopport($computer_node_name, "DISABLE")) {
+ notify($ERRORS{'OK'}, 0, "remote desktop disabled on $computer_node_name");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "remote desktop not disable on $computer_node_name");
+ }
+
+ #due to sysprep sshd is set to manual start
+ if (_set_sshd_startmode($computer_node_name, "auto")) {
+ notify($ERRORS{'OK'}, 0, "successfully set sshd service on $computer_node_name to start auto");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to set sshd service on $computer_node_name to start auto");
+ }
+
+ #check for root logged in on console and then logoff
+ notify($ERRORS{'OK'}, 0, "checking for any console users $computer_node_name");
+
+ my @QA = run_ssh_command($computer_node_name, $IDENTITY_wxp, "cmd /c qwinsta.exe", "root");
+ foreach my $r (@{$QA[1]}) {
+ if ($r =~ /([>]?)([-a-zA-Z0-9]*)\s+([a-zA-Z0-9]*)\s+ ([0-9]*)\s+([a-zA-Z]*)/) {
+ my $state = $5;
+ my $session = $2;
+ my $user = $3;
+ if ($5 =~ /Active/) {
+ notify($ERRORS{'OK'}, 0, "detected $user on $session still logged on $computer_node_name $r, sleeping 7 before logging off");
+ sleep 7;
+ my @LF = run_ssh_command($computer_node_name, $IDENTITY_wxp, "cmd /c logoff.exe $session");
+ foreach my $l (@{$LF[1]}) {
+ notify($ERRORS{'OK'}, 0, "output from attempt to logoff $user on $session");
+ }
+
+ }
+ } ## end if ($r =~ /([>]?)([-a-zA-Z0-9]*)\s+([a-zA-Z0-9]*)\s+ ([0-9]*)\s+([a-zA-Z]*)/)
+ } ## end foreach my $r (@{$QA[1]})
+
+ #reboot the box based on options
+ if ($imagemeta_postoption =~ /reboot/i) {
+ my $rebooted = 1;
+ my $reboot_wait_count = 0;
+ my @retarray;
+ while ($rebooted) {
+ if ($reboot_wait_count > 55) {
+ notify($ERRORS{'CRITICAL'}, 0, "waited $reboot_wait_count on reboot after auto_create_image on $computer_node_name");
+ $retarray[1] = "waited $reboot_wait_count on reboot after netdom on $computer_node_name";
+ return @retarray;
+ }
+ notify($ERRORS{'OK'}, 0, "$computer_node_name not completed reboot sleeping for 25");
+ sleep 25;
+ if (_pping($computer_node_name)) {
+
+ #it pingable check if sshd is open
+ notify($ERRORS{'OK'}, 0, "$computer_node_name is pingable, checking sshd port");
+ my $sshd = _sshd_status($computer_node_name, $image_name);
+ if ($sshd =~ /on/) {
+ $rebooted = 0;
+ notify($ERRORS{'OK'}, 0, "$computer_node_name sshd is open");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "$computer_node_name sshd NOT open yet,sleep 5");
+ sleep 5;
+ }
+ } #_pping
+ $reboot_wait_count++;
+
+ } #while
+ } #reboot
+
+#win2003 only - need to set private adapter to static without a gateway
+# win2003 and probably vista zero out one gateway and we only need a gateway on the public adapter
+# so we need to remove the one on the private side
+# downside - we need to reset it to dhcp before making an image.....
+
+ if ($image_os_name =~ /^(win2003)/) {
+ insertloadlog($reservation_id, $computer_id, "info", "detected OS which requires network gateway modification");
+ notify($ERRORS{'OK'}, 0, "detected win2003 OS, proceeding to change private adapter to static from dhcp on $computer_node_name");
+ my %ip;
+ my $myadapter;
+ my @ipconfig = run_ssh_command($computer_node_name, $IDENTITY_wxp, "ipconfig -all", "root");
+
+ # build hash of needed info and set the correct private adapter.
+ foreach my $a (@{$ipconfig[1]}) {
+ $myadapter = $1 if ($a =~ /Ethernet adapter (.*):/);
+ $ip{$myadapter}{"private"} = 1
+ if ($a =~ /IP Address([\s.]*): $privateIP/);
+ $ip{$myadapter}{"subnetmask"} = $2
+ if ($a =~ /Subnet Mask([\s.]*): ([.0-9]*)/);
+ }
+
+ my $privateadapter;
+ my $subnetmask;
+
+ foreach my $key (keys %ip) {
+ if (defined($ip{$key}{private})) {
+ if ($ip{$key}{private}) {
+ $privateadapter = "\"$key\"";
+ $subnetmask = $ip{$key}{subnetmask};
+ }
+ }
+ }
+
+ notify($ERRORS{'OK'}, 0, "attempted to convert private adapter on $computer_node_name to static with no gateway");
+
+ #not using run_ssh_command here
+ if (open(NETSH, "/usr/bin/ssh -x -i $IDENTITY_wxp $computer_node_name \"netsh interface ip set address name=\\\"$privateadapter\\\" source=static addr=$privateIP mask=$subnetmask\" & 2>&1 |")) {
+
+ #losing connection
+ my $go = 1;
+ while ($go) {
+
+ #print "hi\n";
+ sleep 4;
+ if (open(PS, "ps -ef |")) {
+ my @ps = <PS>;
+ close(PS);
+ sleep 4;
+ foreach my $p (@ps) {
+ if ($p =~ /$computer_node_name netsh interface/) {
+ if ($p =~ /(root)\s+([0-9]*)/) {
+ if (open(KILLIT, "kill -9 $2 |")) {
+ close(KILLIT);
+ close(NETSH);
+ notify($ERRORS{'OK'}, 0, "killing ssh $computer_node_name netsh process");
+ }
+ }
+ }
+ } ## end foreach my $p (@ps)
+ } ## end if (open(PS, "ps -ef |"))
+
+ $go = 0;
+ } ## end while ($go)
+ } ## end if (open(NETSH, "/usr/bin/ssh -x -i $IDENTITY_wxp $computer_node_name \"netsh interface ip set address name=\\\"$privateadapter\\\" source=static addr=$privateIP mask=$subnetmask\" & 2>&1 |"...
+
+ #make sure it came back
+ if (_sshd_status($computer_node_name, $image_name)) {
+ notify($ERRORS{'OK'}, 0, "successful $computer_node_name is accessible after static assignment");
+ insertloadlog($reservation_id, $computer_id, "info", "SUCCESS network gateway modification successful");
+ }
+ else {
+
+ }
+
+ #disable NetBios
+ notify($ERRORS{'OK'}, 0, "attempted to convert private adapter on $computer_node_name to static with no gateway");
+ my $path1 = "$TOOLS/disablenetbios.vbs";
+ my $path2 = "$computer_node_name:disablenetbios.vbs";
+ if (run_scp_command($path1, $path2, $IDENTITY_wxp)) {
+ notify($ERRORS{'DEBUG'}, 0, "copied $path1 to $path2");
+ my @DNBIOS = run_ssh_command($computer_node_name, $IDENTITY_wxp, "cscript.exe //Nologo disablenetbios.vbs", "root");
+ foreach my $l (@{$DNBIOS[1]}) {
+ if ($l =~ /denied|socket/) {
+ notify($ERRORS{'WARNING'}, 0, "failed to disablenetbios.vbs @{ $DNBIOS[1] }");
+ }
+ }
+
+ } ## end if (run_scp_command($path1, $path2, $IDENTITY_wxp...
+ else {
+ notify($ERRORS{'WARNING'}, 0, "run_scp_command failed to copy $path1 to $path2");
+ }
+
+ } ## end if ($image_os_name =~ /^(win2003)/)
+ } ## end if ($image_os_name =~ /winxp|wxp|win2003/)
+
+ # Linux post-load tasks
+ elsif ($image_os_name =~ /^(rh[0-9]image|rhel[0-9]|fc[0-9]image|rhfc[0-9]|rhas[0-9]|esx[0-9]+)/) {
+
+ #linux specfic routines
+ #FIXME move to generic post options on per image basis
+ if ($image_os_name =~ /^(esx[0-9]*)/) {
+
+ #esx specific post
+ my $cmdstring = "/usr/sbin/esxcfg-vswitch -a vSwitch1;/usr/sbin/esxcfg-vswitch -L vmnic1 vSwitch1;/usr/sbin/esxcfg-vswitch -A \"Virtual Machine Public Network\" vSwitch1";
+
+ my @sshd = run_ssh_command($computer_node_name, $IDENTITY_bladerhel, $cmdstring, "root");
+ foreach my $l (@{$sshd[1]}) {
+
+ #any response is a potential problem
+ notify($ERRORS{'DEBUG'}, 0, "esxcfg-vswitch output: $l");
+ }
+
+ #restart mgmt-vmware
+ sleep(8); # sleep briefly before attemping to restart
+ # restart needs to include "&" for some reason it doesn't return but completes - dunno?
+ @sshd = run_ssh_command($computer_node_name, $IDENTITY_bladerhel, "/etc/init.d/mgmt-vmware restart &", "root");
+ foreach my $l (@sshd) {
+ if ($l =~ /failed/i) {
+ notify($ERRORS{'WARNING'}, 0, "failed to restart mgmt-vmware @sshd");
+ return 0;
+ }
+ }
+ } ## end if ($image_os_name =~ /^(esx[0-9]*)/)
+ #FIXME - could be an issue for esx servers
+ if (changelinuxpassword($computer_node_name, "root")) {
+ notify($ERRORS{'OK'}, 0, "successfully changed root password on $computer_node_name");
+
+#insertloadlog($reservation_id, $computer_id, "info", "SUCCESS randomized roots password");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "failed to edit root password on $computer_node_name");
+ }
+
+ #disable ext_sshd
+ my @stopsshd = run_ssh_command($computer_node_name, $IDENTITY_bladerhel, "/etc/init.d/ext_sshd stop", "root");
+ foreach my $l (@{$stopsshd[1]}) {
+ if ($l =~ /Stopping ext_sshd/) {
+ notify($ERRORS{'OK'}, 0, "ext sshd stopped on $computer_node_name");
+ last;
+ }
+ }
+
+ #if an image, clear wtmp and krb token files
+ # FIXME - move to createimage
+ if ($image_os_name =~ /^(rh[0-9]image|rhel[0-9]|fc[0-9]image|rhfc[0-9]|rhas[0-9]|esx[0-9]+)/) {
+ my @cleartmp = run_ssh_command($computer_node_name, $IDENTITY_bladerhel, "/usr/sbin/tmpwatch -f 0 /tmp; /bin/cp /dev/null /var/log/wtmp", "root");
+ foreach my $l (@{$cleartmp[1]}) {
+ notify($ERRORS{'DEBUG'}, 0, "output from cleartmp post load $computer_node_name $l");
+ }
+ }
+
+ # clear external_sshd file of any AllowUsers string
+ my $path1 = "$computer_node_name:/etc/ssh/external_sshd_config";
+ my $path2 = "/tmp/$computer_node_name.sshd";
+ if (run_scp_command($path1, $path2, $IDENTITY_bladerhel)) {
+ notify($ERRORS{'DEBUG'}, 0, "scp success retrieved $path1");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to retrieve $path1");
+ }
+ #remove from sshd
+ if (open(SSHDCFG, "/tmp/$computer_node_name.sshd")) {
+ @file = <SSHDCFG>;
+ close SSHDCFG;
+ foreach my $l (@file) {
+ $l = "" if ($l =~ /AllowUsers/);
+ }
+ if (open(SCP, ">/tmp/$computer_node_name.sshd")) {
+ print SCP @file;
+ close SCP;
+ }
+ undef $path1;
+ undef $path2;
+ $path1 = "/tmp/$computer_node_name.sshd";
+ $path2 = "$computer_node_name:/etc/ssh/external_sshd_config";
+ if (run_scp_command($path1, $path2, $IDENTITY_bladerhel)) {
+ notify($ERRORS{'DEBUG'}, 0, "scp success copied $path1 to $path2");
+ unlink $path1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to copy $path1 to $path2");
+ }
+ } ## end if (open(SSHDCFG, "/tmp/$computer_node_name.sshd"...
+
+
+ } ## end elsif ($image_os_name =~ /^(rh[0-9]image|rhel[0-9]|fc[0-9]image|rhfc[0-9]|rhas[0-9]|esx[0-9]+)/) [ if ($image_os_name =~ /winxp|wxp|win2003/)
+
+ # IP configuration
+ if ($IPCONFIGURATION ne "manualDHCP") {
+ insertloadlog($reservation_id, $computer_id, "info", "detected change required in IP address configuration on node");
+
+ #not default setting
+ if ($IPCONFIGURATION eq "dynamicDHCP") {
+ my $assignedIPaddress = getdynamicaddress($computer_node_name, $image_os_name);
+ if ($assignedIPaddress) {
+
+ #update computer table
+ if (update_computer_address($computer_id, $assignedIPaddress)) {
+ notify($ERRORS{'OK'}, 0, "dynamic address collected $assignedIPaddress -- updated computer table");
+ insertloadlog($reservation_id, $computer_id, "dynamicDHCPaddress", "SUCCESS collected dynamicDHCP address");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "failed to update dynamic address $assignedIPaddress for$computer_id $computer_node_name ");
+ insertloadlog($reservation_id, $computer_id, "dynamicDHCPaddress", "FAILED to update dynamicDHCP address failing reservation");
+ return 0;
+ }
+ } ## end if ($assignedIPaddress)
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not fetch dynamic address from $computer_node_name $image_name");
+ insertloadlog($reservation_id, $computer_id, "dynamicDHCPaddress", "FAILED to collected dynamicDHCP address failing reservation");
+ return 0;
+ }
+ } ## end if ($IPCONFIGURATION eq "dynamicDHCP")
+ elsif ($IPCONFIGURATION eq "static") {
+ insertloadlog($reservation_id, $computer_id, "info", "setting staticIPaddress");
+
+ if (setstaticaddress($computer_node_name, $image_os_name, $computer_ip_address)) {
+ notify($ERRORS{'DEBUG'}, 0, "set static address on $computer_ip_address $computer_node_name ");
+ insertloadlog($reservation_id, $computer_id, "staticIPaddress", "SUCCESS set static IP address on public interface");
+ }
+ else {
+ insertloadlog($reservation_id, $computer_id, "staticIPaddress", "failed to set static IP address on public interface");
+ return 0;
+ }
+ } ## end elsif ($IPCONFIGURATION eq "static") [ if ($IPCONFIGURATION eq "dynamicDHCP")
+ } ## end if ($IPCONFIGURATION ne "manualDHCP")
+
+ return 1;
+} ## end sub load
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 capture_prepare
+
+ Parameters :
+ Returns : 1 if sucessful, 0 if failed
+ Description :
+
+=cut
+
+sub capture_prepare {
+ my $self = shift;
+ if (ref($self) !~ /xCAT/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+ return 0;
+ }
+
+ # Get data
+ my $image_name = $self->data->get_image_name();
+ my $computer_short_name = $self->data->get_computer_short_name();
+ my $computer_node_name = $self->data->get_computer_node_name();
+
+ # Print some preliminary information
+ notify($ERRORS{'OK'}, 0, "image=$image_name, computer=$computer_short_name");
+
+ # Modify currentimage.txt
+ if (write_currentimage_txt($self->data)) {
+ notify($ERRORS{'OK'}, 0, "currentimage.txt updated on $computer_short_name");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to update currentimage.txt on $computer_short_name");
+ }
+
+ if ($self->_edit_nodetype($computer_node_name, $image_name)) {
+ notify($ERRORS{'OK'}, 0, "nodetype modified, node $computer_node_name, image name $image_name");
+ } # Close if _edit_nodetype
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not edit nodetype, node $computer_node_name, image name $image_name");
+ return 0;
+ } # Close _edit_nodetype failed
+
+ my @Images;
+ my ($i, $imagefile);
+
+ # Get the image repository path
+ my $image_repository_path = $self->_get_image_repository_path();
+ if (!$image_repository_path) {
+ notify($ERRORS{'CRITICAL'}, 0, "xCAT image repository information could not be determined");
+ return 0;
+ }
+
+ # Get the image template repository path
+ my $tmpl_repository_path = $self->_get_image_template_path();
+ if (!$tmpl_repository_path) {
+ notify($ERRORS{'CRITICAL'}, 0, "xCAT template repository information could not be determined");
+ return 0;
+ }
+
+ # Get the image template repository path
+ my $basetmpl = $self->_get_base_template_filename();
+ if (!$basetmpl) {
+ notify($ERRORS{'CRITICAL'}, 0, "xCAT template repository information could not be determined");
+ return 0;
+ }
+
+ notify($ERRORS{'OK'}, 0, "attempting to create $tmpl_repository_path/$image_name.tmpl");
+ if (open(IMAGE, "/bin/cp $tmpl_repository_path/$basetmpl $tmpl_repository_path/$image_name.tmpl |")) {
+ @Images = <IMAGE>;
+ close(IMAGE);
+ foreach $i (@Images) {
+
+ #if anything could mean failure
+ if ($i) {
+ notify($ERRORS{'OK'}, 0, "@Images");
+ }
+ }
+ } # Close if open handle for cp tmpl file command
+
+ #check to see if the new image file is there
+ if (open(IMAGES, "/bin/ls -1 $tmpl_repository_path |")) {
+ @Images = <IMAGES>;
+ close(IMAGES);
+ ($i, $imagefile) = 0;
+ foreach $i (@Images) {
+ if ($i =~ /$image_name.tmpl/) {
+ $imagefile = 1;
+ }
+ }
+ if ($imagefile) {
+ notify($ERRORS{'OK'}, 0, "$tmpl_repository_path/$image_name created");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, " $tmpl_repository_path/$image_name NOT created");
+ return 0;
+ }
+ } # Close if tmpl file exists
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not execute /bin/ls -1 $tmpl_repository_path $! ");
+ return 0;
+ } # Close tmpl file does not exist
+
+ # Call xCAT's nodeset, configure xCAT to save image on next reboot
+ if (_nodeset_option($computer_node_name, "image")) {
+ notify($ERRORS{'OK'}, 0, "$computer_node_name set to image state");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "failed $computer_node_name set to image state");
+ return 0;
+ }
+
+ notify($ERRORS{'OK'}, 0, "returning 1");
+ return 1;
+} ## end sub capture_prepare
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 capture_monitor
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub capture_monitor {
+ my $self = shift;
+ if (ref($self) !~ /xCAT/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+ return 0;
+ }
+
+ # Get the required data
+ my $computer_node_name = $self->data->get_computer_node_name();
+ my $image_name = $self->data->get_image_name();
+
+ # Get the image repository path
+ my $image_repository_path = $self->_get_image_repository_path();
+ if (!$image_repository_path) {
+ notify($ERRORS{'CRITICAL'}, 0, "xCAT image repository information could not be determined");
+ return 0;
+ }
+
+ # Wait for node to reboot
+ notify($ERRORS{'OK'}, 0, "sleeping for 120 seconds before beginning to monitor image copy process");
+ sleep 120;
+
+ # Set variables to control how may attempts are made to wait for capture to finish
+ my $capture_loop_attempts = 80;
+ my $capture_loop_wait = 30;
+
+ # Figure out and print how long will wait before timing out
+ my $maximum_wait_minutes = ($capture_loop_attempts * $capture_loop_wait) / 60;
+ notify($ERRORS{'OK'}, 0, "beginning to wait for image capture to complete, maximum wait time: $maximum_wait_minutes minutes");
+
+ my $image_size = 0;
+ my $nodeset_status;
+ CAPTURE_LOOP: for (my $capture_loop_count = 0; $capture_loop_count < $capture_loop_attempts; $capture_loop_count++) {
+ notify($ERRORS{'OK'}, 0, "attempt $capture_loop_count/$capture_loop_attempts: image copy not complete, sleeping for $capture_loop_wait seconds");
+ sleep $capture_loop_wait;
+
+ # Get the nodeset status for the node being captured
+ $nodeset_status = _nodeset_option($computer_node_name, "stat");
+ notify($ERRORS{'DEBUG'}, 0, "nodeset status for $computer_node_name: $nodeset_status");
+
+ # nodeset stat will return 'boot' when image capture (Partimage) is complete
+ if ($nodeset_status eq "boot") {
+ last CAPTURE_LOOP;
+ }
+
+ # Check the image size to see if it's growing
+ notify($ERRORS{'OK'}, 0, "checking size of $image_name");
+ my $current_image_size = $self->get_image_size($image_name);
+
+ # Check if image size is larger than the last time it was checked
+ if ($current_image_size > $image_size) {
+ notify($ERRORS{'OK'}, 0, "image size has increased: $image_size -> $current_image_size, still copying");
+ $image_size = $current_image_size;
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "image size is the same: $image_size=$current_image_size, copy may be complete");
+ }
+ } ## end for (my $capture_loop_count = 0; $capture_loop_count...
+
+ # Exiting waiting loop, nodeset status should be boot if successful
+ if ($nodeset_status eq "boot") {
+ # Nodeset 'boot' flag has been set, image copy process is complete
+ notify($ERRORS{'OK'}, 0, "image copy complete, nodeset status was set to 'boot' for $computer_node_name");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "image copy timed out, waited $maximum_wait_minutes minutes, nodeset status for $computer_node_name never changed to boot: $nodeset_status");
+ return 0;
+ }
+
+ # Create mbr and sfdisk files
+ if (open(LS, "/bin/ls -1s $image_repository_path |")) {
+ my @LS = <LS>;
+ close(LS);
+ foreach my $l (@LS) {
+ if ($l =~ /$image_name-hda/) {
+
+ #create hda.mbr and hda.sfdisk
+ if (open(CP, "/bin/cp $image_repository_path/$image_name-hda.mbr $image_repository_path/$image_name-sda.mbr |")) {
+ close(CP);
+ notify($ERRORS{'OK'}, 0, "copied $image_name-hda.mbr to $image_repository_path/$image_name-sda.mbr");
+
+ #create sfdisk modify hardrive type
+ if (open(CP, "/bin/cp $image_repository_path/$image_name-hda.sfdisk $image_repository_path/$image_name-sda.sfdisk |")) {
+ close(CP);
+ notify($ERRORS{'OK'}, 0, "copied $image_name-hda.sfdisk to $image_repository_path/$image_name-sda.sfdisk");
+
+ #read in file
+ if (open(FILE, "$image_repository_path/$image_name-sda.sfdisk")) {
+ my @lines = <FILE>;
+ close(FILE);
+ foreach my $l (@lines) {
+ if ($l =~ s/hda/sda/g) {
+
+ #editing file
+ }
+ }
+
+ #print array to file
+ if (open(OUTFILE, ">$image_repository_path/$image_name-sda.sfdisk")) {
+ print OUTFILE @lines;
+ close(OUTFILE);
+ notify($ERRORS{'OK'}, 0, "modified drivetype of $image_name-sda.sfdisk");
+ }
+ } ## end if (open(FILE, "$image_repository_path/$image_name-sda.sfdisk"...
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not open $image_repository_path/$image_name-sda.mbr for editing $!");
+ }
+ } # Close if copy hda.sfdisk command
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not copy $image_name-hda.sfdisk to $image_repository_path/$image_name-sda.sfdisk $!");
+ }
+ } # Close if copy mbr file command
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not copy $image_name-hda.mbr to $image_repository_path/$image_name-sda.mbr $!");
+ }
+ } # Close if imagename-hda
+
+ elsif ($l =~ /$image_name-sda/) {
+
+ #create sda.mbr and sda.sfdisk
+ if (open(CP, "/bin/cp $image_repository_path/$image_name-sda.mbr $image_repository_path/$image_name-hda.mbr |")) {
+ close(CP);
+ notify($ERRORS{'OK'}, 0, "copied $image_name-sda.mbr to $image_repository_path/$image_name-hda.mbr");
+
+ #create sfdisk
+ if (open(CP, "/bin/cp $image_repository_path/$image_name-sda.sfdisk $image_repository_path/$image_name-hda.sfdisk |")) {
+ close(CP);
+ notify($ERRORS{'OK'}, 0, "copied $image_name-sda.sfdisk to $image_repository_path/$image_name-hda.sfdisk");
+
+ #read in file
+ if (open(FILE, "$image_repository_path/$image_name-hda.sfdisk")) {
+ my @lines = <FILE>;
+ close(FILE);
+ foreach my $l (@lines) {
+ if ($l =~ s/sda/hda/g) {
+
+ #editing file
+ }
+ }
+
+ #print array to file
+ if (open(OUTFILE, ">$image_repository_path/$image_name-hda.sfdisk")) {
+ print OUTFILE @lines;
+ close(OUTFILE);
+ notify($ERRORS{'OK'}, 0, "modified drivetype of $image_name-hda.sfdisk");
+ }
+ } ## end if (open(FILE, "$image_repository_path/$image_name-hda.sfdisk"...
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not open $image_repository_path/$image_name-hda.sfdisk for editing $!");
+ }
+ } ## end if (open(CP, "/bin/cp $image_repository_path/$image_name-sda.sfdisk $image_repository_path/$image_name-hda.sfdisk |"...
+ else {
+ notify($ERRORS{'OK'}, 0, "could not copy $image_repository_path/$image_name-sda.sfdisk to $image_repository_path/$image_name-hda.sfdisk $!");
+ }
+ } ## end if (open(CP, "/bin/cp $image_repository_path/$image_name-sda.mbr $image_repository_path/$image_name-hda.mbr |"...
+ else {
+ notify($ERRORS{'OK'}, 0, "could not copy $image_repository_path/$image_name-sda.mbr to $image_repository_path/$image_name-hda.mbr $!");
+ }
+ } # Close if image_name-sda
+
+ } # Close foreach line returned from the ls imagerepository command
+ } # Close if ls imagerepository
+
+ # Set file premissions on image files to 644
+ # Allows other management nodes to retrieve the image if neccessary
+ if (open(CHMOD, "/bin/chmod -R 644 $image_repository_path/$image_name\* 2>&1 |")) {
+ close(CHMOD);
+ notify($ERRORS{'DEBUG'}, 0, "recursive update file permissions 644 on $image_repository_path/$image_name");
+ }
+
+ # Image capture complete, return 1
+ notify($ERRORS{'OK'}, 0, "image capture complete");
+ return 1;
+
+} ## end sub capture_monitor
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _edit_template
+
+ Parameters : imagename,drivetype
+ Returns : 0 failed or 1 success
+ Description : general routine to edit /opt/xcat/install/image/x86/imagename.tmpl
+ used in imaging process
+
+=cut
+
+sub _edit_template {
+ my ($imagename, $drivetype) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'CRITCAL'}, 0, "drivetype is not defined")
+ if (!(defined($drivetype)));
+ notify($ERRORS{'CRITCAL'}, 0, "imagename is not defined")
+ if (!(defined($imagename)));
+
+ my $template = "$XCAT_ROOT/install/image/x86/$imagename.tmpl";
+ my @lines;
+ if (open(FILE, $template)) {
+ @lines = <FILE>;
+ close FILE;
+ my $line;
+ for $line (@lines) {
+ if ($line =~ /^export DISKS=/) {
+ $line = "export DISKS=\"$drivetype\"\n";
+ last;
+ }
+ }
+
+ #dump back to template file
+ if (open(FILE, ">$template")) {
+ print FILE @lines;
+ close FILE;
+ return 1;
+ }
+ else {
+
+ # could not open nodetype file for editing
+ notify($ERRORS{'CRITICAL'}, 0, "could not open $template for writing\nerror message: $!");
+ return 0;
+ }
+ } ## end if (open(FILE, $template))
+ else {
+
+ # could not open nodetype file for editing
+ notify($ERRORS{'CRITICAL'}, 0, "could not open $template for reading\nerror message: $!");
+ return 0;
+ }
+} ## end sub _edit_template
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _edit_nodetype
+
+ Parameters : node, imagename, osname
+ Returns : 0 failed or 1 success
+ Description : xCAT specific edits xcat's nodetype file with requested image name
+
+=cut
+
+sub _edit_nodetype {
+ my $self = shift;
+ if (ref($self) !~ /xCAT/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+ return 0;
+ }
+
+ # Use arguments for computer and image if they were passed
+ my $computer_node_name = shift;
+ my $image_name = shift;
+
+ # Use the new image name if it is set
+ $image_name = $self->data->get_image_name() if !$image_name;
+
+ # Get the rest of the variables
+ $computer_node_name = $self->data->get_computer_node_name()
+ if !$computer_node_name;
+ my $image_os_name = $self->data->get_image_os_name();
+ my $image_architecture = $self->data->get_image_architecture();
+ my $image_os_source_path = $self->data->get_image_os_source_path();
+
+ # Fix for Linux images on henry4
+ my $management_node_hostname = $self->data->get_management_node_hostname();
+ my $image_os_type = $self->data->get_image_os_type();
+ if ( $management_node_hostname =~ /henry4/i
+ && $image_os_type =~ /linux/i
+ && $image_os_source_path eq 'image')
+ {
+ $image_os_source_path = 'linux_image';
+ notify($ERRORS{'DEBUG'}, 0, "fixed Linux image path for henry4: image --> linux_image");
+ }
+
+ # Check to make sure the variables are populated
+ if (!$computer_node_name) {
+ notify($ERRORS{'CRITICAL'}, 0, "computer node name is not defined");
+ return 0;
+ }
+ if (!$image_name) {
+ notify($ERRORS{'CRITICAL'}, 0, "image name is not defined");
+ return 0;
+ }
+ if (!$image_os_name) {
+ notify($ERRORS{'CRITICAL'}, 0, "image OS name is not defined");
+ return 0;
+ }
+ if (!$image_architecture) {
+ notify($ERRORS{'CRITICAL'}, 0, "image architecture is not defined");
+ return 0;
+ }
+ if (!$image_os_source_path) {
+ notify($ERRORS{'CRITICAL'}, 0, "image OS source path is not defined");
+ return 0;
+ }
+
+ notify($ERRORS{'DEBUG'}, 0, "$computer_node_name, image=$image_name, os=$image_os_name, arch=$image_architecture, path=$image_os_source_path");
+
+ # Assemble the nodetype.tab and lock file paths
+ my $nodetype_file_path = "$XCAT_ROOT/etc/nodetype.tab";
+ my $lock_file_path = "$nodetype_file_path.lockfile";
+
+ # Open the lock file
+ if (sysopen(LOCKFILE, $lock_file_path, O_RDONLY | O_CREAT)) {
+ notify($ERRORS{'DEBUG'}, 0, "opened $lock_file_path");
+
+ # Set exclusive lock on lock file
+ if (flock(LOCKFILE, LOCK_EX)) {
+ notify($ERRORS{'DEBUG'}, 0, "set exclusive lock on $lock_file_path");
+
+ if (open(NODETYPE, $nodetype_file_path)) { #read file
+ notify($ERRORS{'DEBUG'}, 0, "opened $nodetype_file_path");
+
+ # Get the nodetype.tab lines and close the file
+ my @nodetype_lines = <NODETYPE>;
+ notify($ERRORS{'DEBUG'}, 0, "lines found in nodetype.tab: " . scalar @nodetype_lines);
+
+ # Close the nodetype.tab file
+ close(NODETYPE);
+ notify($ERRORS{'DEBUG'}, 0, "closed $nodetype_file_path");
+
+ # Loop through the nodetype.tab lines
+ for my $line (@nodetype_lines) {
+
+ # Skip over non-matching lines
+ next if ($line !~ /^$computer_node_name\s+([,\w]*)/);
+ notify($ERRORS{'OK'}, 0, "matching line found: $line");
+
+ # Replace line matching $computer_node_name
+ $line = "$computer_node_name\t\t$image_os_source_path,$image_architecture,$image_name\n";
+ notify($ERRORS{'OK'}, 0, "line modified: $line");
+ } ## end for my $line (@nodetype_lines)
+
+ # Dump modified array to nodetype.tab file
+ if (open(NODETYPE, ">$nodetype_file_path")) {
+ notify($ERRORS{'OK'}, 0, "nodetype.tab opened");
+ print NODETYPE @nodetype_lines;
+ notify($ERRORS{'OK'}, 0, "nodetype.tab contents replaced");
+ close(NODETYPE);
+ notify($ERRORS{'OK'}, 0, "nodetype.tab saved");
+ close(LOCKFILE);
+ notify($ERRORS{'DEBUG'}, 0, "lock file closed");
+ return 1;
+ } ## end if (open(NODETYPE, ">$nodetype_file_path"))
+ else {
+
+ # Could not open nodetype.tab file for editing
+ notify($ERRORS{'CRITICAL'}, 0, "could not open file for writing: $nodetype_file_path, $!");
+ close(LOCKFILE);
+ notify($ERRORS{'DEBUG'}, 0, "lock file closed");
+ return 0;
+ }
+ } ## end if (open(NODETYPE, $nodetype_file_path))
+ else {
+
+ # could not open nodetype file for reading
+ notify($ERRORS{'CRITICAL'}, 0, "could not open file for reading: $nodetype_file_path, $!");
+ close(LOCKFILE);
+ notify($ERRORS{'DEBUG'}, 0, "lock file closed");
+ return 0;
+ }
+ } ## end if (flock(LOCKFILE, LOCK_EX))
+ else {
+
+ # Could not open lock
+ notify($ERRORS{'CRITICAL'}, 0, "unable to get exclusive lock on $lock_file_path to edit nodetype.tab, $!");
+ close(LOCKFILE);
+ notify($ERRORS{'DEBUG'}, 0, "lock file closed");
+ return 0;
+ }
+ } ## end if (sysopen(LOCKFILE, $lock_file_path, O_RDONLY...
+
+ else {
+
+ # Could not open lock file
+ notify($ERRORS{'CRITICAL'}, 0, "unable to open $lock_file_path to edit nodetype.tab, $!");
+ return 0;
+ }
+
+} ## end sub _edit_nodetype
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _pping
+
+ Parameters : $node
+ Returns : 1 or 0
+ Description : using xcat pping cmd to ping blade, xcat specific
+
+=cut
+
+sub _pping {
+ my $node = $_[0];
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "_pping: node is not defined")
+ if (!(defined($node)));
+ if (open(PPING, "$XCAT_ROOT/bin/pping $node 2>&1 |")) {
+ my @file = <PPING>;
+ close(PPING);
+ foreach my $l (@file) {
+ chomp $l;
+ notify($ERRORS{'OK'}, 0, "pinging $l");
+ if ($l =~ /noping/) {
+ return 0;
+ }
+ if ($l =~ /$node: ping/) {
+ return 1;
+ }
+ } ## end foreach my $l (@file)
+ return 1;
+ } ## end if (open(PPING, "$XCAT_ROOT/bin/pping $node 2>&1 |"...
+ else {
+ notify($ERRORS{'WARNING'}, 0, "could not execute $XCAT_ROOT/bin/pping $node");
+ return 0;
+ }
+} ## end sub _pping
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _nodeset
+
+ Parameters : $node
+ Returns : xcat state of node or 0
+ Description : using xcat nodeset cmd to retrieve state of blade, xcat specific
+
+=cut
+
+sub _nodeset {
+ my $node = $_[0];
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "_nodeset: node is not defined")
+ if (!(defined($node)));
+ return 0 if (!(defined($node)));
+
+ my ($blah, $case);
+ my @file;
+ my $l;
+ if (open(NODESET, "$XCAT_ROOT/bin/nodeset $node stat |")) {
+
+ #notify($ERRORS{'OK'},0,"executing $XCAT_ROOT/bin/nodeset $node stat ");
+ @file = <NODESET>;
+ close NODESET;
+ foreach $l (@file) {
+ chomp($l);
+ ($blah, $case) = split(/:\s/, $l);
+ }
+ if ($case) {
+
+ #notify($ERRORS{'OK'},0,"$node in $case state ");
+ return $case;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "case for $node is empty");
+ return 0;
+ }
+ } ## end if (open(NODESET, "$XCAT_ROOT/bin/nodeset $node stat |"...
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to execute $XCAT_ROOT/bin/nodeset $node stat");
+ return 0;
+ }
+} ## end sub _nodeset
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _nodeset
+
+ Parameters : $node $option
+ Returns : xcat state of node or 0
+ Description : using xcat nodeset cmd to use the input option of blade, xcat specific
+
+=cut
+
+sub _nodeset_option {
+ my ($node, $option) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "_nodeset_option: node is not defined")
+ if (!(defined($node)));
+ notify($ERRORS{'WARNING'}, 0, "_nodeset_option: option is not defined")
+ if (!(defined($option)));
+ my ($blah, $case);
+ my @file;
+ my $l;
+ if (open(NODESET, "$XCAT_ROOT/bin/nodeset $node $option |")) {
+
+ #notify($ERRORS{'OK'},0,"executing $XCAT_ROOT/bin/nodeset $node $option");
+ @file = <NODESET>;
+ close NODESET;
+ foreach $l (@file) {
+ chomp($l);
+ ($blah, $case) = split(/:\s/, $l);
+ }
+ if ($case) {
+ notify($ERRORS{'OK'}, 0, "$node in $case state ");
+ return $case;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "case for $node is empty");
+ return 0;
+ }
+ } ## end if (open(NODESET, "$XCAT_ROOT/bin/nodeset $node $option |"...
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to execute $XCAT_ROOT/bin/nodeset $node $option");
+ return 0;
+ }
+
+} ## end sub _nodeset_option
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 makesshgkh
+
+ Parameters : imagename
+ Returns : 0 or 1
+ Description : xCAT specific scans node for public ssh key
+
+=cut
+
+sub makesshgkh {
+ my $node = $_[0];
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "node is not defined")
+ if (!(defined($node)));
+ if (!(defined($node))) {
+ return 0;
+ }
+ if (open(MAKESSHGKH, "$XCAT_ROOT/sbin/makesshgkh $node 2>&1 |")) {
+ while (<MAKESSHGKH>) {
+ chomp($_);
+ if ($_ =~ /Scanning keys/) {
+
+ #notify($ERRORS{'OK'},0,"$_");
+ }
+ else {
+
+ #possible error
+ #notify($ERRORS{'OK'},0,"possible error in $_ ");
+ }
+ } ## end while (<MAKESSHGKH>)
+ close(MAKESSHGKH);
+ return 1;
+ } ## end if (open(MAKESSHGKH, "$XCAT_ROOT/sbin/makesshgkh $node 2>&1 |"...
+ return 0;
+} ## end sub makesshgkh
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _rpower
+
+ Parameters : $node, $option
+ Returns : 1 connected 0 not connected
+ Description : xCAT specific command - hard power cycle the blade
+
+=cut
+
+sub _rpower {
+ my ($node, $option) = @_;
+
+ #make sure node and option are defined
+ notify($ERRORS{'WARNING'}, 0, "_rpower: node is not defined")
+ if (!(defined($node)));
+ notify($ERRORS{'WARNING'}, 0, "_rpower: option is not defined setting to cycle")
+ if (!(defined($option)));
+ return 0 if (!(defined($node)));
+
+ $option = "cycle" if (!(defined($option)));
+
+ my $l;
+ my @file;
+ RPOWER:
+ if (open(RPOWER, "$XCAT_ROOT/bin/rpower $node $option |")) {
+ @file = <RPOWER>;
+ close(RPOWER);
+ foreach $l (@file) {
+ if ($l =~ /not in bay/) {
+
+ # not in bay problem
+ if (_fix_rpower($node)) {
+ goto RPOWER; #try again
+ }
+ }
+ if ($l =~ /$node:\s+(on|off)/) {
+ return $1;
+ }
+ } ## end foreach $l (@file)
+ return 0;
+ } ## end if (open(RPOWER, "$XCAT_ROOT/bin/rpower $node $option |"...
+ else {
+ notify($ERRORS{'WARNING'}, 0, "_rpower: could not run $XCAT_ROOT/bin/rpower $node $option $!");
+ return 0;
+ }
+
+} ## end sub _rpower
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _fix_rpower
+
+ Parameters : nodename
+ Returns : 1(success) or 0(failure)
+ Description : due to a bug in a previous firmware version.
+ it's belived to be fixed in previous versions
+
+=cut
+
+sub _fix_rpower {
+ my $node = $_[0];
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "node not set") if (!defined($node));
+
+ # this function kicks the management this is a known xcat bug, the
+ # workaround is to run rinv nodename all twice
+ my $notfixed = 1;
+ my $tries = 0;
+ while ($notfixed) {
+ $tries++;
+ if ($tries > 10) {
+ notify($ERRORS{'CRITICAL'}, 0, "_fix_rpower failed $tries on $node");
+ return 0;
+ }
+
+ #notify($ERRORS{'OK'},0,"executing $XCAT_ROOT/bin/rinv $node all");
+ if (open(RINV, "$XCAT_ROOT/bin/rinv $node all |")) {
+ my @rinv = <RINV>;
+ my $line;
+ close RINV;
+ foreach $line (@rinv) {
+ next if ($line =~ /HTTP login failed/); #expected
+ if ($line =~ /Machine Type/) {
+ notify($ERRORS{'OK'}, 0, "rinv succeded for $node");
+ return 1;
+ }
+ }
+ } ## end if (open(RINV, "$XCAT_ROOT/bin/rinv $node all |"...
+ else {
+ notify($ERRORS{'OK'}, 0, "could not execute $XCAT_ROOT/bin/rinv $node all $!");
+ }
+ } ## end while ($notfixed)
+
+} ## end sub _fix_rpower
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 node_status
+
+ Parameters : [0]: computer node name (optional)
+ [1]: log file path (optional)
+ Returns : If called in scalar or boolean context:
+ 1: node is down or needs to be reloaded
+ 0: node is up and does not need to be reloaded
+ undefined: error occurred while checking node status
+
+ hashref: reference to hash with keys/values:
+ {status} => <"READY","FAIL">
+ {ping} => <0,1>
+ {ssh} => <0,1>
+ {rpower} => <0,1>
+ {nodeset} => <"boot", "install", "image", ...>
+ {nodetype} => <image name>
+ {currentimage} => <image name>
+ Description : Checks the status of an xCAT-provisioned machine. If no
+ arguments are supplied, the node and image for the current
+ reservation will be used.
+
+=cut
+
+sub node_status {
+ my $self = shift;
+ my ($computer_node_name, $log);
+
+ my $management_node_os_name = 0;
+ my $management_node_keys = 0;
+ my $computer_host_name = 0;
+ my $computer_short_name = 0;
+ my $computer_ip_address = 0;
+ my $image_os_name = 0;
+ my $image_name = 0;
+
+ # Check if subroutine was called as a class method
+ if (ref($self) !~ /xcat/i) {
+ #$cidhash->{hostname}, $cidhash->{OSname}, $cidhash->{MNos}, $cidhash->{IPaddress}, $LOG
+ $computer_node_name = $self;
+
+ $log = shift;
+ $log = 0 if !$log;
+ $computer_short_name = $computer_node_name;
+ }
+ else {
+
+ # Get the computer name from the DataStructure
+ $computer_node_name = $self->data->get_computer_node_name();
+
+ # Check if this was called as a class method, but a node name was also specified as an argument
+ my $node_name_argument = shift;
+ $computer_node_name = $node_name_argument if $node_name_argument;
+ $computer_host_name = $self->data->get_computer_host_name();
+ $computer_short_name = $self->data->get_computer_short_name();
+ $image_name = $self->data->get_image_name();
+ $log = 0;
+ } ## end else [ if (ref($self) !~ /xcat/i)
+
+ # Check the node name variable
+ if (!defined($computer_node_name) || !$computer_node_name) {
+ notify($ERRORS{'WARNING'}, 0, "node name could not be determined");
+ return;
+ }
+ notify($ERRORS{'DEBUG'}, 0, "checking status of node: $computer_node_name");
+
+
+
+ # Create a hash to store status components
+ my %status;
+
+ # Initialize all hash keys here to make sure they're defined
+ $status{status} = 0;
+ $status{nodetype} = 0;
+ $status{currentimage} = 0;
+ $status{ping} = 0;
+ $status{rpower} = 0;
+ $status{nodeset} = 0;
+ $status{ssh} = 0;
+
+ # Check the nodetype.tab file
+ notify($ERRORS{'DEBUG'}, $log, "checking the current image listed in nodetype.tab for $computer_short_name");
+ my $nodetype_file_path = "$XCAT_ROOT/etc/nodetype.tab";
+ if (open(NODETYPE, $nodetype_file_path)) {
+ notify($ERRORS{'OK'}, 0, "opened $nodetype_file_path for reading");
+
+ # Get all the lines in nodetype.tab
+ my @nodetype_lines = <NODETYPE>;
+
+ # Close the nodetype.tab file
+ close NODETYPE;
+
+ # Find the nodetype.tab line for the computer
+ # Example line: vcln1-1 image,x86,winxp-base1-v21
+ # vclb2-8 rhas5,x86,rhel5-base587-v0
+ my $nodetype_contents = join("\n", @nodetype_lines);
+ if ($nodetype_contents =~ /^$computer_short_name\s+(\w+),(\w+),(.+)$/xm, $nodetype_contents) {
+ my $nodetype_install_path = $1;
+ my $nodetype_image_architecture = $2;
+ my $nodetype_image_name = $3;
+
+ # Remove any spaces from the beginning and end of the $nodetype_image_name string
+ $nodetype_image_name =~ s/^\s+//;
+ $nodetype_image_name =~ s/\s+$//;
+
+ notify($ERRORS{'DEBUG'}, 0, "found nodetype.tab line: path=$nodetype_install_path, arch=$nodetype_image_architecture, image=$nodetype_image_name");
+ $status{nodetype} = $nodetype_image_name;
+ } ## end if ($nodetype_contents =~ /^$computer_short_name\s+(\w+),(\w+),(.+)$/xm...
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to find line in nodetype.tab for computer: $computer_short_name");
+ return;
+ }
+ } ## end if (open(NODETYPE, $nodetype_file_path))
+ else {
+ notify($ERRORS{'WARNING'}, $log, "could not open $nodetype_file_path for reading");
+ return;
+ }
+
+ # Check if node is pingable
+ notify($ERRORS{'DEBUG'}, $log, "checking if $computer_host_name is pingable");
+ if (_pingnode($computer_host_name)) {
+ $status{ping} = 1;
+ notify($ERRORS{'OK'}, $log, "$computer_host_name is pingable ($status{ping})");
+ }
+ else {
+ $status{ping} = 0;
+ notify($ERRORS{'OK'}, $log, "$computer_host_name is not pingable ($status{ping})");
+ }
+
+ # Check the rpower status
+ notify($ERRORS{'DEBUG'}, $log, "checking $computer_short_name xCAT rpower status");
+ my $rpower_status = _rpower($computer_short_name, "stat");
+ if ($rpower_status =~ /on/i) {
+ $status{rpower} = 1;
+ }
+ else {
+ $status{rpower} = 0;
+ }
+ notify($ERRORS{'OK'}, $log, "$computer_short_name rpower status: $rpower_status ($status{rpower})");
+
+ # Check the xCAT nodeset status
+ notify($ERRORS{'DEBUG'}, $log, "checking $computer_short_name xCAT nodeset status");
+ my $nodeset_status = _nodeset($computer_short_name);
+ notify($ERRORS{'OK'}, $log, "$computer_short_name nodeset status: $nodeset_status");
+ $status{nodeset} = $nodeset_status;
+
+ # Check the sshd status
+ notify($ERRORS{'DEBUG'}, $log, "checking if $computer_short_name sshd service is accessible");
+ my $sshd_status = _sshd_status($computer_short_name, $status{nodetype}, $log);
+
+ # If sshd is accessible, perform sshd-dependent checks
+ if ($sshd_status =~ /on/) {
+ $status{ssh} = 1;
+ notify($ERRORS{'DEBUG'}, $log, "$computer_short_name sshd service is accessible, performing dependent checks");
+
+ # Check the currentimage.txt file on the node
+ notify($ERRORS{'DEBUG'}, $log, "checking image specified in currentimage.txt file on $computer_short_name");
+ if ($status{nodetype} =~ /win|image/) {
+ my $status_currentimage = _getcurrentimage($computer_short_name);
+ if ($status_currentimage) {
+ notify($ERRORS{'OK'}, $log, "$computer_short_name currentimage.txt has: $status_currentimage");
+ $status{currentimage} = $status_currentimage;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, $log, "$computer_short_name currentimage.txt could not be checked");
+ }
+ } ## end if ($status{nodetype} =~ /win|image/)
+ else {
+ notify($ERRORS{'OK'}, $log, "currentimage.txt can not be checked for image type: $status{nodetype}");
+ }
+ } ## end if ($sshd_status =~ /on/)
+ else {
+ $status{ssh} = 0;
+ }
+ notify($ERRORS{'OK'}, $log, "$computer_short_name sshd status: $sshd_status ($status{ssh})");
+
+ # Check if nodetype.tab matches reservation image name
+ my $nodetype_image_match = 0;
+ if ($status{nodetype} eq $image_name) {
+ notify($ERRORS{'OK'}, $log, "nodetype.tab ($status{nodetype}) matches reservation image ($image_name)");
+ $nodetype_image_match = 1;
+ }
+ else {
+ notify($ERRORS{'OK'}, $log, "nodetype.tab ($status{nodetype}) does not match reservation image ($image_name)");
+ }
+
+ # Check if nodetype.tab matches currentimage.txt
+ my $nodetype_currentimage_match = 0;
+ if ($status{nodetype} eq $status{currentimage}) {
+ notify($ERRORS{'OK'}, $log, "nodetype.tab ($status{nodetype}) matches currentimage.txt ($status{currentimage})");
+ $nodetype_currentimage_match = 1;
+ }
+ else {
+ notify($ERRORS{'OK'}, $log, "nodetype.tab ($status{nodetype}) does not match currentimage.txt ($status{currentimage}), assuming nodetype.tab is correct");
+ }
+
+ # Determine the overall machine status based on the individual status results
+ $status{status} = 'READY';
+ if (!$status{rpower}) {
+ $status{status} = 'RELOAD';
+ notify($ERRORS{'OK'}, $log, "rpower status is not on, node needs to be reloaded");
+ }
+ if (!$status{ssh}) {
+ $status{status} = 'RELOAD';
+ notify($ERRORS{'OK'}, $log, "sshd is not accessible, node needs to be reloaded");
+ }
+ if (!$nodetype_image_match) {
+ $status{status} = 'RELOAD';
+ notify($ERRORS{'OK'}, $log, "nodetype.tab does not match requested image, node needs to be reloaded");
+ }
+
+ # Node is up and doesn't need to be reloaded
+ if ($status{status} =~ /ready/i) {
+ notify($ERRORS{'OK'}, $log, "node is up and does not need to be reloaded");
+ }
+ else {
+ notify($ERRORS{'OK'}, $log, "node is either down or needs to be reloaded");
+ }
+
+ notify($ERRORS{'OK'}, $log, "returning node status hash reference with {status}=$status{status}");
+ return \%status;
+} ## end sub node_status
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _assign2project
+
+ Parameters : $node, $project
+ Returns : 0 or 1
+ Description : xCAT specific changes the networking to capable switch modules to either vcl,hpc or vclhpc project
+
+=cut
+
+sub _assign2project {
+ my ($node, $project) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ notify($ERRORS{'CRITICAL'}, 0, "node is not defined")
+ if (!(defined($node)));
+ notify($ERRORS{'CRITICAL'}, 0, "project is not defined")
+ if (!(defined($project)));
+ my $PROJECTtab = "$XCAT_ROOT/etc/project.tab";
+ my $assign2project = "$XCAT_ROOT/sbin/assign2project";
+ my $LCK = $PROJECTtab . "lockfile";
+
+ #make sure this management node can make assignments
+
+ if (-r $PROJECTtab) { #do we have a project.tab file to work with
+
+ #read project tab
+ if (open(PT, "<$PROJECTtab")) {
+ my @pt = <PT>;
+ close(PT);
+ my $p;
+ foreach $p (@pt) {
+ if ($p =~ /^$node\s+/) {
+ if ($p =~ /^$node\s*$project$/i) {
+ notify($ERRORS{'OK'}, 0, "$node is set correctly to $project");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "starting to set exclusive lock on $LCK");
+ if (sysopen(LF, $LCK, O_RDONLY | O_CREAT)) {
+ if (flock(LF, LOCK_EX)) { #set exclusive lock on LF
+ notify($ERRORS{'OK'}, 0, "setting exclusive lock on $LCK");
+ notify($ERRORS{'OK'}, 0, "$node is set incorrectly changing to $project project");
+ if (open(AP, "$assign2project $node $project 2>&1 |")) {
+ my @file = <AP>;
+ close(AP);
+ foreach my $l (@file) {
+ notify($ERRORS{'OK'}, 0, "output @file");
+ if ($l =~ /configurations are already correct! Nothing done/) {
+ notify($ERRORS{'OK'}, 0, "$node is currently assigned to $project - releasing lock");
+ close(LF);
+ return 1;
+ }
+ if ($l =~ /Done!/) {
+ notify($ERRORS{'OK'}, 0, "$node is successfully assigned to $project - releasing lock");
+ close(LF);
+ return 1;
+ }
+
+ } #foreach
+ notify($ERRORS{'CRITICAL'}, 0, "provided unexpected output $node $project - output= @file");
+ close(LF);
+ return 0;
+
+ } #if AP
+ } #flock
+ } #sysopen
+ } #else
+ } #if node
+ } #foreach
+ } #if open
+ else {
+ notify($ERRORS{'WARNING'}, 0, "could not open $PROJECTtab for reading $!");
+ close(LF);
+ return 0;
+ }
+ } #if tabfile readable
+ else {
+ notify($ERRORS{'OK'}, 0, "project.tab does not exist on this Management node");
+ return 1;
+
+ }
+
+} ## end sub _assign2project
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 does_image_exist
+
+ Parameters : optional: image name
+ Returns : 1 if image exists, 0 if it doesn't
+ Description : Checks the management node's local image repository for the
+ existence of the requested image. This subroutine does not
+ attempt to copy the image from another management node. The
+ retrieve_image() subroutine does this. Callers of
+ does_image_exist must also call retrieve_image if image library
+ retrieval functionality is desired.
+
+=cut
+
+sub does_image_exist {
+ my $self = shift;
+ if (ref($self) !~ /xCAT/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+ return 0;
+ }
+
+ # Get the image name, first try passed argument, then data
+ my $image_name = shift;
+ $image_name = $self->data->get_image_name() if !$image_name;
+ if (!$image_name) {
+ notify($ERRORS{'WARNING'}, 0, "unable to determine image name");
+ return;
+ }
+
+ # Get the image repository path
+ my $image_repository_path = $self->_get_image_repository_path();
+ if (!$image_repository_path) {
+ notify($ERRORS{'WARNING'}, 0, "image repository path could not be determined");
+ return;
+ }
+ else {
+ notify($ERRORS{'DEBUG'}, 0, "image repository path: $image_repository_path");
+ }
+
+ # Get the tmpl repository path
+ my $tmpl_repository_path = $self->_get_image_template_path();
+ if (!$tmpl_repository_path) {
+ notify($ERRORS{'WARNING'}, 0, "image template path could not be determined");
+ return;
+ }
+ else {
+ notify($ERRORS{'DEBUG'}, 0, "template repository path: $tmpl_repository_path");
+ }
+
+ # Check if template file exists for the image
+ # -s File has nonzero size
+ my $tmpl_file_exists;
+ if (-s "$tmpl_repository_path/$image_name.tmpl") {
+ $tmpl_file_exists = 1;
+ notify($ERRORS{'DEBUG'}, 0, "template file exists: $image_name.tmpl");
+ }
+ else {
+ $tmpl_file_exists = 0;
+ notify($ERRORS{'OK'}, 0, "template file does not exist: $tmpl_repository_path/$image_name.tmpl");
+ }
+
+ # Check if image files exist (Partimage files)
+ # Open the repository directory
+ if (!opendir(REPOSITORY, $image_repository_path)) {
+ notify($ERRORS{'WARNING'}, 0, "unable to open the image repository directory: $image_repository_path");
+ return;
+ }
+
+ # Get the list of files in the repository and close the directory
+ my @repository_files = readdir(REPOSITORY);
+ closedir(REPOSITORY);
+
+ # Check if any files exist for the image
+ my $image_files_exist;
+ if (my @image_files = grep(/$image_name/, @repository_files)) {
+ $image_files_exist = 1;
+ my $image_file_list = join(@image_files, "\n");
+ notify($ERRORS{'DEBUG'}, 0, "image files exist in repository:\n$image_file_list");
+ }
+ else {
+ $image_files_exist = 0;
+ notify($ERRORS{'OK'}, 0, "image files do not exist in repository: $image_repository_path/$image_name");
+ }
+
+ # Image files found
+ if ($tmpl_file_exists && $image_files_exist) {
+ notify($ERRORS{'OK'}, 0, "image $image_name exists on this management node, returning 0");
+ return 1;
+ }
+ elsif (!$tmpl_file_exists && !$image_files_exist) {
+ notify($ERRORS{'OK'}, 0, "image $image_name does not exist on this management node, returning 1");
+ return 0;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "image $image_name partially exists on this management node, tmpl=$tmpl_file_exists, image=$image_files_exist, returning undefined");
+ return;
+ }
+
+} ## end sub does_image_exist
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 retrieve_image
+
+ Parameters :
+ Returns :
+ Description : Attempts to retrieve an image from an image library partner
+
+=cut
+
+sub retrieve_image {
+ my $self = shift;
+ if (ref($self) !~ /xCAT/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+ return;
+ }
+
+ # Make sure imag library functions are enabled
+ my $image_lib_enable = $self->data->get_management_node_image_lib_enable();
+ if (!$image_lib_enable) {
+ notify($ERRORS{'OK'}, 0, "image library functions are disabled");
+ return;
+ }
+
+ # Get the image name
+ my $image_name = shift;
+ $image_name = $self->data->get_image_name() if !$image_name;
+ if (!$image_name) {
+ notify($ERRORS{'WARNING'}, 0, "unable to determine image name");
+ return;
+ }
+
+ # Get the other image library variables
+ my $image_lib_user = $self->data->get_management_node_image_lib_user()
+ || 'undefined';
+ my $image_lib_key = $self->data->get_management_node_image_lib_key()
+ || 'undefined';
+ my $image_lib_partners = $self->data->get_management_node_image_lib_partners() || 'undefined';
+ if ("$image_lib_user $image_lib_key $image_lib_partners" =~ /undefined/) {
+ notify($ERRORS{'WARNING'}, 0, "image library configuration data is missing: user=$image_lib_user, key=$image_lib_key, partners=$image_lib_partners");
+ return;
+ }
+
+ # Get the image repository path
+ my $image_repository_path = $self->_get_image_repository_path();
+ if (!$image_repository_path) {
+ notify($ERRORS{'WARNING'}, 0, "image repository path could not be determined");
+ return;
+ }
+
+ # Get the tmpl repository path
+ my $tmpl_repository_path = $self->_get_image_template_path();
+ if (!$tmpl_repository_path) {
+ notify($ERRORS{'WARNING'}, 0, "image template path could not be determined");
+ return;
+ }
+
+ # Check if template file exists for the image
+ # -s File has nonzero size
+ if (-s "$tmpl_repository_path/$image_name.tmpl") {
+ notify($ERRORS{'OK'}, 0, "template file already exists: $image_name.tmpl");
+ }
+ else {
+
+ # Get the name of the base tmpl file
+ my $basetmpl = $self->_get_base_template_filename();
+
+ # Template file doesn't exist, try to make a copy of the base template file
+ if (copy("$tmpl_repository_path/$basetmpl", "$tmpl_repository_path/$image_name.tmpl")) {
+ notify($ERRORS{'OK'}, 0, "template file copied: $basetmpl --> $image_name.tmpl");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "template file could not be copied copied: $basetmpl --> $image_name.tmpl, $!");
+ return;
+ }
+ } ## end else [ if (-s "$tmpl_repository_path/$image_name.tmpl")
+
+ # Attempt to copy image from other management nodes
+ notify($ERRORS{'OK'}, 0, "attempting to copy $image_name from other management nodes");
+
+ # Split up the partner list
+ my @partner_list = split(/,/, $image_lib_partners);
+ if ((scalar @partner_list) == 0) {
+ notify($ERRORS{'WARNING'}, 0, "image lib partners variable is not listed correctly or does not contain any information: $image_lib_partners");
+ return;
+ }
+
+ # Loop through the partners, attempt to copy
+ foreach my $partner (@partner_list) {
+ notify($ERRORS{'OK'}, 0, "checking if $partner has $image_name");
+
+ # Use ssh to call ls on the partner management node
+ my ($ls_exit_status, $ls_output_array_ref) = run_ssh_command($partner, $image_lib_key, "ls -1 $image_repository_path", $image_lib_user);
+
+ # Check if the ssh command failed
+ if (!$ls_output_array_ref) {
+ notify($ERRORS{'WARNING'}, 0, "unable to run ls command via ssh on $partner");
+ next;
+ }
+
+ # Convert the output array to a string
+ my $ls_output = join("\n", @{$ls_output_array_ref});
+
+ # Check the ls output for permission denied
+ if ($ls_output =~ /permission denied/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "permission denied when checking if $partner has $image_name, exit status=$ls_exit_status, output:\n$ls_output");
+ next;
+ }
+
+ # Check the ls output for the image name
+ if ($ls_output !~ /$image_name[\.\-]/i) {
+ notify($ERRORS{'OK'}, 0, "$image_name does not exist on $partner");
+ next;
+ }
+
+ # Image exists
+ notify($ERRORS{'OK'}, 0, "$image_name exists on $partner, attempting to copy");
+
+ # Attempt copy
+ if (run_scp_command("$image_lib_user\@$partner:$image_repository_path/$image_name*", $image_repository_path, $image_lib_key)) {
+ notify($ERRORS{'OK'}, 0, "$image_name files copied via SCP");
+ last;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to copy $image_name files via SCP");
+ next;
+ }
+ } ## end foreach my $partner (@partner_list)
+
+ # Make sure image was copied
+ if ($self->does_image_exist($image_name)) {
+ notify($ERRORS{'OK'}, 0, "$image_name was copied to this management node");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "$image_name was not copied to this management node");
+ return 0;
+ }
+} ## end sub retrieve_image
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _check_pxe_grub_file
+
+ Parameters : imagename
+ Returns : 0 failed or 1 success
+ Description : checks the pxe and grub files for xCAT management nodes
+ if file size is equal to 0 delete the file and return true
+ return true if file not empty
+ only return false if failure to execute or delete files
+
+=cut
+
+sub _check_pxe_grub_files {
+ my $imagename = $_[0];
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "node is not defined")
+ if (!(defined($imagename)));
+ if (!(defined($imagename))) {
+ return 0;
+ }
+ my $path = "/tftpboot/xcat/image/x86/";
+ my $ide_grub = "$path" . "$imagename" . "-ide.grub";
+ my $scsi_grub = "$path" . "$imagename" . "-scsi.grub";
+ my $ide_pxe = "$path" . "$imagename" . "-ide.pxe";
+ my $scsi_pxe = "$path" . "$imagename" . "-scsi.pxe";
+ my @errors;
+ if (-e "$ide_grub") {
+
+ #file exists
+ my $fs = -s "$ide_grub";
+ if ($fs == 0) {
+ notify($ERRORS{'CRITICAL'}, 0, "filesize for $ide_grub is zero, deleted ");
+ unlink $ide_grub;
+ }
+ }
+ else {
+
+ #notify($ERRORS{'OK'},0,"skipping $ide_grub file does not exist");
+ }
+ if (-e "$scsi_grub") {
+
+ #file exists
+ my $fs = -s "$scsi_grub";
+ if ($fs == 0) {
+ notify($ERRORS{'CRITICAL'}, 0, "filesize for $scsi_grub is zero, deleted ");
+ unlink $scsi_grub;
+ }
+ }
+ else {
+
+ #notify($ERRORS{'OK'},0,"skipping $scsi_grub file does not exist");
+ }
+ if (-e "$ide_pxe") {
+
+ #file exists
+ my $fs = -s "$ide_pxe";
+ if ($fs == 0) {
+ notify($ERRORS{'CRITICAL'}, 0, "filesize for $ide_pxe is zero, deleted ");
+ unlink $ide_pxe;
+ }
+ }
+ else {
+
+ #notify($ERRORS{'OK'},0,"skipping $ide_pxe file does not exist");
+ }
+ if (-e "$scsi_pxe") {
+
+ #file exists
+ my $fs = -s "$scsi_pxe";
+ if ($fs == 0) {
+ notify($ERRORS{'CRITICAL'}, 0, "filesize for $scsi_grub is zero, deleted ");
+ unlink $scsi_pxe;
+ }
+ }
+ else {
+
+ #notify($ERRORS{'OK'},0,"skipping file $scsi_pxe does not exist");
+ }
+
+ return 1;
+
+} ## end sub _check_pxe_grub_files
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_image_size
+
+ Parameters : $image_name (optional)
+ Returns : 0 failure or size of image
+ Description : in size of Kilobytes
+
+=cut
+
+sub get_image_size {
+ my $self = shift;
+ if (ref($self) !~ /xCAT/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+ return 0;
+ }
+
+# Either use a passed parameter as the image name or use the one stored in this object's DataStructure
+ my $image_name = shift;
+ $image_name = $self->data->get_image_name() if !$image_name;
+ if (!$image_name) {
+ notify($ERRORS{'CRITICAL'}, 0, "image name could not be determined");
+ return 0;
+ }
+ notify($ERRORS{'DEBUG'}, 0, "getting size of image: $image_name");
+
+ my $image_repository_path = $self->_get_image_repository_path();
+ if (!$image_repository_path) {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to determine image repository location, returning 0");
+ return 0;
+ }
+
+ # Execute the command
+ my $du_command = "du -c $image_repository_path/$image_name* 2>&1";
+ notify($ERRORS{'DEBUG'}, 0, "du command: $du_command");
+ my $du_output = `$du_command`;
+
+ # Save the exit status
+ my $du_exit_status = $?;
+
+#notify($ERRORS{'DEBUG'}, 0, "du exit staus: $du_exit_status, output:\n$du_output");
+
+ # Check the du command output
+ if ($du_exit_status > 0) {
+ notify($ERRORS{'WARNING'}, 0, "du exit status > 0: $du_exit_status, output:\n$du_output");
+ return 0;
+ }
+ elsif ($du_output !~ /total/s) {
+ notify($ERRORS{'WARNING'}, 0, "du command did not produce expected output, du exit staus: $du_exit_status, output:\n$du_output");
+ return 0;
+ }
+
+ # Find the du output line containing 'total'
+ $du_output =~ /(\d+)\s+total/s;
+ my $size_bytes = $1;
+
+ # Check the du command output
+ if (!$size_bytes) {
+ notify($ERRORS{'WARNING'}, 0, "du produced unexpected output: $du_exit_status, output:\n$du_output");
+ return 0;
+ }
+
+ # Calculate the size in MB
+ my $size_mb = int($size_bytes / 1024);
+ notify($ERRORS{'DEBUG'}, 0, "returning image size: $size_mb MB ($size_bytes bytes)");
+ return $size_mb;
+
+} ## end sub get_image_size
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _get_image_repository_path
+
+ Parameters : none, must be called as an xCAT object method
+ Returns :
+ Description :
+
+=cut
+
+sub _get_image_repository_path {
+ my $self = shift;
+ my $return_template_path = shift;
+
+ if (ref($self) !~ /xCAT/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+ return 0;
+ }
+
+ # Get the required variables from the DataStructure
+ my $management_node_id = $self->data->get_management_node_id();
+ my $management_node_hostname = $self->data->get_management_node_hostname();
+ my $install_path = $self->data->get_management_node_install_path();
+ my $image_os_name = $self->data->get_image_os_name();
+ my $image_os_type = $self->data->get_image_os_type();
+ my $image_os_install_type = $self->data->get_image_os_install_type();
+ my $image_os_source_path = $self->data->get_image_os_source_path();
+ my $image_architecture = $self->data->get_image_architecture();
+
+ if (!(defined($image_os_name) && defined($image_os_type) && defined($image_os_install_type) && defined($image_os_source_path) && defined($image_architecture))) {
+ notify($ERRORS{'CRITICAL'}, 0, "some of the required data could not be retrieved");
+ return 0;
+ }
+
+ $return_template_path = 0 if !defined($return_template_path);
+
+ notify($ERRORS{'DEBUG'}, 0, "OS=$image_os_name, OS type=$image_os_type, OS install type=$image_os_install_type, OS source=$image_os_source_path");
+
+ # Fix for Linux images on henry4
+ if ( $management_node_hostname =~ /henry4/i
+ && $image_os_type =~ /linux/i
+ && $image_os_source_path eq 'image')
+ {
+ $image_os_source_path = 'linux_image';
+ notify($ERRORS{'DEBUG'}, 0, "fixed Linux image path for henry4: image --> linux_image");
+ }
+
+ # Remove trailing / from $image_os_source_path if exists
+ $image_os_source_path =~ s/\/$//;
+
+ # If image OS source path has a leading /, assume it was meant to be absolute
+ # Otherwise, prepend the install path
+ my $image_install_path;
+ if ($image_os_source_path =~ /^\//) {
+
+ # If $image_os_source_path = '/centos5', use '/centos5'
+ $image_install_path = $image_os_source_path;
+ }
+ else {
+
+ # If $image_os_source_path = 'centos5', use '/install/centos5'
+ # Note: $install_path has a leading /
+ $image_install_path = "$install_path/$image_os_source_path";
+ }
+
+ # Note: $XCAT_ROOT has a leading /
+ # Note: $image_install_path has a leading /
+
+# Check $return_template_path, either return repo path or template directory path
+# This is done because the code to figure out the paths is mostly the same
+# _get_image_repository_path calls this subroutine with the $return_template_path flag set
+ my $return_path;
+ if ($return_template_path) {
+ $return_path = "$XCAT_ROOT$image_install_path/$image_architecture";
+ notify($ERRORS{'DEBUG'}, 0, "template path: $return_path");
+ return $return_path;
+ }
+ elsif ($image_os_install_type eq 'kickstart') {
+
+ # Kickstart installs use the xCAT path for both repo and tmpl paths
+ $return_path = "$XCAT_ROOT$image_install_path/$image_architecture";
+ notify($ERRORS{'DEBUG'}, 0, "kickstart path: $return_path");
+ return $return_path;
+ }
+ else {
+
+# Imaging installs use the xCAT path for the tmpl path, and the install path for the repo path
+ $return_path = "$image_install_path/$image_architecture";
+ notify($ERRORS{'DEBUG'}, 0, "repository path: $return_path");
+ return $return_path;
+ }
+} ## end sub _get_image_repository_path
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _get_image_template_path
+
+ Parameters : none, must be called as an xCAT object method
+ Returns :
+ Description :
+
+=cut
+
+sub _get_image_template_path {
+ my $self = shift;
+ if (ref($self) !~ /xCAT/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+ return 0;
+ }
+
+ return $self->_get_image_repository_path(1);
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _get_base_template_filename
+
+ Parameters : none, must be called as an xCAT object method
+ Returns :
+ Description :
+
+=cut
+
+sub _get_base_template_filename {
+ my $self = shift;
+ if (ref($self) !~ /xCAT/i) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method");
+ return 0;
+ }
+
+ # Get some variables
+ my $image_os_name = $self->data->get_image_os_name();
+ my $image_os_type = $self->data->get_image_os_type();
+
+ # Get the image template directory path
+ my $image_template_path = $self->_get_image_template_path();
+ if (!$image_template_path) {
+ notify($ERRORS{'CRITICAL'}, 0, "image template path could not be determined");
+ return 0;
+ }
+
+ # Find the template file to use, from most specific to least
+ # Try OS-specific: <OS name>.tmpl
+ if (-e "$image_template_path/$image_os_name.tmpl") {
+ notify($ERRORS{'DEBUG'}, 0, "OS specific base image template file found: $image_template_path/$image_os_name.tmpl");
+ return "$image_os_name.tmpl";
+ }
+ elsif (-e "$image_template_path/$image_os_type.tmpl") {
+ notify($ERRORS{'DEBUG'}, 0, "OS type specific base image template file found: $image_template_path/$image_os_type.tmpl");
+ return "$image_os_type.tmpl";
+ }
+ elsif (-e "$image_template_path/default.tmpl") {
+ notify($ERRORS{'DEBUG'}, 0, "default base image template file found: $image_template_path/default.tmpl");
+ return "default.tmpl";
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "failed to find suitable base image template file in $image_template_path");
+ return 0;
+ }
+} ## end sub _get_base_template_filename
+
+#/////////////////////////////////////////////////////////////////////////////
+
+initialize() if (!$XCAT_ROOT);
+1;
+
+#/////////////////////////////////////////////////////////////////////////////
+
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+
+=cut
diff --git a/managementnode/lib/VCL/Module/State.pm b/managementnode/lib/VCL/Module/State.pm
new file mode 100644
index 0000000..d7a8a33
--- /dev/null
+++ b/managementnode/lib/VCL/Module/State.pm
@@ -0,0 +1,511 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: State.pm 1953 2008-12-12 14:23:17Z arkurth $
+##############################################################################
+
+=head1 NAME
+
+VCL::Core::State - VCL state base module
+
+=head1 SYNOPSIS
+
+ use base qw(VCL::Module::State);
+
+=head1 DESCRIPTION
+
+ Needs to be written.
+
+=cut
+
+##############################################################################
+package VCL::Module::State;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/../..";
+
+# Configure inheritance
+use base qw(VCL::Module);
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+use English '-no_match_vars';
+
+use VCL::utils;
+use VCL::DataStructure;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 initialize
+
+ Parameters : Reference to current inuse object is automatically passed when
+ invoked as a class method.
+ Returns : 1 if successful, 0 otherwise
+ Description : Prepares the delete object to process a reservation. Renames the
+ process.
+
+=cut
+
+sub initialize {
+ my $self = shift;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Initialize the database handle count
+ $ENV{dbh_count} = 0;
+
+ # Attempt to get a database handle
+ if ($ENV{dbh} = getnewdbh()) {
+ notify($ERRORS{'OK'}, 0, "obtained a database handle for this state process, stored as \$ENV{dbh}");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to obtain a database handle for this state process");
+ }
+
+ # Check the image OS before creating OS object
+ if (!$self->check_image_os()) {
+ notify($ERRORS{'WARNING'}, 0, "failed to check if image OS is correct");
+ $self->reservation_failed();
+ }
+
+ # Store some hash variables into local variables
+ my $request_id = $self->data->get_request_id();
+ my $reservation_id = $self->data->get_reservation_id();
+ my $provisioning_perl_package = $self->data->get_computer_provisioning_module_perl_package();
+ my $os_perl_package = $self->data->get_image_os_module_perl_package();
+ my $predictive_perl_package = $self->data->get_management_node_predictive_module_perl_package();
+
+ # Store the name of this class in an environment variable
+ $ENV{class_name} = ref($self);
+
+ # Rename this process to include some request info
+ rename_vcld_process($self->data);
+
+ # Set the PARENTIMAGE and SUBIMAGE keys in the request data hash
+ # These are deprecated, DataStructure's is_parent_reservation function should be used
+ $self->data->get_request_data->{PARENTIMAGE} = ($self->data->is_parent_reservation() + 0);
+ $self->data->get_request_data->{SUBIMAGE} = (!$self->data->is_parent_reservation() + 0);
+
+ # Set the parent PID and this process's PID in the hash
+ set_hash_process_id($self->data->get_request_data);
+
+ # Attempt to load the computer provisioning module
+ if ($provisioning_perl_package) {
+ notify($ERRORS{'OK'}, 0, "attempting to load provisioning module: $provisioning_perl_package");
+ eval "use $provisioning_perl_package";
+ if ($EVAL_ERROR) {
+ notify($ERRORS{'WARNING'}, 0, "$provisioning_perl_package module could not be loaded");
+ notify($ERRORS{'OK'}, 0, "returning 0");
+ return 0;
+ }
+ notify($ERRORS{'OK'}, 0, "$provisioning_perl_package module successfully loaded");
+
+ # Create provisioner object
+ if (my $provisioner = ($provisioning_perl_package)->new({data_structure => $self->data})) {
+ notify($ERRORS{'OK'}, 0, ref($provisioner) . " provisioner object successfully created");
+ $self->{provisioner} = $provisioner;
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "provisioning object could not be created, returning 0");
+ return 0;
+ }
+ } ## end if ($provisioning_perl_package)
+ else {
+ notify($ERRORS{'OK'}, 0, "provisioning module not loaded, Perl package is not defined");
+ }
+
+ # Attempt to load the OS module
+ if ($os_perl_package) {
+ notify($ERRORS{'OK'}, 0, "attempting to load OS module: $os_perl_package");
+ eval "use $os_perl_package";
+ if ($EVAL_ERROR) {
+ notify($ERRORS{'WARNING'}, 0, "$os_perl_package module could not be loaded");
+ notify($ERRORS{'OK'}, 0, "returning 0");
+ return 0;
+ }
+ if (my $os = ($os_perl_package)->new({data_structure => $self->data})) {
+ notify($ERRORS{'OK'}, 0, ref($os) . " OS object successfully created");
+ $self->{os} = $os;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "OS object could not be created, returning 0");
+ return 0;
+ }
+ } ## end if ($os_perl_package)
+ else {
+ notify($ERRORS{'OK'}, 0, "OS module not loaded, Perl package is not defined");
+ }
+
+ # Attempt to load the predictive loading module
+ if ($predictive_perl_package) {
+ notify($ERRORS{'OK'}, 0, "attempting to load predictive loading module: $predictive_perl_package");
+ eval "use $predictive_perl_package";
+ if ($EVAL_ERROR) {
+ notify($ERRORS{'WARNING'}, 0, "$predictive_perl_package module could not be loaded");
+ notify($ERRORS{'OK'}, 0, "returning 0");
+ return 0;
+ }
+ if (my $predictor = ($predictive_perl_package)->new({data_structure => $self->data})) {
+ notify($ERRORS{'OK'}, 0, ref($predictor) . " predictive loading object successfully created");
+ $self->{predictor} = $predictor;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "predictive loading object could not be created, returning 0");
+ return 0;
+ }
+ } ## end if ($predictive_perl_package)
+ else {
+ notify($ERRORS{'OK'}, 0, "predictive loading module not loaded, Perl package is not defined");
+ }
+
+ notify($ERRORS{'OK'}, 0, "returning 1");
+ return 1;
+
+} ## end sub initialize
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 provisioner
+
+ Parameters : None
+ Returns : Object's provisioner object
+ Description : Returns this objects provisioner object, which is stored in
+ $self->{provisioner}. This method allows it to accessed using
+ $self->provisioner.
+
+=cut
+
+sub provisioner {
+ my $self = shift;
+ return $self->{provisioner};
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 os
+
+ Parameters : None
+ Returns : Object's OS object
+ Description : Returns this objects OS object, which is stored in
+ $self->{os}. This method allows it to accessed using
+ $self->os.
+
+=cut
+
+sub os {
+ my $self = shift;
+ return $self->{os};
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 predictor
+
+ Parameters : None
+ Returns : Object's predictive loading object
+ Description : Returns this objects predictive loading object, which is stored
+ in $self->{predictor}. This method allows it to accessed using
+ $self->predictor.
+
+=cut
+
+sub predictor {
+ my $self = shift;
+ return $self->{predictor};
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 reservation_failed
+
+ Parameters : Message string
+ Returns : Nothing, process exits
+ Description : Performs the steps required when a reservation fails:
+ -if request was deleted
+ -sets computer state to available
+ -exits with status 0
+
+ -inserts 'failed' computerloadlog table entry
+ -updates ending field in the log table to 'failed'
+ -updates the computer state to 'failed'
+ -updates the request state to 'failed', laststate to request's previous state
+ -removes computer from blockcomputers table if this is a block request
+ -exits with status 1
+
+=cut
+
+sub reservation_failed {
+ my $self = shift;
+ if (ref($self) !~ /VCL::/) {
+ notify($ERRORS{'CRITICAL'}, 0, "subroutine was called as a function, it must be called as a class method, reservation failure tasks not attempted, process exiting");
+ exit 1;
+ }
+
+ # Check if a message was passed as an argument
+ my $message = shift;
+ if (!$message) {
+ $message = 'reservation failed';
+ }
+
+ # Get the required data
+ my $request_id = $self->data->get_request_id();
+ my $request_logid = $self->data->get_request_log_id();
+ my $reservation_id = $self->data->get_reservation_id();
+ my $computer_id = $self->data->get_computer_id();
+ my $computer_short_name = $self->data->get_computer_short_name();
+ my $request_state_name = $self->data->get_request_state_name();
+ my $request_laststate_name = $self->data->get_request_laststate_name();
+
+ # Check if the request has been deleted
+ if (is_request_deleted($request_id)) {
+ notify($ERRORS{'OK'}, 0, "request has been deleted, setting computer state to available and exiting");
+
+ # Update the computer state to available
+ if (update_computer_state($computer_id, "available")) {
+ notify($ERRORS{'OK'}, 0, "$computer_short_name ($computer_id) state set to 'available'");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "failed to set $computer_short_name ($computer_id) state to 'available'");
+ }
+
+ notify($ERRORS{'OK'}, 0, "exiting 0");
+ exit 0;
+ } ## end if (is_request_deleted($request_id))
+
+ # Display the message
+ notify($ERRORS{'CRITICAL'}, 0, "reservation failed on $computer_short_name: $message");
+
+ # Insert a row into the computerloadlog table
+ if (insertloadlog($reservation_id, $computer_id, "failed", $message)) {
+ notify($ERRORS{'OK'}, 0, "inserted computerloadlog entry");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to insert computerloadlog entry");
+ }
+
+ # Update log table ending column to failed for this request
+ if (update_log_ending($request_logid, "failed")) {
+ notify($ERRORS{'OK'}, 0, "updated log ending value to 'failed', logid=$request_logid");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to update log ending value to 'failed', logid=$request_logid");
+ }
+
+ # Update the computer state to failed
+ if (update_computer_state($computer_id, "failed")) {
+ notify($ERRORS{'OK'}, 0, "computer $computer_short_name ($computer_id) state set to failed");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to set computer $computer_short_name ($computer_id) state to failed");
+ }
+
+ # Update the request state to failed
+ if (update_request_state($request_id, "failed", $request_laststate_name)) {
+ notify($ERRORS{'OK'}, 0, "set request state to 'failed'/'$request_laststate_name'");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to set request to 'failed'/'$request_laststate_name'");
+ }
+
+ # Check if computer is part of a blockrequest, if so pull out of blockcomputers table
+ if (is_inblockrequest($computer_id)) {
+ notify($ERRORS{'OK'}, 0, "$computer_short_name in blockcomputers table");
+ if (clearfromblockrequest($computer_id)) {
+ notify($ERRORS{'OK'}, 0, "removed $computer_short_name from blockcomputers table");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "failed to remove $computer_short_name from blockcomputers table");
+ }
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "$computer_short_name is NOT in blockcomputers table");
+ }
+
+ notify($ERRORS{'OK'}, 0, "exiting 1");
+ exit 1;
+} ## end sub reservation_failed
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 check_image_os
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+
+sub check_image_os {
+ my $self = shift;
+ my $request_state_name = $self->data->get_request_state_name();
+ my $image_id = $self->data->get_image_id();
+ my $image_name = $self->data->get_image_name();
+ my $image_os_name = $self->data->get_image_os_name();
+ my $imagerevision_id = $self->data->get_imagerevision_id();
+
+ # Only make corrections if state is image
+ if ($request_state_name ne 'image') {
+ notify($ERRORS{'OK'}, 0, "no corrections need to be made, not an imaging request, returning 1");
+ return 1;
+ }
+
+ my $image_os_name_new;
+ if ($image_os_name =~ /^(rh)el([0-9])/ || $image_os_name =~ /^rh(fc)([0-9])/) {
+ # Change rhelX --> rhXimage, rhfcX --> fcXimage
+ $image_os_name_new = "$1$2image";
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "no corrections need to be made to image OS: $image_os_name");
+ return 1;
+ }
+
+ # Change the image name
+ $image_name =~ /^[^-]+-(.*)/;
+ my $image_name_new = "$image_os_name_new-$1";
+
+ notify($ERRORS{'OK'}, 0, "Kickstart image OS needs to be changed: $image_os_name -> $image_os_name_new, image name: $image_name -> $image_name_new");
+
+ # Update the image table, change the OS for this image
+ my $sql_statement = "
+ UPDATE
+ OS,
+ image,
+ imagerevision
+ SET
+ image.OSid = OS.id,
+ image.name = \'$image_name_new\',
+ imagerevision.imagename = \'$image_name_new\'
+ WHERE
+ image.id = $image_id
+ AND imagerevision.id = $imagerevision_id
+ AND OS.name = \'$image_os_name_new\'
+ ";
+
+ # Update the image and imagerevision tables
+ if (database_execute($sql_statement)) {
+ notify($ERRORS{'OK'}, 0, "image and imagerevision tables updated: $image_name -> $image_name_new");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "failed to update image and imagerevision tables: $image_name -> $image_name_new, returning 0");
+ return 0;
+ }
+
+ if ($self->data->refresh()) {
+ notify($ERRORS{'OK'}, 0, "DataStructure refreshed after correcting image OS");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to update DataStructure updated correcting image OS, returning 0");
+ return 0;
+ }
+
+ notify($ERRORS{'OK'}, 0, "returning 1");
+ return 1;
+} ## end sub check_image_os
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 DESTROY
+
+ Parameters : None
+ Returns : Nothing
+ Description : Performs module cleanup actions:
+ -closes the database connection
+
+ If child classes of VCL::Module need to implement their own
+ DESTROY method, they should call this method from their own
+ DESTROY method using:
+ $self->SUPER::DESTROY if $self->can("SUPER::DESTROY");
+
+=cut
+
+sub DESTROY {
+ my $self = shift;
+ my $reservation_id = $self->data->get_reservation_id();
+
+ notify($ERRORS{'DEBUG'}, 0, "destructor called, ref(\$self)=" . ref($self));
+
+ # Delete all computerloadlog rows with loadstatename = 'begin' for thie reservation
+ if (delete_computerloadlog_reservation($reservation_id, 'begin')) {
+ notify($ERRORS{'OK'}, 0, "removed computerloadlog rows with loadstate=begin for reservation");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to remove computerloadlog rows with loadstate=begin for reservation");
+ }
+
+ # Print the number of database handles this process created for testing/development
+ if (defined $ENV{dbh_count}) {
+ notify($ERRORS{'DEBUG'}, 0, "number of database handles state process created: $ENV{dbh_count}");
+ }
+ else {
+ notify($ERRORS{'DEBUG'}, 0, "state process created unknown number of database handles, \$ENV{dbh_count} is undefined");
+ }
+
+ # Close the database handle
+ if (defined $ENV{dbh}) {
+ notify($ERRORS{'DEBUG'}, 0, "process has a database handle stored in \$ENV{dbh}, attempting disconnect");
+
+ if ($ENV{dbh}->disconnect) {
+ notify($ERRORS{'OK'}, 0, "\$ENV{dbh}: database disconnect successful");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "\$ENV{dbh}: database disconnect failed, " . DBI::errstr());
+ }
+ } ## end if (defined $ENV{dbh})
+ else {
+ notify($ERRORS{'OK'}, 0, "process does not have a database handle stored in \$ENV{dbh}");
+ }
+
+ # Check for an overridden destructor
+ $self->SUPER::DESTROY if $self->can("SUPER::DESTROY");
+} ## end sub DESTROY
+
+#/////////////////////////////////////////////////////////////////////////////
+
+1;
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+
+=cut
diff --git a/managementnode/lib/VCL/Module/Utils/Logging.pm b/managementnode/lib/VCL/Module/Utils/Logging.pm
new file mode 100644
index 0000000..4a4d2b7
--- /dev/null
+++ b/managementnode/lib/VCL/Module/Utils/Logging.pm
@@ -0,0 +1,136 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: Logging.pm 1953 2008-12-12 14:23:17Z arkurth $
+##############################################################################
+
+=head1 NAME
+
+VCL::Module::Utils::Logging
+
+=head1 SYNOPSIS
+
+ Needs to be written
+
+=head1 DESCRIPTION
+
+ This module provides...
+
+=cut
+
+##############################################################################
+package VCL::Module::Utils::Logging;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/../../..";
+
+# Configure inheritance
+use base qw();
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(
+ &log_info
+ &log_verbose
+ &log_warning
+ &log_critical
+);
+
+use VCL::utils qw(
+ %ERRORS
+ ¬ify
+);
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 log_info
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub log_info {
+ my ($message, $data) = @_;
+ notify($ERRORS{'OK'}, 0, $message, $data);
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 log_verbose
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub log_verbose {
+ my ($message, $data) = @_;
+ notify($ERRORS{'DEBUG'}, 0, $message, $data);
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 log_warning
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub log_warning {
+ my ($message, $data) = @_;
+ notify($ERRORS{'WARNING'}, 0, $message, $data);
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 log_critical
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub log_critical {
+ my ($message, $data) = @_;
+ notify($ERRORS{'CRITICAL'}, 0, $message, $data);
+}
+
+1;
diff --git a/managementnode/lib/VCL/Module/Utils/SCP.pm b/managementnode/lib/VCL/Module/Utils/SCP.pm
new file mode 100644
index 0000000..737d8f7
--- /dev/null
+++ b/managementnode/lib/VCL/Module/Utils/SCP.pm
@@ -0,0 +1,222 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: SCP.pm 1953 2008-12-12 14:23:17Z arkurth $
+##############################################################################
+
+=head1 NAME
+
+VCL::Module::Utils::SCP
+
+=head1 SYNOPSIS
+
+ Needs to be written
+
+=head1 DESCRIPTION
+
+ This module provides...
+
+=cut
+
+##############################################################################
+package VCL::Module::Utils::SCP;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/../../..";
+
+# Configure inheritance
+use base qw();
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(
+ &scp
+);
+
+use File::Basename;
+use VCL::Module::Utils::Logging;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 scp
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+
+sub scp {
+ my $options_hashref = shift;
+
+ my $options = $options_hashref->{options};
+ my $cipher = $options_hashref->{cipter};
+ my $ssh_config = $options_hashref->{ssh_config};
+ my $identity_file = $options_hashref->{identity_file};
+ my $limit = $options_hashref->{limit};
+ my $ssh_option = $options_hashref->{ssh_option};
+ my $port = $options_hashref->{port};
+ my $program = $options_hashref->{program};
+
+ my $source_user = $options_hashref->{source_user};
+ my $source_host = $options_hashref->{source_host};
+ my $source_path = $options_hashref->{source_path};
+
+ my $destination_user = $options_hashref->{destination_user};
+ my $destination_host = $options_hashref->{destination_host};
+ my $destination_path = $options_hashref->{destination_path};
+
+ if (!$source_path || !$destination_host || !$destination_path) {
+ log_warning("missing at least 1 of the required parameters: source_path, destination_host, destination_path");
+ return 0;
+ }
+
+ # TODO: Add ssh path to config file and set global variable
+ # Locate the path to the scp binary
+ my @possible_scp_paths = ('scp.exe', 'scp', 'C:/cygwin/bin/scp.exe', 'D:/cygwin/bin/scp.exe', '/usr/bin/scp',);
+
+ my $scp_path;
+ for my $possible_scp_path (@possible_scp_paths) {
+ if (-x $possible_scp_path) {
+ $scp_path = $possible_scp_path;
+ last;
+ }
+ }
+ if (!$scp_path) {
+ log_warning("unable to locate the SCP executable");
+ return 0;
+ }
+
+ # Fix the options
+ $options = '' if !$options;
+
+ # -B, Selects batch mode (prevents asking for passwords or passphrases).
+ $options .= 'B' if ($options !~ /B/);
+
+ # -p, Preserves modification times, access times, and modes from the original file.
+ $options .= 'p' if ($options !~ /p/);
+
+ # -r, Recursively copy entire directories.
+ $options .= 'r' if ($options !~ /r/);
+
+ # Don't use -q, Disables the progress meter. Error messages are more descriptive without it
+ $options =~ s/q//g if ($options =~ /q/);
+
+ # Remove all dashes and spaces from the options string
+ $options =~ s/[-\s]//g;
+
+ # Replace 'x' with ' -x'
+ $options =~ s/(\w)/ -$1/gx;
+
+ # Remove leading space
+ $options =~ s/^\s//;
+
+ # Fix some things if pscp.exe is being used
+
+
+ # Set the default destination user
+ $destination_user = 'root' if !$destination_user;
+
+ # Set the default port
+ $port = '22' if !$port;
+
+ # Create a variable to store the entire SCP command
+ my $scp_command;
+
+ # Check if source path contains a colon (likely a Windows machine)
+ # SCP can't handle Windows-style paths like C:\...
+ # cd to the directory then run SCP on the local file name
+ if ($source_path =~ /:/) {
+ # Take the source path apart
+ my ($source_filename, $source_directory) = fileparse($source_path);
+
+ # Add the cd command to the beginning of the SCP command
+ # Use the /D switch to change drives if necessary
+ $scp_command .= "cd /D \"$source_directory\" && ";
+
+ # Change the source file path to the file name
+ $source_path = $source_filename;
+ } ## end if ($source_path =~ /:/)
+
+ # Assemble the SCP command
+ $scp_command .= "\"$scp_path\" ";
+ $scp_command .= "$options ";
+ $scp_command .= "-c $cipher " if $cipher;
+ $scp_command .= "-F \"$ssh_config\" " if $ssh_config;
+ $scp_command .= "-i \"$identity_file\" " if $identity_file;
+ $scp_command .= "-l $limit " if $limit;
+ $scp_command .= "-o $ssh_option " if $ssh_option;
+ $scp_command .= "-P $port ";
+ $scp_command .= "-S \"$program\" " if $program;
+ $scp_command .= "$source_user@" if $source_user;
+ $scp_command .= "$source_host:" if $source_host;
+ $scp_command .= "\"$source_path\" ";
+ $scp_command .= "$destination_user@";
+ $scp_command .= "$destination_host:";
+ $scp_command .= "\"$destination_path\" ";
+
+ # Redirect standard output and error output so all messages are captured
+ $scp_command .= ' 2>&1';
+
+ # Print the configuration if $VERBOSE
+ log_verbose("SCP command: $scp_command");
+
+ # Execute the command
+ my $scp_output = `$scp_command` || 'scp did not produce any output';
+
+ # Save the exit status
+ my $scp_exit_status = $?;
+
+ # Strip out the key warning message
+ $scp_output =~ s/\@{10,}.*man-in-the-middle attacks\.//igs;
+ chomp $scp_output;
+
+ # Check the exit status
+ # scp exits with 0 on success or >0 if an error occurred
+ if ($scp_exit_status <= 0) {
+ # Success
+ log_verbose("scp exit status: $scp_exit_status (success), output: $scp_output");
+ log_info("successfully copied files using scp");
+ return 1;
+ }
+ else {
+ # Failure
+ log_verbose("failed to copy files using scp, exit status: $scp_exit_status, output: $scp_output");
+ return 0;
+ }
+} ## end sub scp
+
+1;
diff --git a/managementnode/lib/VCL/Module/Utils/SSH.pm b/managementnode/lib/VCL/Module/Utils/SSH.pm
new file mode 100644
index 0000000..c8c93dd0
--- /dev/null
+++ b/managementnode/lib/VCL/Module/Utils/SSH.pm
@@ -0,0 +1,168 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: SSH.pm 1953 2008-12-12 14:23:17Z arkurth $
+##############################################################################
+
+=head1 NAME
+
+VCL::Module::Utils::SSH
+
+=head1 SYNOPSIS
+
+ Needs to be written
+
+=head1 DESCRIPTION
+
+ This module provides...
+
+=cut
+
+##############################################################################
+package VCL::Module::Utils::SSH;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/../../..";
+
+# Configure inheritance
+use base qw();
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(
+ &ssh
+);
+
+use VCL::Module::Utils::Logging;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 ssh
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+
+sub ssh {
+ my ($node, $identity_path, $command, $user, $port) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the arguments
+ if (!defined($node) || !$node) {
+ log_warning("computer node was not specified");
+ return 0;
+ }
+ if (!defined($identity_path) || !$identity_path) {
+ log_warning("identity file path was not specified");
+ return 0;
+ }
+ if (!defined($command) || !$command) {
+ log_warning("command was not specified");
+ return 0;
+ }
+
+ # Set default values if not passed as an argument
+ $user = "root" if (!defined($user));
+ $port = 22 if (!defined($port));
+
+
+ # TODO: Add ssh path to config file and set global variable
+ # Locate the path to the ssh binary
+ my @possible_ssh_paths = ('ssh.exe', 'ssh', 'C:/cygwin/bin/ssh.exe', 'D:/cygwin/bin/ssh.exe', '/usr/bin/ssh',);
+
+ my $ssh_path;
+ for my $possible_ssh_path (@possible_ssh_paths) {
+ if (-x $possible_ssh_path) {
+ $ssh_path = $possible_ssh_path;
+ last;
+ }
+ }
+ if (!$ssh_path) {
+ log_warning("unable to locate the SSH executable");
+ return 0;
+ }
+
+ # Print the configuration if $VERBOSE
+ log_verbose("node: $node, identity file path: $identity_path, user: $user, port: $port caller info $package, $filename, $line, $sub");
+ log_verbose("command: $command");
+
+ # Assemble the SSH command
+ # -i <identity_file>, Selects the file from which the identity (private key) for RSA authentication is read.
+ # -l <login_name>, Specifies the user to log in as on the remote machine.
+ # -p <port>, Port to connect to on the remote host.
+ # -x, Disables X11 forwarding.
+ # Dont use: -q, Quiet mode. Causes all warning and diagnostic messages to be suppressed.
+ my $ssh_command = "$ssh_path -i '$identity_path' -l $user -p $port -x $node \"$command\"";
+
+ # Redirect standard output and error output so all messages are captured
+ $ssh_command .= ' 2>&1';
+
+ # Print the command if $VERBOSE
+ log_verbose("ssh command: $ssh_command");
+
+ # Execute the command
+ my $ssh_output = `$ssh_command` || 'ssh did not produce any output';
+
+ # Save the exit status
+ # For some reason the ssh exit status is right-padded with 8 0's
+ # Shift right 8 bits to get the real value
+ my $ssh_exit_status = $? >> 8;
+
+ # Print the exit status and output if $VERBOSE
+ log_verbose("ssh exit status: $ssh_exit_status, output:\n$ssh_output");
+
+ # Check the exit status
+ # ssh exits with the exit status of the remote command or with 255 if an error occurred.
+ if ($ssh_exit_status == 255) {
+ log_warning("failed to execute ssh command, exit status: $ssh_exit_status, ssh exits with the exit status of the remote command or with 255 if an error occurred, output:\n$ssh_output");
+ return ();
+ }
+ elsif ($ssh_exit_status > 0) {
+ log_warning("most likely failed to execute ssh command, exit status: $ssh_exit_status, output:\n$ssh_output");
+ return ();
+ }
+
+ # Split the output up into an array of lines
+ my @output_lines = split(/\n/, $ssh_output);
+
+ # Return the exit status and output
+ return ($ssh_exit_status, \@output_lines);
+
+} ## end sub ssh
+
+1;
diff --git a/managementnode/lib/VCL/blockrequest.pm b/managementnode/lib/VCL/blockrequest.pm
new file mode 100644
index 0000000..eb489b6
--- /dev/null
+++ b/managementnode/lib/VCL/blockrequest.pm
@@ -0,0 +1,815 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: blockrequest.pm 1953 2008-12-12 14:23:17Z arkurth $
+##############################################################################
+
+=head1 NAME
+
+VCL::blockrequest
+
+=head1 SYNOPSIS
+
+ Needs to be written
+
+=head1 DESCRIPTION
+
+ This module provides VCL support for...
+
+=cut
+
+##############################################################################
+package VCL::blockrequest;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/..";
+
+# Configure inheritance
+use base qw(VCL::Module::State);
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+use English '-no_match_vars';
+
+use VCL::utils;
+use DBI;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 initialize
+
+ Parameters : Reference to current inuse object is automatically passed when
+ invoked as a class method.
+ Returns : 1 if successful, 0 otherwise
+ Description : Prepares the delete object to process a reservation. Renames the
+ process.
+
+=cut
+
+sub initialize {
+ my $self = shift;
+
+ # Initialize the database handle count
+ $ENV{dbh_count} = 0;
+
+ # Attempt to get a database handle
+ if ($ENV{dbh} = getnewdbh()) {
+ notify($ERRORS{'OK'}, 0, "obtained a database handle for this state process, stored as \$ENV{dbh}");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to obtain a database handle for this state process");
+ }
+
+
+ # Store the name of this class in an environment variable
+ $ENV{class_name} = ref($self);
+
+ # Rename this process to include some request info
+ rename_vcld_process($self->data);
+
+ # Call the old _initialize subroutine
+ if (!$self->_initialize()) {
+ return 0;
+ }
+
+ notify($ERRORS{'OK'}, 0, "returning 1");
+ return 1;
+
+} ## end sub initialize
+
+=pod
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn function _initialize
+///
+/// \param hash data structure of the referenced object
+///
+/// \return
+///
+/// \brief collects data based this modules goals, sets up data structure
+///
+////////////////////////////////////////////////////////////////////////////////
+=cut
+
+sub _initialize {
+ my $self = shift;
+ my $request = $self->data->get_blockrequest_data();
+ my ($package, $filename, $line) = caller;
+
+ # Create a new database handler
+ my $dbh = getnewdbh();
+
+ # Retrieve data from the data structure
+ my $blockrequest_id = $self->data->get_blockrequest_id();
+ my $blockrequest_mode = $self->data->get_blockrequest_mode();
+ my $blockrequest_image_id = $self->data->get_blockrequest_image_id();
+ my $blockrequest_number_machines = $self->data->get_blockrequest_number_machines();
+ my $blockrequest_expire = $self->data->get_blockrequest_expire();
+ my $blocktime_id = $self->data->get_blocktime_id();
+ my $blocktime_processed = $self->data->get_blocktime_processed();
+ my $blocktime_start = $self->data->get_blocktime_start();
+ my $blocktime_end = $self->data->get_blocktime_end();
+
+ notify($ERRORS{'DEBUG'}, 0, "blockrequest id: $blockrequest_id");
+ notify($ERRORS{'DEBUG'}, 0, "blockrequest mode: $blockrequest_mode");
+ notify($ERRORS{'DEBUG'}, 0, "blockrequest image id: $blockrequest_image_id");
+ notify($ERRORS{'DEBUG'}, 0, "blockrequest number machines: $blockrequest_number_machines");
+ notify($ERRORS{'DEBUG'}, 0, "blockrequest expire: $blockrequest_expire");
+ notify($ERRORS{'DEBUG'}, 0, "blocktime id: $blocktime_id");
+ notify($ERRORS{'DEBUG'}, 0, "blocktime processed: $blocktime_processed");
+ notify($ERRORS{'DEBUG'}, 0, "blocktime start: $blocktime_start");
+ notify($ERRORS{'DEBUG'}, 0, "blocktime end: $blocktime_end");
+
+ sleep 2;
+
+ #record my process start time
+ $request->{"myprocessStart"} = convert_to_epoch_seconds();
+
+
+ # active db handle ?
+ if (!($dbh->ping)) {
+ notify($ERRORS{'WARNING'}, 0, "database handle died, trying to create another one");
+ $dbh = getnewdbh();
+ notify($ERRORS{'OK'}, 0, "database handle re-est") if ($dbh->ping);
+ notify($ERRORS{'WARNING'}, 0, "database handle NOT re-set") if (!($dbh->ping));
+ }
+
+ #get the production imagerevision
+ my $imageselh = $dbh->prepare(
+ "SELECT ir.imagename,ir.id
+ FROM imagerevision ir
+ WHERE ir.production = 1 AND ir.imageid = ?") or notify($ERRORS{'WARNING'}, 0, "block request Could not prepare selecting production image from imagerevision" . $dbh->errstr());
+
+ $imageselh->execute($blockrequest_image_id) or notify($ERRORS{'WARNING'}, 0, "block request Could not execute selecting production image from imagerevision " . $dbh->errstr());
+ my $imagerows = $imageselh->rows;
+ my @imagerow;
+ if ($imagerows != 0) {
+ @imagerow = $imageselh->fetchrow_array;
+ $request->{"imagename"} = $imagerow[0];
+ $request->{"imagerevisionid"} = $imagerow[1];
+ notify($ERRORS{'OK'}, 0, "collected production imagename imagerevisionid @imagerow $blockrequest_image_id");
+ }
+ else {
+ #warning no data for imageid
+ notify($ERRORS{'CRITICAL'}, 0, "no data from imagerevision table $blockrequest_image_id");
+ #preform more steps to prevent looping
+ return 0;
+ }
+
+ if ($blockrequest_mode eq "start") {
+ # find all nodes that can load/run requested image including those under other management nodes
+ # collect resourceid for this imageid
+ my $selh = $dbh->prepare(
+ "SELECT r.id
+ FROM resource r, resourcetype rt
+ WHERE r.resourcetypeid = rt.id AND rt.name = ? AND r.subid = ?") or notify($ERRORS{'WARNING'}, 0, "block request Could not prepare select imageid resourceid" . $dbh->errstr());
+ $selh->execute("image", $blockrequest_image_id) or notify($ERRORS{'WARNING'}, 0, "block request Could not execute select imageid resourceid" . $dbh->errstr());
+ my $rows = $selh->rows;
+ my @row;
+ if ($rows != 0) {
+ @row = $selh->fetchrow_array;
+ $request->{"imageresourceid"} = $row[0];
+ notify($ERRORS{'OK'}, 0, "collected resourceid $row[0] for imageid $blockrequest_image_id");
+ }
+ else {
+ #warning no data for imageid
+ notify($ERRORS{'CRITICAL'}, 0, "no resource id associated with imageid $blockrequest_image_id");
+ #preform more steps to prevent looping
+ return 0;
+ }
+ # collect resource groups this image is a member of
+ $selh = $dbh->prepare(
+ "SELECT resourcegroupid
+ FROM resourcegroupmembers
+ WHERE resourceid = ?") or notify($ERRORS{'WARNING'}, 0, "Could not prepare select resource group membership resourceid" . $dbh->errstr());
+ $selh->execute($request->{imageresourceid}) or notify($ERRORS{'WARNING'}, 0, "Could not execute select resource group membership resourceid" . $dbh->errstr());
+ $rows = $selh->rows;
+ if ($rows != 0) {
+ while (@row = $selh->fetchrow_array) {
+ push(@{$request->{resourcegroups}}, $row[0]);
+ notify($ERRORS{'OK'}, 0, "pushing image resource group $row[0] on list");
+ }
+ notify($ERRORS{'OK'}, 0, "complete list of image resource groups @{ $request->{resourcegroups} }");
+ }
+ else {
+ #warning no data for imageid
+ notify($ERRORS{'CRITICAL'}, 0, "image resource id $request->{imageresourceid} is not in any groups");
+ #preform more steps to prevent looping
+ return 0;
+ }
+
+ # active db handle ?
+ if (!($dbh->ping)) {
+ notify($ERRORS{'WARNING'}, 0, "database handle died, trying to create another one");
+ $dbh = getnewdbh();
+ notify($ERRORS{'OK'}, 0, "database handle re-est") if ($dbh->ping);
+ notify($ERRORS{'WARNING'}, 0, "database handle NOT re-set") if (!($dbh->ping));
+ }
+
+ #find mapping between image resource groups and computer groups
+ $selh = $dbh->prepare(
+ "SELECT r.resourcegroupid2,r.resourcetypeid2
+ FROM resourcemap r, resourcetype rt
+ WHERE r.resourcetypeid1 = rt.id AND rt.name = ? AND r.resourcegroupid1 = ?") or notify($ERRORS{'WARNING'}, 0, "Could not prepare resource to computer group mapping" . $dbh->errstr());
+ foreach my $rgroupid (@{$request->{resourcegroups}}) {
+ notify($ERRORS{'OK'}, 0, "fetching list of groups mapped to image resource group $rgroupid");
+ $selh->execute("image", $rgroupid) or notify($ERRORS{'WARNING'}, 0, "Could not execute select resource group membership resourceid" . $dbh->errstr());
+ $rows = $selh->rows;
+ if ($rows != 0) {
+ while (@row = $selh->fetchrow_array) {
+ $request->{"computergroups"}->{$row[0]}->{"resourceid"} = $row[0];
+ $request->{"computergroups"}->{$row[0]}->{"resourcetypeid"} = $row[1];
+ notify($ERRORS{'OK'}, 0, "computer group= $row[0] can run image grpid= $rgroupid");
+ }
+ }
+ else {
+ #warning no data for mapped resources on resourcegroupid
+ notify($ERRORS{'WARNING'}, 0, "no computer groups found for image resource groupid $rgroupid");
+ #preform more steps to prevent looping
+ #check next one
+
+ }
+ } ## end foreach my $rgroupid (@{$request->{resourcegroups...
+ # active db handle ?
+ if (!($dbh->ping)) {
+ notify($ERRORS{'WARNING'}, 0, "database handle died, trying to create another one");
+ $dbh = getnewdbh();
+ notify($ERRORS{'OK'}, 0, "database handle re-est") if ($dbh->ping);
+ notify($ERRORS{'WARNING'}, 0, "database handle NOT re-set") if (!($dbh->ping));
+ }
+ #who(Management Node) can control these computer group(s)
+ $selh = $dbh->prepare(
+ "SELECT rg.resourceid
+ FROM resourcemap rm, resourcegroupmembers rg, resourcetype rt
+ WHERE rg.resourcegroupid = rm.resourcegroupid1 AND rm.resourcetypeid1 = rt.id AND rt.name = ? AND rm.resourcegroupid2 = ?") or notify($ERRORS{'WARNING'}, 0, "Could not prepare managment node owner of computer group" . $dbh->errstr());
+ #seperating statement about management node information
+ my $selhmn = $dbh->prepare(
+ "SELECT r.subid,m.IPaddress,m.hostname,m.ownerid,s.name,m.lastcheckin
+ FROM resource r,managementnode m,resourcetype rt,state s
+ WHERE m.id = r.subid AND r.resourcetypeid = rt.id AND s.id = m.stateid AND rt.name = ? AND r.id = ?") or notify($ERRORS{'WARNING'}, 0, "Could not prepare managment node info statement" . $dbh->errstr());
+
+ foreach my $computergrpid (keys %{$request->{computergroups}}) {
+ $selh->execute("managementnode", $computergrpid) or notify($ERRORS{'WARNING'}, 0, "Could not execute select resource group membership resourceid" . $dbh->errstr());
+ $rows = $selh->rows;
+ if ($rows != 0) {
+ while (@row = $selh->fetchrow_array) {
+ $request->{"computergroups"}->{$computergrpid}->{"controllingmnids"}->{$row[0]}->{"resourceid"} = $row[0];
+ notify($ERRORS{'OK'}, 0, "management node resourceid @row can control this computer grp $computergrpid");
+ $selhmn->execute("managementnode", $row[0]) or notify($ERRORS{'WARNING'}, 0, "Could not execute select management node info" . $dbh->errstr());
+ my $mrows = $selhmn->rows;
+ if ($mrows != 0) {
+ while (my @mrow = $selhmn->fetchrow_array) {
+ $request->{"computergroups"}->{$computergrpid}->{"controllingmnids"}->{$mrow[0]}->{"IPaddress"} = $mrow[1];
+ $request->{"computergroups"}->{$computergrpid}->{"controllingmnids"}->{$mrow[0]}->{"hostname"} = $mrow[2];
+ $request->{"computergroups"}->{$computergrpid}->{"controllingmnids"}->{$mrow[0]}->{"ownerid"} = $mrow[3];
+ $request->{"computergroups"}->{$computergrpid}->{"controllingmnids"}->{$mrow[0]}->{"state"} = $mrow[4];
+ $request->{"computergroups"}->{$computergrpid}->{"controllingmnids"}->{$mrow[0]}->{"lastcheckin"} = $mrow[5];
+ $request->{"computergroups"}->{$computergrpid}->{"controllingmnids"}->{$mrow[0]}->{"managementnodeid"} = $mrow[0];
+ notify($ERRORS{'OK'}, 0, "management node $mrow[2] can control computergroup $computergrpid");
+ }
+ } ## end if ($mrows != 0)
+ else {
+ #warning no data for mapped resources on resourcegroupid
+ notify($ERRORS{'CRITICAL'}, 0, "no management nodes listed controlling computer groupid $row[0] skipping this group");
+ #preform more steps to prevent looping
+ }
+ } ## end while (@row = $selh->fetchrow_array)
+ } ## end if ($rows != 0)
+ else {
+ #warning no data for mapped resources on resourcegroupid
+ notify($ERRORS{'CRITICAL'}, 0, "no management nodes listed to control computer group id $computergrpid, attempting to remove from our local hash");
+ #preform more steps to prevent looping
+ #delete computergroupid from hash
+ delete($request->{computergroups}->{$computergrpid});
+ if (!(exists($request->{computergroups}->{$computergrpid}))) {
+ notify($ERRORS{'OK'}, 0, "SUCCESSFULLY removed problem computer groupid from list");
+ }
+ } ## end else [ if ($rows != 0)
+ } ## end foreach my $computergrpid (keys %{$request->{computergroups...
+ # active db handle ?
+ if (!($dbh->ping)) {
+ notify($ERRORS{'WARNING'}, 0, "database handle died, trying to create another one");
+ $dbh = getnewdbh();
+ notify($ERRORS{'OK'}, 0, "database handle re-est") if ($dbh->ping);
+ notify($ERRORS{'WARNING'}, 0, "database handle NOT re-set") if (!($dbh->ping));
+ }
+ #collect computer members of associated computer groups
+ $selh = $dbh->prepare(
+ "SELECT c.id,c.hostname,c.IPaddress,s.name,c.currentimageid,c.type
+ FROM resourcetype rt, resource r,resourcegroupmembers rg,computer c,state s
+ WHERE s.id = c.stateid AND rg.resourceid = r.id AND r.subid = c.id AND r.resourcetypeid = rt.id AND rt.name = ? AND rg.resourcegroupid = ?") or notify($ERRORS{'WARNING'}, 0, "Could not prepare statement collect members of related computer groups" . $dbh->errstr());
+
+ #collect list of computers already in the blockcomputers table for this start time
+ my $bcselh = $dbh->prepare(
+ "SELECT bc.computerid FROM blockComputers bc, blockTimes bt
+ WHERE bc.blockTimeid = bt.id AND bt.id != ? AND bt.start < ? AND bt.end > ?") or notify($ERRORS{'WARNING'}, 0, "Could not prepare statement collect members of related computer groups" . $dbh->errstr());
+ $bcselh->execute($blocktime_id, $blocktime_end, $blocktime_start) or notify($ERRORS{'WARNING'}, 0, "Could not execute blockcomputer lookup " . $dbh->errstr());
+ my $bcrows = $bcselh->rows;
+ if ($bcrows != 0) {
+ my @bclist;
+ while (@bclist = $bcselh->fetchrow_array) {
+ $request->{"blockcomputerslist"}->{$bclist[0]} = 1;
+ }
+ }
+
+ #collect OSname for image id
+ my $selhOS = $dbh->prepare(
+ "SELECT o.name FROM OS o,image i
+ WHERE i.id = ?") or notify($ERRORS{'WARNING'}, 0, "Could not prepare statement for OS " . $dbh->errstr());
+ #sort through list of computers
+ foreach my $grpid (keys %{$request->{computergroups}}) {
+ $selh->execute("computer", $grpid) or notify($ERRORS{'WARNING'}, 0, "Could not execute select computer members of group ids" . $dbh->errstr());
+ $rows = $selh->rows;
+ if ($rows != 0) {
+ while (@row = $selh->fetchrow_array) {
+ $request->{"computergroups"}->{computercount}++;
+ $request->{"computergroups"}->{$grpid}->{"members"}->{$row[0]}->{"id"} = $row[0];
+ $request->{"computergroups"}->{$grpid}->{"members"}->{$row[0]}->{"hostname"} = $row[1];
+ $request->{"computergroups"}->{$grpid}->{"members"}->{$row[0]}->{"IPaddress"} = $row[2];
+ $request->{"computergroups"}->{$grpid}->{"members"}->{$row[0]}->{"state"} = $row[3];
+ if (exists($request->{"blockcomputerslist"}->{$row[0]})) {
+ notify($ERRORS{'OK'}, 0, "computer id $row[0] hostname $row[1] is in another block reservation");
+ $row[3] = "inuse";
+ $request->{"computergroups"}->{$grpid}->{"members"}->{$row[0]}->{"state"} = $row[3];
+ }
+ if ($row[3] eq "available") {
+ notify($ERRORS{'OK'}, 0, "available machineid $row[0] hostname $row[1]");
+ $request->{"availablemachines"}->{$row[0]}->{"id"} = $row[0];
+ $request->{"availablemachines"}->{$row[0]}->{"hostname"} = $row[1];
+ $request->{"availablemachines"}->{$row[0]}->{"IPaddress"} = $row[2];
+ $request->{"availablemachines"}->{$row[0]}->{"state"} = $row[3];
+ $request->{"availablemachines"}->{$row[0]}->{"currentimageid"} = $row[4];
+ $request->{"availablemachines"}->{$row[0]}->{"type"} = $row[5];
+ $request->{"availablemachines"}->{$row[0]}->{"shortname"} = $1 if ($row[1] =~ /([-_a-zA-Z0-9]*)\./);
+ #which management node should handle this -- in case there are more than one
+ my $mncount = 0;
+ foreach my $mnid (keys %{$request->{computergroups}->{$grpid}->{controllingmnids}}) {
+ if ($request->{computergroups}->{$grpid}->{controllingmnids}->{$mnid}->{managementnodeid}) {
+ $mncount++;
+ notify($ERRORS{'OK'}, 0, "setting MN to $request->{computergroups}->{$grpid}->{controllingmnids}->{$mnid}->{managementnodeid} for computerid $row[0]");
+ $request->{"availablemachines"}->{$row[0]}->{"managementnodeid"} = $request->{computergroups}->{$grpid}->{controllingmnids}->{$mnid}->{managementnodeid};
+
+ if ($mncount > 1) {
+ #need to figure out which one has less load
+ }
+ }
+ } ## end foreach my $mnid (keys %{$request->{computergroups...
+
+ if ($row[4] eq $blockrequest_image_id) {
+ push(@{$request->{preloadedlist}}, $row[0]);
+ $request->{"availablemachines"}->{$row[0]}->{"preloaded"} = 1;
+ }
+ else {
+ $request->{"availablemachines"}->{$row[0]}->{"preloaded"} = 0;
+ }
+ if ($row[5] =~ /lab/) {
+ $selhOS->execute($row[4]) or notify($ERRORS{'WARNING'}, 0, "Could not execute statement to collect OS info" . $dbh->errstr());
+ my $OS;
+ my $dbretval = $selhOS->bind_columns(\($OS));
+ if ($selhOS->fetch) {
+ $request->{"availablemachines"}->{$row[0]}->{"OS"} = $OS;
+ }
+ }
+ } ## end if ($row[3] eq "available")
+ } ## end while (@row = $selh->fetchrow_array)
+ } ## end if ($rows != 0)
+ else {
+ notify($ERRORS{'WARNING'}, 0, "possible empty group for groupid $grpid");
+ }
+ } ## end foreach my $grpid (keys %{$request->{computergroups...
+ #collect id for reload state and vclreload user
+ $selh = $dbh->prepare("SELECT s.id,u.id FROM state s,user u WHERE s.name= ? AND u.unityid=?") or notify($ERRORS{'WARNING'}, 0, "Could not prepare statement to find reload state" . $dbh->errstr());
+ $selh->execute("reload", "vclreload") or notify($ERRORS{'WARNING'}, 0, "Could not execute reload stateid fetch" . $dbh->errstr());
+ $rows = $selh->rows;
+ if ($rows != 0) {
+ if (@row = $selh->fetchrow_array) {
+ $request->{"reloadstateid"} = $row[0];
+ $request->{"vclreloaduid"} = $row[1];
+ }
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "reload state id or vclreload user id not found");
+ }
+ } ## end if ($blockrequest_mode eq "start")
+ elsif ($blockrequest_mode eq "end") {
+ #collect machines assigned for this blockRequest
+ my $selhandle = $dbh->prepare("SELECT computerid FROM blockComputers WHERE blockTimeid = ?") or notify($ERRORS{'WARNING'}, 0, "Could not prepare statement to collect computerids under blockTimesid" . $dbh->errstr());
+ $selhandle->execute($blocktime_id);
+ if (!$dbh->err) {
+ notify($ERRORS{'OK'}, 0, "collected computer ids for block time $blocktime_id");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "could not execute statement collect computerid under blockTimesid" . $dbh->errstr());
+ }
+
+ my $rows = $selhandle->rows;
+ if (!$rows == 0) {
+ while (my @row = $selhandle->fetchrow_array) {
+ $request->{"blockComputers"}->{$row[0]}->{"id"} = $row[0];
+ }
+ }
+ else {
+ #strange -- no machines
+ notify($ERRORS{'WARNING'}, 0, "mode= $blockrequest_mode no machines found for blockRequest $blockrequest_id blockTimesid $blocktime_id in blockTimes table");
+ }
+ } ## end elsif ($blockrequest_mode eq "end") [ if ($blockrequest_mode eq "start")
+ elsif ($blockrequest_mode eq "expire") {
+ #just remove request entry from table
+
+ }
+ else {
+ #mode not set or mode
+ notify($ERRORS{'CRITICAL'}, 0, "mode not determined mode= $blockrequest_mode");
+ }
+
+ return 1;
+} ## end sub _initialize
+
+=pod
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn sub process
+///
+/// \param hash
+///
+/// \return 1, 0
+///
+/// \brief start mode:
+/// sorts through list of computers, pull out machines that are not
+/// available or are inuse or already scheduled to be used
+/// based on the number of machines needed put machines into blockcomputers
+/// table and insert reload requests
+/// end mode:
+/// remove machines from blockComputers table for block request id X
+/// reload ?
+/// expire mode:
+/// delete entries related to blockRequest
+///
+////////////////////////////////////////////////////////////////////////////////
+=cut
+
+sub process {
+ my $self = shift;
+ my $request = $self->data->get_blockrequest_data();
+ my ($package, $filename, $line) = caller;
+
+ # Create a new database handler
+ my $dbh = getnewdbh();
+
+ # Retrieve data from the data structure
+ my $blockrequest_id = $self->data->get_blockrequest_id();
+ my $blockrequest_mode = $self->data->get_blockrequest_mode();
+ my $blockrequest_image_id = $self->data->get_blockrequest_image_id();
+ my $blockrequest_number_machines = $self->data->get_blockrequest_number_machines();
+ my $blockrequest_expire = $self->data->get_blockrequest_expire();
+ my $blocktime_id = $self->data->get_blocktime_id();
+ my $blocktime_processed = $self->data->get_blocktime_processed();
+ my $blocktime_start = $self->data->get_blocktime_start();
+ my $blocktime_end = $self->data->get_blocktime_end();
+
+ notify($ERRORS{'DEBUG'}, 0, "blockrequest id: $blockrequest_id");
+ notify($ERRORS{'DEBUG'}, 0, "blockrequest mode: $blockrequest_mode");
+ notify($ERRORS{'DEBUG'}, 0, "blockrequest image id: $blockrequest_image_id");
+ notify($ERRORS{'DEBUG'}, 0, "blockrequest number machines: $blockrequest_number_machines");
+ notify($ERRORS{'DEBUG'}, 0, "blockrequest expire: $blockrequest_expire");
+ notify($ERRORS{'DEBUG'}, 0, "blocktime id: $blocktime_id");
+ notify($ERRORS{'DEBUG'}, 0, "blocktime processed: $blocktime_processed");
+ notify($ERRORS{'DEBUG'}, 0, "blocktime start: $blocktime_start");
+ notify($ERRORS{'DEBUG'}, 0, "blocktime end: $blocktime_end");
+
+ if ($blockrequest_mode eq "start") {
+ #confirm preloaded list
+ if ($blocktime_processed) {
+
+ notify($ERRORS{'WARNING'}, 0, "id $blockrequest_id has already been processed, pausing 60 seconds before reseting the processing flag");
+ ##remove processing flag
+ sleep 60;
+ my $updatehdle = $dbh->prepare("UPDATE blockRequest SET processing = ? WHERE id = ?") or notify($ERRORS{'WARNING'}, 0, "Could not prepare update processing statement for end mode" . $dbh->errstr());
+ $updatehdle->execute(0, $blockrequest_id) or notify($ERRORS{'WARNING'}, 0, "Could not execute update processing statement for end mode" . $dbh->errstr());
+ notify($ERRORS{'OK'}, 0, "removed processing flag from blockrequest id $blockrequest_id");
+ return 1;
+ } ## end if ($blocktime_processed)
+ $request->{"availmachinecount"} = 0;
+ # active db handle ?
+ if (!($dbh->ping)) {
+ notify($ERRORS{'WARNING'}, 0, "database handle died, trying to create another one");
+ $dbh = getnewdbh();
+ notify($ERRORS{'OK'}, 0, "database handle re-est") if ($dbh->ping);
+ notify($ERRORS{'WARNING'}, 0, "database handle NOT re-set") if (!($dbh->ping));
+ }
+
+ my $selh = $dbh->prepare(
+ "SELECT r.id,r.start,r.end,s.name
+ FROM request r, reservation rs, state s
+ WHERE r.stateid = s.id AND rs.computerid = ?") or notify($ERRORS{'WARNING'}, 0, "Could not prepare statement for furture reservations checks of computer id " . $dbh->errstr());
+ #sort hash based on preloaded flag
+ foreach my $computerid (sort {$request->{availablemachines}->{$b}->{preloaded} eq '1'} keys %{$request->{availablemachines}}) {
+ #confirm status of available machines
+ notify($ERRORS{'OK'}, 0, "$computerid preload flag= $request->{availablemachines}->{$computerid}->{preloaded}");
+
+ #can only check the machines under this MN control
+ $request->{availablemachines}->{$computerid}->{"ok"} = 0;
+ my @status;
+ if ($request->{availablemachines}->{$computerid}->{type} =~ /blade/) {
+ $request->{availablemachines}->{$computerid}->{"on"} = 1;
+ }
+ elsif ($request->{availablemachines}->{$computerid}->{type} =~ /lab/) {
+ @status = virtual_status_unix($request->{availablemachines}->{$computerid}->{hostname}, $request->{availablemachines}->{$computerid}->{OS}, "linux", $request->{availablemachines}->{$computerid}->{IPaddress});
+ if ($status[2]) {
+ $request->{availablemachines}->{$computerid}->{"on"} = 1;
+ }
+ }
+ elsif ($request->{availablemachines}->{$computerid}->{type} =~ /virtualmachine/) {
+ $request->{availablemachines}->{$computerid}->{"on"} = 1;
+ }
+ notify($ERRORS{'OK'}, 0, "checking for future reservations for computerid $computerid");
+ #check for future reservations
+ $selh->execute($computerid) or notify($ERRORS{'WARNING'}, 0, "Could not execute statement for furture reservations checks of computer id $computerid" . $dbh->errstr());
+ my $rows = $selh->rows;
+ if (!$rows == 0) {
+ my @row = $selh->fetchrow_array;
+ #does blockrequest end time end before this reservations start time
+ if ($row[3] =~ /new/) {
+ my $furture_start = convert_to_epoch_seconds($row[1]);
+ my $BRend = convert_to_epoch_seconds($blocktime_end);
+ #is start greater than end by at least 35 minutes -- to be safe?
+ if ((($furture_start - (35 * 60)) > $BRend)) {
+ #this one is ok
+ $request->{availablemachines}->{$computerid}->{"ok"} = 1;
+ notify($ERRORS{'OK'}, 0, "setting ok flag for computerid $computerid");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "$computerid not ok to use deleting from hash");
+ my $d = ($furture_start - (35 * 60));
+ notify($ERRORS{'OK'}, 0, "furture_start $furture_start : BRend $BRend : delta $d");
+ #skip and remove from our list
+ #my $a = delete($request->{availablemachines}->{$computerid});
+ #next;
+ $request->{availablemachines}->{$computerid}->{"ok"} = 0;
+ }
+ } ## end if ($row[3] =~ /new/)
+ else {
+ $request->{availablemachines}->{$computerid}->{"ok"} = 0;
+ notify($ERRORS{'OK'}, 0, "NOT setting ok flag for computerid $computerid : listed in request $row[0] with state $row[3]");
+ }
+ } ## end if (!$rows == 0)
+ else {
+ #nothing scheduled for this computer id
+ $request->{availablemachines}->{$computerid}->{"ok"} = 1;
+ notify($ERRORS{'OK'}, 0, " setting ok flag for computerid $computerid");
+ }
+
+ if ($request->{availablemachines}->{$computerid}->{on} && $request->{availablemachines}->{$computerid}->{ok}) {
+ # add to our master list
+ $request->{"masterlist"}->{$computerid}->{"id"} = $computerid;
+ $request->{"masterlist"}->{$computerid}->{"controllingMNid"} = $request->{availablemachines}->{$computerid}->{managementnodeid};
+ #increment our count
+ $request->{availmachinecount}++;
+ }
+
+ if ($request->{availmachinecount} > $blockrequest_number_machines) {
+ #should end up with one extra machine
+ last;
+ }
+
+ } ## end foreach my $computerid (sort {$request->{availablemachines...
+
+ #insert machines into Block computers
+ # insert reload request for machine
+ #one sanity check
+ if (!$request->{availmachinecount}) {
+ #nothing -- not good, complain
+ notify($ERRORS{'CRITICAL'}, 0, "no machines where found or allocated for block request $blockrequest_id");
+
+ }
+ if ($request->{availmachinecount} >= $blockrequest_number_machines) {
+ #good they can get what they requested
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "Could not allocate number of requested machines for block request id $blockrequest_id . Only $request->{availmachinecount} are available, will give them those.");
+ }
+ # active db handle ?
+ if (!($dbh->ping)) {
+ notify($ERRORS{'WARNING'}, 0, "database handle died, trying to create another one");
+ $dbh = getnewdbh();
+ notify($ERRORS{'OK'}, 0, "database handle re-est") if ($dbh->ping);
+ notify($ERRORS{'WARNING'}, 0, "database handle NOT re-set") if (!($dbh->ping));
+ }
+ my $insertBC = $dbh->prepare("INSERT INTO blockComputers (blockTimeid,computerid) VALUES(?,?)") or notify($ERRORS{'WARNING'}, 0, "Could not prepare INSERT of blockcomputer table for start mode" . $dbh->errstr());
+
+ my $insertlog = $dbh->prepare("INSERT INTO log (userid,start,initialend,wasavailable,computerid,imageid) VALUES(?,?,?,?,?,?)") or notify($ERRORS{'WARNING'}, 0, "Could not prepare INSERT log entry " . $dbh->errstr());
+ my $lastinsertid;
+ my $insertsublog = $dbh->prepare("INSERT INTO sublog (logid,imageid,computerid) VALUES(?,?,?)") or notify($ERRORS{'WARNING'}, 0, "Could not prepare INSERT of sublog for reload mode" . $dbh->errstr());
+
+ my $insertrequest = $dbh->prepare("INSERT INTO request (stateid,userid,laststateid,logid,start,end,daterequested) VALUES(?,?,?,?,?,?,?)") or notify($ERRORS{'WARNING'}, 0, "Could not prepare INSERT of request for reload mode" . $dbh->errstr());
+ my $insertreservation = $dbh->prepare("INSERT INTO reservation (requestid,computerid,imageid,imagerevisionid,managementnodeid) VALUES (?,?,?,?,?)") or notify($ERRORS{'WARNING'}, 0, "Could not prepare INSERT of reservation for reload mode" . $dbh->errstr());
+
+
+ # $request->masterlist should contain a list of machines we can allocate
+ notify($ERRORS{'OK'}, 0, "number of available machines= $request->{availmachinecount}");
+
+ #do this in two or more loops
+ foreach my $computerid (keys %{$request->{masterlist}}) {
+ $insertBC->execute($blocktime_id, $request->{masterlist}->{$computerid}->{id}) or notify($ERRORS{'WARNING'}, 0, "Could not execute blockcomputers INSERT statement for computerid $computerid under blockrequest id $blockrequest_id" . $dbh->errstr());
+ notify($ERRORS{'OK'}, 0, "Inserted computerid $computerid blockTimesid $blocktime_id into blockcomputers table for block request $blockrequest_id");
+ }
+
+ foreach my $compid (keys %{$request->{masterlist}}) {
+ # set start to be 35 minutes prior to start time
+ # convert to epoch time
+ my $starttimeepoch = convert_to_epoch_seconds($blocktime_start);
+ #subtract 35 minutes from start time
+ $starttimeepoch = ($starttimeepoch - (35 * 60));
+ #convert back to datetime
+ my $starttime = convert_to_datetime($starttimeepoch);
+ #set to nearest 15 minute mark
+ my $start = timefloor15interval($starttime);
+ #set end time
+ my $Eend = ($starttimeepoch + (15 * 60));
+ my $end = convert_to_datetime($Eend);
+ notify($ERRORS{'OK'}, 0, "blockstart= $blocktime_start reloadstart= $start reloadend= $end");
+ #insert into log and sublog
+ $insertlog->execute($request->{vclreloaduid}, $start, $end, 1, $compid, $blockrequest_image_id) or notify($ERRORS{'WARNING'}, 0, "Could not execute log entry" . $dbh->errstr());
+ #get last insertid
+ $lastinsertid = $dbh->{'mysql_insertid'};
+ notify($ERRORS{'OK'}, 0, "lastinsertid for log entry is $lastinsertid");
+ $request->{masterlist}->{$compid}->{"logid"} = $lastinsertid;
+ #insert sublog entry
+ $insertsublog->execute($lastinsertid, $blockrequest_image_id, $request->{masterlist}->{$compid}->{id}) or notify($ERRORS{'WARNING'}, 0, "Could not execute sublog entry" . $dbh->errstr());
+ $lastinsertid = 0;
+ #insert reload request
+ $insertrequest->execute($request->{reloadstateid}, $request->{vclreloaduid}, $request->{reloadstateid}, $request->{masterlist}->{$compid}->{logid}, $start, $end, $start) or notify($ERRORS{'WARNING'}, 0, "Could not prepare INSERT of request for reload mode" . $dbh->errstr());
+ #fetch request insert id
+ $lastinsertid = $dbh->{'mysql_insertid'};
+ notify($ERRORS{'OK'}, 0, "lastinsertid for request entry is $lastinsertid");
+ $request->{masterlist}->{$compid}->{"requestid"} = $lastinsertid;
+ #insert reservation
+ $insertreservation->execute($lastinsertid, $request->{masterlist}->{$compid}->{id}, $blockrequest_image_id, $request->{imagerevisionid}, $request->{masterlist}->{$compid}->{controllingMNid}) or notify($ERRORS{'WARNING'}, 0, "Could not execute reservation entry" . $dbh->errstr());
+ } ## end foreach my $compid (keys %{$request->{masterlist...
+
+ #update processed flag for request
+ my $updatetimes = $dbh->prepare("UPDATE blockTimes SET processed=? WHERE id =?") or notify($ERRORS{'WARNING'}, 0, "Could not prepare INSERT of blockcomputer table for start mode " . $dbh->errstr());
+ $updatetimes->execute(1, $blocktime_id) or notify($ERRORS{'WARNING'}, 0, "could not execute update processing flag on blockRequest id $blockrequest_id " . $dbh->errstr());
+
+
+ #pause
+ if (pauseprocessing($request->{myprocessStart})) {
+ notify($ERRORS{'OK'}, 0, "past check window for this request, -- ok to proceed");
+ }
+ # active db handle ?
+ if (!($dbh->ping)) {
+ notify($ERRORS{'WARNING'}, 0, "database handle died, trying to create another one");
+ $dbh = getnewdbh();
+ notify($ERRORS{'OK'}, 0, "database handle re-est") if ($dbh->ping);
+ notify($ERRORS{'WARNING'}, 0, "database handle NOT re-set") if (!($dbh->ping));
+ }
+
+ #remove processing flag
+ my $update = $dbh->prepare("UPDATE blockRequest SET processing = ? WHERE id = ?") or notify($ERRORS{'WARNING'}, 0, "Could not prepare INSERT of blockcomputer table for start mode " . $dbh->errstr());
+ $update->execute(0, $blockrequest_id);
+ if (!$dbh->errstr()) {
+ notify($ERRORS{'OK'}, 0, "updated processing flag on blockRequest $blockrequest_id to 0");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to update processing flag on blockRequest $blockrequest_id to 0: " . $dbh->errstr());
+ }
+
+ } ## end if ($blockrequest_mode eq "start")
+ elsif ($blockrequest_mode eq "end") {
+ # active db handle ?
+ if (!($dbh->ping)) {
+ notify($ERRORS{'WARNING'}, 0, "database handle died, trying to create another one");
+ $dbh = getnewdbh();
+ notify($ERRORS{'OK'}, 0, "database handle re-est") if ($dbh->ping);
+ notify($ERRORS{'WARNING'}, 0, "database handle NOT re-set") if (!($dbh->ping));
+ }
+
+ # remove blockTime entry for this request
+ #
+ my $delhandle = $dbh->prepare("DELETE blockTimes FROM blockTimes WHERE id = ?") or notify($ERRORS{'WARNING'}, 0, "Could not prepare DELETE blockTimes under id $blockrequest_id" . $dbh->errstr());
+ $delhandle->execute($blocktime_id) or notify($ERRORS{'WARNING'}, 0, "Could not prepare DELETE blockcomputers under id $blockrequest_id" . $dbh->errstr());
+ notify($ERRORS{'OK'}, 0, "removed blockTimes id $blocktime_id from blockTimes table");
+
+ $delhandle = $dbh->prepare("DELETE blockComputers FROM blockComputers WHERE blockTimeid = ? AND computerid = ?") or notify($ERRORS{'WARNING'}, 0, "Could not prepare DELETE blockcomputers under id $blockrequest_id" . $dbh->errstr());
+ # remove each computer in order to reload blades
+ foreach my $computerid (keys %{$request->{"blockComputers"}}) {
+ #remove machines from blockComputers table for block request id X
+ $delhandle->execute($blocktime_id, $request->{blockComputers}->{$computerid}->{id}) or notify($ERRORS{'WARNING'}, 0, "Could not prepare DELETE blockcomputers under id $blockrequest_id" . $dbh->errstr());
+ notify($ERRORS{'OK'}, 0, "removed block computerid $computerid from blockComputers table for blockTimeid $blocktime_id");
+
+ #reload blades
+ #call get next image -- placeholder
+
+ }
+ #check expire time also, if this was the last blockTimes entry then this is likely the expiration time as well
+ my $status = check_blockrequest_time($blocktime_start, $blocktime_end, $blockrequest_expire);
+ if ($status eq "expire") {
+ #fork start processing
+ notify($ERRORS{'OK'}, 0, "this is expire time also");
+ #just remove blockRequest entry from BlockRequest table
+ my $delhandle = $dbh->prepare("DELETE blockRequest FROM blockRequest WHERE id = ?") or notify($ERRORS{'WARNING'}, 0, "Could not prepare DELETE blockRequest id $blockrequest_id " . $dbh->errstr());
+ $delhandle->execute($blockrequest_id) or notify($ERRORS{'WARNING'}, 0, "Could not execute DELETE blcokRequest id $blockrequest_id " . $dbh->errstr());
+ notify($ERRORS{'OK'}, 0, "blockRequest id $blockrequest_id has expired and was removed from the database");
+ return 1;
+ }
+
+ ##remove processing flag
+ my $updatehdle = $dbh->prepare("UPDATE blockRequest SET processing = ? WHERE id = ?") or notify($ERRORS{'WARNING'}, 0, "Could not prepare update processing statement for end mode" . $dbh->errstr());
+ $updatehdle->execute(0, $blockrequest_id) or notify($ERRORS{'WARNING'}, 0, "Could not execute update processing statement for end mode" . $dbh->errstr());
+ notify($ERRORS{'OK'}, 0, "removed processing flag from blockrequest id $blockrequest_id");
+
+ } ## end elsif ($blockrequest_mode eq "end") [ if ($blockrequest_mode eq "start")
+ elsif ($blockrequest_mode eq "expire") {
+ #there should not be any blockTimes entries for this request
+ #just remove blockRequest entry from BlockRequest table
+ my $delhandle = $dbh->prepare("DELETE blockRequest FROM blockRequest WHERE id = ?") or notify($ERRORS{'WARNING'}, 0, "Could not prepare DELETE blockRequest id $blockrequest_id " . $dbh->errstr());
+ $delhandle->execute($blockrequest_id) or notify($ERRORS{'WARNING'}, 0, "Could not execute DELETE blcokRequest id $blockrequest_id " . $dbh->errstr());
+ notify($ERRORS{'OK'}, 0, "blockRequest id $blockrequest_id has expired and was removed from the database");
+ return 1;
+ }
+ else {
+ #should not of hit this
+ notify($ERRORS{'CRITICAL'}, 0, "mode not determined mode= $blockrequest_mode");
+ }
+ return 1;
+
+} ## end sub process
+
+=pod
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn sub pauseprocessing
+///
+/// \param process start time
+///
+/// \return 1, 0
+///
+/// \brief rest until our window for checking request has closed
+///
+////////////////////////////////////////////////////////////////////////////////
+=cut
+
+sub pauseprocessing {
+ my $myStartTime = shift;
+ # set timer to 8 minutes
+ my $wait_minutes = (8 * 60);
+ my $delta = (convert_to_epoch_seconds() - $myStartTime);
+ while ($delta < $wait_minutes) {
+ #continue to loop
+ notify($ERRORS{'OK'}, 0, "going to sleep for 30 seconds, delta=$delta (until delta >= $wait_minutes)");
+ sleep 30;
+ $delta = (convert_to_epoch_seconds() - $myStartTime);
+ }
+ return 1;
+} ## end sub pauseprocessing
+#/////////////////////////////////////////////////////////////////////////////
+
+1;
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+=cut
+
+
diff --git a/managementnode/lib/VCL/healthcheck.pm b/managementnode/lib/VCL/healthcheck.pm
new file mode 100644
index 0000000..41b937e
--- /dev/null
+++ b/managementnode/lib/VCL/healthcheck.pm
@@ -0,0 +1,805 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: healthcheck.pm 1945 2008-12-11 20:58:08Z fapeeler $
+##############################################################################
+
+=head1 NAME
+
+VCL::healthcheck
+
+=head1 SYNOPSIS
+
+ use base qw(VCL::healthcheck);
+
+=head1 DESCRIPTION
+
+ Needs to be written.
+
+=cut
+
+##############################################################################
+package VCL::healthcheck;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/..";
+
+# Configure inheritance
+use base qw();
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use VCL::utils;
+use DBI;
+use Net::DNS;
+use VCL::Module::Provisioning::xCAT;
+use VCL::Module::Provisioning::Lab;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+#----------GLOBALS--------------
+our $LOG = "/var/log/healthcheckvcl.log";
+our $MYDBH;
+
+=pod
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn function
+///
+/// \param
+///
+/// \return
+///
+/// \brief
+///
+////////////////////////////////////////////////////////////////////////////////
+=cut
+
+sub new {
+ my ($class, %input) = @_;
+ my $obj_ref = {%input,};
+ bless $obj_ref, $class; # bless ref to said class
+ $obj_ref->_initialize(); # more work to do
+ return $obj_ref;
+
+}
+
+=pod
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn function
+///
+/// \param
+///
+/// \return
+///
+/// \brief
+///
+////////////////////////////////////////////////////////////////////////////////
+=cut
+
+sub _initialize {
+ my ($hck) = @_;
+ my ($mnid, $managementnodeid, $selh, @row, $rows, $mnresourceid, $resourceid);
+ my @hostinfo = hostname;
+ $hck->{MN} = $hostinfo[0];
+ $hck->{MNos} = $hostinfo[1];
+ $hck->{dbh} = getnewdbh;
+
+ #set global dbh for imagerevision check
+ $MYDBH = $hck->{dbh};
+
+ #= DBI->connect(qq{dbi:mysql:$DATABASE:$SERVER}, $WRTUSER,$WRTPASS, {PrintError => 0});
+ unless (defined $hck->{dbh}) { # dbh is an undef on failure
+ my $outstring = DBI::errstr();
+ notify($ERRORS{'WARNING'}, $LOG, $outstring);
+ #goto SLEEP;
+ return 0;
+ }
+ $hck->{"globalmsg"}->{"header"} = "STATUS SUMMARY of VCL nodes:\n\n";
+
+ #1 get management node id and management node's resource id
+ $selh = $hck->{dbh}->prepare(
+ "SELECT m.id,r.id
+ FROM resource r, resourcetype rt, managementnode m
+ WHERE r.resourcetypeid = rt.id AND r.subid = m.id AND rt.name = ? AND m.hostname = ?") or notify($ERRORS{'WARNING'}, $hck->{LOG}, "Could not prepare select for management node id" . $hck->{dbh}->errstr());
+
+ $selh->execute("managementnode", $hck->{MN}) or notify($ERRORS{'WARNING'}, $LOG, "Could not execute management node id" . $hck->{dbh}->errstr());
+
+ my $dbretval = $selh->bind_columns(\($managementnodeid, $resourceid));
+ $rows = $selh->rows;
+ if ($rows != 0) {
+ while ($selh->fetch) {
+ $mnid = $managementnodeid;
+ $mnresourceid = $resourceid;
+ $hck->{"mnid"} = $managementnodeid;
+ $hck->{"mnresourceid"} = $resourceid;
+ notify($ERRORS{'OK'}, $LOG, "$hck->{MN} mnid $mnid resourceid $resourceid");
+ }
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, $LOG, "No management id for $hck->{MN}.");
+ exit;
+ }
+
+ #2 select management node groups I belong to
+
+ $selh = $hck->{dbh}->prepare("SELECT resourcegroupid FROM resourcegroupmembers WHERE resourceid= ?") or notify($ERRORS{'WARNING'}, $LOG, "Could not prepare select for management node group membership" . $hck->{dbh}->errstr());
+ $selh->execute($hck->{mnresourceid}) or notify($ERRORS{'WARNING'}, $LOG, "Could not execute statement for collecting my group membership" . $hck->{dbh}->errstr());
+ $rows = $selh->rows;
+ if ($rows != 0) {
+ while (@row = $selh->fetchrow_array) {
+ $hck->{"groupmembership"}->{$row[0]} = $row[0];
+ notify($ERRORS{'OK'}, $LOG, "$hck->{MN} resourceid $hck->{mnresourceid} is in group $row[0]");
+ }
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, $LOG, "Not a member of any groups $hck->{MN} resourceid $hck->{mnresourceid}");
+ exit;
+ }
+
+ #3 get list of computer groups I have access to control
+ $selh = $hck->{dbh}->prepare("SELECT r.resourcegroupid2 FROM resourcemap r, resourcetype rt WHERE r.resourcetypeid2=rt.id AND r.resourcegroupid1=? AND rt.name=?") or notify($ERRORS{'WARNING'}, $LOG, "Could not prepare computer groups statement:" . $hck->{dbh}->errstr());
+ foreach my $grpid (sort keys(%{$hck->{groupmembership}})) {
+ $selh->execute($hck->{groupmembership}->{$grpid}, "computer") or notify($ERRORS{'WARNING'}, $LOG, "Could not execute computer goups statement:" . $hck->{dbh}->errstr());
+ $rows = $selh->rows;
+ if ($rows != 0) {
+ while (@row = $selh->fetchrow_array) {
+ $hck->{"groupscancrontrol"}->{$row[0]} = $row[0];
+ notify($ERRORS{'OK'}, $LOG, "$hck->{MN} resourceid $hck->{mnresourceid} cg= $grpid manages group $row[0]");
+ }
+ }
+ else {
+ notify($ERRORS{'WARNING'}, $LOG, "no group to control $hck->{MN} resourceid $hck->{mnresourceid} groupid $grpid ");
+ }
+ } ## end foreach my $grpid (sort keys(%{$hck->{groupmembership...
+
+ #4 foreach of the groups i can manage get the computer members
+ $selh = $hck->{dbh}->prepare(
+ "SELECT r.subid,r.id
+ FROM resourcegroupmembers rm,resourcetype rt,resource r
+ WHERE rm.resourceid=r.id AND rt.id=r.resourcetypeid AND rt.name=? AND rm.resourcegroupid =?
+ ") or notify($ERRORS{'WARNING'}, $LOG, "Could not prepare computer groups statement:" . $hck->{dbh}->errstr());
+ foreach my $rgroupid (sort keys(%{$hck->{groupscancrontrol}})) {
+ $selh->execute("computer", $hck->{groupscancrontrol}->{$rgroupid}) or notify($ERRORS{'WARNING'}, $LOG, "Could not execute computer goups statement:" . $hck->{dbh}->errstr());
+ $rows = $selh->rows;
+ #notify($ERRORS{'OK'},$LOG,"rows = $rows for group$hck->{groupscancrontrol}->{$rgroupid}");
+ if ($rows != 0) {
+ while (@row = $selh->fetchrow_array) {
+ $hck->{"computers"}->{$row[0]}->{"id"} = $row[0];
+ # notify($ERRORS{'OK'},$LOG,"$hck->{MN} resourceid $row[1] computerid $row[0] in group $hck->{groupscancrontrol}->{$rgroupid}");
+ }
+ }
+ else {
+ notify($ERRORS{'WARNING'}, $LOG, "no group to control $hck->{MN} resourceid $hck->{mnresourceid} groupid $rgroupid ");
+ }
+ } ## end foreach my $rgroupid (sort keys(%{$hck->{groupscancrontrol...
+
+ #5 based from our hash table of computer ids collect individual computer information
+ $selh = $hck->{dbh}->prepare(
+ "SELECT c.hostname,c.IPaddress,c.lastcheck,s.name,c.currentimageid,c.preferredimageid,c.imagerevisionid,c.type,c.ownerid,i.name,o.name,c.deleted
+ FROM computer c,state s, image i, OS o
+ WHERE s.id=c.stateid AND i.id=c.currentimageid AND o.id=i.OSid AND c.id =?
+ ") or notify($ERRORS{'WARNING'}, $LOG, "Could not prepare computer info statement:" . $hck->{dbh}->errstr());
+ foreach my $cid (sort keys(%{$hck->{computers}})) {
+ $selh->execute($hck->{computers}->{$cid}->{id}) or notify($ERRORS{'WARNING'}, $LOG, "Could not execute computer info statement:" . $hck->{dbh}->errstr());
+ $rows = $selh->rows;
+ my @crow;
+ if ($rows != 0) {
+ while (@crow = $selh->fetchrow_array) {
+ $hck->{computers}->{$cid}->{"hostname"} = $crow[0];
+ $hck->{computers}->{$cid}->{"IPaddress"} = $crow[1];
+ $hck->{computers}->{$cid}->{"lastcheck"} = $crow[2] if (defined($crow[2]));
+ $hck->{computers}->{$cid}->{"state"} = $crow[3];
+ $hck->{computers}->{$cid}->{"currentimageid"} = $crow[4];
+ $hck->{computers}->{$cid}->{"preferredimageid"} = $crow[5];
+ $hck->{computers}->{$cid}->{"imagerevisionid"} = $crow[6];
+ $hck->{computers}->{$cid}->{"type"} = $crow[7];
+ $hck->{computers}->{$cid}->{"ownerid"} = $crow[8];
+ $hck->{computers}->{$cid}->{"dbimagename"} = $crow[9];
+ $hck->{computers}->{$cid}->{"OSname"} = $crow[10];
+ $hck->{computers}->{$cid}->{"shortname"} = $1 if ($crow[0] =~ /([-_a-zA-Z0-9]*)\./); #should cover all host
+ $hck->{computers}->{$cid}->{"MNos"} = $hck->{MNos};
+ $hck->{computers}->{$cid}->{"deleted"} = $crow[11];
+ $hck->{computers}->{$cid}->{"id"} = $cid;
+ } ## end while (@crow = $selh->fetchrow_array)
+ } ## end if ($rows != 0)
+ else {
+ notify($ERRORS{'WARNING'}, $LOG, "no rows related to computer id $hck->{computers}->{$cid}->{id} reporting no data to pull for computer info statement ");
+ }
+ } ## end foreach my $cid (sort keys(%{$hck->{computers}}...
+} ## end sub _initialize
+
+=pod
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn function process
+///
+/// \param
+///
+/// \return
+///
+/// \brief check each computer, sort checks by type
+/// lab: ssh check,vclclientd running, adduser,deluser
+/// blade: ssh check, correct image, adduser,deluser
+///
+////////////////////////////////////////////////////////////////////////////////
+=cut
+
+sub process {
+ my ($hck) = @_;
+ notify($ERRORS{'OK'}, $LOG, "in processing routine");
+ $hck->{"globalmsg"}->{"body"} = "Summary of VCL node monitoring system:\n\n";
+
+ if (!($hck->{dbh}->ping)) {
+ $hck->{dbh} = getnewdbh();
+ }
+
+ my $checkstate = $hck->{dbh}->prepare(
+ "SELECT s.name,c.lastcheck FROM computer c,state s
+ WHERE s.id=c.stateid AND c.id =?") or notify($ERRORS{'WARNING'}, $LOG, "Could not prepare state check statement on computer:" . $hck->{dbh}->errstr());
+
+ $hck->{"computercount"} = 0;
+ $hck->{"computerschecked"} = 0;
+
+ foreach my $cid (sort keys(%{$hck->{computers}})) {
+ #skipping virtual machines for now
+ next if ($hck->{computers}->{$cid}->{type} eq "virtualmachine");
+
+ # check ssh
+ # check uptime
+ # check vclclientd working
+ # reboot if needed
+ # update lastcheck timestamp
+ # update state if needed
+ # add to failed notification summary if needed
+ # $hostname,$os,$mnOS,$ipaddress,$log
+ # check the current image revision
+
+ #count the node
+ $hck->{"computercount"} += 1;
+ #recheck state and lastcheck time -- this is important as more machines are checked
+ if (!($hck->{dbh}->ping)) {
+ #just incase handle and statement are lost
+ $hck->{dbh} = getnewdbh();
+ $checkstate = $hck->{dbh}->prepare(
+ "SELECT s.name FROM computer c,state s
+ WHERE s.id=c.stateid AND c.id =?") or notify($ERRORS{'WARNING'}, $LOG, "Could not prepare state check statement on computer:" . $hck->{dbh}->errstr());
+
+ }
+
+ $checkstate->execute($hck->{computers}->{$cid}->{id}) or notify($ERRORS{'WARNING'}, $LOG, "Could not execute computer check state for $hck->{computers}->{$cid}->{id}:" . $hck->{dbh}->errstr());
+ my $rows = $checkstate->rows;
+ if ($rows != 0) {
+ my @crow = $checkstate->fetchrow_array;
+ $hck->{computers}->{$cid}->{"state"} = $crow[0];
+ }
+ else {
+ notify($ERRORS{'WARNING'}, $LOG, "no rows related to computer id $hck->{computers}->{$cid}->{id} reporting no data to pull for computer info statement ");
+ $hck->{"globalmsg"}->{"failedbody"} .= "$hck->{computers}->{$cid}->{hostname} : UNABLE to pull current state, skipping";
+ next;
+ }
+ if ($hck->{computers}->{$cid}->{state} =~ /inuse|reloading/) {
+ next;
+ notify($ERRORS{'OK'}, $LOG, "NODE $hck->{computers}->{$cid}->{hostname} inuse skipping");
+
+ }
+ if ($hck->{computers}->{$cid}->{state} =~ /^(maintenance|hpc|vmhostinue)/) {
+ $hck->{computers}->{$cid}->{"skip"} = 1;
+ $hck->{"computersskipped"} += 1;
+ next;
+ }
+
+ if ($hck->{computers}->{$cid}->{deleted}) {
+ #machine deleted but set on a state we monitor
+ $hck->{computers}->{$cid}->{"confirmedstate"} = "maintenance";
+ goto UPDATESTATE;
+ }
+
+ #check lastcheck
+ if (defined($hck->{computers}->{$cid}->{"lastcheck"})) {
+ my $lastcheckepoch = convert_to_epoch_seconds($hck->{computers}->{$cid}->{lastcheck});
+ my $currentimeepoch = convert_to_epoch_seconds();
+ my $delta = ($currentimeepoch - $lastcheckepoch);
+ #if( $delta <= (5*60) ){
+ if ($delta <= (1 * 60 * 60 * 24 + 60 * 60)) {
+ #if( $delta <= (90*60) ){
+ notify($ERRORS{'OK'}, $LOG, "NODE $hck->{computers}->{$cid}->{hostname} recently checked skipping");
+ #this node was recently checked
+ $hck->{computers}->{$cid}->{"skip"} = 1;
+ $hck->{"computersskipped"} += 1;
+ next;
+ }
+ $hck->{"computerschecked"} += 1;
+ } ## end if (defined($hck->{computers}->{$cid}->{"lastcheck"...
+
+ #handle the failed machines first
+ if ($hck->{computers}->{$cid}->{state} =~ /failed|available/) {
+
+ if (_valid_host($hck->{computers}->{$cid}->{hostname})) {
+ $hck->{computers}->{$cid}->{"valid_host"} = 1;
+ $hck->{computers}->{$cid}->{"basechecksok"} = 0;
+ notify($ERRORS{'OK'}, $LOG, "process: reports valid host for $hck->{computers}->{$cid}->{hostname}");
+ }
+ else {
+ # for now leave state as to annoy owner to either remove or update the machine
+ $hck->{computers}->{$cid}->{"valid_host"} = 0;
+ $hck->{"globalmsg"}->{"failedbody"} .= "$hck->{computers}->{$cid}->{hostname}, $hck->{computers}->{$cid}->{IPaddress} : INVALID HOSTname, remove or update\n";
+ next;
+ }
+
+ my @basestatus = _baseline_checks($hck->{computers}->{$cid});
+ $hck->{computers}->{$cid}->{"ping"} = $basestatus[0];
+ $hck->{computers}->{$cid}->{"sshd"} = $basestatus[1];
+ $hck->{computers}->{$cid}->{"vclclientd"} = $basestatus[2] if ($hck->{computers}->{$cid}->{type} eq "lab");
+ $hck->{computers}->{$cid}->{"localimagename"} = $basestatus[2] if ($hck->{computers}->{$cid}->{type} eq "blade");
+ $hck->{computers}->{$cid}->{"uptime"} = $basestatus[3];
+ $hck->{computers}->{$cid}->{"basechecksok"} = $basestatus[4];
+ $hck->{"globalmsg"}->{"failedbody"} .= "$hck->{computers}->{$cid}->{hostname} : $basestatus[5]\n" if (defined($basestatus[5]));
+ #notify($ERRORS{'OK'},$LOG,"status= $basestatus[0],$basestatus[1],$basestatus[2],$basestatus[3],$basestatus[4]");
+
+ if ($hck->{computers}->{$cid}->{basechecksok}) {
+ #baseline checks ok, do more checks
+ if (_imagerevision_check($hck->{computers}->{$cid})) {
+
+ }
+
+ if ($hck->{computers}->{$cid}->{type} eq "lab") {
+ # if(enablesshd($hck->{computers}->{$cid}->{hostname},"eostest1",$hck->{computers}->{$cid}->{IPaddress},"new",$hck->{computers}->{$cid}->{OSname},$LOG)){
+ #good now disable it disable($hostname,$unityname,$remoteIP,$state,$osname,$log
+ # if(disablesshd($hck->{computers}->{$cid}->{hostname},"eostest1",$hck->{computers}->{$cid}->{IPaddress},"timeout",$hck->{computers}->{$cid}->{OSname},$LOG)){
+ $hck->{computers}->{$cid}->{"confirmedstate"} = "available";
+ $hck->{"labnodesavailable"} += 1;
+ $hck->{"globalmsg"}->{"correctedbody"} .= "$hck->{computers}->{$cid}->{hostname} : was failed, now active\n" if ($hck->{computers}->{$cid}->{state} eq "failed");
+ # }
+ # else{
+ # #failed
+ #$hck->{computers}->{$cid}->{"confirmedstate"}="failed";
+ # $hck->{"labnodesfailed"} +=1;
+ #$hck->{"globalmsg"}->{"failedbody"} .= "$hck->{computers}->{$cid}->{hostname} : failed could not disablesshd\n";
+ #}
+ #}
+ #else{
+ #failed
+ #$hck->{computers}->{$cid}->{"confirmedstate"}="failed";
+ #$hck->{"globalmsg"}->{"failedbody"} .= "$hck->{computers}->{$cid}->{hostname} : failed could not enablesshd\n";
+ #}
+ if ($hck->{computers}->{$cid}->{uptime} >= 10) {
+ $hck->{"globalmsg"}->{"failedbody"} .= "$hck->{computers}->{$cid}->{hostname} : UPTIME $hck->{computers}->{$cid}->{uptime} days\n";
+ }
+ } ## end if ($hck->{computers}->{$cid}->{type} eq "lab")
+ elsif ($hck->{computers}->{$cid}->{type} eq "blade") {
+ #blade tasks
+ #options fork in order to load mulitples simultaneously
+ #TASKS:
+ # 1) partly completed, basechecks are ok, pingable, sshd running/logins ok,
+ # 2) does image name match whats listed
+ #
+ $hck->{computers}->{$cid}->{"confirmedstate"} = "available";
+ }
+ } ## end if ($hck->{computers}->{$cid}->{basechecksok...
+ else {
+ #basechecks failed, reason appended to failedbody already
+ if ($hck->{computers}->{$cid}->{type} eq "lab") {
+ # can not do much about a lab machine
+ $hck->{computers}->{$cid}->{"confirmedstate"} = "failed";
+ $hck->{"labnodesfailed"} += 1;
+ }
+ elsif ($hck->{computers}->{$cid}->{type} eq "blade") {
+ $hck->{computers}->{$cid}->{"confirmedstate"} = "failed";
+ #dig deeper --
+ #if no power turn on and wait
+ #if no sshd
+ }
+ } ## end else [ if ($hck->{computers}->{$cid}->{basechecksok...
+ UPDATESTATE:
+ if ($hck->{computers}->{$cid}->{"confirmedstate"} ne $hck->{computers}->{$cid}->{"state"}) {
+ #different states update db to reflected confirmed state
+ #my $stateid;
+ #$stateid = 2 if($hck->{computers}->{$cid}->{"confirmedstate"} eq "available");
+ #$stateid = 5 if($hck->{computers}->{$cid}->{"confirmedstate"} eq "failed");
+ #$stateid = 10 if($hck->{computers}->{$cid}->{"confirmedstate"} eq "maintenance");
+ $hck->{computers}->{$cid}->{"state"} = $hck->{computers}->{$cid}->{"confirmedstate"};
+ #notify($ERRORS{'OK'}, $LOG, "basestatus check= $hck->{computers}->{$cid}->{basechecksok} setting to $hck->{computers}->{$cid}->{hostname} to $hck->{computers}->{$cid}->{confirmedstate} ") if (updatestate(0, $hck->{computers}->{$cid}->{id}, "computer", $hck->{computers}->{$cid}->{confirmedstate}, 0, $LOG));
+ if (update_computer_state($hck->{computers}->{$cid}->{id}, $hck->{computers}->{$cid}->{confirmedstate})) {
+ notify($ERRORS{'OK'}, $LOG, "basestatus check= $hck->{computers}->{$cid}->{basechecksok} setting to $hck->{computers}->{$cid}->{hostname} to $hck->{computers}->{$cid}->{confirmedstate} ");
+ }
+
+ } ## end if ($hck->{computers}->{$cid}->{"confirmedstate"...
+ } ## end if ($hck->{computers}->{$cid}->{state} =~ ...
+ if ($hck->{computers}->{$cid}->{skip}) {
+ #update lastcheck time
+ my $datestring = makedatestring;
+ my $update_lc = $hck->{dbh}->prepare("UPDATE computer SET lastcheck=? WHERE id=?") or notify($ERRORS{'WARNING'}, $LOG, "Could not prepare lastcheck time update" . $hck->{dbh}->errstr());
+ $update_lc->execute($datestring, $hck->{computers}->{$cid}->{id}) or notify($ERRORS{'WARNING'}, $LOG, "Could not execute lastcheck time update");
+ $update_lc->finish;
+ }
+ } #for loop
+ $hck->{dbh}->disconnect;
+ return 1;
+} ## end sub process
+
+=pod
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn function _valid_host
+///
+/// \param
+///
+/// \return 1,0
+///
+/// \brief is this a valid host in dns
+///
+////////////////////////////////////////////////////////////////////////////////
+=cut
+
+sub _valid_host {
+ my ($node) = @_;
+ my @ns = qw(152.1.1.22 152.1.2.22 152.1.1.161);
+ my $rns = \@ns;
+ my $res = Net::DNS::Resolver->new(nameservers => $rns,
+ tcp_timeout => 5,
+ retry => 2);
+ my $q = $res->search($node);
+ if ($q) {
+ foreach my $rr ($q->answer) {
+ next unless $rr->type eq "A";
+ next unless $rr->type eq "PTR";
+ }
+ return 1;
+ }
+ else {
+ return 0;
+ }
+} ## end sub _valid_host
+
+=pod
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn function _baseline_checks
+///
+/// \param
+///
+/// \return array - ping status(1,0),ssh status(1,0),uptime(1,0)- reboots, basestatus (1,0), failure statement
+///
+/// \brief pingable, sshd, uptime
+///
+////////////////////////////////////////////////////////////////////////////////
+=cut
+
+sub _baseline_checks {
+ my ($cidhash) = @_;
+ #based on type and OS
+ #ping
+ #sshd
+ #uptime
+ # ? for unix lab machines is vclclientd running
+ my @ret;
+ my $node = $cidhash->{IPaddress};
+ if ($cidhash->{type} eq "blade") {
+ $node = $cidhash->{shortname};
+ }
+
+ # node_status
+ # hashref: reference to hash with keys/values:
+ # {status} => <"READY","FAIL">
+ # {ping} => <0,1>
+ # {ssh} => <0,1>
+ # {rpower} => <0,1>
+ # {nodeset} => <"boot", "install", "image", ...>
+ # {nodetype} => <image name>
+ # {currentimage} => <image name>
+
+ if ($cidhash->{type} eq "lab") {
+ my $identity;
+ if ($cidhash->{OSname} =~ /sun4x/) {
+ $identity = $IDENTITY_solaris_lab;
+ }
+ elsif ($cidhash->{OSname} =~ /rhel/) {
+ $identity = $IDENTITY_linux_lab;
+ }
+ else {
+ notify($ERRORS{'OK'}, $LOG, "os $cidhash->{OSname} set but not something I can handle yet, will attempt the unix identity.");
+
+ $identity = $IDENTITY_linux_lab;
+ }
+
+ #my @status = VCL::Module::Provisioning::Lab::node_status($cidhash->{hostname}, $cidhash->{OSname}, $cidhash->{MNos}, $cidhash->{IPaddress}, $identity, $LOG);
+ my $node_status = VCL::Module::Provisioning::Lab::node_status($cidhash->{hostname}, $cidhash->{OSname}, $cidhash->{MNos}, $cidhash->{IPaddress}, $identity, $LOG);
+ if ($node_status->{ping}) {
+ #pingable
+ notify($ERRORS{'OK'}, $LOG, "$cidhash->{IPaddress} pingable");
+ push(@ret, 1);
+ }
+ else {
+ push(@ret, 0, 0, 0, 0, 0, "NOT pingable");
+ return @ret;
+ }
+ #sshd
+ if ($node_status->{ssh}) {
+ push(@ret, 1);
+ notify($ERRORS{'OK'}, $LOG, "$cidhash->{IPaddress} ssh reponds");
+ }
+ else {
+ push(@ret, 0, 0, 0, 0, "sshd NOT responding");
+ return @ret;
+ }
+ #vclclientd
+ if ($node_status->{vcl_client}) {
+ push(@ret, 1);
+ notify($ERRORS{'OK'}, $LOG, "$cidhash->{IPaddress} vclclientd running");
+ }
+ else {
+ push(@ret, 0, 0, 0, "vclclientd NOT running");
+ return @ret;
+ }
+ #check_uptime ($node,$IPaddress,$OSname,$type)
+ my @check_uptime_array = check_uptime($cidhash->{hostname}, $cidhash->{IPaddress}, $cidhash->{OSname}, $cidhash->{type}, $LOG);
+ push(@ret, $check_uptime_array[0]);
+
+ #if here then basechecks are ok
+ push(@ret, 1);
+
+ } ## end if ($cidhash->{type} eq "lab")
+ elsif ($cidhash->{type} eq "blade") {
+ #my @status = VCL::Module::Provisioning::xCAT::node_status($cidhash->{shortname}, $LOG);
+ my $node_status = VCL::Module::Provisioning::xCAT::node_status($cidhash->{shortname}, $LOG);
+ # First see if it returned a hashref
+ if (ref($node_status) eq 'HASH') {
+ notify($ERRORS{'DEBUG'}, 0, "node_status returned a hash reference");
+ }
+
+ # Check if node_status returned an array ref
+ elsif (ref($node_status) eq 'ARRAY') {
+ notify($ERRORS{'OK'}, $LOG, "node_status returned an array reference");
+
+ }
+
+ # Check if node_status didn't return a reference
+ # Assume string was returned
+ elsif (!ref($node_status)) {
+ # Use scalar value of node_status's return value
+ }
+
+ else {
+ notify($ERRORS{'OK'}, $LOG, "->node_status() returned an unsupported reference type: " . ref($node_status) . ", returning");
+ return;
+ }
+
+ #host/power (pingable)
+ #if ($status[1] eq "on") {
+ if ($node_status->{rpower}) {
+ #powered on
+ notify($ERRORS{'OK'}, $LOG, "$cidhash->{shortname} power on ");
+ push(@ret, 1);
+ }
+ else {
+ push(@ret, 0, 0, 0, 0, 0, "Powered off\n");
+ return @ret;
+ }
+ #sshd
+ #if ($status[3] eq "on") {
+ if ($node_status->{ssh}) {
+ push(@ret, 1);
+ notify($ERRORS{'OK'}, $LOG, "$cidhash->{shortname} ssh reponds");
+ }
+ else {
+ push(@ret, 0, 0, 0, 0, "$cidhash->{shortname} sshd NOT responding");
+ return @ret;
+ }
+ #imagename
+ #if ($status[7]) {
+ if ($node_status->{nodetype}) {
+ notify($ERRORS{'OK'}, $LOG, "$cidhash->{shortname} imagename set $node_status->{nodetype}");
+
+ if ($node_status->{currentimage}) {
+ if ($node_status->{currentimage} =~ /\r/) {
+ chop($node_status->{currentimage});
+ #notify($ERRORS{'OK'},$LOG,"$cidhash->{shortname} imagename had carriage return $status[8]");
+ }
+ if ($node_status->{nodetype} =~ /$node_status->{currentimage}/) { #do 7 & 8 match
+ #notify($ERRORS{'OK'},$LOG,"$cidhash->{shortname} nodetype matches imagename on local file");
+ push(@ret, $node_status->{nodetype});
+ }
+ else {
+ #notify($ERRORS{'OK'},$LOG,"$cidhash->{shortname} nodetype DO NOT matche imagename on remote file");
+ push(@ret, "$node_status->{currentimage}");
+ }
+ } ## end if ($node_status->{currentimage})
+ else {
+ #possible linux env
+ push(@ret, $node_status->{nodetype});
+ }
+
+ } ## end if ($node_status->{nodetype})
+ else {
+ #very strange imagename for nodetype not defined
+ push(@ret, 0, 0, "imagename for nodetype not defined");
+ return @ret;
+ }
+ #uptime not checkable yet for some blades
+ #basechecks ok if made it here
+ push(@ret, 0, 1);
+
+ notify($ERRORS{'OK'}, $LOG, "$cidhash->{shortname} past basecheck flag ret = @ret");
+
+ } ## end elsif ($cidhash->{type} eq "blade") [ if ($cidhash->{type} eq "lab")
+
+ return @ret;
+} ## end sub _baseline_checks
+
+=pod
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn function _reload
+///
+/// \param
+///
+/// \return array - [1,0], [string]
+///
+/// \brief trys to reload the blade if needed, returns success or reason why could not be done
+///
+////////////////////////////////////////////////////////////////////////////////
+=cut
+
+sub _reload {
+ my ($cidhash) = @_;
+
+}
+
+=pod
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn function _imagerevision_check
+///
+/// \param
+///
+/// \return array - [1,0], [string]
+///
+/// \brief checks image name and revsion number of computer id
+///
+////////////////////////////////////////////////////////////////////////////////
+=cut
+
+sub _imagerevision_check {
+ my ($cidhash) = @_;
+
+ if (!($MYDBH->ping)) {
+ $MYDBH = getnewdbh();
+ }
+
+ my %imagerev;
+
+ my $sel = $MYDBH->prepare(
+ "SELECT ir.id,ir.imagename,ir.revision,ir.production
+ FROM imagerevision ir
+ WHERE ir.imageid = ?") or notify($ERRORS{'WARNING'}, $LOG, "Could not prepare select for imagerevision check" . $MYDBH->errstr());
+ $sel->execute($cidhash->{currentimageid}) or notify($ERRORS{'WARNING'}, $LOG, "Could not prepare select for imagerevision check" . $MYDBH->errstr());
+
+ my $update = $MYDBH->prepare("UPDATE computer SET imagerevisionid =? WHERE id = ?") or notify($ERRORS{'WARNING'}, $LOG, "Could not prepare update for correct image revision" . $MYDBH->errstr());
+
+ my $rows = $sel->rows;
+ if ($rows != 0) {
+ while (my @row = $sel->fetchrow_array) {
+ $imagerev{"$row[0]"}{"id"} = $row[0];
+ $imagerev{"$row[0]"}{"imagename"} = $row[1];
+ $imagerev{"$row[0]"}{"revision"} = $row[2];
+ $imagerev{"$row[0]"}{"production"} = $row[3];
+ if ($row[3]) {
+ #check computer version
+ if ($row[0] != $cidhash->{imagerevisionid}) {
+ $update->execute($row[0], $cidhash->{id}) or notify($ERRORS{'WARNING'}, $LOG, "Could not update for correct image revision" . $MYDBH->errstr());
+ notify($ERRORS{'OK'}, $LOG, "imagerevisionid $cidhash->{imagerevisionid} does not match on computer id $cidhash->{id} -- setting to version $row[2] revision id $row[0]");
+ }
+ else {
+ notify($ERRORS{'OK'}, $LOG, "imagerevision matches -- skipping update");
+ }
+ return 1;
+ } ## end if ($row[3])
+ } ## end while (my @row = $sel->fetchrow_array)
+ } ## end if ($rows != 0)
+ else {
+ notify($ERRORS{'WARNING'}, $LOG, "imagerevision check -- no rows found for computer id $cidhash->{id}");
+ return 0;
+ }
+
+} ## end sub _imagerevision_check
+
+=pod
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn function send_report
+///
+/// \param
+///
+/// \return 1,0
+///
+/// \brief sends detailed report to owners of possible issues with the boxes
+///
+////////////////////////////////////////////////////////////////////////////////
+=cut
+
+sub send_report {
+ my ($hck) = @_;
+
+ #notify($ERRORS{'OK'},$LOG,"$hck->{globalmsg}->{body}\n\n $hck->{globalmsg}->{failedbody}\n");
+ if (defined($hck->{computercount})) {
+ $hck->{globalmsg}->{body} .= "Number of nodes found for this management node $hck->{MN}: $hck->{computercount}\n";
+ }
+ if (defined($hck->{"computerschecked"})) {
+ $hck->{globalmsg}->{body} .= "Number of nodes checked: $hck->{computerschecked}\n";
+ }
+ if (defined($hck->{"computersskipped"})) {
+ $hck->{globalmsg}->{body} .= "Number of nodes skipped due to recent check: $hck->{computersskipped}\n";
+ }
+ if (defined($hck->{labnodesfailed})) {
+ $hck->{globalmsg}->{body} .= "UNavailable labnodes: $hck->{labnodesfailed}\n";
+ }
+ if (defined($hck->{labnodesavailable})) {
+ $hck->{globalmsg}->{body} .= "Available labnodes: $hck->{labnodesavailable}\n";
+ }
+
+ if (defined($hck->{globalmsg}->{correctedbody})) {
+ $hck->{globalmsg}->{body} .= "\nCorrected VCL nodes:\n\n$hck->{globalmsg}->{correctedbody}\n";
+ }
+ if (defined($hck->{globalmsg}->{failedbody})) {
+ $hck->{"globalmsg"}->{body} .= "\nProblem VCL nodes:\n\n$hck->{globalmsg}->{failedbody}\n";
+
+ }
+ if (!defined($hck->{globalmsg}->{failedbody}) && !defined($hck->{globalmsg}->{correctedbody})) {
+ $hck->{globalmsg}->{body} .= "\nAll nodes report ok";
+
+ }
+ mail($SYSADMIN, "VCL node monitoring report", "$hck->{globalmsg}->{body}");
+} ## end sub send_report
+#/////////////////////////////////////////////////////////////////////////////
+
+1;
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+
+=cut
diff --git a/managementnode/lib/VCL/image.pm b/managementnode/lib/VCL/image.pm
new file mode 100644
index 0000000..6aaf0ce
--- /dev/null
+++ b/managementnode/lib/VCL/image.pm
@@ -0,0 +1,460 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: image.pm 1945 2008-12-11 20:58:08Z fapeeler $
+##############################################################################
+
+=head1 NAME
+
+VCL::image - Perl module for the VCL image state
+
+=head1 SYNOPSIS
+
+ use VCL::image;
+ use VCL::utils;
+
+ # Set variables containing the IDs of the request and reservation
+ my $request_id = 5;
+ my $reservation_id = 6;
+
+ # Call the VCL::utils::get_request_info subroutine to populate a hash
+ my %request_info = get_request_info($request_id);
+
+ # Set the reservation ID in the hash
+ $request_info{RESERVATIONID} = $reservation_id;
+
+ # Create a new VCL::image object based on the request information
+ my $image = VCL::image->new(%request_info);
+
+=head1 DESCRIPTION
+
+ This module supports the VCL "image" state.
+
+=cut
+
+##############################################################################
+package VCL::image;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/..";
+
+# Configure inheritance
+use base qw(VCL::Module::State);
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use VCL::utils;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 process
+
+ Parameters : $request_data_hash_reference
+ Returns : 1 if successful, 0 otherwise
+ Description : Processes a reservation in the timout state. You must pass this
+ method a reference to a hash containing request data.
+
+=cut
+
+sub process {
+ my $self = shift;
+ my $request_id = $self->data->get_request_id();
+ my $reservation_id = $self->data->get_reservation_id();
+ my $user_id = $self->data->get_user_id();
+ my $user_unityid = $self->data->get_user_login_id();
+ my $user_preferredname = $self->data->get_user_preferred_name();
+ my $user_email = $self->data->get_user_email();
+ my $affiliation_sitewwwaddress = $self->data->get_user_affiliation_sitewwwaddress();
+ my $affiliation_helpaddress = $self->data->get_user_affiliation_helpaddress();
+ my $image_id = $self->data->get_image_id();
+ my $image_name = $self->data->get_image_name();
+ my $image_prettyname = $self->data->get_image_prettyname();
+ my $image_size = $self->data->get_image_size();
+ my $imagerevision_id = $self->data->get_imagerevision_id();
+ my $imagemeta_sysprep = $self->data->get_imagemeta_sysprep();
+ my $computer_id = $self->data->get_computer_id();
+ my $computer_type = $self->data->get_computer_type();
+ my $computer_shortname = $self->data->get_computer_short_name();
+ my $managementnode_shortname = $self->data->get_management_node_short_name();
+
+ # Notify administrators that image creation is starting
+ my $body = <<"END";
+VCL Image Creation Started
+
+Request ID: $request_id
+Reservation ID: $reservation_id
+PID: $$
+
+Image ID: $image_id
+Image name: $image_name
+Base image size: $image_size
+Base revision ID: $imagerevision_id
+
+Management node: $managementnode_shortname
+
+Username: $user_unityid
+User ID: $user_id
+
+Computer ID: $computer_id
+Computer name: $computer_shortname
+
+Use Sysprep: $imagemeta_sysprep
+END
+ mail($SYSADMIN, "VCL IMAGE Creation Started: $image_name", $body, $affiliation_helpaddress);
+
+ # Make sure image does not exist in the repository
+ my $image_already_exists = $self->provisioner->does_image_exist();
+ if ($image_already_exists) {
+ notify($ERRORS{'CRITICAL'}, 0, "image $image_name already exists in the repository");
+ $self->image_creation_failed();
+ }
+ elsif (!defined($image_already_exists)) {
+ notify($ERRORS{'CRITICAL'}, 0, "image $image_name already partially exists in the repository");
+ $self->image_creation_failed();
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "image $image_name does not exist in the repository");
+ }
+
+ # Get the current timestamp
+ # This will be used for image.lastupdate, imagerevision.datecreated and currentimage.txt
+ my $timestamp = makedatestring();
+ $self->data->set_image_lastupdate($timestamp);
+ $self->data->set_imagerevision_date_created($timestamp);
+
+ # Call the create image subroutine in utils.pm
+ my $create_image_result;
+ if ($computer_type eq "blade" && $self->os) {
+ $create_image_result = 1;
+
+ notify($ERRORS{'OK'}, 0, "OS modularization supported, beginning OS module capture prepare");
+ if (!($create_image_result = $self->os->capture_prepare())) {
+ notify($ERRORS{'WARNING'}, 0, "OS module capture prepare failed");
+ }
+
+ notify($ERRORS{'OK'}, 0, "beginning provisioning module capture prepare");
+ if ($create_image_result && !($create_image_result = $self->provisioner->capture_prepare())) {
+ notify($ERRORS{'WARNING'}, 0, "provisioning module capture prepare failed");
+ }
+
+ notify($ERRORS{'OK'}, 0, "beginning OS module capture start");
+ if ($create_image_result && !($create_image_result = $self->os->capture_start())) {
+ notify($ERRORS{'WARNING'}, 0, "OS module capture start failed");
+ }
+
+ notify($ERRORS{'OK'}, 0, "beginning provisioning module capture monitor");
+ if ($create_image_result && !($create_image_result = $self->provisioner->capture_monitor())) {
+ notify($ERRORS{'WARNING'}, 0, "provisioning module capture monitor failed");
+ }
+
+ } ## end if ($computer_type eq "blade" && $self->os)
+ elsif ($computer_type eq "blade") {
+ $create_image_result = $self->provisioner->capture_prepare();
+
+ if ($create_image_result) {
+ $create_image_result = $self->provisioner->capture_monitor();
+ }
+ }
+ elsif ($computer_type eq "virtualmachine") {
+ $create_image_result = $self->provisioner->capture();
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "unsupported computer type: $computer_type");
+ $self->image_creation_failed();
+ }
+
+ # Image creation was successful, proceed to update database tables
+ if ($create_image_result) {
+ # Success
+ notify($ERRORS{'OK'}, 0, "$image_name image files successfully saved");
+
+ # Update the request state to completed, laststate to image
+ if (update_request_state($request_id, "completed", "image")) {
+ notify($ERRORS{'OK'}, 0, "request state updated to completed, laststate to image");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to update request state to completed, laststate to image");
+ }
+
+ # Get the new image size
+ my $image_size_new;
+ if ($image_size_new = $self->provisioner->get_image_size($image_name)) {
+ notify($ERRORS{'OK'}, 0, "size of $image_name: $image_size_new");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to retrieve size of new revision: $image_name, old size will be used");
+ $image_size_new = $image_size;
+ }
+ $self->data->set_image_size($image_size_new);
+
+ # Update image timestamp, clear deleted flag
+ # Set test flag if according to whether this image is new or updated
+ # Update the image size
+ my $update_image_statement = "
+ UPDATE
+ image,
+ imagerevision
+ SET
+ image.lastupdate = \'$timestamp\',
+ image.deleted = \'0\',
+ image.size = \'$image_size_new\',
+ image.name = \'$image_name\',
+ imagerevision.deleted = \'0\',
+ imagerevision.datecreated = \'$timestamp\'
+ WHERE
+ image.id = $image_id
+ AND imagerevision.id = $imagerevision_id
+ ";
+
+ # Execute the image update statement
+ if (database_execute($update_image_statement)) {
+ notify($ERRORS{'OK'}, 0, "image and imagerevision tables updated for image=$image_id, imagerevision=$imagerevision_id, name=$image_name, lastupdate=$timestamp, deleted=0, size=$image_size_new");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "image table could not be updated for image=$image_id");
+ }
+ } ## end if ($create_image_result)
+
+ # Check if image creation was successful and database tables were successfully updated
+ # Notify user and admins of the results
+ if ($create_image_result) {
+ $self->image_creation_successful($image_size);
+ }
+
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "image creation failed, see previous log messages");
+ $self->image_creation_failed();
+ }
+
+} ## end sub process
+#/////////////////////////////////////////////////////////////////////////////
+
+sub image_creation_successful {
+ my $self = shift;
+ my $image_size_old = shift;
+
+ my $request_data = $self->data->get_request_data();
+ my $request_id = $self->data->get_request_id();
+ my $reservation_id = $self->data->get_reservation_id();
+ my $user_id = $self->data->get_user_id();
+ my $user_unityid = $self->data->get_user_login_id();
+ my $user_preferredname = $self->data->get_user_preferred_name();
+ my $user_email = $self->data->get_user_email();
+ my $affiliation_sitewwwaddress = $self->data->get_user_affiliation_sitewwwaddress();
+ my $affiliation_helpaddress = $self->data->get_user_affiliation_helpaddress();
+ my $image_id = $self->data->get_image_id();
+ my $image_name = $self->data->get_image_name();
+ my $image_prettyname = $self->data->get_image_prettyname();
+ my $image_size = $self->data->get_image_size();
+ my $imagerevision_id = $self->data->get_imagerevision_id();
+ my $imagemeta_sysprep = $self->data->get_imagemeta_sysprep();
+ my $computer_id = $self->data->get_computer_id();
+ my $computer_type = $self->data->get_computer_type();
+ my $computer_shortname = $self->data->get_computer_short_name();
+ my $managementnode_shortname = $self->data->get_management_node_short_name();
+
+ # Send image creation successful email to user
+ my $body_user = <<"END";
+$user_preferredname,
+Your VCL image creation request for $image_prettyname has
+succeeded. Please visit $affiliation_sitewwwaddress and
+you should see an image called $image_prettyname.
+Please test this image to confirm it works correctly.
+
+Thank You,
+VCL Team
+END
+ mail($user_email, "VCL -- $image_prettyname Image Creation Succeeded", $body_user, $affiliation_helpaddress);
+
+ # Send mail to SYSADMIN
+ my $body_admin = <<"END";
+VCL Image Creation Completed
+
+Request ID: $request_id
+Reservation ID: $reservation_id
+PID: $$
+
+Image ID: $image_id
+Image name: $image_name
+Image size change: $image_size_old --> $image_size
+
+Revision ID: $imagerevision_id
+
+Management node: $managementnode_shortname
+
+Username: $user_unityid
+User ID: $user_id
+
+Computer ID: $computer_id
+Computer name: $computer_shortname
+
+Use Sysprep: $imagemeta_sysprep
+END
+
+ mail($SYSADMIN, "VCL IMAGE Creation Completed: $image_name", $body_admin, $affiliation_helpaddress);
+
+ # Insert reload request data into the datbase
+ if (insert_reload_request($request_data)) {
+ notify($ERRORS{'OK'}, 0, "inserted reload request into database for computer id=$computer_id");
+
+ # Switch the request state to complete, leave the computer state as is, update log ending to EOR, exit
+ switch_state($request_data, 'complete', '', 'EOR', '1');
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "failed to insert reload request into database for computer id=$computer_id");
+
+ # Switch the request and computer states to failed, set log ending to failed, exit
+ switch_state($request_data, 'failed', 'failed', 'failed', '1');
+ }
+
+ notify($ERRORS{'OK'}, 0, "exiting");
+ exit;
+} ## end sub image_creation_successful
+
+#/////////////////////////////////////////////////////////////////////////////
+
+sub image_creation_failed {
+ my $self = shift;
+
+ my $request_data = $self->data->get_request_data();
+ my $request_id = $self->data->get_request_id();
+ my $reservation_id = $self->data->get_reservation_id();
+ my $user_id = $self->data->get_user_id();
+ my $user_unityid = $self->data->get_user_login_id();
+ my $user_preferredname = $self->data->get_user_preferred_name();
+ my $user_email = $self->data->get_user_email();
+ my $affiliation_sitewwwaddress = $self->data->get_user_affiliation_sitewwwaddress();
+ my $affiliation_helpaddress = $self->data->get_user_affiliation_helpaddress();
+ my $image_id = $self->data->get_image_id();
+ my $image_name = $self->data->get_image_name();
+ my $image_prettyname = $self->data->get_image_prettyname();
+ my $image_size = $self->data->get_image_size();
+ my $imagerevision_id = $self->data->get_imagerevision_id();
+ my $imagemeta_sysprep = $self->data->get_imagemeta_sysprep();
+ my $computer_id = $self->data->get_computer_id();
+ my $computer_type = $self->data->get_computer_type();
+ my $computer_shortname = $self->data->get_computer_short_name();
+ my $managementnode_shortname = $self->data->get_management_node_short_name();
+
+ # Image process failed
+ notify($ERRORS{'CRITICAL'}, 0, "$image_name image creation failed");
+
+ # Send mail to user
+ my $body_user = <<"END";
+$user_preferredname,
+We apologize for the inconvenience.
+Your image creation of $image_prettyname has been delayed
+due to a system issue that prevented the automatic completion.
+
+The image creation request and the computing resource have
+been placed in a safe mode. The VCL system administrators
+have been notified for manual intervention.
+
+Once the issues have been resolved, you will be notified
+by the successful completion email or contacted directly
+by the VCL system administrators.
+
+If you do not receive a response within one business day, please
+reply to this email.
+
+Thank You,
+VCL Team
+END
+ mail($user_email, "VCL -- NOTICE DELAY Image Creation $image_prettyname", $body_user, $affiliation_helpaddress);
+
+ # Send mail to SYSADMIN
+ my $body_admin = <<"END";
+VCL Image Creation Failed
+
+Request ID: $request_id
+Reservation ID: $reservation_id
+PID: $$
+
+Image ID: $image_id
+Image name: $image_name
+
+Revision ID: $imagerevision_id
+
+Management node: $managementnode_shortname
+
+Username: $user_unityid
+User ID: $user_id
+
+Computer ID: $computer_id
+Computer name: $computer_shortname
+
+Use Sysprep: $imagemeta_sysprep
+END
+
+ mail($SYSADMIN, "VCL -- NOTICE FAILED Image Creation $image_prettyname", $body_admin, $affiliation_helpaddress);
+
+ # Update the request state to maintenance, laststate to image
+ if (update_request_state($request_id, "maintenance", "image")) {
+ notify($ERRORS{'OK'}, 0, "request state set to maintenance, laststate to image");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to set request state to maintenance, laststate to image");
+ }
+
+ # Update the computer state to maintenance
+ if (update_computer_state($computer_id, "maintenance")) {
+ notify($ERRORS{'OK'}, 0, "$computer_shortname state set to maintenance");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to set $computer_shortname state to maintenance");
+ }
+
+ notify($ERRORS{'OK'}, 0, "exiting");
+ exit;
+} ## end sub image_creation_failed
+
+#/////////////////////////////////////////////////////////////////////////////
+
+1;
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+=cut
diff --git a/managementnode/lib/VCL/inuse.pm b/managementnode/lib/VCL/inuse.pm
new file mode 100644
index 0000000..2d74643
--- /dev/null
+++ b/managementnode/lib/VCL/inuse.pm
@@ -0,0 +1,865 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: inuse.pm 1945 2008-12-11 20:58:08Z fapeeler $
+##############################################################################
+
+=head1 NAME
+
+VCL::inuse - Perl module for the VCL inuse state
+
+=head1 SYNOPSIS
+
+ use VCL::inuse;
+ use VCL::utils;
+
+ # Set variables containing the IDs of the request and reservation
+ my $request_id = 5;
+ my $reservation_id = 6;
+
+ # Call the VCL::utils::get_request_info subroutine to populate a hash
+ my %request_info = get_request_info($request_id);
+
+ # Set the reservation ID in the hash
+ $request_info{RESERVATIONID} = $reservation_id;
+
+ # Create a new VCL::inuse object based on the request information
+ my $inuse = VCL::inuse->new(%request_info);
+
+=head1 DESCRIPTION
+
+ This module supports the VCL "inuse" state. The inuse state is reached after
+ a user has made a reservation, acknowledged the reservation, and connected to
+ the machine. Once connected, vcld creates a new process which then
+ creates a new instance of this module.
+
+ If the "checkuser" flag is set for the image that the user requested,
+ this process will periodically check to make sure the user is still
+ connected. Users have 15 minutes to reconnect before the machine is
+ reclaimed.
+
+ This module periodically checks the end time for the user's request versus
+ the current time. If the end time is near, notifications may be sent to the
+ user. Once the end time has been reached, the user is disconnected and the
+ request and computer are put into the "timeout" state.
+
+=cut
+
+##############################################################################
+package VCL::inuse;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/..";
+
+# Configure inheritance
+use base qw(VCL::Module::State);
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use VCL::utils;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 process
+
+ Parameters : $request_data_hash_reference
+ Returns : 1 if successful, 0 otherwise
+ Description : Processes a reservation in the inuse state. You must pass this
+ method a reference to a hash containing request data.
+
+=cut
+
+sub process {
+ my $self = shift;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Store hash variables into local variables
+ my $request_data = $self->data->get_request_data;
+
+ my $request_id = $request_data->{id};
+ my $reservation_id = $request_data->{RESERVATIONID};
+ my $request_end = $request_data->{end};
+ my $request_logid = $request_data->{logid};
+ my $request_checktime = $request_data->{CHECKTIME};
+ my $reservation_remoteip = $request_data->{reservation}{$reservation_id}{remoteIP};
+ my $computer_id = $request_data->{reservation}{$reservation_id}{computer}{id};
+ my $computer_shortname = $request_data->{reservation}{$reservation_id}{computer}{SHORTNAME};
+ my $computer_type = $request_data->{reservation}{$reservation_id}{computer}{type};
+ my $computer_hostname = $request_data->{reservation}{$reservation_id}{computer}{hostname};
+ my $computer_nodename = $request_data->{reservation}{$reservation_id}{computer}{NODENAME};
+ my $computer_ipaddress = $request_data->{reservation}{$reservation_id}{computer}{IPaddress};
+ my $image_os_name = $request_data->{reservation}{$reservation_id}{image}{OS}{name};
+ my $imagemeta_checkuser = $request_data->{reservation}{$reservation_id}{image}{imagemeta}{checkuser};
+ my $user_unityid = $request_data->{user}{unityid};
+ my $request_forimaging = $request_data->{forimaging};
+ my $identity_key = $request_data->{reservation}{$reservation_id}{image}{IDENTITY};
+ my $image_os_type = $self->data->get_image_os_type();
+ my $reservation_count = $self->data->get_reservation_count();
+ my $is_parent_reservation = $self->data->is_parent_reservation();
+
+ # Set the user connection timeout limit in minutes
+ my $connect_timeout_limit = 15;
+
+ # Remove rows from computerloadlog for this reservation
+ if (delete_computerloadlog_reservation($reservation_id)) {
+ notify($ERRORS{'OK'}, 0, "rows removed from computerloadlog table for reservation $reservation_id");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "unable to remove rows from computerloadlog table for reservation $reservation_id");
+ }
+
+ # Update the lastcheck value for this reservation to now
+ if (update_reservation_lastcheck($reservation_id)) {
+ notify($ERRORS{'OK'}, 0, "updated lastcheck time for reservation $reservation_id");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to update lastcheck time for reservation $reservation_id");
+ }
+
+ # For inuse state, check_time should return 'end', 'poll', or 'nothing'
+
+ # Is this a poll or end time
+ if ($request_checktime eq "poll") {
+ notify($ERRORS{'OK'}, 0, "beginning to poll");
+
+ if ($image_os_type =~ /windows/) {
+ if (firewall_compare_update($computer_nodename, $reservation_remoteip, $identity_key, $image_os_type)) {
+ notify($ERRORS{'OK'}, 0, "confirmed firewall scope has been updated");
+ }
+ }
+
+ # Check the imagemeta checkuser flag, request forimaging flag, and if cluster request
+ if (!$imagemeta_checkuser || $request_forimaging || ($reservation_count > 1)) {
+ # Either imagemeta checkuser flag = 0, forimaging = 1, or cluster request
+ if (!$imagemeta_checkuser) {
+ notify($ERRORS{'OK'}, 0, "imagemeta checkuser flag not set, skipping user connection check");
+ }
+ if ($request_forimaging) {
+ notify($ERRORS{'OK'}, 0, "forimaging flag is set to 1, skipping user connection check");
+ }
+ if ($reservation_count > 1) {
+ notify($ERRORS{'OK'}, 0, "reservation count is $reservation_count, skipping user connection check");
+ }
+
+ # Get a date string for the current time
+ my $date_string;
+
+ # Check end time for a notice interval
+ # This returns 0 if no notice is to be given
+ my $notice_interval = check_endtimenotice_interval($request_end);
+
+ if ($notice_interval) {
+ notify($ERRORS{'OK'}, 0, "notice interval is set to $notice_interval");
+
+ # Notify the user of the end time
+ $self->_notify_user_endtime($notice_interval);
+
+ # Set lastcheck time ahead by 16 minutes for all notices except the last (30 minute) notice
+ if ($notice_interval ne "30 minutes") {
+ my $epoch_now = convert_to_epoch_seconds();
+ $date_string = convert_to_datetime(($epoch_now + (16 * 60)));
+ }
+ else {
+ my $epoch_now = convert_to_epoch_seconds();
+ $date_string = convert_to_datetime($epoch_now);
+ }
+ } ## end if ($notice_interval)
+
+ # Check if the user deleted the request
+ if (is_request_deleted($request_id)) {
+ # User deleted request, exit queitly
+ notify($ERRORS{'OK'}, 0, "user has deleted the request, quietly exiting");
+ exit;
+ }
+
+ # If forimage flag is set - check for state change to image creation mode and exit quietly
+ if ($request_forimaging) {
+ notify($ERRORS{'DEBUG'}, 0, "request has forimaging flag enabled, checking for image state");
+ if (is_request_imaging($request_id)) {
+ notify($ERRORS{'OK'}, 0, "request is now in image creation mode, quietly exiting");
+ exit;
+ }
+ }
+
+ # Put this request back into the inuse state
+ if ($is_parent_reservation && update_request_state($request_id, "inuse", "inuse")) {
+ notify($ERRORS{'OK'}, 0, "request state set back to inuse");
+ }
+ elsif (!$is_parent_reservation) {
+ notify($ERRORS{'OK'}, 0, "child reservation, request state NOT set back to inuse");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to set request state back to inuse");
+ }
+
+ # Update the lastcheck time for this reservation
+ if (update_reservation_lastcheck($reservation_id)) {
+ my $dstring = convert_to_datetime();
+ notify($ERRORS{'OK'}, 0, "updated lastcheck time for this reservation to $dstring");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to update lastcheck time for this reservation to $date_string");
+ }
+
+ notify($ERRORS{'OK'}, 0, "exiting");
+ exit;
+ } # Close if poll and checkuser = 0
+
+
+ # Poll:
+ # Simply check for user connection
+ # If not connected:
+ # Loop; check end time, continue to check for connection
+ # If not connected within 15 minutes -- timeout
+ # If end time is near prepare
+ notify($ERRORS{'OK'}, 0, "proceeding to check for user connection");
+
+ # Get epoch seconds for current and end time, calculate difference
+ my $now_epoch = convert_to_epoch_seconds();
+ my $end_epoch = convert_to_epoch_seconds($request_end);
+ my $time_difference = $end_epoch - $now_epoch;
+
+ # If end time is 10-15 minutes from now:
+ # Sleep difference
+ # Go to end mode
+ if ($time_difference >= (10 * 60) && $time_difference <= (15 * 60)) {
+ notify($ERRORS{'OK'}, 0, "end time ($time_difference seconds) is 10-15 minutes from now");
+
+ # Calculate the sleep time = time until the request end - 10 minutes
+ # User will have 10 minutes after this sleep call before disconnected
+ my $sleep_time = $time_difference - (10 * 60);
+ notify($ERRORS{'OK'}, 0, "sleeping for $sleep_time seconds");
+ sleep $sleep_time;
+ $request_data->{CHECKTIME} = "end";
+ goto ENDTIME;
+ } # Close if poll, checkuser=1, and end time is 10-15 minutes away
+
+ notify($ERRORS{'OK'}, 0, "end time not yet reached, polling machine for user connection");
+
+ # Check the user connection, this will loop until user connects or time limit is reached
+ my $check_connection = check_connection($computer_nodename, $computer_ipaddress, $computer_type, $reservation_remoteip, $connect_timeout_limit, $image_os_name, 0, $request_id, $user_unityid);
+
+ #TESTING
+ #$check_connection = 'timeout';
+
+ # Proceed based on status of check_connection
+ if ($check_connection eq "connected") {
+ notify($ERRORS{'OK'}, 0, "user connected");
+
+ # Put this request back into the inuse state
+ if (update_request_state($request_id, "inuse", "inuse")) {
+ notify($ERRORS{'OK'}, 0, "request state set back to inuse");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to set request state back to inuse");
+ }
+
+ # Update the lastcheck time for this reservation
+ if (update_reservation_lastcheck($reservation_id)) {
+ notify($ERRORS{'OK'}, 0, "updated lastcheck time for this reservation to now");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to update lastcheck time for this reservation to now");
+ }
+
+ notify($ERRORS{'OK'}, 0, "exiting");
+ exit;
+ } # Close check_connection is connected
+
+ elsif ($check_connection eq "conn_wrong_ip") {
+ notify($ERRORS{'OK'}, 0, "polling, user connected but wrong remote IP is used");
+
+ # Update the lastcheck time for this reservation
+ if (update_reservation_lastcheck($reservation_id)) {
+ notify($ERRORS{'OK'}, 0, "updated lastcheck time for this reservation to now");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to update lastcheck time for this reservation to now");
+ }
+
+ # Put this request back into the inuse state
+ if (update_request_state($request_id, "inuse", "inuse")) {
+ notify($ERRORS{'OK'}, 0, "request state set back to inuse");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to set request state back to inuse");
+ }
+
+ notify($ERRORS{'OK'}, 0, "exiting");
+ exit;
+ } ## end elsif ($check_connection eq "conn_wrong_ip") [ if ($check_connection eq "connected")
+
+
+ elsif ($check_connection eq "timeout") {
+ notify($ERRORS{'OK'}, 0, "user did not reconnect within $connect_timeout_limit minute time limit");
+
+ notify($ERRORS{'OK'}, 0, "notifying user that request timed out");
+ $self->_notify_user_timeout();
+
+ # Put this request into the timeout state
+ if (update_request_state($request_id, "timeout", "inuse")) {
+ notify($ERRORS{'OK'}, 0, "request state set to timeout");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to set request state to timeout");
+ }
+
+ # Get the current computer state directly from the database
+ my $computer_state;
+ if ($computer_state = get_computer_current_state_name($computer_id)) {
+ notify($ERRORS{'OK'}, 0, "computer $computer_id state retrieved from database: $computer_state");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to retrieve computer $computer_id state from database");
+ }
+
+ # Check if computer is in maintenance state
+ if ($computer_state =~ /maintenance/) {
+ notify($ERRORS{'OK'}, 0, "computer $computer_shortname in maintenance state, skipping update");
+ }
+ else {
+ # Computer is not in maintenance state, set its state to timeout
+ if (update_computer_state($computer_id, "timeout")) {
+ notify($ERRORS{'OK'}, 0, "computer $computer_id set to timeout state");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to set computer $computer_id to the timeout state");
+ }
+ }
+
+ # Update the entry in the log table with the current finalend time and ending set to timeout
+ if (update_log_ending($request_logid, "timeout")) {
+ notify($ERRORS{'OK'}, 0, "log id $request_logid finalend was updated to now and ending set to timeout");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "log id $request_logid finalend could not be updated to now and ending set to timeout");
+ }
+
+ notify($ERRORS{'OK'}, 0, "exiting");
+ exit;
+ } ## end elsif ($check_connection eq "timeout") [ if ($check_connection eq "connected")
+
+ elsif ($check_connection eq "deleted") {
+ # Exit quietly
+ notify($ERRORS{'OK'}, 0, "user has deleted the request, quietly exiting");
+ exit;
+ }
+
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "unexpected return value from check_connection: $check_connection, treating request as connected");
+
+ # Put this request back into the inuse state
+ if (update_request_state($request_id, "inuse", "inuse")) {
+ notify($ERRORS{'OK'}, 0, "request state set back to inuse");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to set request state back to inuse");
+ }
+
+ # Update the lastcheck time for this reservation
+ if (update_reservation_lastcheck($reservation_id)) {
+ notify($ERRORS{'OK'}, 0, "updated lastcheck time for this reservation to now");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to update lastcheck time for this reservation to now");
+ }
+
+ notify($ERRORS{'OK'}, 0, "exiting");
+ exit;
+ } ## end else [ if ($check_connection eq "connected") [... [elsif ($check_connection eq "deleted")
+
+ } # Close if checktime is poll
+
+ elsif ($request_checktime eq "end") {
+ # Time has ended
+ # Notify user to save work and exit within 10 minutes
+
+ ENDTIME:
+ my $notified = 0;
+ my $disconnect_time = 10;
+
+ # Loop until disconnect time = 0
+ while ($disconnect_time != 0) {
+ notify($ERRORS{'OK'}, 0, "minutes left until user is disconnected: $disconnect_time");
+
+ # Notify user at 10 minutes until disconnect
+ if ($disconnect_time == 10) {
+ $self->_notify_user_disconnect($disconnect_time);
+ insertloadlog($reservation_id, $computer_id, "inuseend10", "notifying user of disconnect");
+ }
+
+ # Sleep one minute and decrement disconnect time by a minute
+ sleep 60;
+ $disconnect_time--;
+
+ # Check if the user deleted the request
+ if (is_request_deleted($request_id)) {
+ # User deleted request, exit queitly
+ notify($ERRORS{'OK'}, 0, "user has deleted the request, quietly exiting");
+ exit;
+ }
+
+ # check for state change to image creation mode and exit quietly
+ if (is_request_imaging($request_id)) {
+ notify($ERRORS{'OK'}, 0, "request is now in image creation mode, quietly exiting");
+ exit;
+ }
+
+ # Perform some actions at 5 minutes until end of request
+ if ($disconnect_time == 5) {
+ # Check for connection
+ if (isconnected($computer_hostname, $computer_type, $reservation_remoteip, $image_os_name, $computer_ipaddress)) {
+ insertloadlog($reservation_id, $computer_id, "inuseend5", "notifying user of endtime");
+ $self->_notify_user_disconnect($disconnect_time);
+ }
+ else {
+ insertloadlog($reservation_id, $computer_id, "inuseend5", "user is not connected, notification skipped");
+ notify($ERRORS{'OK'}, 0, "user has disconnected from $computer_shortname, skipping additional notices");
+ }
+ } # Close if disconnect time = 5
+
+ # Check to see if the end time was extended
+ my $new_request_end;
+ if ($new_request_end = get_request_end($request_id)) {
+ notify($ERRORS{'OK'}, 0, "request end value in database: $new_request_end");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to retrieve updated request end value from database");
+ }
+
+ # Convert the current and new end times to epoch seconds
+ my $new_request_end_epoch = convert_to_epoch_seconds($new_request_end);
+ my $request_end_epoch = convert_to_epoch_seconds($request_end);
+
+ # Check if request end is later than the original (user extended time)
+ if ($new_request_end_epoch > $request_end_epoch) {
+ notify($ERRORS{'OK'}, 0, "user extended end time, returning request to inuse state");
+
+ # Put this request back into the inuse state
+ if ($is_parent_reservation && update_request_state($request_id, "inuse", "inuse")) {
+ notify($ERRORS{'OK'}, 0, "request state set back to inuse");
+ }
+ elsif (!$is_parent_reservation) {
+ notify($ERRORS{'OK'}, 0, "child reservation, request state NOT set back to inuse");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to set request state back to inuse");
+ }
+
+ notify($ERRORS{'OK'}, 0, "exiting");
+ exit;
+ } ## end if ($new_request_end_epoch > $request_end_epoch)
+
+ } # Close while disconnect time is not 0
+
+ # If forimage flag is set - check for state change to image creation mode and exit quietly
+ # One last check - if forimaging lets sleep 1 min and check the state
+ if ($request_forimaging) {
+ sleep 60;
+ notify($ERRORS{'OK'}, 0, "request has forimaging flag enabled checking for image state");
+ if (is_request_imaging($request_id)) {
+ notify($ERRORS{'OK'}, 0, "request is now in image creation mode, quietly exiting");
+ exit;
+ }
+ }
+
+ # Insert an entry into the load log
+ insertloadlog($reservation_id, $computer_id, "timeout", "endtime reached moving to timeout");
+ notify($ERRORS{'OK'}, 0, "end time reached, setting request to timeout state");
+
+ # Put this request into the timeout state
+ if ($is_parent_reservation && update_request_state($request_id, "timeout", "inuse")) {
+ notify($ERRORS{'OK'}, 0, "request state set to timeout");
+ }
+ elsif (!$is_parent_reservation) {
+ notify($ERRORS{'OK'}, 0, "child reservation, request state NOT set back to timeout");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to set request state to timout");
+ }
+
+ # Get the current computer state directly from the database
+ my $computer_state;
+ if ($computer_state = get_computer_current_state_name($computer_id)) {
+ notify($ERRORS{'OK'}, 0, "computer $computer_id state retrieved from database: $computer_state");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to retrieve computer $computer_id state from database");
+ }
+
+ # Check if computer is in maintenance state
+ if ($computer_state =~ /maintenance/) {
+ notify($ERRORS{'OK'}, 0, "computer $computer_shortname in maintenance state, skipping computer state update");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "computer not in maintenance, setting computer to timeout state");
+ # Computer is not in maintenance state, set its state to timeout
+ if (update_computer_state($computer_id, "timeout")) {
+ notify($ERRORS{'OK'}, 0, "computer $computer_id set to timeout state");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to set computer $computer_id to the timeout state");
+ }
+ } ## end else [ if ($computer_state =~ /maintenance/)
+
+ # Notify user about ending request
+ $self->_notify_user_request_ended();
+
+ # Update the entry in the log table with the current finalend time and ending set to timeout
+ if ($is_parent_reservation && update_log_ending($request_logid, "EOR")) {
+ notify($ERRORS{'OK'}, 0, "log id $request_logid finalend was updated to now and ending set to EOR");
+ }
+ elsif (!$is_parent_reservation) {
+ notify($ERRORS{'OK'}, 0, "child reservation, log id $request_logid finalend was NOT updated");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "log id $request_logid finalend could not be updated to now and ending set to EOR");
+ }
+
+ notify($ERRORS{'OK'}, 0, "exiting");
+ exit;
+
+ } # Close if request checktime is end
+
+ # Not poll or end
+ else {
+ notify($ERRORS{'OK'}, 0, "returning \'$request_checktime\', exiting");
+ exit;
+ }
+
+ notify($ERRORS{'OK'}, 0, "exiting");
+ exit;
+} ## end sub process
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _notify_user_endtime
+
+ Parameters : $request_data_hash_reference, $notice_interval
+ Returns : 1 if successful, 0 otherwise
+ Description : Notifies the user how long they have until the end of the
+ request. Based on the user configuration, an e-mail message,
+ IM message, or wall message may be sent.
+ A notice interval string must be passed. Its value should be
+ something like "5 minutes".
+
+=cut
+
+sub _notify_user_endtime {
+ my $self = shift;
+ my $notice_interval = shift;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ my $request_data = $self->data->get_request_data;
+ my $is_parent_reservation = $self->data->is_parent_reservation();
+
+ # Check to make sure notice interval is set
+ if (!defined($notice_interval)) {
+ notify($ERRORS{'WARNING'}, 0, "end time message not set, notice interval was not passed");
+ return 0;
+ }
+
+ # Store hash variables into local variables
+ my $request_id = $request_data->{id};
+ my $reservation_id = $request_data->{RESERVATIONID};
+ my $user_preferredname = $request_data->{user}{preferredname};
+ my $user_email = $request_data->{user}{email};
+ my $user_emailnotices = $request_data->{user}{emailnotices};
+ my $user_im_name = $request_data->{user}{IMtype}{name};
+ my $user_im_id = $request_data->{user}{IMid};
+ my $user_unityid = $request_data->{user}{unityid};
+ my $affiliation_sitewwwaddress = $request_data->{user}{affiliation}{sitewwwaddress};
+ my $affiliation_helpaddress = $request_data->{user}{affiliation}{helpaddress};
+ my $image_prettyname = $request_data->{reservation}{$reservation_id}{image}{prettyname};
+ my $image_os_name = $request_data->{reservation}{$reservation_id}{image}{OS}{name};
+ my $computer_ipaddress = $request_data->{reservation}{$reservation_id}{computer}{IPaddress};
+ my $computer_type = $request_data->{reservation}{$reservation_id}{computer}{type};
+ my $computer_shortname = $request_data->{reservation}{$reservation_id}{computer}{SHORTNAME};
+
+ my $message = <<"EOF";
+$user_preferredname,
+You have $notice_interval until the end of your reservation for image $image_prettyname.
+
+Reservation extensions are available if the machine you are on does not have a reservation immediately following.
+
+To edit this reservation:
+-Visit $affiliation_sitewwwaddress
+-Select Current Reservations
+
+Thank You,
+VCL Team
+EOF
+
+ my $subject = "VCL -- $notice_interval until end of reservation";
+
+ # Send mail
+ if ($is_parent_reservation && $user_emailnotices) {
+ mail($user_email, $subject, $message, $affiliation_helpaddress);
+ }
+
+ # Send IM
+ if ($is_parent_reservation && $user_im_name ne "none") {
+ notify_via_IM($user_im_name, $user_im_id, $message);
+ }
+
+ return 1;
+} ## end sub _notify_user_endtime
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _notify_user_disconnect
+
+ Parameters : $request_data_hash_reference, $disconnect_time
+ Returns : 1 if successful, 0 otherwise
+ Description : Notifies the user that the session will be disconnected soon.
+ Based on the user configuration, an e-mail message, IM message,
+ Windows msg, or Linux wall message may be sent.
+ A scalar containing the number of minutes until the user is
+ disconnected must be passed as the 2nd parameter.
+
+=cut
+
+sub _notify_user_disconnect {
+ my $self = shift;
+ my $disconnect_time = shift;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ my $request_data = $self->data->get_request_data;
+ my $is_parent_reservation = $self->data->is_parent_reservation();
+
+ # Check to make sure disconnect time was passed
+ if (!defined($disconnect_time)) {
+ notify($ERRORS{'WARNING'}, 0, "disconnect time message not set, disconnect time was not passed");
+ return 0;
+ }
+
+ # Store hash variables into local variables
+ my $request_id = $request_data->{id};
+ my $reservation_id = $request_data->{RESERVATIONID};
+ my $user_preferredname = $request_data->{user}{preferredname};
+ my $user_email = $request_data->{user}{email};
+ my $user_emailnotices = $request_data->{user}{emailnotices};
+ my $user_im_name = $request_data->{user}{IMtype}{name};
+ my $user_im_id = $request_data->{user}{IMid};
+ my $user_unityid = $request_data->{user}{unityid};
+ my $affiliation_sitewwwaddress = $request_data->{user}{affiliation}{sitewwwaddress};
+ my $affiliation_helpaddress = $request_data->{user}{affiliation}{helpaddress};
+ my $image_prettyname = $request_data->{reservation}{$reservation_id}{image}{prettyname};
+ my $image_os_name = $request_data->{reservation}{$reservation_id}{image}{OS}{name};
+ my $computer_ipaddress = $request_data->{reservation}{$reservation_id}{computer}{IPaddress};
+ my $computer_type = $request_data->{reservation}{$reservation_id}{computer}{type};
+ my $computer_shortname = $request_data->{reservation}{$reservation_id}{computer}{SHORTNAME};
+
+ my $disconnect_string;
+ if ($disconnect_time == 0) {
+ $disconnect_string = "0 minutes";
+ }
+ elsif ($disconnect_time == 1) {
+ $disconnect_string = "1 minute";
+ }
+ else {
+ $disconnect_string = "$disconnect_time minutes";
+ }
+
+ my $message = <<"EOF";
+$user_preferredname,
+You have $disconnect_string until the end of your reservation for image $image_prettyname, please save all work and prepare to exit.
+
+Reservation extensions are available if the machine you are on does not have a reservation immediately following.
+
+Visit $affiliation_sitewwwaddress and select Current Reservations to edit this reservation.
+
+Thank you,
+VCL Team
+EOF
+
+ my $short_message = "$user_preferredname, You have $disconnect_string until the end of your reservation. Please save all work and prepare to log off.";
+
+ my $subject = "VCL -- $disconnect_string until end of reservation";
+
+ # Send mail
+ if ($is_parent_reservation && $user_emailnotices) {
+ mail($user_email, $subject, $message, $affiliation_helpaddress);
+ }
+
+ # Send IM
+ if ($is_parent_reservation && $user_im_name ne "none") {
+ notify_via_IM($user_im_name, $user_im_id, $message);
+ }
+
+ # Send message to machine
+ if ($computer_type =~ /blade|virtualmachine/) {
+ if ($image_os_name =~ /^(win|vmwarewin)/) {
+ # Notify via windows msg cmd
+ notify_via_msg($computer_shortname, $user_unityid, $short_message);
+ }
+ elsif ($image_os_name =~ /^(rh[0-9]image|rhel[0-9]|fc[0-9]image|rhfc[0-9]|rhas[0-9])/) {
+ # Notify via wall
+ notify_via_wall($computer_shortname, $user_unityid, $short_message, $image_os_name, $computer_type);
+ }
+ } ## end if ($computer_type =~ /blade|virtualmachine/)
+ elsif ($computer_type eq "lab") {
+ # Notify via wall
+ notify_via_wall($computer_ipaddress, $user_unityid, $short_message, $image_os_name, $computer_type);
+ }
+
+ return 1;
+} ## end sub _notify_user_disconnect
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _notify_user_timeout
+
+ Parameters : $request_data_hash_reference
+ Returns : 1 if successful, 0 otherwise
+ Description : Notifies the user that the session has timed out.
+ Based on the user configuration, an e-mail message, IM message,
+ Windows msg, or Linux wall message may be sent.
+
+=cut
+
+sub _notify_user_timeout {
+ my $self = shift;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ my $request_data = $self->data->get_request_data;
+ my $is_parent_reservation = $self->data->is_parent_reservation();
+
+ # Store some hash variables into local variables
+ my $reservation_id = $request_data->{RESERVATIONID};
+ my $user_preferredname = $request_data->{user}{preferredname};
+ my $user_email = $request_data->{user}{email};
+ my $user_emailnotices = $request_data->{user}{emailnotices};
+ my $user_im_name = $request_data->{user}{IMtype}{name};
+ my $user_im_id = $request_data->{user}{IMid};
+ my $affiliation_sitewwwaddress = $request_data->{user}{affiliation}{sitewwwaddress};
+ my $affiliation_helpaddress = $request_data->{user}{affiliation}{helpaddress};
+ my $image_prettyname = $request_data->{reservation}{$reservation_id}{image}{prettyname};
+ my $computer_ipaddress = $request_data->{reservation}{$reservation_id}{computer}{IPaddress};
+
+ my $message = <<"EOF";
+$user_preferredname,
+Your reservation has timed out due to inactivity for image $image_prettyname at address $computer_ipaddress.
+
+To make another reservation, please revisit:
+$affiliation_sitewwwaddress
+
+Thank you
+VCL Team
+EOF
+
+ my $subject = "VCL -- reservation timeout";
+
+ # Send mail
+ if ($is_parent_reservation && $user_emailnotices) {
+ mail($user_email, $subject, $message, $affiliation_helpaddress);
+ }
+
+ # Send IM
+ if ($is_parent_reservation && $user_im_name ne "none") {
+ notify_via_IM($user_im_name, $user_im_id, $message);
+ }
+
+ return 1;
+} ## end sub _notify_user_timeout
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _notify_user_request_ended
+
+ Parameters : $request_data_hash_reference
+ Returns : 1 if successful, 0 otherwise
+ Description : Notifies the user that the session has ended.
+ Based on the user configuration, an e-mail message, IM message,
+ Windows msg, or Linux wall message may be sent.
+
+=cut
+
+sub _notify_user_request_ended {
+ my $self = shift;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ my $request_data = $self->data->get_request_data;
+ my $is_parent_reservation = $self->data->is_parent_reservation();
+
+ # Store some hash variables into local variables
+ my $reservation_id = $request_data->{RESERVATIONID};
+ my $user_preferredname = $request_data->{user}{preferredname};
+ my $user_email = $request_data->{user}{email};
+ my $user_emailnotices = $request_data->{user}{emailnotices};
+ my $user_im_name = $request_data->{user}{IMtype}{name};
+ my $user_im_id = $request_data->{user}{IMid};
+ my $affiliation_helpaddress = $request_data->{user}{affiliation}{helpaddress};
+ my $affiliation_sitewwwaddress = $request_data->{user}{affiliation}{sitewwwaddress};
+ my $image_prettyname = $request_data->{reservation}{$reservation_id}{image}{prettyname};
+
+ my $subject = "VCL -- End of reservation";
+
+ my $message = <<"EOF";
+$user_preferredname,
+Your reservation of $image_prettyname has ended. Thank you for using $affiliation_sitewwwaddress.
+
+Regards,
+VCL Team
+EOF
+
+ # Send mail
+ if ($is_parent_reservation && $user_emailnotices) {
+ mail($user_email, $subject, $message, $affiliation_helpaddress);
+ }
+
+ # Send IM
+ if ($is_parent_reservation && $user_im_name ne "none") {
+ notify_via_IM($user_im_name, $user_im_id, $message);
+ }
+
+ return 1;
+} ## end sub _notify_user_request_ended
+#/////////////////////////////////////////////////////////////////////////////
+
+1;
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+
+=cut
diff --git a/managementnode/lib/VCL/makeproduction.pm b/managementnode/lib/VCL/makeproduction.pm
new file mode 100644
index 0000000..0c688f7
--- /dev/null
+++ b/managementnode/lib/VCL/makeproduction.pm
@@ -0,0 +1,262 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: makeproduction.pm 1945 2008-12-11 20:58:08Z fapeeler $
+##############################################################################
+
+=head1 NAME
+
+VCL::makeproduction - Perl module for the VCL makeproduction state
+
+=head1 SYNOPSIS
+
+ use VCL::makeproduction;
+ use VCL::utils;
+
+ # Set variables containing the IDs of the request and reservation
+ my $request_id = 5;
+ my $reservation_id = 6;
+
+ # Call the VCL::utils::get_request_info subroutine to populate a hash
+ my %request_info = get_request_info($request_id);
+
+ # Set the reservation ID in the hash
+ $request_info{RESERVATIONID} = $reservation_id;
+
+ # Create a new VCL::makeproduction object based on the request information
+ my $makeproduction = VCL::makeproduction->new(%request_info);
+
+=head1 DESCRIPTION
+
+ This module supports the VCL "makeproduction" state.
+
+=cut
+
+##############################################################################
+package VCL::makeproduction;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/..";
+
+# Configure inheritance
+use base qw(VCL::Module::State);
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use VCL::utils;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 process
+
+ Parameters :
+ Returns : exits with status 0 if successful, 1 if failed
+ Description : Processes a reservation in the makeproduction state.
+
+=cut
+
+sub process {
+ my $self = shift;
+ my $request_data = $self->data->get_request_data();
+ my $request_id = $self->data->get_request_id();
+ my $reservation_id = $self->data->get_reservation_id();
+ my $request_state_name = $self->data->get_request_state_name();
+ my $image_id = $self->data->get_image_id();
+ my $image_name = $self->data->get_image_name();
+
+ # Update the image and imagerevision tables:
+ # image.name = imagename of new production revision
+ # image.test = 0
+ # image.lastupdate = now
+ # imagerevision.production = 1 for revision specified in hash
+ # imagerevision.production = 0 for all other revisions associated with this image
+ if ($self->set_imagerevision_to_production()) {
+ notify($ERRORS{'OK'}, 0, "successfully updated image and imagerevision tables");
+ }
+ else {
+ $self->reservation_failed("unable to update the image and imagerevision tables");
+ }
+
+ # Notify owner that image is in production mode
+ if ($self->notify_imagerevision_to_production()) {
+ notify($ERRORS{'OK'}, 0, "successfully notified owner that $image_name is in production mode");
+ }
+ else {
+ $self->reservation_failed("failed to notify owner that $image_name is in production mode");
+ }
+
+ # Update the request state to deleted, leave the computer state alone, exit
+ switch_state($request_data, 'deleted', '', 'EOR', '1');
+
+} ## end sub process
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 set_imagerevision_to_production
+
+ Parameters : None, uses image and image revision set in DataStructure
+ Returns : 1 if successful, 0 if failed
+ Description : Changes the production image revision for a given image.
+ It sets the imagerevision.production column to 1 for the
+ imagerevision specified in the DataStructure, and all other
+ image revisions to 0 for the same image.
+
+=cut
+
+sub set_imagerevision_to_production {
+ my $self = shift;
+ my $image_id = $self->data->get_image_id();
+ my $image_name = $self->data->get_image_name();
+ my $imagerevision_id = $self->data->get_imagerevision_id();
+
+ # Check the variables necessary to update the database
+ if (!defined $image_id) {
+ notify($ERRORS{'WARNING'}, 0, "unable to change production imagerevision, image id is not defined");
+ return 0;
+ }
+ elsif ($image_id <= 0) {
+ notify($ERRORS{'WARNING'}, 0, "unable to change production imagerevision, image id is $image_id");
+ return 0;
+ }
+ if (!defined $imagerevision_id) {
+ notify($ERRORS{'WARNING'}, 0, "unable to change production imagerevision, imagerevision id is not defined");
+ return 0;
+ }
+ elsif ($imagerevision_id <= 0) {
+ notify($ERRORS{'WARNING'}, 0, "unable to change production imagerevision, imagerevision id is $image_id");
+ return 0;
+ }
+
+ # Clear production flag for all image revisions
+ # Set the correct image revision to production
+ # Update the image name, set test = 0, and lastupdate to now
+ my $sql_statement = "
+ UPDATE
+ image,
+ imagerevision imagerevision_production,
+ imagerevision imagerevision_others
+ SET
+ image.name = imagerevision_production.imagename,
+ image.test = 0,
+ image.lastupdate = NOW(),
+ imagerevision_production.production = 1,
+ imagerevision_others.production = 0
+ WHERE
+ image.id = '$image_id'
+ AND imagerevision_production.imageid = image.id
+ AND imagerevision_others.imageid = image.id
+ AND imagerevision_production.id = '$imagerevision_id'
+ AND imagerevision_others.id != imagerevision_production.id
+ ";
+
+ # Call the database execute subroutine
+ if (database_execute($sql_statement)) {
+ notify($ERRORS{'OK'}, 0, "imagerevision $imagerevision_id set to production for image $image_name");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to set imagerevision $imagerevision_id to production for image $image_name");
+ return 0;
+ }
+
+} ## end sub _update_flags
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 notify_imagerevision_to_production
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub notify_imagerevision_to_production {
+ my $self = shift;
+ my $image_id = $self->data->get_image_id();
+ my $image_name = $self->data->get_image_name();
+ my $image_prettyname = $self->data->get_image_prettyname();
+ my $imagerevision_id = $self->data->get_imagerevision_id();
+ my $imagerevision_revision = $self->data->get_imagerevision_revision();
+ my $user_preferredname = $self->data->get_user_preferred_name();
+ my $user_affiliation_helpaddress = $self->data->get_user_affiliation_helpaddress();
+ my $user_email = $self->data->get_user_email();
+
+
+ # Assemble the message subject
+ my $subject = "VCL -- Image $image_prettyname made production";
+
+ # Assemble the message body
+ my $body = <<"END";
+$user_preferredname,
+Revision $imagerevision_revision of your VCL '$image_prettyname' image has been made production. Any new reservations for the image will receive this revision by default.
+
+If you have any questions, please contact $user_affiliation_helpaddress.
+
+Thank You,
+VCL Team
+END
+
+ # Send the message
+ if (mail($user_email, $subject, $body)) {
+ notify($ERRORS{'OK'}, 0, "email message sent to $user_email");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to send email message to $user_email");
+ return 0;
+ }
+
+} ## end sub _notify_owner
+
+#/////////////////////////////////////////////////////////////////////////////
+
+1;
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+
+=cut
diff --git a/managementnode/lib/VCL/new.pm b/managementnode/lib/VCL/new.pm
new file mode 100644
index 0000000..9e28534
--- /dev/null
+++ b/managementnode/lib/VCL/new.pm
@@ -0,0 +1,1351 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: new.pm 1953 2008-12-12 14:23:17Z arkurth $
+##############################################################################
+
+=head1 NAME
+
+VCL::new - Perl module for the VCL new state
+
+=head1 SYNOPSIS
+
+ use VCL::new;
+ use VCL::utils;
+
+ # Set variables containing the IDs of the request and reservation
+ my $request_id = 5;
+ my $reservation_id = 6;
+
+ # Call the VCL::utils::get_request_info subroutine to populate a hash
+ my %request_info = get_request_info($request_id);
+
+ # Set the reservation ID in the hash
+ $request_info{RESERVATIONID} = $reservation_id;
+
+ # Create a new VCL::new object based on the request information
+ my $new = VCL::new->new(%request_info);
+
+=head1 DESCRIPTION
+
+ This module supports the VCL "new" state.
+
+=cut
+
+##############################################################################
+package VCL::new;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/..";
+
+# Configure inheritance
+use base qw(VCL::Module::State);
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use VCL::utils;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 process
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub process {
+ my $self = shift;
+
+ my $request_data = $self->data->get_request_data();
+ my $request_id = $self->data->get_request_id();
+ my $request_logid = $self->data->get_request_log_id();
+ my $request_state_name = $self->data->get_request_state_name();
+ my $request_laststate_name = $self->data->get_request_laststate_name();
+ my $request_forimaging = $self->data->get_request_forimaging();
+ my $request_preload_only = $self->data->get_request_preload_only();
+ my $reservation_count = $self->data->get_reservation_count();
+ my $reservation_id = $self->data->get_reservation_id();
+ my $reservation_is_parent = $self->data->is_parent_reservation;
+ my $computer_id = $self->data->get_computer_id();
+ my $computer_host_name = $self->data->get_computer_host_name();
+ my $computer_short_name = $self->data->get_computer_short_name();
+ my $computer_type = $self->data->get_computer_type();
+ my $computer_ip_address = $self->data->get_computer_ip_address();
+ my $computer_state_name = $self->data->get_computer_state_name();
+ my $computer_preferred_image_id = $self->data->get_computer_preferredimage_id();
+ my $computer_preferred_image_name = $self->data->get_computer_preferredimage_name();
+ my $image_id = $self->data->get_image_id();
+ my $image_os_name = $self->data->get_image_os_name();
+ my $image_name = $self->data->get_image_name();
+ my $image_prettyname = $self->data->get_image_prettyname();
+ my $image_project = $self->data->get_image_project();
+ my $image_reloadtime = $self->data->get_image_reload_time();
+ my $image_architecture = $self->data->get_image_architecture();
+ my $image_os_type = $self->data->get_image_os_type();
+ my $imagemeta_checkuser = $self->data->get_imagemeta_checkuser();
+ my $imagemeta_usergroupid = $self->data->get_imagemeta_usergroupid();
+ my $imagemeta_usergroupmembercount = $self->data->get_imagemeta_usergroupmembercount();
+ my $imagemeta_usergroupmembers = $self->data->get_imagemeta_usergroupmembers();
+ my $imagerevision_id = $self->data->get_computer_imagerevision_id();
+ my $managementnode_id = $self->data->get_management_node_id();
+ my $managementnode_hostname = $self->data->get_management_node_hostname();
+ my $user_unityid = $self->data->get_user_login_id();
+ my $user_uid = $self->data->get_user_uid();
+ my $user_preferredname = $self->data->get_user_preferred_name();
+ my $user_affiliation_sitewwwaddress = $self->data->get_user_affiliation_sitewwwaddress();
+ my $user_affiliation_helpaddress = $self->data->get_user_affiliation_helpaddress();
+ my $user_standalone = $self->data->get_user_standalone();
+ my $user_email = $self->data->get_user_email();
+ my $user_emailnotices = $self->data->get_user_emailnotices();
+ my $user_imtype_name = $self->data->get_user_imtype_name();
+ my $user_im_id = $self->data->get_user_im_id();
+
+ notify($ERRORS{'OK'}, 0, "reservation is parent = $reservation_is_parent");
+ notify($ERRORS{'OK'}, 0, "preload only = $request_preload_only");
+ notify($ERRORS{'OK'}, 0, "originating request state = $request_state_name");
+ notify($ERRORS{'OK'}, 0, "originating request laststate = $request_laststate_name");
+ notify($ERRORS{'OK'}, 0, "originating computer state = $computer_state_name");
+ notify($ERRORS{'OK'}, 0, "originating computer type = $computer_type");
+
+ # If state is tomaintenance, place machine into maintenance state and set request to complete
+ if ($request_state_name =~ /tomaintenance/) {
+ notify($ERRORS{'OK'}, 0, "this is a 'tomaintenance' request");
+
+ # Update the request state to complete, update the computer state to maintenance, set the log ending to EOR, exit
+ if (switch_state($request_data, 'complete', 'maintenance', 'EOR', '0')) {
+ notify($ERRORS{'OK'}, 0, "$computer_short_name set to maintenance");
+ }
+
+ # Set vmhostid to null
+ if (switch_vmhost_id($computer_id, 'NULL')) {
+ notify($ERRORS{'OK'}, 0, "$computer_short_name vmhostid removed");
+
+ if ($self->provisioner->can("post_maintenance_action")) {
+ if ($self->provisioner->post_maintenance_action()) {
+ notify($ERRORS{'OK'}, 0, "post action completed $computer_short_name");
+ }
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "post action skipped, post_maintenance_action not implemented by " . ref($self->provisioner) . ", assuming no steps required");
+ }
+ } ## end if (switch_vmhost_id($computer_id, 'NULL'))
+
+ notify($ERRORS{'OK'}, 0, "exiting");
+ exit;
+ } ## end if ($request_state_name =~ /tomaintenance/)
+
+ # Confirm requested computer is available
+ if ($self->computer_not_being_used()) {
+ notify($ERRORS{'OK'}, 0, "$computer_short_name is not being used");
+ }
+ elsif ($request_state_name ne 'new') {
+ # Computer is not available, not a new request (most likely a simple reload)
+ notify($ERRORS{'WARNING'}, 0, "request state=$request_state_name, $computer_short_name is NOT available");
+
+ # Set the computer preferred image so it gets loaded if/when other reservations are complete
+ if ($image_name ne $computer_preferred_image_name) {
+ notify($ERRORS{'OK'}, 0, "$computer_short_name is not available, setting computer preferred image to $image_name");
+ if (setpreferredimage($computer_id, $image_id)) {
+ notify($ERRORS{'OK'}, 0, "$computer_short_name preferred image set to $image_name");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to set $computer_short_name preferred image to $image_name");
+ }
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "$computer_short_name is not available, computer preferred image is already set to $image_name");
+ }
+
+ # Update request state to complete
+ if (update_request_state($request_id, "complete", $request_state_name)) {
+ notify($ERRORS{'OK'}, 0, "request state updated to 'complete'/'$request_state_name'");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "failed to update the request state to 'complete'/'$request_state_name'");
+ }
+
+ notify($ERRORS{'OK'}, 0, "exiting");
+ exit;
+ } ## end elsif ($request_state_name ne 'new') [ if ($self->computer_not_being_used())
+ elsif ($request_preload_only) {
+ # Computer is not available, preload only = true
+ notify($ERRORS{'WARNING'}, 0, "preload reservation, $computer_short_name is NOT available");
+
+ # Set the computer preferred image so it gets loaded if/when other reservations are complete
+ if ($image_name ne $computer_preferred_image_name) {
+ notify($ERRORS{'OK'}, 0, "preload only request, $computer_short_name is not available, setting computer preferred image to $image_name");
+ if (setpreferredimage($computer_id, $image_id)) {
+ notify($ERRORS{'OK'}, 0, "$computer_short_name preferred image set to $image_name");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to set $computer_short_name preferred image to $image_name");
+ }
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "preload only request, $computer_short_name is not available, computer preferred image is already set to $image_name");
+ }
+
+ # Only the parent reservation is allowed to modify the request state in this module
+ if (!$reservation_is_parent) {
+ notify($ERRORS{'OK'}, 0, "child preload reservation, computer is not available, states will be changed by the parent");
+ notify($ERRORS{'OK'}, 0, "exiting");
+ exit;
+ }
+
+ # Return back to original states
+ notify($ERRORS{'OK'}, 0, "parent preload reservation, returning states back to original");
+
+ # Set the preload flag back to 1 so it will be processed again
+ if (update_preload_flag($request_id, 1)) {
+ notify($ERRORS{'OK'}, 0, "updated preload flag to 1");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to update preload flag to 1");
+ }
+
+ # Return request state back to the original
+ if (update_request_state($request_id, $request_state_name, $request_state_name)) {
+ notify($ERRORS{'OK'}, 0, "request state set back to '$request_state_name'/'$request_state_name'");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to set request state back to '$request_state_name'/'$request_state_name'");
+ }
+
+ # Return computer state back to the original
+ if (update_computer_state($computer_id, $computer_state_name)) {
+ notify($ERRORS{'OK'}, 0, "$computer_short_name state set back to '$computer_state_name'");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to set $computer_short_name state back to '$computer_state_name'");
+ }
+
+ notify($ERRORS{'OK'}, 0, "exiting");
+ exit;
+ } ## end elsif ($request_preload_only) [ if ($self->computer_not_being_used())
+ else {
+ # Computer not available, state=new, PRELOADONLY = false
+ notify($ERRORS{'WARNING'}, 0, "$computer_short_name is NOT available");
+
+ # Call reservation_failed
+ $self->reservation_failed("process failed because computer is not available");
+ }
+
+ # Confirm requested resouces are available
+ if ($self->reload_image()) {
+ notify($ERRORS{'OK'}, 0, "$computer_short_name is loaded with $image_name");
+ }
+ elsif ($request_preload_only) {
+ # Load failed preload only = true
+ notify($ERRORS{'WARNING'}, 0, "preload reservation, failed to load $computer_short_name with $image_name");
+
+ # Check if parent, only the parent is allowed to modify the request state in this module
+ if (!$reservation_is_parent) {
+ notify($ERRORS{'OK'}, 0, "this is a child preload reservation, states will be changed by the parent");
+
+ notify($ERRORS{'OK'}, 0, "exiting");
+ exit;
+ }
+
+ # Return back to original states
+ notify($ERRORS{'OK'}, 0, "this is a parent preload reservation, returning states back to original");
+
+ # Set the preload flag back to 1 so it will be processed again
+ if (update_preload_flag($request_id, 1)) {
+ notify($ERRORS{'OK'}, 0, "updated preload flag to 1");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to update preload flag to 1");
+ }
+
+ # Return request state back to the original
+ if (update_request_state($request_id, $request_state_name, $request_state_name)) {
+ notify($ERRORS{'OK'}, 0, "request state set back to '$request_state_name'/'$request_state_name'");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to set request state back to '$request_state_name'/'$request_state_name'");
+ }
+
+ # Return computer state back to the original
+ if (update_computer_state($computer_id, $computer_state_name)) {
+ notify($ERRORS{'OK'}, 0, "$computer_short_name state set back to '$computer_state_name'");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to set $computer_short_name state back to '$computer_state_name'");
+ }
+
+ notify($ERRORS{'OK'}, 0, "exiting");
+ exit;
+ } ## end elsif ($request_preload_only) [ if ($self->reload_image())
+ else {
+ # Load failed, PRELOADONLY = false
+ notify($ERRORS{'WARNING'}, 0, "failed to load $computer_short_name with $image_name");
+
+ # Call reservation_failed, problem computer not opened for reservation
+ $self->reservation_failed("process failed after trying to load or make available");
+ }
+
+
+ # Parent only checks and waits for any other images to complete and checkin
+ if ($reservation_is_parent && $reservation_count > 1) {
+ insertloadlog($reservation_id, $computer_id, "info", "cluster based reservation");
+
+ # Wait on child reservations
+ if ($self->wait_for_child_reservations()) {
+ notify($ERRORS{'OK'}, 0, "done waiting for child reservations, they are all ready");
+ }
+ else {
+ # Call reservation_failed, problem computer not opened for reservation
+ $self->reservation_failed("child reservations never all became ready");
+ }
+ } ## end if ($reservation_is_parent && $reservation_count...
+
+
+ # Check if request has been deleted
+ if (is_request_deleted($request_id)) {
+ notify($ERRORS{'OK'}, 0, "request has been deleted, setting computer state to 'available' and exiting");
+
+ # Update state of computer and exit
+ switch_state($request_data, '', 'available', '', '1');
+ }
+
+ my $next_computer_state;
+ my $next_request_state;
+
+ # Attempt to reserve the computer if this is a 'new' reservation
+ # These steps are not done for simple reloads
+ if ($request_state_name eq 'new') {
+ # Set the computer preferred image to the one for this reservation
+ if ($image_name ne $computer_preferred_image_name) {
+ if (setpreferredimage($computer_id, $image_id)) {
+ notify($ERRORS{'OK'}, 0, "$computer_short_name preferred image set to $image_name");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to set $computer_short_name preferred image to $image_name");
+ }
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "$computer_short_name preferred image is already set to $image_name");
+ }
+
+ if ($request_preload_only) {
+ # Return back to original states
+ notify($ERRORS{'OK'}, 0, "this is a preload reservation, returning states back to original");
+
+ # Set the preload flag back to 1 so it will be processed again
+ if (update_preload_flag($request_id, 1)) {
+ notify($ERRORS{'OK'}, 0, "updated preload flag to 1");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to update preload flag to 1");
+ }
+
+ # Set variables for the next states
+ $next_computer_state = $computer_state_name;
+ $next_request_state = $request_state_name;
+
+ } ## end if ($request_preload_only)
+ else {
+ # Perform the steps necessary to prepare the computer for a user
+ if ($self->reserve_computer()) {
+ notify($ERRORS{'OK'}, 0, "$computer_short_name with $image_name successfully reserved");
+ }
+ else {
+ # reserve_computer() returned false
+ notify($ERRORS{'OK'}, 0, "$computer_short_name with $image_name could NOT be reserved");
+
+ # Call reservation_failed, problem computer not opened for reservation
+ $self->reservation_failed("process failed after attempting to reserve the computer");
+ }
+
+ # Insert a row into the computerloadlog table
+ if (insertloadlog($reservation_id, $computer_id, "reserved", "$computer_short_name successfully reserved with $image_name")) {
+ notify($ERRORS{'OK'}, 0, "inserted computerloadlog entry, load state=reserved");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to insert computerloadlog entry, load state=reserved");
+ }
+
+ # Set variables for the next states
+ $next_computer_state = "reserved";
+ $next_request_state = "reserved";
+ } ## end else [ if ($request_preload_only)
+ } ## end if ($request_state_name eq 'new')
+ elsif ($request_state_name eq 'tovmhostinuse') {
+ # Set variables for the next states
+ $next_computer_state = "vmhostinuse";
+ $next_request_state = "complete";
+ }
+ else {
+ # Set variables for the next states
+ $next_computer_state = "available";
+ $next_request_state = "complete";
+ }
+
+ # Update the computer state
+ if (update_computer_state($computer_id, $next_computer_state)) {
+ notify($ERRORS{'OK'}, 0, "$computer_short_name state set to '$next_computer_state'");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to set $computer_short_name state to '$next_computer_state'");
+ }
+
+ # Update request state if this is the parent reservation
+ # Only parent reservations should modify the request state
+ if ($reservation_is_parent && update_request_state($request_id, $next_request_state, $request_state_name)) {
+ notify($ERRORS{'OK'}, 0, "request state set to '$next_request_state'/'$request_state_name'");
+ }
+ elsif ($reservation_is_parent) {
+ notify($ERRORS{'CRITICAL'}, 0, "failed to set request state to '$next_request_state'/'$request_state_name'");
+ notify($ERRORS{'OK'}, 0, "exiting");
+ exit;
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "this is a child image, request state NOT changed to '$next_request_state'");
+ }
+
+ # Insert a row into the computerloadlog table
+ if (insertloadlog($reservation_id, $computer_id, "info", "$computer_short_name successfully set to $next_computer_state with $image_name")) {
+ notify($ERRORS{'OK'}, 0, "inserted computerloadlog entry: $computer_short_name successfully set to $next_computer_state with $image_name");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to insert computerloadlog entry: $computer_short_name successfully set to $next_computer_state with $image_name");
+ }
+
+ notify($ERRORS{'OK'}, 0, "exiting");
+ exit;
+
+} ## end sub process
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 reload_image
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub reload_image {
+ my $self = shift;
+
+ my $request_data = $self->data->get_request_data();
+ my $request_id = $self->data->get_request_id();
+ my $request_logid = $self->data->get_request_log_id();
+ my $request_state_name = $self->data->get_request_state_name();
+ my $request_laststate_name = $self->data->get_request_laststate_name();
+ my $request_forimaging = $self->data->get_request_forimaging();
+ my $request_preload_only = $self->data->get_request_preload_only();
+ my $reservation_count = $self->data->get_reservation_count();
+ my $reservation_id = $self->data->get_reservation_id();
+ my $reservation_is_parent = $self->data->is_parent_reservation;
+ my $computer_id = $self->data->get_computer_id();
+ my $computer_host_name = $self->data->get_computer_host_name();
+ my $computer_short_name = $self->data->get_computer_short_name();
+ my $computer_type = $self->data->get_computer_type();
+ my $computer_ip_address = $self->data->get_computer_ip_address();
+ my $computer_state_name = $self->data->get_computer_state_name();
+ my $computer_preferred_image_id = $self->data->get_computer_preferredimage_id();
+ my $computer_preferred_image_name = $self->data->get_computer_preferredimage_name();
+ my $image_id = $self->data->get_image_id();
+ my $image_os_name = $self->data->get_image_os_name();
+ my $image_name = $self->data->get_image_name();
+ my $image_prettyname = $self->data->get_image_prettyname();
+ my $image_project = $self->data->get_image_project();
+ my $image_reloadtime = $self->data->get_image_reload_time();
+ my $image_architecture = $self->data->get_image_architecture();
+ my $image_os_type = $self->data->get_image_os_type();
+ my $imagemeta_checkuser = $self->data->get_imagemeta_checkuser();
+ my $imagemeta_usergroupid = $self->data->get_imagemeta_usergroupid();
+ my $imagemeta_usergroupmembercount = $self->data->get_imagemeta_usergroupmembercount();
+ my $imagemeta_usergroupmembers = $self->data->get_imagemeta_usergroupmembers();
+ my $imagerevision_id = $self->data->get_computer_imagerevision_id();
+ my $managementnode_id = $self->data->get_management_node_id();
+ my $managementnode_hostname = $self->data->get_management_node_hostname();
+ my $user_unityid = $self->data->get_user_login_id();
+ my $user_uid = $self->data->get_user_uid();
+ my $user_preferredname = $self->data->get_user_preferred_name();
+ my $user_affiliation_sitewwwaddress = $self->data->get_user_affiliation_sitewwwaddress();
+ my $user_affiliation_helpaddress = $self->data->get_user_affiliation_helpaddress();
+ my $user_standalone = $self->data->get_user_standalone();
+ my $user_email = $self->data->get_user_email();
+ my $user_emailnotices = $self->data->get_user_emailnotices();
+ my $user_imtype_name = $self->data->get_user_imtype_name();
+ my $user_im_id = $self->data->get_user_im_id();
+
+ # Try to get the node status if the provisioning engine has implemented a node_status() subroutine
+ my $node_status;
+ my $node_status_string = '';
+ if ($self->provisioner->can("node_status")) {
+ notify($ERRORS{'DEBUG'}, 0, "calling " . ref($self->provisioner) . "->node_status()");
+ insertloadlog($reservation_id, $computer_id, "statuscheck", "checking status of node");
+
+ # Call node_status(), check the return value
+ $node_status = $self->provisioner->node_status();
+
+ # Make sure a return value is defined, an error occurred if it is undefined
+ if (!defined($node_status)) {
+ notify($ERRORS{'CRITICAL'}, 0, ref($self->provisioner) . "->node_status() returned an undefined value, returning");
+ return;
+ }
+
+ # Check what node_status returned and try to get the "status" string
+ # First see if it returned a hashref
+ if (ref($node_status) eq 'HASH') {
+ notify($ERRORS{'DEBUG'}, 0, "node_status returned a hash reference");
+
+ # Check if the hash contains a key called "status"
+ if (defined $node_status->{status}) {
+ $node_status_string = $node_status->{status};
+ notify($ERRORS{'DEBUG'}, 0, "node_status hash reference contains key {status}=$node_status_string");
+ }
+ else {
+ notify($ERRORS{'DEBUG'}, 0, "node_status hash reference does not contain a key called 'status'");
+ }
+ } ## end if (ref($node_status) eq 'HASH')
+
+ # Check if node_status returned an array ref
+ elsif (ref($node_status) eq 'ARRAY') {
+ notify($ERRORS{'DEBUG'}, 0, "node_status returned an array reference");
+
+ # Check if the hash contains a key called "status"
+ if (defined((@{$node_status})[0])) {
+ $node_status_string = (@{$node_status})[0];
+ notify($ERRORS{'DEBUG'}, 0, "node_status array reference contains index [0]=$node_status_string");
+ }
+ else {
+ notify($ERRORS{'DEBUG'}, 0, "node_status array reference is empty");
+ }
+ } ## end elsif (ref($node_status) eq 'ARRAY') [ if (ref($node_status) eq 'HASH')
+
+ # Check if node_status didn't return a reference
+ # Assume string was returned
+ elsif (!ref($node_status)) {
+ # Use scalar value of node_status's return value
+ $node_status_string = $node_status;
+ notify($ERRORS{'DEBUG'}, 0, "node_status returned a scalar: $node_status");
+ }
+
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, ref($self->provisioner) . "->node_status() returned an unsupported reference type: " . ref($node_status) . ", returning");
+ insertloadlog($reservation_id, $computer_id, "failed", "node_status() returned an undefined value");
+ return;
+ }
+ } ## end if ($self->provisioner->can("node_status"))
+ else {
+ notify($ERRORS{'OK'}, 0, "node status not checked, node_status() not implemented by " . ref($self->provisioner) . ", assuming load=true");
+ }
+
+ if ($request_state_name eq 'reload') {
+ # Always call load() if state is reload regardless of node_status()
+ # Admin-initiated reloads will always cause node to be reloaded
+ notify($ERRORS{'OK'}, 0, "request state is $request_state_name, node will be reloaded regardless of status");
+ $node_status_string = 'reload';
+ }
+
+ # Check the status string returned by node_status
+ if ($node_status_string !~ /^ready/i) {
+ notify($ERRORS{'OK'}, 0, "node status is $node_status_string, $computer_short_name will be reloaded");
+ insertloadlog($reservation_id, $computer_id, "loadimageblade", "$computer_short_name must be reloaded with $image_name");
+
+ # Make sure provisioning module's load() subroutine exists
+ if (!$self->provisioner->can("load")) {
+ notify($ERRORS{'CRITICAL'}, 0, ref($self->provisioner) . "->load() subroutine does not exist, returning");
+ insertloadlog($reservation_id, $computer_id, "failed", ref($self->provisioner) . "->load() subroutine does not exist");
+ return;
+ }
+
+ # Make sure the image exists on this management node's local disks
+ # Attempt to retrieve it if necessary
+ if ($self->provisioner->can("does_image_exist")) {
+ notify($ERRORS{'DEBUG'}, 0, "calling " . ref($self->provisioner) . "->does_image_exist()");
+
+ if ($self->provisioner->does_image_exist($image_name)) {
+ notify($ERRORS{'OK'}, 0, "$image_name exists on this management node");
+ insertloadlog($reservation_id, $computer_id, "doesimageexists", "confirmed image exists");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "$image_name does not exist on this management node");
+
+ # Try to retrieve the image files from another management node
+ if ($self->provisioner->can("retrieve_image")) {
+ notify($ERRORS{'DEBUG'}, 0, "calling " . ref($self->provisioner) . "->retrieve_image()");
+
+ if ($self->provisioner->retrieve_image($image_name)) {
+ notify($ERRORS{'OK'}, 0, "$image_name was retrieved from another management node");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "$image_name does not exist on management node and could not be retrieved");
+ insertloadlog($reservation_id, $computer_id, "failed", "requested image does not exist on management node and could not be retrieved");
+ return;
+ }
+ } ## end if ($self->provisioner->can("retrieve_image"...
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to retrieve image from another management node, retrieve_image() is not implemented by " . ref($self->provisioner));
+ insertloadlog($reservation_id, $computer_id, "failed", "failed requested image does not exist on management node, retrieve_image() is not implemented");
+ return;
+ }
+ } ## end else [ if ($self->provisioner->does_image_exist($image_name...
+ } ## end if ($self->provisioner->can("does_image_exist"...
+ else {
+ notify($ERRORS{'OK'}, 0, "unable to check if image exists, does_image_exist() not implemented by " . ref($self->provisioner));
+ }
+
+ # Update the computer state to reloading
+ if (update_computer_state($computer_id, "reloading")) {
+ notify($ERRORS{'OK'}, 0, "computer $computer_short_name state set to reloading");
+ insertloadlog($reservation_id, $computer_id, "info", "computer state updated to reloading");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to set $computer_short_name into reloading state, returning");
+ insertloadlog($reservation_id, $computer_id, "failed", "unable to set computer $computer_short_name state to reloading");
+ return;
+ }
+
+ # Call provisioning module's load() subroutine
+ notify($ERRORS{'OK'}, 0, "calling " . ref($self->provisioner) . "->load() subroutine");
+ insertloadlog($reservation_id, $computer_id, "info", "calling " . ref($self->provisioner) . "->load() subroutine");
+ if ($self->provisioner->load($node_status)) {
+ notify($ERRORS{'OK'}, 0, "$image_name was successfully reloaded on $computer_short_name");
+ insertloadlog($reservation_id, $computer_id, "loadimagecomplete", "$image_name was successfully reloaded on $computer_short_name");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "$image_name failed to load on $computer_short_name, returning");
+ insertloadlog($reservation_id, $computer_id, "loadimagefailed", "$image_name failed to load on $computer_short_name");
+ return;
+ }
+
+ # Update the current image ID in the computer table
+ if (update_currentimage($computer_id, $image_id, $imagerevision_id, $image_id)) {
+ notify($ERRORS{'OK'}, 0, "updated computer table for $computer_short_name: currentimageid=$image_id");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to update computer table for $computer_short_name: currentimageid=$image_id");
+ }
+
+ insertloadlog($reservation_id, $computer_id, "nodeready", "$computer_short_name was reloaded with $image_name");
+ } ## end if ($node_status_string !~ /^ready/i)
+
+ else {
+ # node_status returned 'ready'
+ notify($ERRORS{'OK'}, 0, "node_status returned '$node_status_string', $computer_short_name will not be reloaded");
+ insertloadlog($reservation_id, $computer_id, "info", "node status is $node_status_string, $computer_short_name will not be reloaded");
+ }
+
+ notify($ERRORS{'OK'}, 0, "returning 1");
+ return 1;
+} ## end sub reload_image
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 computer_not_being_used
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub computer_not_being_used {
+ my $self = shift;
+
+ my $request_data = $self->data->get_request_data();
+ my $request_id = $self->data->get_request_id();
+ my $request_logid = $self->data->get_request_log_id();
+ my $request_state_name = $self->data->get_request_state_name();
+ my $request_laststate_name = $self->data->get_request_laststate_name();
+ my $request_forimaging = $self->data->get_request_forimaging();
+ my $request_preload_only = $self->data->get_request_preload_only();
+ my $reservation_count = $self->data->get_reservation_count();
+ my $reservation_id = $self->data->get_reservation_id();
+ my $reservation_is_parent = $self->data->is_parent_reservation;
+ my $computer_id = $self->data->get_computer_id();
+ my $computer_host_name = $self->data->get_computer_host_name();
+ my $computer_short_name = $self->data->get_computer_short_name();
+ my $computer_type = $self->data->get_computer_type();
+ my $computer_ip_address = $self->data->get_computer_ip_address();
+ my $computer_state_name = $self->data->get_computer_state_name();
+ my $computer_preferred_image_id = $self->data->get_computer_preferredimage_id();
+ my $computer_preferred_image_name = $self->data->get_computer_preferredimage_name();
+ my $image_id = $self->data->get_image_id();
+ my $image_os_name = $self->data->get_image_os_name();
+ my $image_name = $self->data->get_image_name();
+ my $image_prettyname = $self->data->get_image_prettyname();
+ my $image_project = $self->data->get_image_project();
+ my $image_reloadtime = $self->data->get_image_reload_time();
+ my $image_architecture = $self->data->get_image_architecture();
+ my $image_os_type = $self->data->get_image_os_type();
+ my $imagemeta_checkuser = $self->data->get_imagemeta_checkuser();
+ my $imagemeta_usergroupid = $self->data->get_imagemeta_usergroupid();
+ my $imagemeta_usergroupmembercount = $self->data->get_imagemeta_usergroupmembercount();
+ my $imagemeta_usergroupmembers = $self->data->get_imagemeta_usergroupmembers();
+ my $imagerevision_id = $self->data->get_computer_imagerevision_id();
+ my $managementnode_id = $self->data->get_management_node_id();
+ my $managementnode_hostname = $self->data->get_management_node_hostname();
+ my $user_unityid = $self->data->get_user_login_id();
+ my $user_uid = $self->data->get_user_uid();
+ my $user_preferredname = $self->data->get_user_preferred_name();
+ my $user_affiliation_sitewwwaddress = $self->data->get_user_affiliation_sitewwwaddress();
+ my $user_affiliation_helpaddress = $self->data->get_user_affiliation_helpaddress();
+ my $user_standalone = $self->data->get_user_standalone();
+ my $user_email = $self->data->get_user_email();
+ my $user_emailnotices = $self->data->get_user_emailnotices();
+ my $user_imtype_name = $self->data->get_user_imtype_name();
+ my $user_im_id = $self->data->get_user_im_id();
+
+ # Possible computer states:
+ # available
+ # deleted
+ # failed
+ # inuse
+ # maintenance
+ # reloading
+ # reserved
+ # vmhostinuse
+
+ # Return 0 if computer state is maintenance or deleted
+ if ($computer_state_name =~ /^(deleted|maintenance)$/) {
+ notify($ERRORS{'WARNING'}, 0, "$computer_short_name is NOT available, its state is $computer_state_name");
+ return 0;
+ }
+
+ # Check if computer state is available
+ if ($computer_state_name =~ /^(available|reload)$/) {
+ notify($ERRORS{'OK'}, 0, "$computer_short_name is available, its state is $computer_state_name");
+ return 1;
+ }
+ # Warn if computer state is failed, proceed to check for neighbor reservations
+ else {
+ notify($ERRORS{'WARNING'}, 0, "$computer_short_name state is $computer_state_name, checking if any conflicting requests are active");
+ }
+
+ # Set variables to control how may attempts are made to wait for an existing inuse reservation to end
+ my $inuse_loop_attempts = 4;
+ my $inuse_loop_wait = 30;
+
+ INUSE_LOOP: for (my $inuse_loop_count = 0; $inuse_loop_count < $inuse_loop_attempts; $inuse_loop_count++) {
+
+ # Check if this isn't the first iteration meaning something conflicting was found
+ if ($inuse_loop_count > 0) {
+ notify($ERRORS{'OK'}, 0, "attempt $inuse_loop_count/$inuse_loop_attempts: waiting for $inuse_loop_wait seconds before checking neighbor requests again");
+ sleep $inuse_loop_wait;
+ }
+
+ # Check if there is another request using this machine
+ # Get a hash containing all of the reservations for the computer
+ notify($ERRORS{'OK'}, 0, "checking neighbor reservations for $computer_short_name");
+ my %neighbor_requests = get_request_by_computerid($computer_id);
+
+ # There should be at least 1 request -- the one being processed
+ if (!%neighbor_requests) {
+ notify($ERRORS{'WARNING'}, 0, "failed to retrieve any requests for computer id=$computer_id, there should be at least 1");
+ return;
+ }
+
+ notify($ERRORS{'OK'}, 0, "found " . scalar keys(%neighbor_requests) . " total reservations for $computer_short_name");
+
+ # Loop through the neighbor requests
+ NEIGHBOR_REQUESTS: foreach my $neighbor_request_key (keys %neighbor_requests) {
+ my $neighbor_request_id = $neighbor_requests{$neighbor_request_key}{requestid};
+ my $neighbor_reservation_id = $neighbor_requests{$neighbor_request_key}{reservationid};
+ my $neighbor_state_name = $neighbor_requests{$neighbor_request_key}{currentstate};
+ my $neighbor_laststate_name = $neighbor_requests{$neighbor_request_key}{laststate};
+ my $neighbor_request_start = $neighbor_requests{$neighbor_request_key}{requeststart};
+
+ my $neighbor_request_start_epoch = convert_to_epoch_seconds($neighbor_request_start);
+ my $now_epoch = time();
+ my $neighbor_start_diff = $neighbor_request_start_epoch - $now_epoch;
+
+ # Ignore the request currently being processed and any complete requests
+ if ($neighbor_reservation_id == $reservation_id) {
+ next NEIGHBOR_REQUESTS;
+ }
+
+ notify($ERRORS{'DEBUG'}, 0, "checking neighbor request=$neighbor_request_id, reservation=$neighbor_reservation_id, state=$neighbor_state_name, laststate=$neighbor_laststate_name");
+ notify($ERRORS{'DEBUG'}, 0, "neighbor start time: $neighbor_request_start ($neighbor_start_diff)");
+
+ # Ignore any complete requests
+ if ($neighbor_state_name eq "complete") {
+ notify($ERRORS{'OK'}, 0, "neighbor request is complete: id=$neighbor_request_id, state=$neighbor_state_name");
+ next NEIGHBOR_REQUESTS;
+ }
+
+ # Check for overlapping reservations which user is involved or image is being created
+ # Don't check for state = new, it could be a future reservation
+ if ($neighbor_state_name =~ /^(reserved|inuse|image)$/) {
+ notify($ERRORS{'WARNING'}, 0, "detected overlapping reservation on $computer_short_name: req=$neighbor_request_id, res=$neighbor_reservation_id, request state=$neighbor_state_name, laststate=$neighbor_laststate_name, computer state=$computer_state_name");
+ return 0;
+ }
+
+ # Check for other currently pending requests
+ elsif ($neighbor_state_name eq "pending") {
+
+ # Make sure neighbor request process is actually running
+ my $neighbor_process_count = checkonprocess($neighbor_laststate_name, $neighbor_request_id);
+ if ($neighbor_process_count) {
+ notify($ERRORS{'OK'}, 0, "detected neighbor request $neighbor_request_id is active");
+ }
+ elsif ($neighbor_process_count == 0) {
+ notify($ERRORS{'OK'}, 0, "detected neighbor request $neighbor_request_id is NOT active, setting its state to 'complete'");
+ # Process was not found, set neighbor request to complete
+ if (update_request_state($neighbor_request_id, "complete", $neighbor_laststate_name)) {
+ notify($ERRORS{'OK'}, 0, "neighbor request $neighbor_request_id state set to 'complete'");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to set neighbor request $neighbor_request_id state to 'complete'");
+ }
+ # Check other neighbor requests
+ next NEIGHBOR_REQUESTS;
+ } ## end elsif ($neighbor_process_count == 0) [ if ($neighbor_process_count)
+ else {
+ # Undefined was returned from checkonprocess(), meaning error occurred
+ notify($ERRORS{'CRITICAL'}, 0, "error occurred while checking if neighbor request $neighbor_request_id process is running");
+
+ # Wait then try again
+ next INUSE_LOOP;
+ }
+
+ # Check for state = pending and laststate = new, reserved, inuse, or image
+ # Just return 0 for these, don't bother waiting
+ if ($neighbor_laststate_name =~ /^(new|reserved|inuse|image)$/) {
+ notify($ERRORS{'WARNING'}, 0, "detected overlapping reservation on $computer_short_name: req=$neighbor_request_id, res=$neighbor_reservation_id, request state=$neighbor_state_name, laststate=$neighbor_laststate_name, computer state=$computer_state_name");
+ return 0;
+ }
+
+ # Neighbor request state is pending and process is actively running
+ # Neighbor request state should be deleted|timeout|reload|reclaim
+ if ($neighbor_laststate_name !~ /^(deleted|timeout|reload|reclaim)$/) {
+ notify($ERRORS{'WARNING'}, 0, "unexpected neighbor request laststate: $neighbor_laststate_name");
+ }
+
+ # Computer should be loading
+ if (monitorloading($neighbor_reservation_id, $image_name, $computer_id, $computer_short_name, $image_reloadtime)) {
+ # Returns 1 if specified image has been successfully loaded
+ # Returns 0 if another image is being loaded or if loading fails
+ notify($ERRORS{'OK'}, 0, "$image_name should have been loaded on $computer_short_name by reservation $neighbor_reservation_id");
+
+ # Check other neighbor requests
+ next NEIGHBOR_REQUESTS;
+ }
+
+ # Computer is not being loaded with the correct image or loading failed
+ # Take evasive action - recheck on neighbor process
+ if (checkonprocess($neighbor_laststate_name, $neighbor_request_id)) {
+ notify($ERRORS{'OK'}, 0, "neighbor request=$neighbor_request_id, reservation=$neighbor_reservation_id owning $computer_short_name is not loading correct image or taking too long, attempting to kill process for reservation $neighbor_reservation_id");
+
+ # Kill competing neighbor process - set it's state to complete
+ if (kill_reservation_process($neighbor_reservation_id)) {
+ notify($ERRORS{'OK'}, 0, "killed competing process for reservation $neighbor_reservation_id");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to kill competing process for reservation $neighbor_reservation_id");
+ # Wait then try again
+ next INUSE_LOOP;
+ }
+ } ## end if (checkonprocess($neighbor_laststate_name...
+
+ # Either neighbor process was not found or competing process was just killed
+ # Set neighbor request to complete
+ if (update_request_state($neighbor_request_id, "complete", $neighbor_laststate_name)) {
+ notify($ERRORS{'OK'}, 0, "neighbor request $neighbor_request_id state set to 'complete'");
+ # Check other neighbor requests
+ next NEIGHBOR_REQUESTS;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to set neighbor request $neighbor_request_id state to 'complete'");
+ # Wait then try again
+ next INUSE_LOOP;
+ }
+ } ## end elsif ($neighbor_state_name eq "pending") [ if ($neighbor_state_name =~ /^(reserved|inuse|image)$/)
+
+ # Check for other requests
+ else {
+ notify($ERRORS{'OK'}, 0, "neighbor request state is OK: $neighbor_state_name/$neighbor_laststate_name");
+ }
+
+ } ## end foreach my $neighbor_request_key (keys %neighbor_requests)
+
+ # Checked all neighbor requests and didn't find any conflicting reservations
+ notify($ERRORS{'OK'}, 0, "checked neighbor requests and didn't find any conflicting reservations for $computer_short_name");
+ return 1;
+
+ } ## end for (my $inuse_loop_count = 0; $inuse_loop_count...
+
+ # Checked all neighbor requests several times and find something conflicting every time
+ notify($ERRORS{'WARNING'}, 0, "$computer_short_name does not appear to be available");
+ return 0;
+
+} ## end sub computer_not_being_used
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 reserve_computer
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub reserve_computer {
+ my $self = shift;
+
+ my $request_data = $self->data->get_request_data();
+ my $request_id = $self->data->get_request_id();
+ my $request_logid = $self->data->get_request_log_id();
+ my $request_state_name = $self->data->get_request_state_name();
+ my $request_laststate_name = $self->data->get_request_laststate_name();
+ my $request_forimaging = $self->data->get_request_forimaging();
+ my $request_preload_only = $self->data->get_request_preload_only();
+ my $reservation_count = $self->data->get_reservation_count();
+ my $reservation_id = $self->data->get_reservation_id();
+ my $reservation_is_parent = $self->data->is_parent_reservation;
+ my $computer_id = $self->data->get_computer_id();
+ my $computer_host_name = $self->data->get_computer_host_name();
+ my $computer_short_name = $self->data->get_computer_short_name();
+ my $computer_type = $self->data->get_computer_type();
+ my $computer_ip_address = $self->data->get_computer_ip_address();
+ my $computer_state_name = $self->data->get_computer_state_name();
+ my $computer_preferred_image_id = $self->data->get_computer_preferredimage_id();
+ my $computer_preferred_image_name = $self->data->get_computer_preferredimage_name();
+ my $image_id = $self->data->get_image_id();
+ my $image_os_name = $self->data->get_image_os_name();
+ my $image_name = $self->data->get_image_name();
+ my $image_prettyname = $self->data->get_image_prettyname();
+ my $image_project = $self->data->get_image_project();
+ my $image_reloadtime = $self->data->get_image_reload_time();
+ my $image_architecture = $self->data->get_image_architecture();
+ my $image_os_type = $self->data->get_image_os_type();
+ my $imagemeta_checkuser = $self->data->get_imagemeta_checkuser();
+ my $imagemeta_usergroupid = $self->data->get_imagemeta_usergroupid();
+ my $imagemeta_usergroupmembercount = $self->data->get_imagemeta_usergroupmembercount();
+ my $imagemeta_usergroupmembers = $self->data->get_imagemeta_usergroupmembers();
+ my $imagerevision_id = $self->data->get_computer_imagerevision_id();
+ my $managementnode_id = $self->data->get_management_node_id();
+ my $managementnode_hostname = $self->data->get_management_node_hostname();
+ my $user_unityid = $self->data->get_user_login_id();
+ my $user_uid = $self->data->get_user_uid();
+ my $user_preferredname = $self->data->get_user_preferred_name();
+ my $user_affiliation_sitewwwaddress = $self->data->get_user_affiliation_sitewwwaddress();
+ my $user_affiliation_helpaddress = $self->data->get_user_affiliation_helpaddress();
+ my $user_standalone = $self->data->get_user_standalone();
+ my $user_email = $self->data->get_user_email();
+ my $user_emailnotices = $self->data->get_user_emailnotices();
+ my $user_imtype_name = $self->data->get_user_imtype_name();
+ my $user_im_id = $self->data->get_user_im_id();
+
+ notify($ERRORS{'OK'}, 0, "user_standalone=$user_standalone, image OS type=$image_os_type");
+
+ my ($mailstring, $subject, $r);
+
+ # check for deletion
+ if (is_request_deleted($request_id)) {
+ notify($ERRORS{'OK'}, 0, "user has deleted, quietly exiting");
+ #return 0 and let process routine handle reset computer state
+ return 0;
+ }
+
+ if ($computer_type =~ /blade|virtualmachine/) {
+ # if dynamicDHCP update or dble check address in table
+ #ipconfiguration
+ if ($IPCONFIGURATION ne "manualDHCP") {
+ #not default setting
+ if ($IPCONFIGURATION eq "dynamicDHCP") {
+ my $assignedIPaddress = getdynamicaddress($computer_short_name, $image_os_name);
+
+ if ($assignedIPaddress) {
+ #$IPaddressforlog = $assignedIPaddress;
+ #update computer table
+ if (update_computer_address($computer_id, $assignedIPaddress)) {
+ notify($ERRORS{'OK'}, 0, "dynamic address collect $assignedIPaddress -- updating computer table");
+ }
+ #change our local and hash variables
+ $self->data->set_computer_ip_address($assignedIPaddress);
+ $computer_ip_address = $assignedIPaddress;
+ } ## end if ($assignedIPaddress)
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not fetch dynamic address from $computer_short_name $image_name");
+ insertloadlog($reservation_id, $computer_id, "failed", "node problem could not collect IP address form $computer_short_name");
+ return 0;
+ }
+ } ## end if ($IPCONFIGURATION eq "dynamicDHCP")
+ } ## end if ($IPCONFIGURATION ne "manualDHCP")
+
+
+ insertloadlog($reservation_id, $computer_id, "info", "node ready adding user account");
+
+ if ($image_os_type =~ /windows/ || ($image_os_type =~ /linux/ && $user_standalone)) {
+ # Get a random password
+ my $reservation_password = getpw();
+
+ # Update pw in reservation table
+ if (update_request_password($reservation_id, $reservation_password)) {
+ notify($ERRORS{'OK'}, 0, "updated password entry reservation_id $reservation_id");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "failed to update password entry reservation_id $reservation_id");
+ }
+
+ if ($image_os_type =~ /windows/ && $request_forimaging) {
+ if (changewindowspasswd($computer_short_name, "administrator", $reservation_password)) {
+ notify($ERRORS{'OK'}, 0, "password changed for administrator account on $computer_short_name to $reservation_password");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to change password for administrator account on $computer_short_name to $reservation_password");
+ return 0;
+ }
+ }
+ elsif ($image_os_type =~ /windows/) {
+ # Add user to computer
+ # Linux user addition is handled in reserve.pm
+ notify($ERRORS{'OK'}, 0, "attempting to add user $user_unityid to $computer_short_name");
+ insertloadlog($reservation_id, $computer_id, "addinguser", "adding user account $user_unityid");
+
+ # Add the request user to the computer
+ if (add_user($computer_short_name, $user_unityid, $user_uid, $reservation_password, $computer_host_name, $image_os_name, 0, 0, 0)) {
+ notify($ERRORS{'OK'}, 0, "user $user_unityid added to $computer_short_name");
+ }
+ else {
+ # check for deletion
+ if (is_request_deleted($request_id)) {
+ notify($ERRORS{'OK'}, 0, "unable to add user $user_unityid to $computer_short_name due to deleted requested ");
+ #return 0 and let process routine handle reset computer state
+ return 0;
+ }
+ notify($ERRORS{'CRITICAL'}, 0, "unable to add user $user_unityid to $computer_short_name");
+ return 0;
+ } ## end else [ if (add_user($computer_short_name, $user_unityid...
+
+ # If imagemeta has user group members, add them to the computer
+ if ($imagemeta_usergroupmembercount) {
+ notify($ERRORS{'OK'}, 0, "multiple users detected");
+
+ insertloadlog($reservation_id, $computer_id, "info", "multiple user accounts flagged adding additional users");
+
+ if (add_users_by_group($computer_short_name, $reservation_password, $computer_host_name, $image_os_name, $imagemeta_usergroupmembers)) {
+ notify($ERRORS{'OK'}, 0, "successfully added multiple users");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "failed to add multiple users");
+ return 0;
+ }
+ notify($ERRORS{'OK'}, 0, "users from group $imagemeta_usergroupid added");
+
+ } ## end if ($imagemeta_usergroupmembercount)
+
+ } ## end elsif ($image_os_type =~ /windows/) [ if ($image_os_type =~ /windows/ && $request_forimaging)
+ } ## end if ($image_os_type =~ /windows/ || ($image_os_type...
+ elsif ($image_os_type =~ /linux/) {
+ if ($user_standalone) {
+ # Get a random password
+ my $reservation_password = getpw();
+
+ # Update pw in reservation table
+ if (update_request_password($reservation_id, $reservation_password)) {
+ notify($ERRORS{'OK'}, 0, "updated password entry reservation_id $reservation_id");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "failed to update password entry reservation_id $reservation_id");
+ }
+ } ## end if ($user_standalone)
+ } ## end elsif ($image_os_type =~ /linux/) [ if ($image_os_type =~ /windows/ || ($image_os_type...
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "password set failed, unsupported image OS type: $image_os_type");
+ return 0;
+ }
+
+ if (!$reservation_is_parent) {
+ #sub image; parent handles notification
+ return 1;
+ }
+
+ # Assemble the message subject based on whether this is a cluster based or normal request
+ if ($request_forimaging) {
+ $subject = "VCL -- $image_prettyname imaging reservation";
+ }
+ elsif ($reservation_count > 1) {
+ $subject = "VCL -- Cluster-based reservation";
+ }
+ else {
+ $subject = "VCL -- $image_prettyname reservation";
+ }
+
+ # Assemble the message body
+ if ($request_forimaging) {
+ $mailstring = <<"EOF";
+$user_preferredname,
+The resources for your VCL image creation request have been successfully reserved.
+
+EOF
+ }
+ else {
+ $mailstring = <<"EOF";
+$user_preferredname,
+The resources for your VCL request have been successfully reserved.
+
+EOF
+ }
+
+ # Add the image name and IP address information
+ $mailstring .= "Reservation Information:\n";
+ foreach $r (keys %{$request_data->{reservation}}) {
+ my $reservation_image_name = $request_data->{reservation}{$r}{image}{prettyname};
+ my $computer_ip_address = $request_data->{reservation}{$r}{computer}{IPaddress};
+ $mailstring .= "Image Name: $reservation_image_name\n";
+ $mailstring .= "IP Address: $computer_ip_address\n\n";
+ }
+
+ $mailstring .= <<"EOF";
+Connection will not be allowed until you acknowledge using the VCL web interface. You must acknowledge the reservation within the next 15 minutes or the resources will be reclaimed for other VCL users.
+
+-Visit $user_affiliation_sitewwwaddress
+-Select "Current Reservations"
+-Click the "Connect" button
+
+Upon acknowledgement, all of the remaining connection details will be displayed.
+
+EOF
+
+ if ($request_forimaging) {
+ $mailstring .= <<"EOF";
+You have up to 8 hours to complete the new image. Once you have completed preparing the new image:
+
+-Visit $user_affiliation_sitewwwaddress
+-Select "Current Reservations"
+-Click the "Create Image" button and follow the instuctions
+
+EOF
+ } ## end if ($request_forimaging)
+
+ $mailstring .= <<"EOF";
+Thank You,
+VCL Team
+EOF
+ if ($user_emailnotices) {
+ mail($user_email, $subject, $mailstring, $user_affiliation_helpaddress);
+ }
+ else {
+ #just for our email record keeping, might be overkill
+ notify($ERRORS{'MAILMASTERS'}, 0, " $user_email\n$mailstring");
+ }
+
+ notify($ERRORS{'DEBUG'}, 0, "IMTYPE_name= $user_imtype_name calling notify_via");
+ if ($user_imtype_name ne "none") {
+ notify_via_IM($user_imtype_name, $user_im_id, $mailstring, $user_affiliation_helpaddress);
+ }
+
+
+
+ } ## end if ($computer_type =~ /blade|virtualmachine/)
+
+ elsif ($computer_type eq "lab") {
+ if ($image_os_name =~ /sun4x_|rhel/) {
+ # i can't really do anything here
+ # because I need the remoteIP the user
+ # will be accessing the machine from
+ $subject = "VCL -- $image_prettyname reservation";
+
+ $mailstring = <<"EOF";
+$user_preferredname,
+A machine with $image_prettyname has been reserved. Use ssh to connect to $computer_ip_address.
+
+Username: your Unity ID
+Password: your Unity password
+
+Connection will not be allowed until you acknowledge using the VCL web interface.
+-Visit $user_affiliation_sitewwwaddress
+-Select Current Reservations
+-Click the Connect button to acknowledge
+
+Thank You,
+VCL Team
+EOF
+
+ if ($user_emailnotices) {
+ #if "0" user does not care to get additional notices
+ mail($user_email, $subject, $mailstring, $user_affiliation_helpaddress);
+ }
+ else {
+ #just for our record keeping
+ notify($ERRORS{'MAILMASTERS'}, 0, "$user_email\n$mailstring");
+ }
+ if ($user_imtype_name ne "none") {
+ notify_via_IM($user_imtype_name, $user_im_id, $mailstring, $user_affiliation_helpaddress);
+ }
+ } ## end if ($image_os_name =~ /sun4x_|rhel/)
+ elsif ($image_os_name =~ /realm/) {
+ #same as above
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "hrmm found an OS I am not set to handle $image_os_name");
+ return 0;
+ }
+ } ## end elsif ($computer_type eq "lab") [ if ($computer_type =~ /blade|virtualmachine/)
+
+ #update log table with the IPaddress of the machine
+ if (update_sublog_ipaddress($request_logid, $computer_ip_address)) {
+ notify($ERRORS{'OK'}, 0, "updated sublog $request_logid for node $computer_short_name IPaddress $computer_ip_address");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "could not update sublog $request_logid for node $computer_short_name IPaddress $computer_ip_address");
+ }
+
+ return 1;
+} ## end sub reserve_computer
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 wait_for_child_reservations
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub wait_for_child_reservations {
+ my $self = shift;
+ my $request_data = $self->data->get_request_data();
+ my $request_id = $self->data->get_request_id();
+ my $reservation_count = $self->data->get_reservation_count();
+ my $reservation_id = $self->data->get_reservation_id();
+ my @reservation_ids = $self->data->get_reservation_ids();
+
+ # Set limits on how many attempts to make and how long to wait between attempts
+ # Wait a long time - 20 minutes
+ my $loop_iteration_limit = 40;
+ my $loop_iteration_delay = 30;
+
+ WAITING_LOOP: for (my $loop_iteration = 1; $loop_iteration <= $loop_iteration_limit; $loop_iteration++) {
+ if ($loop_iteration > 1) {
+ notify($ERRORS{'OK'}, 0, "waiting for $loop_iteration_delay seconds");
+ sleep $loop_iteration_delay;
+ }
+
+ # Check if request has been deleted
+ if (is_request_deleted($request_id)) {
+ notify($ERRORS{'OK'}, 0, "request has been deleted, setting computer state to 'available' and exiting");
+
+ # Update state of computer and exit
+ switch_state($request_data, '', 'available', '', '1');
+ }
+
+ # Check if all of the reservations are ready according to the computerloadlog table
+ my $computerloadlog_reservations_ready = reservations_ready($request_id);
+ if ($computerloadlog_reservations_ready) {
+ notify($ERRORS{'OK'}, 0, "ready: all child reservations are ready according to computerloadlog, returning 1");
+ return 1;
+ }
+ elsif (defined $computerloadlog_reservations_ready) {
+ notify($ERRORS{'OK'}, 0, "not ready: all child reservations are NOT ready according to computerloadlog");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "error occurred checking if child reservations are ready according to computerloadlog");
+ }
+
+ notify($ERRORS{'OK'}, 0, "attempt $loop_iteration/$loop_iteration_limit: waiting for child reservations to become ready");
+
+ RESERVATION_LOOP: foreach my $child_reservation_id (@reservation_ids) {
+ # Don't bother checking this reservation
+ if ($child_reservation_id == $reservation_id) {
+ next RESERVATION_LOOP;
+ }
+
+ # Get the computer ID of the child reservation
+ my $child_computer_id = $request_data->{reservation}{$child_reservation_id}{computer}{id};
+ notify($ERRORS{'DEBUG'}, 0, "checking reservation $child_reservation_id: computer ID=$child_computer_id");
+
+ # Get the child reservation's current computer state
+ my $child_computer_state = get_computer_current_state_name($child_computer_id);
+ notify($ERRORS{'DEBUG'}, 0, "reservation $child_reservation_id: computer state=$child_computer_state");
+
+ # Check child reservation's computer state, is it reserved?
+ if ($child_computer_state eq "reserved") {
+ notify($ERRORS{'OK'}, 0, "ready: reservation $child_reservation_id computer state is reserved");
+ }
+ elsif ($child_computer_state eq "reloading") {
+ notify($ERRORS{'OK'}, 0, "not ready: reservation $child_reservation_id is still reloading");
+ next WAITING_LOOP;
+ }
+ elsif ($child_computer_state eq "available" && $loop_iteration > 2) {
+ # Child computer may still be in the available state if the request start is recent
+ # Warn if still in available state after this subroutine has iterated a couple times
+ notify($ERRORS{'WARNING'}, 0, "not ready: reservation $child_reservation_id: computer state is still $child_computer_state");
+ next WAITING_LOOP;
+ }
+ elsif ($child_computer_state eq "available") {
+ notify($ERRORS{'OK'}, 0, "not ready: reservation $child_reservation_id: reloading has not begun yet");
+ next WAITING_LOOP;
+ }
+ elsif ($child_computer_state =~ /^(failed|maintenance|deleted)$/) {
+ notify($ERRORS{'WARNING'}, 0, "abort: reservation $child_reservation_id: computer was put into maintenance, returning");
+ return;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unexpected: reservation $child_reservation_id: computer in unexpected state: $child_computer_state");
+ next WAITING_LOOP;
+ }
+ } ## end foreach my $child_reservation_id (@reservation_ids)
+
+ notify($ERRORS{'OK'}, 0, "all child reservations are ready, returning 1");
+ return 1;
+ } ## end for (my $loop_iteration = 1; $loop_iteration...
+
+ # If out of main loop, waited maximum amount of time
+ notify($ERRORS{'WARNING'}, 0, "waited maximum amount of time for child reservations to become ready, returning 0");
+ return 0;
+
+} ## end sub wait_for_child_reservations
+#/////////////////////////////////////////////////////////////////////////////
+
+1;
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+=cut
diff --git a/managementnode/lib/VCL/reclaim.pm b/managementnode/lib/VCL/reclaim.pm
new file mode 100644
index 0000000..edfaa03
--- /dev/null
+++ b/managementnode/lib/VCL/reclaim.pm
@@ -0,0 +1,403 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: reclaim.pm 1953 2008-12-12 14:23:17Z arkurth $
+##############################################################################
+
+=head1 NAME
+
+VCL::reclaim - Perl module for the VCL reclaim state
+
+=head1 SYNOPSIS
+
+ use VCL::reclaim;
+ use VCL::utils;
+
+ # Set variables containing the IDs of the request and reservation
+ my $request_id = 5;
+ my $reservation_id = 6;
+
+ # Call the VCL::utils::get_request_info subroutine to populate a hash
+ my %request_info = get_request_info($request_id);
+
+ # Set the reservation ID in the hash
+ $request_info{RESERVATIONID} = $reservation_id;
+
+ # Create a new VCL::reclaim object based on the request information
+ my $reclaim = VCL::reclaim->new(%request_info);
+
+=head1 DESCRIPTION
+
+ This module supports the VCL "reclaim" state.
+
+=cut
+
+##############################################################################
+package VCL::reclaim;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/..";
+
+# Configure inheritance
+use base qw(VCL::Module::State);
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use VCL::utils;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 process
+
+ Parameters : $request_data_hash_reference
+ Returns : 1 if successful, 0 otherwise
+ Description : Processes a reservation in the reclaim state. You must pass this
+ method a reference to a hash containing request data.
+
+=cut
+
+sub process {
+ my $self = shift;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Store hash variables into local variables
+ my $request_data = $self->data->get_request_data;
+
+ my $request_id = $request_data->{id};
+ my $request_state_name = $request_data->{state}{name};
+ my $request_laststate_name = $request_data->{laststate}{name};
+ my $reservation_id = $request_data->{RESERVATIONID};
+ my $reservation_remoteip = $request_data->{reservation}{$reservation_id}{remoteIP};
+ my $computer_type = $request_data->{reservation}{$reservation_id}{computer}{type};
+ my $computer_id = $request_data->{reservation}{$reservation_id}{computer}{id};
+ my $computer_shortname = $request_data->{reservation}{$reservation_id}{computer}{SHORTNAME};
+ my $computer_hostname = $request_data->{reservation}{$reservation_id}{computer}{hostname};
+ my $computer_ipaddress = $request_data->{reservation}{$reservation_id}{computer}{IPaddress};
+ my $computer_state_name = $request_data->{reservation}{$reservation_id}{computer}{state}{name};
+ my $image_os_name = $request_data->{reservation}{$reservation_id}{image}{OS}{name};
+ my $imagerevision_imagename = $request_data->{reservation}{$reservation_id}{imagerevision}{imagename};
+ my $user_unityid = $request_data->{user}{unityid};
+
+ # Assemble a consistent prefix for notify messages
+ my $notify_prefix = "req=$request_id, res=$reservation_id:";
+
+ # Retrieve next image
+ # It's possible the results may not get used based on the state of the reservation
+ my @nextimage;
+
+ if($self->predictor->can("get_next_image")){
+ @nextimage = $self->predictor->get_next_image();
+ }
+ else{
+ notify($ERRORS{'WARNING'}, 0, "$notify_prefix predictor module does not support get_next_image, calling default get_next_image from utils");
+ @nextimage = get_next_image_default($computer_id);
+ }
+
+ # Assign values to hash for insert reload request
+ # Not necessary to change local variables for active image
+ $request_data->{reservation}{$reservation_id}{imagerevision}{imagename} = $nextimage[0];
+ $request_data->{reservation}{$reservation_id}{image}{id} = $nextimage[1];
+ $request_data->{reservation}{$reservation_id}{imagerevision}{id} = $nextimage[2];
+ $request_data->{reservation}{$reservation_id}{imageid} = $nextimage[1];
+ $request_data->{reservation}{$reservation_id}{imagerevisionid} = $nextimage[2];
+
+ my $nextimagename = $nextimage[0];
+ notify($ERRORS{'OK'}, 0, "$notify_prefix nextimage results imagename=$nextimage[0] imageid=$nextimage[1] imagerevisionid=$nextimage[2]");
+
+
+ # Insert into computerloadlog if request state = timeout
+ if ($request_state_name =~ /timeout|deleted/) {
+ insertloadlog($reservation_id, $computer_id, $request_state_name, "reclaim: starting $request_state_name process");
+ }
+ insertloadlog($reservation_id, $computer_id, "info", "reclaim: request state is $request_state_name");
+ insertloadlog($reservation_id, $computer_id, "info", "reclaim: request laststate is $request_laststate_name");
+ insertloadlog($reservation_id, $computer_id, "info", "reclaim: computer type is $computer_type");
+ insertloadlog($reservation_id, $computer_id, "info", "reclaim: computer OS is $image_os_name");
+
+ # If request laststate = new, nothing needs to be done
+ if ($request_laststate_name =~ /new/) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix request laststate is $request_laststate_name, nothing needs to be done to the computer");
+ # Proceed to set request to complete and computer to available
+ }
+
+ # Don't attempt to do anything to machines that are currently reloading
+ elsif ($computer_state_name =~ /maintenance|reloading/) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix computer in $computer_state_name state, nothing needs to be done to the computer");
+ # Proceed to set request to complete
+ }
+
+ # Check the computer type
+ # Treat blades and virtual machines the same
+ # The request will either be changed to "reload" or they will be cleaned
+ # up based on the OS.
+ # Lab computers only need to have sshd disabled.
+
+ elsif ($computer_type =~ /blade|virtualmachine/) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix computer type is $computer_type");
+
+ # Check if request laststate is reserved
+ # This is the only case where computers will be cleaned and not reloaded
+ if ($request_laststate_name =~ /reserved/) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix request laststate is $request_laststate_name, attempting to clean up computer for next user");
+
+ # Check the image OS type and clean up computer accordingly
+ if ($image_os_name =~ /^(win|vmwarewin|vmwareesxwin)/) {
+ # Loaded Windows image needs to be cleaned up
+ notify($ERRORS{'OK'}, 0, "$notify_prefix attempting steps to clean up loaded $image_os_name image");
+
+ # Remove user
+ if (del_user($computer_shortname, $user_unityid, $computer_type, $image_os_name)) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix user $user_unityid removed from $computer_shortname");
+ insertloadlog($reservation_id, $computer_id, "info", "reclaim: removed user");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "$notify_prefix could not remove user $user_unityid from $computer_shortname, proceed to forced reload");
+
+ # Insert reload request data into the datbase
+ if (insert_reload_request($request_data)) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix inserted reload request into database for computer id=$computer_id imagename=$nextimagename");
+
+ # Switch the request state to complete, leave the computer state as is
+ # Update log ending to EOR
+ # Exit
+ switch_state($request_data, 'complete', '', 'EOR', '1');
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "$notify_prefix failed to insert reload request into database for computer id=$computer_id imagename=$nextimagename");
+
+ # Switch the request and computer states to failed, log ending to failed, exit
+ switch_state($request_data, 'failed', 'failed', 'failed', '1');
+ }
+ exit;
+ } ## end else [ if (del_user($computer_shortname, $user_unityid...
+
+ # Disable RDP
+ if (remotedesktopport($computer_shortname, "DISABLE")) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix remote desktop disabled on $computer_shortname");
+ insertloadlog($reservation_id, $computer_id, "info", "reclaim: disabled RDP");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "$notify_prefix remote desktop could not be disabled on $computer_shortname");
+
+ # Insert reload request data into the datbase
+ if (insert_reload_request($request_data)) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix inserted reload request into database for computer id=$computer_id imagename=$nextimagename");
+
+ # Switch the request state to complete, leave the computer state as is, log ending to EOR, exit
+ switch_state($request_data, 'complete', '', 'EOR', '1');
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "$notify_prefix failed to insert reload request into database for computer id=$computer_id imagename=$nextimagename");
+
+ # Switch the request and computer states to failed, log ending to failed, exit
+ switch_state($request_data, 'failed', 'failed', 'failed', '1');
+ }
+ exit;
+ } ## end else [ if (remotedesktopport($computer_shortname,...
+
+ ## Stop Tivoli Monitoring
+ #if (system_monitoring($computer_shortname, $imagerevision_imagename, "stop", "ITM")) {
+ # notify($ERRORS{'OK'}, 0, "$notify_prefix ITM monitoring disabled");
+ #}
+ } ## end if ($image_os_name =~ /^(win|vmwarewin|vmwareesxwin)/)
+
+ elsif ($image_os_name =~ /^(rh[0-9]image|rhel[0-9]|fc[0-9]image|rhfc[0-9]|rhas[0-9])/) {
+ # Loaded Linux image needs to be cleaned up
+ notify($ERRORS{'OK'}, 0, "$notify_prefix attempting steps to clean up loaded $image_os_name image");
+
+ # Make sure user is not connected
+ if (isconnected($computer_shortname, $computer_type, $reservation_remoteip, $image_os_name, $computer_ipaddress)) {
+ notify($ERRORS{'WARNING'}, 0, "$notify_prefix user $user_unityid is connected to $computer_shortname, vm will be reloaded");
+
+ # Insert reload request data into the datbase
+ if (insert_reload_request($request_data)) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix inserted reload request into database for computer id=$computer_id imagename=$nextimagename");
+
+ # Switch the request state to complete, leave the computer state as is, set log ending to EOR, exit
+ switch_state($request_data, 'complete', '', 'EOR', '1');
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "$notify_prefix failed to insert reload request into database for computer id=$computer_id");
+
+ # Switch the request and computer states to failed, log ending to failed, exit
+ switch_state($request_data, 'failed', 'failed', 'failed', '1');
+ }
+ exit;
+ } ## end if (isconnected($computer_shortname, $computer_type...
+
+ # User is not connected, delete the user
+ if (del_user($computer_shortname, $user_unityid, $computer_type, $image_os_name)) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix user $user_unityid removed from $computer_shortname");
+ insertloadlog($reservation_id, $computer_id, "info", "reclaim: removed user");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix user $user_unityid could not be removed from $computer_shortname, vm will be reloaded");
+
+ # Insert reload request data into the datbase
+ if (insert_reload_request($request_data)) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix inserted reload request into database for computer id=$computer_id");
+
+ # Switch the request state to complete, leave the computer state as is, log ending to EOR, exit
+ switch_state($request_data, 'complete', '', 'EOR', '1');
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "$notify_prefix failed to insert reload request into database for computer id=$computer_id");
+
+ # Switch the request and computer states to failed, log ending to failed, exit
+ switch_state($request_data, 'failed', 'failed', 'failed', '1');
+ }
+ exit;
+ } ## end else [ if (del_user($computer_shortname, $user_unityid...
+ } ## end elsif ($image_os_name =~ /^(rh[0-9]image|rhel[0-9]|fc[0-9]image|rhfc[0-9]|rhas[0-9])/) [ if ($image_os_name =~ /^(win|vmwarewin|vmwareesxwin)/)
+
+ else {
+ # Unknown image type
+ notify($ERRORS{'WARNING'}, 0, "$notify_prefix unsupported image OS detected: $image_os_name, reload will be attempted");
+
+ # Insert reload request data into the datbase
+ if (insert_reload_request($request_data)) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix inserted reload request into database for computer id=$computer_id");
+
+ # Switch the request state to complete, leave the computer state as is, log ending to EOR, exit
+ switch_state($request_data, 'complete', '', 'EOR', '1');
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "$notify_prefix failed to insert reload request into database for computer id=$computer_id");
+
+ # Switch the request and computer states to failed, log ending to failed, exit
+ switch_state($request_data, 'failed', 'failed', 'failed', '1');
+ }
+ exit;
+ } ## end else [ if ($image_os_name =~ /^(win|vmwarewin|vmwareesxwin)/) [elsif ($image_os_name =~ /^(rh[0-9]image|rhel[0-9]|fc[0-9]image|rhfc[0-9]|rhas[0-9])/)
+ } ## end if ($request_laststate_name =~ /reserved/)
+
+ else {
+ # Either blade or vm, request laststate is not reserved
+ # Computer should be reloaded
+ notify($ERRORS{'OK'}, 0, "$notify_prefix request laststate is $request_laststate_name, reload will be attempted");
+
+ # Insert reload request data into the datbase
+ if (insert_reload_request($request_data)) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix inserted reload request into database for computer id=$computer_id imagename=$nextimagename");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "$notify_prefix failed to insert reload request into database for computer id=$computer_id imagename=$nextimagename");
+
+ # Switch the request and computer states to failed, log ending to failed, exit
+ switch_state($request_data, 'failed', 'failed', 'failed', '1');
+ }
+
+ # Switch the request state to complete, leave the computer state as is, log ending to EOR, exit
+ switch_state($request_data, 'complete', '', 'EOR', '1');
+
+ } ## end else [ if ($request_laststate_name =~ /reserved/)
+
+ } ## end elsif ($computer_type =~ /blade|virtualmachine/) [ if ($request_laststate_name =~ /new/)
+
+ elsif ($computer_type =~ /lab/) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix computer type is $computer_type");
+
+ # Display a warning if laststate is not inuse, or reserved
+ # but still try to clean up computer
+ if ($request_laststate_name =~ /inuse|reserved/) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix request laststate is $request_laststate_name");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "$notify_prefix laststate for request is $request_laststate_name, this shouldn't happen");
+ }
+
+ # Disable sshd
+ if (disablesshd($computer_ipaddress, $user_unityid, $reservation_remoteip, "timeout", $image_os_name)) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix sshd on $computer_shortname $computer_ipaddress has been disabled");
+ insertloadlog($reservation_id, $computer_id, "info", "reclaim: disabled sshd");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "$notify_prefix unable to disable sshd on $computer_shortname $computer_ipaddress");
+ insertloadlog($reservation_id, $computer_id, "info", "reclaim: unable to disable sshd");
+
+ # Attempt to put lab computer in failed state if not already in maintenance
+ if ($computer_state_name =~ /maintenance/) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix $computer_shortname in $computer_state_name state, skipping state update to failed");
+ }
+ else {
+ if (update_computer_state($computer_id, "failed")) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix $computer_shortname put into failed state");
+ insertloadlog($reservation_id, $computer_id, "info", "reclaim: set computer state to failed");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "$notify_prefix unable to put $computer_shortname into failed state");
+ insertloadlog($reservation_id, $computer_id, "info", "reclaim: unable to set computer state to failed");
+ }
+ } ## end else [ if ($computer_state_name =~ /maintenance/)
+ } ## end else [ if (disablesshd($computer_ipaddress, $user_unityid...
+ } ## end elsif ($computer_type =~ /lab/) [ if ($request_laststate_name =~ /new/)
+
+ # Unknown computer type, this shouldn't happen
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "$notify_prefix unsupported computer type: $computer_type, not blade, virtualmachine, or lab");
+ insertloadlog($reservation_id, $computer_id, "info", "reclaim: unsupported computer type: $computer_type");
+ }
+
+ # Update the request state to complete and exit
+ # Set the computer state to available if it isn't in the maintenance or reloading state
+ if ($computer_state_name =~ /maintenance|reloading/) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix $computer_shortname in $computer_state_name state, skipping state update to available");
+ switch_state($request_data, 'complete', '', '', '1');
+ }
+ else {
+ switch_state($request_data, 'complete', 'available', '', '1');
+ }
+
+} ## end sub process
+#/////////////////////////////////////////////////////////////////////////////
+
+1;
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+=cut
+
+=======
diff --git a/managementnode/lib/VCL/reserved.pm b/managementnode/lib/VCL/reserved.pm
new file mode 100644
index 0000000..73f961f
--- /dev/null
+++ b/managementnode/lib/VCL/reserved.pm
@@ -0,0 +1,699 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: reserved.pm 1953 2008-12-12 14:23:17Z arkurth $
+##############################################################################
+
+=head1 NAME
+
+VCL::reserved - Perl module for the VCL reserved state
+
+=head1 SYNOPSIS
+
+ use VCL::reserved;
+ use VCL::utils;
+
+ # Set variables containing the IDs of the request and reservation
+ my $request_id = 5;
+ my $reservation_id = 6;
+
+ # Call the VCL::utils::get_request_info subroutine to populate a hash
+ my %request_info = get_request_info($request_id);
+
+ # Set the reservation ID in the hash
+ $request_info{RESERVATIONID} = $reservation_id;
+
+ # Create a new VCL::reserved object based on the request information
+ my $reserved = VCL::reserved->new(%request_info);
+
+=head1 DESCRIPTION
+
+ This module supports the VCL "reserved" state. The reserved state is reached
+ after a user creates a reservation from the VCL web page. This module checks
+ whether or not the user has acknowledged the reservation and connected to
+ the machine. Once connected, the reservation will be put into the "inuse"
+ state and the reserved process exits.
+
+=cut
+
+##############################################################################
+package VCL::reserved;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/..";
+
+# Configure inheritance
+use base qw(VCL::Module::State);
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use VCL::utils;
+
+##############################################################################
+
+=head1 OBJECT METHODS
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 process
+
+ Parameters : Reference to current reserved object is automatically passed
+ when invoked as a class method.
+ Returns : 1 if successful, 0 otherwise
+ Description : Processes a reservation in the reserved state. Waits for user
+ acknowledgement and connection.
+
+=cut
+
+sub process {
+ my $self = shift;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Store hash variables into local variables
+ my $request_data = $self->data->get_request_data;
+
+ my $request_id = $request_data->{id};
+ my $request_logid = $request_data->{logid};
+ my $reservation_id = $request_data->{RESERVATIONID};
+ my $reservation_password = $request_data->{reservation}{$reservation_id}{pw};
+ my $computer_id = $request_data->{reservation}{$reservation_id}{computer}{id};
+ my $computer_hostname = $request_data->{reservation}{$reservation_id}{computer}{hostname};
+ my $computer_short_name = $request_data->{reservation}{$reservation_id}{computer}{SHORTNAME};
+ my $computer_type = $request_data->{reservation}{$reservation_id}{computer}{type};
+ my $computer_ip_address = $request_data->{reservation}{$reservation_id}{computer}{IPaddress};
+ my $image_os_name = $request_data->{reservation}{$reservation_id}{image}{OS}{name};
+ my $request_forimaging = $request_data->{forimaging};
+ my $image_name = $request_data->{reservation}{$reservation_id}{imagerevision}{imagename};
+ my $user_uid = $request_data->{user}{uid};
+ my $user_unityid = $request_data->{user}{unityid};
+ my $user_standalone = $request_data->{user}{STANDALONE};
+ my $imagemeta_checkuser = $request_data->{reservation}{$reservation_id}{image}{imagemeta}{checkuser};
+ my $reservation_count = $self->data->get_reservation_count();
+
+
+ # Update the log table, set the loaded time to now for this request
+ if (update_log_loaded_time($request_logid)) {
+ notify($ERRORS{'OK'}, 0, "updated log table, set loaded time to now for id:$request_logid");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to update log table while attempting to set id:$request_logid loaded time to now");
+ }
+
+ # Figure out if image has usergroupid set in meta data and how many members it has
+ my $imagemeta_usergroupid = '';
+ my @user_group_members;
+ my $user_group_member_count = 0;
+ if (defined $request_data->{reservation}{$reservation_id}{image}{imagemeta}{usergroupid}) {
+ notify($ERRORS{'OK'}, 0, "imagemeta user group defined $request_data->{reservation}{$reservation_id}{image}{imagemeta}{usergroupid}");
+ $imagemeta_usergroupid = $request_data->{reservation}{$reservation_id}{image}{imagemeta}{usergroupid};
+ @user_group_members = getusergroupmembers($imagemeta_usergroupid);
+ $user_group_member_count = scalar @user_group_members;
+ }
+ notify($ERRORS{'OK'}, 0, "imagemeta user group membership count = $user_group_member_count");
+
+ my $nodename;
+ my $retval_conn;
+
+ # Figure out the node name based on the type of computer
+ if ($computer_type eq "blade") {
+ $nodename = $computer_short_name;
+ }
+ elsif ($computer_type eq "lab") {
+ $nodename = $computer_hostname;
+ }
+ elsif ($computer_type eq "virtualmachine") {
+ $nodename = $computer_short_name;
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "computer id=$computer_id did not have a type, exiting");
+ exit;
+ }
+
+ notify($ERRORS{'OK'}, 0, "computer info: id=$computer_id, type=$computer_type, hostname=$nodename");
+ notify($ERRORS{'OK'}, 0, "user info: uid=$user_uid, unity id=$user_unityid, standalone=$user_standalone");
+ notify($ERRORS{'OK'}, 0, "imagemeta checkuser set to: $imagemeta_checkuser");
+ notify($ERRORS{'OK'}, 0, "formimaging set to: $request_forimaging");
+
+ my $connected = 0;
+ my $curr_time = time();
+ my $time_limit = 15;
+ my $time_exceeded = 0;
+ my $break = 0;
+
+ # Create limit to keep our magic under control
+ my $acknowledge_attempts = 0;
+
+ notify($ERRORS{'OK'}, 0, "begin checking for user acknowledgement");
+ insertloadlog($reservation_id, $computer_id, "info", "reserved: waiting for user acknowledgement");
+
+ my $remote_ip;
+
+ ACKNOWLEDGE:
+ $acknowledge_attempts++;
+
+ if (!defined($remote_ip)) {
+ # Try to get the remote IP again and update the data hash
+ $remote_ip = get_reservation_remote_ip($reservation_id);
+ $request_data->{reservation}{$reservation_id}{remoteIP} = $remote_ip;
+
+ # Undef should be returned if remoteIP isn't set, 0 if an error occurred
+ if (defined $remote_ip && $remote_ip eq '0') {
+ notify($ERRORS{'WARNING'}, 0, "could not determine remote IP");
+ }
+
+ # Check if remoteIP is defined yet (user has acknowledged)
+ elsif (defined($remote_ip)) {
+ # User has acknowledged
+ notify($ERRORS{'OK'}, 0, "user acknowledged, remote IP: $remote_ip");
+
+ # Check if computer type is blade
+ if ($computer_type =~ /blade|virtualmachine/) {
+ notify($ERRORS{'OK'}, 0, "blade or virtual machine detected: $computer_type");
+ # different senerios
+ # standard -- 1-1-1 with connection checks
+ # group access M-N-K -- multiple users need access
+ # standard with no connection checks
+
+ if ($image_os_name =~ /win|vmwarewin/) {
+ notify($ERRORS{'OK'}, 0, "Windows image detected: $image_os_name");
+
+ # Determine whether to open RDP port for single IP or group access
+ if ($user_group_member_count > 0) {
+ # Imagemeta user group defined and member count is > 0
+ notify($ERRORS{'OK'}, 0, "group set in imagemeta has members");
+ if (remotedesktopport($nodename, "ENABLE")) {
+ notify($ERRORS{'OK'}, 0, "remote desktop enabled on $nodename for group access");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "remote desktop not group enabled on $nodename");
+ $retval_conn = "failed";
+ goto RETVALCONN;
+ }
+ } # Close imagemeta user group defined and member count is > 0
+ else {
+ # Imagemeta user group undefined or member count is 0
+ notify($ERRORS{'OK'}, 0, "either group not set in imagemeta or has 0 members");
+ if (remotedesktopport($nodename, "ENABLE", $remote_ip)) {
+ insertloadlog($reservation_id, $computer_id, "info", "reserved: opening remote access port for $remote_ip");
+ notify($ERRORS{'OK'}, 0, "remote desktop enabled on $nodename");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "remote desktop not enabled on $nodename");
+ $retval_conn = "failed";
+ goto RETVALCONN;
+ }
+ } # Close imagemeta user group undefined or member count is 0
+
+ # Check if forimaging is set on the request
+ if (!$request_forimaging) {
+ ## Don't care to monitor any imaging reservations
+ #notify($ERRORS{'OK'}, 0, "this is not a forimaging request, check for ITM monitoring");
+ #if (system_monitoring($nodename, $image_name, "start", "ITM")) {
+ # notify($ERRORS{'OK'}, 0, "ITM monitoring enabled");
+ # insertloadlog($reservation_id, $computer_id, "info", "reserved: ITM detected starting system monitoring");
+ #}
+ #else {
+ # # Don't care at this time
+ # notify($ERRORS{'OK'}, 0, "ITM monitoring is not enabled");
+ #}
+ } # Close if request forimaging
+
+ } # Close if OS name is win or vmware
+
+ # Check if linux image
+ elsif ($image_os_name =~ /^(rh[0-9]image|rhel[0-9]|fc[0-9]image|rhfc[0-9]|rhas[0-9])/) {
+ notify($ERRORS{'OK'}, 0, "Linux image detected: $image_os_name");
+
+ # adduser ; this adds user and restarts sshd
+ # check for group access
+
+ my $grpflag = 0;
+ my @group;
+
+ if ($imagemeta_usergroupid ne '') {
+ notify($ERRORS{'OK'}, 0, "group access groupid $imagemeta_usergroupid");
+
+ # Check group membership count
+ if ($user_group_member_count > 0) {
+ # Good, at least something is listed
+ notify($ERRORS{'OK'}, 0, "imagemeta group acess membership is $user_group_member_count");
+ $grpflag = $user_group_member_count;
+ @group = @user_group_members;
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "image claims group acess but membership is 0, usergrouid: $imagemeta_usergroupid, only adding reqeustor");
+ }
+
+ } # Close imagemeta user group defined and member count is > 0
+
+ # Try to add the user account to the linux computer
+ if (add_user($computer_short_name, $user_unityid, $user_uid, 0, $computer_hostname, $image_os_name, $remote_ip, $grpflag, @group)) {
+ notify($ERRORS{'OK'}, 0, "user $user_unityid added to $computer_short_name");
+ insertloadlog($reservation_id, $computer_id, "info", "reserved: adding user and opening remote access port for $remote_ip");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "could not add user $user_unityid to $computer_short_name");
+ insertloadlog($reservation_id, $computer_id, "failed", "reserved: could not add user to node");
+ $retval_conn = "failed";
+ goto RETVALCONN;
+ }
+
+ # Check if user was set to standalone
+ # Occurs if affiliation is not NCSU or if vcladmin is the user
+ if ($user_standalone) {
+ if (changelinuxpassword($computer_short_name, $user_unityid, $reservation_password)) {
+ # Password successfully changed
+ notify($ERRORS{'OK'}, 0, "password changed on $computer_short_name for standalone user $user_unityid");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "could not change linux password for $user_unityid on $computer_short_name");
+ insertloadlog($reservation_id, $computer_id, "failed", "reserved: could not change user password on node");
+ $retval_conn = "failed";
+ goto RETVALCONN;
+ }
+ } # Close if standalone
+ else {
+ notify($ERRORS{'OK'}, 0, "password not changed on $computer_short_name for non-standalone user $user_unityid");
+ }
+
+ #if cluster reservation - populate parent node with child node information
+ if ($request_data->{RESERVATIONCOUNT} > 1) {
+ notify($ERRORS{'OK'}, 0, "cluster reservation, attempting to populate nodes with cluster_info data");
+ if (update_cluster_info($request_data)) {
+ notify($ERRORS{'OK'}, 0, "updated cluster nodes with cluster infomation");
+ }
+ }
+
+ } # Close elseif linux computer
+
+ } # Close if computer type is blade
+
+ # Check if computer type is lab
+ elsif ($computer_type eq "lab") {
+ notify($ERRORS{'OK'}, 0, "lab computer detected");
+
+ # Check if Solaris or RHEL
+ if ($image_os_name =~ /sun4x_|rhel/) {
+ notify($ERRORS{'OK'}, 0, "Sun or RHEL lab computer detected");
+ if (enablesshd($computer_ip_address, $user_unityid, $remote_ip, "new", $image_os_name)) {
+ notify($ERRORS{'OK'}, 0, "SSHD enabled on $computer_hostname $computer_ip_address");
+ }
+ else {
+ # Could not enable SSHD
+ # Add code to better handle this such as fetch another machine
+ notify($ERRORS{'WARNING'}, 0, "could not enable SSHD on $computer_hostname");
+
+ # Update the computer state to failed
+ if (update_computer_state($computer_id, "failed", "new")) {
+ notify($ERRORS{'OK'}, 0, "setting computer ID $computer_id into failed state");
+ }
+
+ insertloadlog($reservation_id, $computer_id, "failed", "reserved: could not enable access port on remote machine");
+ $retval_conn = "failed";
+ goto RETVALCONN;
+ } ## end else [ if (enablesshd($computer_ip_address, $user_unityid...
+ } # Close if Solaris or RHEL
+
+ } # Close elsif computer type is lab
+
+ } # close if defined remoteIP
+
+ elsif ($acknowledge_attempts < 180) {
+ # User has approximately 15 minutes to acknowledge (5 seconds * 180 attempts)
+
+ # Print a status message every tenth attempt
+ if (($acknowledge_attempts % 10) == 0) {
+ # Print message every tenth attempt
+ notify($ERRORS{'OK'}, 0, "attempt $acknowledge_attempts of 180, user has not acknowleged");
+ }
+
+ sleep 5;
+
+ # Check if user deleted the request
+ if (is_request_deleted($request_id)) {
+ notify($ERRORS{'OK'}, 0, "user has deleted the request, exiting");
+ exit;
+ }
+
+ # Going back to check for user acknowledgment again
+ goto ACKNOWLEDGE;
+
+ } # Close acknowledge attempts < 120
+
+
+ else {
+ # Acknowledge attemtps >= 120
+ # User never acknowledged reques, return noack
+ notify($ERRORS{'OK'}, 0, "user never acknowleged request, proceed to timeout");
+
+ # Check if user deleted the request
+ if (is_request_deleted($request_id)) {
+ notify($ERRORS{'OK'}, 0, "user has deleted the request, exiting");
+ exit;
+ }
+
+ $retval_conn = "noack";
+
+ # Skipping check_connection code
+ goto RETVALCONN;
+ } ## end else [ if (defined $remote_ip && $remote_ip eq '0') [... [elsif ($acknowledge_attempts < 180)
+
+ } # Close remoteIP not defined
+
+ # Determine if connection needs to be checked based on imagemeta checkuser flag
+ if (!$imagemeta_checkuser) {
+ # If checkuser = 1, check for a user connection
+ # If checkuser = 0, set as inuse and return
+ notify($ERRORS{'OK'}, 0, "checkuser flag set to 0, skipping user connection");
+ $retval_conn = "connected";
+ goto RETVALCONN;
+ }
+ # Check if cluster request
+ elsif ($reservation_count > 1) {
+ notify($ERRORS{'OK'}, 0, "reservation count is $reservation_count, skipping user connection check");
+ $retval_conn = "connected";
+ goto RETVALCONN;
+ }
+ else {
+ # Check for user connection
+ notify($ERRORS{'OK'}, 0, "checkuser flag is set to 1, checking user connection");
+ # Check for the normal user ID if this isn't an imaging request
+ # Check for "administrator" if this is an imaging request
+ if ($request_forimaging) {
+ notify($ERRORS{'OK'}, 0, "forimaging flag is set to 1, checking for connection by administrator");
+ $retval_conn = check_connection($nodename, $computer_ip_address, $computer_type, $remote_ip, $time_limit, $image_os_name, 0, $request_id, "administrator");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "forimaging flag is set to 0, checking for connection by $user_unityid");
+ $retval_conn = check_connection($nodename, $computer_ip_address, $computer_type, $remote_ip, $time_limit, $image_os_name, 0, $request_id, $user_unityid);
+ }
+ } ## end else [ if (!$imagemeta_checkuser)
+
+ RETVALCONN:
+ notify($ERRORS{'OK'}, 0, "retval_conn = $retval_conn");
+
+ # Check the return value and perform some actions
+ if ($retval_conn eq "deleted") {
+ notify($ERRORS{'OK'}, 0, "user deleted request, exiting");
+ exit;
+ }
+
+ elsif ($retval_conn eq "connected") {
+ # User is connected, update state of the request, computer and set lastcheck time to current time
+ notify($ERRORS{'OK'}, 0, "$remote_ip connected to $nodename");
+
+ insertloadlog($reservation_id, $computer_id, "connected", "reserved: user connected to remote machine");
+
+ # Update the request state to either inuse or imageinuse
+ if (update_request_state($request_id, "inuse", "reserved")) {
+ notify($ERRORS{'OK'}, 0, "setting request into inuse state");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to set request into inuse state");
+ }
+
+ # Update the computer state to inuse
+ if (update_computer_state($computer_id, "inuse")) {
+ notify($ERRORS{'OK'}, 0, "setting computerid $computer_id into inuse state");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to set computerid $computer_id into inuse state");
+ }
+
+ # Update the lastcheck value for this reservation to now
+ if (update_reservation_lastcheck($reservation_id)) {
+ notify($ERRORS{'OK'}, 0, "updated lastcheck time for reservation $reservation_id");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to update lastcheck time for reservation $reservation_id");
+ }
+
+ notify($ERRORS{'OK'}, 0, "exiting");
+ exit;
+ } ## end elsif ($retval_conn eq "connected") [ if ($retval_conn eq "deleted")
+
+ elsif ($retval_conn eq "conn_wrong_ip") {
+ # does the same as above, until we make a firm decision as to how to handle this
+
+ # Update the request state to inuse
+ if (update_request_state($request_id, "inuse", "reserved")) {
+ notify($ERRORS{'OK'}, 0, "setting request into inuse state");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to set request into inuse state");
+ }
+
+ # Update the computer state to inuse
+ if (update_computer_state($computer_id, "inuse")) {
+ notify($ERRORS{'OK'}, 0, "setting computerid $computer_id into inuse state");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to set computerid $computer_id into inuse state");
+ }
+
+ # Update the lastcheck value for this reservation to now
+ if (update_reservation_lastcheck($reservation_id)) {
+ notify($ERRORS{'OK'}, 0, "updated lastcheck time for reservation $reservation_id");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to update lastcheck time for reservation $reservation_id");
+ }
+
+ notify($ERRORS{'OK'}, 0, "exiting");
+ exit;
+ } ## end elsif ($retval_conn eq "conn_wrong_ip") [ if ($retval_conn eq "deleted")
+
+ elsif ($retval_conn eq "nologin") {
+ #user ack'd but did not login
+ notify($ERRORS{'OK'}, 0, "user acknowledged but did not log in");
+
+ # Update the request state to timeout
+ if (update_request_state($request_id, "timeout", "reserved")) {
+ notify($ERRORS{'OK'}, 0, "setting request into timeout state");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to set request into timeout state");
+ }
+
+ # Update the computer state to timeout
+ if (update_computer_state($computer_id, "timeout")) {
+ notify($ERRORS{'OK'}, 0, "setting computerid $computer_id into timeout state");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to set computerid $computer_id into timeout state");
+ }
+
+ $self->_notify_user_timeout($request_data);
+
+ # Update the entry in the log table with the current finalend time and ending set to nologin
+ if (update_log_ending($request_logid, "nologin")) {
+ notify($ERRORS{'OK'}, 0, "log id $request_logid was updated and ending set to nologin");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "log id $request_logid could not be updated and ending set to nologin");
+ }
+
+ insertloadlog($reservation_id, $computer_id, "info", "reserved: timing out user not connected to remote machine");
+
+ notify($ERRORS{'OK'}, 0, "exiting");
+ exit;
+ } ## end elsif ($retval_conn eq "nologin") [ if ($retval_conn eq "deleted")
+ elsif ($retval_conn eq "noack") {
+ # set to timeout state
+ #user never ack'd
+ notify($ERRORS{'OK'}, 0, "user never acknowledged");
+
+ # Update the request state to timeout
+ if (update_request_state($request_id, "timeout", "reserved")) {
+ notify($ERRORS{'OK'}, 0, "setting request into timeout state");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to set request into timeout state");
+ }
+
+ # Update the computer state to timeout
+ if (update_computer_state($computer_id, "timeout")) {
+ notify($ERRORS{'OK'}, 0, "setting computerid $computer_id into timeout state");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to set computerid $computer_id into timeout state");
+ }
+
+ $self->_notify_user_timeout($request_data);
+
+ # Update the entry in the log table with the current finalend time and ending set to noack
+ if (update_log_ending($request_logid, "noack")) {
+ notify($ERRORS{'OK'}, 0, "log id $request_logid was updated and ending set to noack");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "log id $request_logid could not be updated and ending set to noack");
+ }
+
+ insertloadlog($reservation_id, $computer_id, "info", "reserved: timing out user not acknowledged reservation");
+
+ notify($ERRORS{'OK'}, 0, "exiting");
+ exit;
+ } ## end elsif ($retval_conn eq "noack") [ if ($retval_conn eq "deleted")
+ elsif ($retval_conn eq "failed") {
+ # Update the request state to failed
+ notify($ERRORS{'OK'}, 0, "failed to reserve machine");
+
+ if (update_request_state($request_id, "failed", "reserved")) {
+ notify($ERRORS{'OK'}, 0, "setting request into failed state");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to set request into failed state");
+ }
+
+ # Update the computer state to failed
+ if (update_computer_state($computer_id, "failed")) {
+ notify($ERRORS{'OK'}, 0, "setting computerid $computer_id into failed state");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to set computerid $computer_id into failed state");
+ }
+
+ # Update the entry in the log table with the current finalend time and ending set to noack
+ if (update_log_ending($request_logid, "failed")) {
+ notify($ERRORS{'OK'}, 0, "log id $request_logid was updated and ending set to failed");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "log id $request_logid could not be updated and ending set to failed");
+ }
+
+ notify($ERRORS{'OK'}, 0, "exiting");
+ exit;
+ } ## end elsif ($retval_conn eq "failed") [ if ($retval_conn eq "deleted")
+
+ elsif ($retval_conn eq "timeout") {
+ # Update the request state to timeout
+ notify($ERRORS{'OK'}, 0, "reservation timed out");
+
+ if (update_request_state($request_id, "timeout", "reserved")) {
+ notify($ERRORS{'OK'}, 0, "setting request into timeout state");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to set request into timeout state");
+ }
+
+ # Update the computer state to timeout
+ if (update_computer_state($computer_id, "timeout")) {
+ notify($ERRORS{'OK'}, 0, "setting computerid $computer_id into timeout state");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to set computerid $computer_id into timeout state");
+ }
+
+ # Update the entry in the log table with the current finalend time and ending set to timeout
+ if (update_log_ending($request_logid, "timeout")) {
+ notify($ERRORS{'OK'}, 0, "log id $request_logid was updated and ending set to timeout");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "log id $request_logid could not be updated and ending set to timeout");
+ }
+
+ notify($ERRORS{'OK'}, 0, "exiting");
+ exit;
+ } ## end elsif ($retval_conn eq "timeout") [ if ($retval_conn eq "deleted")
+} ## end sub process
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _notify_user_timeout
+
+ Parameters : $request_data_hash_reference
+ Returns : 1 if successful, 0 otherwise
+ Description : Notifies the user that the request has timed out becuase no
+ initial connection was made. An e-mail and/or IM message will
+ be sent to the user.
+
+=cut
+
+sub _notify_user_timeout {
+ my $self = shift;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Store hash variables into local variables
+ my $request_data = $self->data->get_request_data;
+
+ my $request_id = $request_data->{id};
+ my $reservation_id = $request_data->{RESERVATIONID};
+ my $user_preferredname = $request_data->{user}{preferredname};
+ my $user_email = $request_data->{user}{email};
+ my $user_emailnotices = $request_data->{user}{emailnotices};
+ my $user_im_name = $request_data->{user}{IMtype}{name};
+ my $user_im_id = $request_data->{user}{IMid};
+ my $affiliation_sitewwwaddress = $request_data->{user}{affiliation}{sitewwwaddress};
+ my $affiliation_helpaddress = $request_data->{user}{affiliation}{helpaddress};
+ my $image_prettyname = $request_data->{reservation}{$reservation_id}{image}{prettyname};
+ my $computer_ip_address = $request_data->{reservation}{$reservation_id}{computer}{IPaddress};
+
+ #my ($emailaddress,$firstname,$type,$ipaddress,$imagename,$url,$IMname,$IMid) = @_;
+ my $message = <<"EOF";
+$user_preferredname,
+Your reservation has timed out for image $image_prettyname at address $computer_ip_address because no initial connection was made.
+
+To make another reservation, please revisit $affiliation_sitewwwaddress.
+
+Thank You,
+VCL Team
+EOF
+
+ my $subject = "VCL -- Reservation Timeout";
+
+ if ($user_emailnotices) {
+ #if "0" user does not care to get additional notices
+ mail($user_email, $subject, $message, $affiliation_helpaddress);
+ notify($ERRORS{'OK'}, 0, "sent reservation timeout e-mail to $user_email");
+ }
+ if ($user_im_name ne "none") {
+ notify_via_IM($user_im_name, $user_im_id, $message);
+ notify($ERRORS{'OK'}, 0, "sent reservation timeout IM to $user_im_name");
+ }
+ return 1;
+} ## end sub _notify_user_timeout
+#/////////////////////////////////////////////////////////////////////////////
+
+1;
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+=cut
diff --git a/managementnode/lib/VCL/utils.pm b/managementnode/lib/VCL/utils.pm
new file mode 100644
index 0000000..18ee266
--- /dev/null
+++ b/managementnode/lib/VCL/utils.pm
@@ -0,0 +1,9911 @@
+#!/usr/bin/perl -w
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+##############################################################################
+# $Id: utils.pm 1953 2008-12-12 14:23:17Z arkurth $
+##############################################################################
+
+=head1 NAME
+
+VCL::utils
+
+=head1 SYNOPSIS
+
+ use VCL::utils;
+
+=head1 DESCRIPTION
+
+ This module contains general VCL utility subroutines.
+
+=cut
+
+##############################################################################
+package VCL::utils;
+
+# Specify the lib path using FindBin
+use FindBin;
+use lib "$FindBin::Bin/..";
+
+# Configure inheritance
+use base qw();
+
+# Specify the version of this module
+our $VERSION = '2.00';
+
+# Specify the version of Perl to use
+use 5.008000;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use Mail::Mailer;
+use Shell qw(mkdir);
+use File::Find;
+use Time::Local;
+use DBI;
+use DBI::Const::GetInfoType;
+use diagnostics;
+use Net::Ping;
+use Fcntl qw(:DEFAULT :flock);
+use FindBin;
+use Getopt::Long;
+use Carp;
+use Text::Wrap;
+use English;
+use List::Util qw(min max);
+
+
+#use Date::Calc qw(Delta_DHMS Time_to_Date Date_to_Time);
+
+require Exporter;
+our @ISA = qw(Exporter);
+
+our @EXPORT = qw(
+ _checknstartservice
+ _getcurrentimage
+ _is_user_added
+ _killsysprep
+ _machine_os
+ _pingnode
+ _set_sshd_startmode
+ _sshd_status
+ add_user
+ add_users_by_group
+ changelinuxpassword
+ changewindowspasswd
+ check_blockrequest_time
+ check_connection
+ check_endtimenotice_interval
+ check_ssh
+ check_time
+ check_uptime
+ checkonprocess
+ clearfromblockrequest
+ collectsshkeys
+ construct_image_name
+ controlVM
+ convert_to_datetime
+ convert_to_epoch_seconds
+ database_execute
+ database_select
+ del_user
+ delete_computerloadlog_reservation
+ delete_request
+ disablesshd
+ doesimageexists
+ enablesshd
+ firewall_compare_update
+ format_data
+ get_computer_current_state_name
+ get_highest_imagerevision_info
+ get_image_info
+ get_imagemeta_info
+ get_imagerevision_info
+ get_ip_address_from_hosts
+ get_management_node_blockrequests
+ get_management_node_id
+ get_management_node_info
+ get_management_node_requests
+ get_next_image_default
+ get_production_imagerevision_info
+ get_request_by_computerid
+ get_request_end
+ get_request_info
+ get_reservation_remote_ip
+ get_vmhost_info
+ getanothermachine
+ getdynamicaddress
+ getimagesize
+ getnewdbh
+ getpw
+ getusergroupmembers
+ hostname
+ insert_reload_request
+ insert_request
+ insertloadlog
+ is_inblockrequest
+ is_request_deleted
+ is_request_imaging
+ isconnected
+ isfilelocked
+ kill_reservation_process
+ known_hosts
+ lockfile
+ mail
+ makedatestring
+ monitorloading
+ nmap_port
+ notify
+ notify_via_IM
+ notify_via_msg
+ notify_via_wall
+ preplogfile
+ remotedesktopport
+ rename_vcld_process
+ reservation_being_processed
+ reservations_ready
+ restoresshkeys
+ round
+ run_scp_command
+ run_ssh_command
+ set_hash_process_id
+ set_logfile_path
+ setimageid
+ setpreferredimage
+ setstaticaddress
+ string_to_ascii
+ switch_state
+ switch_vmhost_id
+ system_monitoring
+ time_exceeded
+ timefloor15interval
+ unlockfile
+ update_blockrequest_processing
+ update_cluster_info
+ update_computer_address
+ update_computer_state
+ update_currentimage
+ update_image_name
+ update_lastcheckin
+ update_log_ending
+ update_log_loaded_time
+ update_preload_flag
+ update_request_password
+ update_request_state
+ update_reservation_lastcheck
+ update_sublog_ipaddress
+ virtual_status_unix
+ virtual_status_vm
+ windowsroutetable
+ write_currentimage_txt
+
+ $CONF_FILE_PATH
+ $DATABASE
+ $DEFAULTHELPEMAIL
+ $DEFAULTURL
+ $ETHDEVICE
+ $FQDN
+ $IDENTITY_bladerhel
+ $IDENTITY_wxp
+ $IDENTITY_linux_lab
+ $IDENTITY_solaris_lab
+ $IPCONFIGURATION
+ $jabPass
+ $jabPort
+ $jabResource
+ $jabServer
+ $jabUser
+ $LINUX_IMAGE
+ $LINUX_IMAGEREPOSITORY
+ $LOGFILE
+ $MYSQL_SSL
+ $MYSQL_SSL_CERT
+ $PIDFILE
+ $PROCESSNAME
+ $WINDOWS_ROOT_PASSWORD
+ $SERVER
+ $SYSADMIN
+ $SYSPREP
+ $SYSPREP_2003
+ $TESTING
+ $THROTTLE
+ $TOOLS
+ $VERBOSE
+ $VMWAREREPOSITORY
+ $WRTPASS
+ $WRTUSER
+ %ERRORS
+ %OPTIONS
+
+ $IMAGELIBENABLE
+ $IMAGELIBUSER
+ $IMAGELIBKEY
+ $IMAGESERVERS
+
+ $TOOLS
+ $VMWAREREPOSITORY
+ $SYSPREP_2003
+ $SYSPREP
+ $SYSPREP_VMWARE
+ $SYSPREP_VMWARE2003
+ $VERBOSE
+);
+
+#our %ERRORS=('DEPENDENT'=>4,'UNKNOWN'=>3,'OK'=>0,'WARNING'=>1,'CRITICAL'=>2,'MAILMASTERS'=>5);
+
+BEGIN {
+ #parse config file and set globals
+
+ our ($JABBER, $jabServer, $jabUser, $jabPass, $jabResource, $jabPort) = 0;
+ our ($LOGFILE, $PIDFILE, $PROCESSNAME) = 0;
+ our ($DATABASE, $SERVER, $WRTUSER, $WRTPASS, $LockerRdUser, $rdPass) = 0;
+ our ($SYSADMIN, $SHARED_MAILBOX, $DEFAULTURL, $DEFAULTHELPEMAIL) = 0;
+ our ($XCATROOT) = 0;
+ our ($FQDN) = 0;
+ our ($MYSQL_SSL, $MYSQL_SSL_CERT);
+ our ($IPCONFIGURATION, $DNSserver, $GATEWAY, $NETMASK, $ETHDEVICE) = 0;
+ our ($LINUX_IMAGE, $THROTTLE);
+ our ($CORE_IMAGEREPOSITORY, $WIN_IMAGEREPOSITORY, $LINUX_IMAGEREPOSITORY);
+ our ($IDENTITY_linux_lab, $IDENTITY_solaris_lab, $IDENTITY_wxp, $IDENTITY_newwxp, $IDENTITY_bladerhel);
+ our ($IMAGELIBENABLE) = 0;
+ our ($IMAGESERVERS, $IMAGELIBUSER, $IMAGELIBKEY);
+ our ($VMWARETYPE, $VMWARE_DISK);
+ our ($WINDOWS_ROOT_PASSWORD);
+
+ # Set Getopt pass_through so this module doesn't erase parameters that other modules may use
+ Getopt::Long::Configure('pass_through');
+
+ # Set the VERBOSE flag to 0 by default
+ our ($VERBOSE) = 0;
+
+ # Set the TESTING flag to 0 by default
+ our ($TESTING) = 0;
+
+ # Use the default configuration file path if -conf isn't specified on the command line
+ our $BIN_PATH = $FindBin::Bin;
+ print STDOUT "BIN PATH: $BIN_PATH\n";
+ our ($CONF_FILE_PATH) = 'C:/vcldev.conf';
+ if (!-f $CONF_FILE_PATH) {
+ if ($BIN_PATH =~ /dev/) {
+ $CONF_FILE_PATH = "/etc/vcl/vcldev.conf";
+ }
+ else {
+ $CONF_FILE_PATH = "/etc/vcl/vcld.conf";
+ }
+ }
+
+ # Store the command line options in this hash
+ our %OPTIONS;
+
+ GetOptions(\%OPTIONS, 'verbose', 'testing', 'config=s', 'logfile=s');
+
+ # Get the command line parameters
+ $CONF_FILE_PATH = $OPTIONS{config} if (defined($OPTIONS{config} && $OPTIONS{config}));
+
+ print STDOUT "pre-execution: config file being used: $CONF_FILE_PATH\n";
+
+ if (open(CONF, $CONF_FILE_PATH)) {
+ my @conf = <CONF>;
+ close(CONF);
+ foreach my $l (@conf) {
+ # Remove all new line and carriage return characters from the end of the line
+ # Chomp doesn't always remove carriage returns
+ $l =~ s/[\r\n]*$//;
+
+ #logfile
+ if ($l =~ /^log=(.*)/ && (!defined($LOGFILE) || !($LOGFILE))) {
+ chomp($l);
+ $LOGFILE = $1;
+ }
+ #pidfile
+ if ($l =~ /^pidfile=(.*)/) {
+ chomp($l);
+ $PIDFILE = $1;
+ }
+
+ if ($l =~ /^DEFAULTURL=(.*)/) {
+ $DEFAULTURL = $1;
+ }
+
+ if ($l =~ /^DEFAULTHELPEMAIL=(.*)/) {
+ $DEFAULTHELPEMAIL = $1;
+ }
+
+ #FQDN - to many issues trying to figure out my FQDN so just tell me
+ if ($l =~ /^FQDN=([-.a-zA-Z0-9]*)/) {
+ $FQDN = $1;
+ }
+
+ #mysql settings
+ #name of db
+ if ($l =~ /^database=([a-zA-Z0-9]*)/) {
+ $DATABASE = $1;
+ }
+ #name of database server
+ if ($l =~ /^server=([.a-zA-Z0-9]*)/) {
+ $SERVER = $1;
+ }
+ #write user name
+ if ($l =~ /^LockerWrtUser=([-a-zA-Z0-9]*)/) {
+ $WRTUSER = $1;
+ }
+
+ #write user password
+ #if($l =~ /^wrtPass=([-a-zA-Z0-9]*)/){
+ if ($l =~ /^wrtPass=(.*)/) {
+ $WRTPASS = $1;
+ }
+
+ #read user name
+ if ($l =~ /^LockerRdUser=([-a-zA-Z0-9]*)/) {
+ $LockerRdUser = $1;
+ }
+
+ #read user password
+ if ($l =~ /^rdPass=(.*)/) {
+ $rdPass = $1;
+ }
+ #is mysql ssl option enabled
+ if ($l =~ /^enable_mysql_ssl=(yes)/) {
+ $MYSQL_SSL = 1;
+ }
+ elsif ($l =~ /^enable_mysql_ssl=(no)/) {
+ $MYSQL_SSL = 0;
+ }
+
+ #collect path to cert -- only valid if $MYSQL_SSL is true
+ if ($l =~ /^mysql_ssl_cert=(.*)/) {
+ $MYSQL_SSL_CERT = $1;
+ }
+
+ #ipconfiguration
+ if ($l =~ /^ipconfiguration=(static|manualDHCP|dynamicDHCP)/) {
+ $IPCONFIGURATION = $1;
+ }
+
+ if ($l =~ /^DNSserver=([,.0-9]*)/) {
+ $DNSserver = $1;
+ }
+ if ($l =~ /^GATEWAY=([.0-9]*)/) {
+ $GATEWAY = $1;
+ }
+ if ($l =~ /^NETMASK=([.0-9]*)/) {
+ $NETMASK = $1;
+ }
+ if ($l =~ /^ETHDEVICE=(eth[0-9])/) {
+ $ETHDEVICE = $1;
+ }
+ #Sysadmin list
+ if ($l =~ /^sysadmin=([,.\@a-zA-Z0-9]*)/) {
+ $SYSADMIN = $1;
+ }
+
+ #sharedmailbox
+ if ($l =~ /^sharedmailbox=([,-.\@a-zA-Z0-9]*)/) {
+ $SHARED_MAILBOX = $1;
+ }
+
+ #jabber - stuff
+ if ($l =~ /^jabber=(yes)/) {
+ $JABBER = 1;
+ }
+ if ($l =~ /^jabber=(no)/) {
+ $JABBER = 0;
+ }
+ #collect remaining pieces of the jabber settings
+ #$jabServer,$jabUser,$jabPass,$jabResource,$jabPort
+ if ($l =~ /^jabServer=([.a-zA-Z0-9]*)/) {
+ $jabServer = $1;
+ }
+ if ($l =~ /^jabPort=([0-9]*)/) {
+ $jabPort = $1;
+ }
+ if ($l =~ /^jabUser=([.a-zA-Z0-9]*)/) {
+ $jabUser = $1;
+ }
+ if ($l =~ /^jabPass=([a-zA-Z0-9]*)/) {
+ $jabPass = $1;
+ }
+ if ($l =~ /^jabResource=([a-zA-Z0-9]*)/) {
+ $jabResource = $1;
+ }
+
+ #process name
+ if ($l =~ /^processname=([-_a-zA-Z0-9]*)/) {
+ $PROCESSNAME = $1;
+ }
+
+ #xcat linux image path
+ # linux kernal 2.4 - we had to modify xcat to load from seperate install tree.
+ if ($l =~ /^LINUXIMAGEid=(image|linux_image)/) {
+ $LINUX_IMAGE = $1;
+ }
+
+ #Linux_imagerepository
+ if ($l =~ /^LINUX_IMAGEREPOSITORY=([\/a-zA-Z0-9]*)/) {
+ $LINUX_IMAGEREPOSITORY = $1;
+ }
+
+ #throttle
+ if ($l =~ /^THROTTLE=([0-9]*)/) {
+ $THROTTLE = $1;
+ }
+
+ #ssh private keys
+ if ($l =~ /^IDENTITY_blade_linux=(.*)/) {
+ $IDENTITY_bladerhel = $1;
+ }
+ if ($l =~ /^IDENTITY_blade_win=(.*)/) {
+ $IDENTITY_wxp = $1;
+ }
+ if ($l =~ /^IDENTITY_solaris_lab=(.*)/) {
+ $IDENTITY_solaris_lab = $1;
+ }
+ if ($l =~ /^IDENTITY_linux_lab=(.*)/) {
+ $IDENTITY_linux_lab = $1;
+ }
+
+ #image library share - sync images across multiple management nodes
+ # $IMAGELIBENABLE,$IMAGESERVERS,$IMAGELIBUSER,$IMAGELIBKEY
+ if ($l =~ /^IMAGELIBENABLE=(yes)/) {
+ $IMAGELIBENABLE = 1;
+ }
+ elsif ($l =~ /^IMAGELIBENABLE=(no)/) {
+ $IMAGELIBENABLE = 0;
+ }
+ if ($l =~ /^imageservers=(.*)/) {
+ $IMAGESERVERS = $1;
+ }
+ if ($l =~ /^imagelibuser=([a-z0-9]*)/) {
+ $IMAGELIBUSER = $1;
+ }
+ if ($l =~ /^imagelibuser=([-a-zA-Z0-9]*)/) {
+ $IMAGELIBUSER = $1;
+ }
+ if ($l =~ /^imagelibidkey=(.*)/) {
+ $IMAGELIBKEY = $1;
+ }
+ #vmware settings
+ # localdisk
+ if ($l =~ /^VMWARE_DISK=(localdisk|networkdisk)/) {
+ $VMWARE_DISK = $1;
+ }
+
+ if ($l =~ /^windows_root_password=(.*)/i) {
+ $WINDOWS_ROOT_PASSWORD = $1;
+ }
+
+ if ($l =~ /^verbose=(.*)/i) {
+ $VERBOSE = $1;
+ }
+
+ if ($l =~ /^test=(.*)/i) {
+ $TESTING = $1;
+ }
+ } # Close foreach line in conf file
+ } # Close open conf file
+
+ else {
+ die "VCLD : $CONF_FILE_PATH does not exist, exiting -- $! \n";
+ }
+
+ if (!$PROCESSNAME) {
+ $PROCESSNAME = "vcld";
+ }
+ if (!($LOGFILE) && $LOGFILE ne '0') {
+ #set default
+ $LOGFILE = "/var/log/$PROCESSNAME.log";
+ }
+
+ if (!$THROTTLE) {
+ $THROTTLE = 0;
+ }
+
+ if (!$IDENTITY_bladerhel) {
+
+ }
+ if (!$IDENTITY_wxp) {
+
+ }
+ if (!$IDENTITY_solaris_lab) {
+ }
+ if (!$IDENTITY_linux_lab) {
+ }
+
+ if (!$WINDOWS_ROOT_PASSWORD) {
+ $WINDOWS_ROOT_PASSWORD = "clOudy";
+ }
+
+ if (!($FQDN)) {
+ print STDOUT "FQDN is not listed\n";
+ }
+ if (!($PIDFILE)) {
+ #set default
+ $PIDFILE = "/var/run/$PROCESSNAME.pid";
+ }
+ if (!$IPCONFIGURATION) {
+ #default
+ $IPCONFIGURATION = "manualDHCP";
+ }
+ elsif ($IPCONFIGURATION eq "static") {
+ #check for dependiencies
+ if (!$DNSserver) {
+ print STDOUT "pre-execution: ipconfiguration is $IPCONFIGURATION dnsserver setting is missing in configuration file\n";
+ }
+ if (!$GATEWAY) {
+ print STDOUT "pre-execution: ipconfiguration is $IPCONFIGURATION gateway setting is missing in configuration file\n";
+ }
+ if (!$NETMASK) {
+ print STDOUT "pre-execution: ipconfiguration is $IPCONFIGURATION netmask setting is missing in configuration file\n";
+ }
+ } ## end elsif ($IPCONFIGURATION eq "static") [ if (!$IPCONFIGURATION)
+
+ if (!$LINUX_IMAGE) {
+ $LINUX_IMAGE = "image";
+ }
+
+ if ($JABBER) {
+ #jabber is enabled - import required jabber module
+ # todo - check if Jabber module is installed
+ # i.e. perl -MNet::Jabber -e1
+ # check version -- perl -MNet::Jabber -e'print $Net::Jabber::VERSION\n";'
+ require "Net/Jabber.pm";
+ import Net::Jabber qw(client);
+ }
+
+ # Get the remaining command line parameters
+ $VERBOSE = $OPTIONS{verbose} if (defined($OPTIONS{verbose} && $OPTIONS{verbose}));
+ $TESTING = $OPTIONS{testing} if (defined($OPTIONS{testing} && $OPTIONS{testing}));
+ $LOGFILE = $OPTIONS{logfile} if (defined($OPTIONS{logfile} && $OPTIONS{logfile}));
+
+ print STDOUT "pre-execution: process name is set to: $PROCESSNAME\n";
+ print STDOUT "pre-execution: verbose mode is set to: $VERBOSE\n";
+ print STDOUT "pre-execution: testing mode is set to: $TESTING\n";
+ print STDOUT "pre-execution: log file being used: $LOGFILE\n";
+ print STDOUT "pre-execution: PID file being used: $PIDFILE\n";
+} ## end BEGIN
+
+
+#use Net::Jabber qw(Client);
+our ($JABBER, $PROCESSNAME);
+our %ERRORS = ('DEPENDENT' => 4, 'UNKNOWN' => 3, 'OK' => 0, 'WARNING' => 1, 'CRITICAL' => 2, 'MAILMASTERS' => 5, 'DEBUG' => 6);
+our ($LockerWrtUser, $wrtPass, $database, $server);
+our ($jabServer, $jabUser, $jabPass, $jabResource, $jabPort);
+our ($vcldquerykey, $SYSADMIN, $SHARED_MAILBOX, $DEFAULTURL, $DEFAULTHELPEMAIL);
+our ($LOGFILE, $PIDFILE, $VCLDRPCQUERYKEY);
+our ($SERVER, $DATABASE, $WRTUSER, $WRTPASS);
+our ($MYSQL_SSL, $MYSQL_SSL_CERT);
+our ($IPCONFIGURATION, $DNSserver, $GATEWAY, $NETMASK, $ETHDEVICE);
+our ($LINUX_IMAGE, $THROTTLE);
+our ($FQDN);
+our ($IDENTITY_linux_lab, $IDENTITY_solaris_lab, $IDENTITY_wxp, $IDENTITY_bladerhel);
+our ($IMAGELIBENABLE, $IMAGESERVERS, $IMAGELIBUSER, $IMAGELIBKEY);
+our ($VMWARE_DISK);
+our $IDENTITY_newwxp = "$FindBin::Bin/../lib/VCL/newwinxp_blade.key";
+our $XCATROOT = "/opt/xcat";
+our $TOOLS = "$FindBin::Bin/../tools";
+our $VMWAREREPOSITORY = "/install/vmware_images";
+our $SYSPREP_2003 = "$TOOLS/Sysprep_2003";
+our $SYSPREP = "$TOOLS/Sysprep";
+our $SYSPREP_VMWARE = "$TOOLS/Sysprep_vmware";
+our $SYSPREP_VMWARE2003 = "$TOOLS/Sysprep_vmware2003";
+our $VERBOSE;
+our $TESTING;
+our $CONF_FILE_PATH;
+our $WINDOWS_ROOT_PASSWORD;
+
+sub makedatestring;
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 preplogfile
+
+ Parameters : nothing
+ Returns : nothing
+ Description : writes header to global log file
+
+=cut
+
+sub preplogfile {
+ my $currenttime = makedatestring();
+ my ($package, $filename, $line, $sub) = caller(0);
+ $filename =~ s(^.*/)(); #remove leading path from filename
+ # print initial info to log file
+ print STDERR "===========================================================\n";
+ print STDERR "OUTPUT for $filename run on $currenttime\n";
+ print STDERR "===========================================================\n";
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 notify
+
+ Parameters : $error, $LOG, $string, $data
+ Returns : nothing
+ Description : based on error value write string and/or data to
+ provide or default log file
+=cut
+
+sub notify {
+ my $error = shift;
+ my $LOG = shift;
+ my $string = shift;
+ my @data = @_;
+
+ # Just return if DEBUG and verbose isn't enabled
+ return if ($error == 6 && !$VERBOSE);
+
+ # Get the current time
+ my $currenttime = makedatestring();
+
+ # Redirect STDOUT and STDERR to the log file
+ $LOG = $LOGFILE if (!$LOG);
+ open(STDOUT, ">>$LOG") if $LOG;
+ open(STDERR, ">>$LOG") if $LOG;
+
+ # Get info about the subroutine which called this subroutine
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Remove leading path from filename
+ $filename =~ s/.*\///;
+
+ # Remove the leading package path from the sub name (VC::...)
+ $sub =~ s/.*:://;
+
+ # Assemble the caller information
+ my $caller_info;
+ if (caller(1)) {
+ my ($caller_previous_package, $caller_previous_filename, $caller_previous_line, $caller_previous_sub) = caller(1);
+ $caller_previous_filename =~ s/.*\///;
+ $caller_previous_sub =~ s/.*:://;
+ $caller_info = "$filename:$caller_previous_sub($line)";
+ }
+ else {
+ $caller_info = "$filename:$sub($line)";
+ }
+
+ # Get the caller trace information
+ my $caller_trace = get_caller_trace(6);
+
+
+ # Format the message string
+ # Remove Windows carriage returns from the message string for consistency
+ $string =~ s/\r//g;
+
+ # Remove newlines from the beginning and end of the message string
+ $string =~ s/^\n+//;
+ $string =~ s/\n+$//;
+
+ # Remove any spaces from the beginning or end of the string
+ $string =~ s/^\s+//;
+ $string =~ s/\s+$//;
+
+ # Replace consecutive spaces with a single space to keep log file concise as long as string doesn't contain a quote
+ if ($string !~ /[\'\"]/gs) {
+ $string =~ s/[ \t]+/ /gs;
+ }
+
+ # Assemble the process identifier string
+ my $process_identifier = $PID;
+ $process_identifier .= "|$ENV{request_id}:$ENV{reservation_id}" if (defined $ENV{request_id} && defined $ENV{reservation_id});
+ $process_identifier .= "|$ENV{state}" if (defined $ENV{state});
+
+ # Assemble the log message
+ my $log_message = "$currenttime|$process_identifier|$caller_info|$string";
+
+ # Format the data if WARNING or CRITICAL, and @data was passed
+ my $formatted_data;
+ if (@data && ($error == 1 || $error == 2)) {
+ # Add the data to the message body if it was passed
+ $formatted_data = "DATA:\n" . format_data(\@data, 'DATA');
+ chomp $formatted_data;
+ }
+
+ # Assemble an email message body if CRITICAL or MAILMASTERS
+ my $body;
+ if ($error == 2 || ($error == 5 && $SHARED_MAILBOX)) {
+ # Get the previous several log file entries for this process
+ my $log_history_count = 100;
+ my $log_history = "RECENT LOG ENTRIES FOR THIS PROCESS:\n";
+ $log_history .= `grep "|$PID|" $LOG | tail -n $log_history_count`;
+ chomp $log_history;
+
+ # Assemble the e-mail message body
+ $body = <<"END";
+$string
+
+Time: $currenttime
+PID: $PID
+Caller: $caller_info
+
+$caller_trace
+
+$log_history
+END
+
+ # Add the formatted data to the message body if data was passed
+ $body .= "\n\n$formatted_data\n" if $formatted_data;
+ } ## end if ($error == 2 || ($error == 5 && $SHARED_MAILBOX...
+
+
+ # OK, VERBOSE
+ if (!$error || ($error == 6 && $VERBOSE)) {
+
+ }
+
+ # WARNING
+ if ($error == 1) {
+ $log_message = "\n---- WARNING ---- \n$log_message\n$caller_trace\n\n";
+ }
+
+ # CRITICAL
+ elsif ($error == 2) {
+ $log_message = "\n---- CRITICAL ---- \n$log_message\n$caller_trace\n";
+ $log_message .= "$formatted_data\n" if $formatted_data;
+ $log_message .= "\n";
+
+ my $from = "root\@$FQDN";
+ my $to = $SYSADMIN;
+ my $subject = "PROBLEM -- $filename";
+ mail($to, $subject, $body, $from);
+ } ## end elsif ($error == 2) [ if ($error == 1)
+
+ # MAILMASTERS - only for email notifications
+ elsif ($error == 5 && $SHARED_MAILBOX) {
+ my $to = $SHARED_MAILBOX;
+ my $from = "root\@$FQDN";
+ my $subject = "Informational -- $filename";
+ mail($to, $subject, $body, $from);
+ }
+
+ # Add the process identifier to every line of the log message
+ chomp $log_message;
+ $log_message =~ s/\n([^\n])/\n|$process_identifier| $1/g;
+
+ # Print the log message to the log file
+ print STDOUT "$log_message\n";
+
+} ## end sub notify
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 makedatestring
+
+ Parameters : empty
+ Returns : current time in date_time format
+ Description :
+
+=cut
+
+sub makedatestring {
+ my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime();
+ $year += 1900;
+ $mon++;
+ my $datestring = sprintf("%04d-%02d-%02d %02d:%02d:%02d", $year, $mon, $mday, $hour, $min, $sec);
+ return $datestring;
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 convert_to_datetime
+
+ Parameters : time in epoch format
+ Returns : date in datetime format
+ Description : accepts time in epoch format (10 digit) and
+ returns time in datetime format
+
+=cut
+
+sub convert_to_datetime {
+ my ($epochtime) = shift;
+
+ if (!defined($epochtime) || $epochtime == 0) {
+ $epochtime = time();
+ }
+
+ my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($epochtime);
+ $year += 1900;
+ $mon++;
+ my $datestring = sprintf("%04d-%02d-%02d %02d:%02d:%02d", $year, $mon, $mday, $hour, $min, $sec);
+ return $datestring;
+
+} ## end sub convert_to_datetime
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 convert_to_epoch_seconds
+
+ Parameters : datetime
+ Returns : time in epoch format
+ Description : takes input(optional) and returns epoch 10 digit string of
+ the supplied date_time or the current time
+
+=cut
+
+sub convert_to_epoch_seconds {
+ my ($date_time) = shift;
+ if (!defined($date_time)) {
+ return time();
+ }
+ #somehow we got a null timestamp, set it to current time
+ if ($date_time =~ /0000-00-00 00:00:00/) {
+ $date_time = makedatestring;
+ }
+
+ #format received: year-mon-mday hr:min:sec
+ my ($vardate, $vartime) = split(/ /, $date_time);
+ my ($yr, $mon, $mday) = split(/-/, $vardate);
+ my ($hr, $min, $sec) = split(/:/, $vartime);
+ $mon = $mon - 1; #time uses 0-11 for months :(
+ my $epoch_time = timelocal($sec, $min, $hr, $mday, $mon, $yr);
+ return $epoch_time;
+} ## end sub convert_to_epoch_seconds
+
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 check_endtimenotice_interval
+
+ Parameters : endtime
+ Returns : scalar: 2week, 1week, 2day, 1day, 30min, or 0
+ Description : used to send a notice to owner regarding how far out the end of
+ their reservation is
+
+=cut
+
+sub check_endtimenotice_interval {
+ my $end = $_[0];
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "endtime not set") if (!defined($end));
+ my $now = time();
+ my $epochend = convert_to_epoch_seconds($end);
+ #flag on: 2 & 1 week; 2,1 day, 1 hour, 30,15,10,5 minutes
+ #2 week: between 14 days and a 14 day -15 minutes window
+ if ($epochend <= (14 * 60 * 60 * 24) && $epochend >= (14 * 60 * 60 * 24 - 15 * 60)) {
+ return (1, "2week");
+ }
+ #1 week: between 7 days and a 14 day -15 minute window
+ elsif ($epochend <= (7 * 60 * 60 * 24) && $epochend >= (7 * 60 * 60 * 24 - 15 * 60)) {
+ return (1, "1week");
+ }
+ #2 day: between 2 days and a 2 day -15 minute window
+ if ($epochend <= (2 * 60 * 60 * 24) && $epochend >= (2 * 60 * 60 * 24 - 15 * 60)) {
+ return (1, "2day");
+ }
+ #1 day: between 1 days and a 1 day -15 minute window
+ if ($epochend <= (1 * 60 * 60 * 24) && $epochend >= (1 * 60 * 60 * 24 - 15 * 60)) {
+ return (1, "1day");
+ }
+ #30-25 minutes
+ if ($epochend <= (30 * 60) && $epochend >= (25 * 60)) {
+ return (1, "30min");
+ }
+} ## end sub check_endtimenotice_interval
+#sub new_check_endtimenotice_interval {
+# my ($request_end, $base_time) = @_;
+# my ($package, $filename, $line, $sub) = caller(0);
+#
+# # Check the parameter
+# if (!defined($request_end)) {
+# notify($ERRORS{'WARNING'}, 0, "request end time was not specified"");
+# return 0;
+# }
+# elsif (!$request_end) {
+# notify($ERRORS{'WARNING'}, 0, "request end time was specified but is blank"");
+# return 0;
+# }
+#
+# # Convert the request end time to epoch seconds
+# my $end_epoch_seconds = convert_to_epoch_seconds($request_end);
+#
+# # This is only used for testing
+# my @now;
+# if ($base_time) {
+# my $base_epoch_seconds = convert_to_epoch_seconds($base_time);
+# @now = Time_to_Date($base_epoch_seconds);
+# }
+# else {
+# @now = Time_to_Date();
+# }
+#
+# # Get arrays from the Date::Calc::Time_to_Date functions for now and the end time
+# my @end = Time_to_Date($end_epoch_seconds);
+#
+# # Calculate the difference
+# my ($days, $hours, $minutes, $seconds) = Delta_DHMS(@now, @end);
+#
+# # Return a value on: 2 & 1 week; 2,1 day, 1 hour, 30,15,10,5 minutes
+# my $return_value = 0;
+#
+# # Ignore: over 14 days away
+# if ($days >= 14){
+# $return_value = 0;
+# }
+# # 2 week notice: between 14 days and a 14 day - 15 minute window
+# elsif ($days >= 13 && $hours >= 23 && $minutes >= 45){
+# $return_value = "2 weeks";
+# }
+# # Ignore: between 7 days and 14 day - 15 minute window
+# elsif ($days >= 7) {
+# $return_value = 0;
+# }
+# # 1 week notice: between 7 days and a 7 day -15 minute window
+# elsif ($days >= 6 && $hours >= 23 && $minutes >= 45) {
+# $return_value = "1 week";
+# }
+# # Ignore: between 2 days and 7 day - 15 minute window
+# elsif ($days >= 2) {
+# $return_value = 0;
+# }
+# # 2 day notice: between 2 days and a 2 day -15 minute window
+# elsif($days >= 1 && $hours >= 23 && $minutes >= 45) {
+# $return_value = "2 days";
+# }
+# # Ignore: between 1 days and 2 day - 15 minute window
+# elsif ($days >= 1) {
+# $return_value = 0;
+# }
+# # 1 day notice: between 1 days and a 1 day -15 minute window
+# elsif($days >= 0 && $hours >= 23 && $minutes >= 45) {
+# $return_value = "1 day";
+# }
+# #30-25 minutes
+# elsif ($minutes >= 25 && $minutes <= 30) {
+# $return_value = "30 minutes";
+# }
+
+# notify($ERRORS{'OK'}, 0, "days: time difference is days:$days hours:$hours minutes:$minutes, returning $return_value");
+# return $return_value;
+#}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 check_blockrequest_time
+
+ Parameters : start, end, and expire times
+ Returns : 0 or 1 and task
+ Description : check current time against all three tasks
+ expire time overides end, end overrides start
+
+=cut
+
+sub check_blockrequest_time {
+ my ($start_datetime, $end_datetime, $expire_datetime) = @_;
+
+ # Check the arguments
+ if (!$start_datetime) {
+ notify($ERRORS{'WARNING'}, 0, "start time argument was not passed correctly");
+ return;
+ }
+ if (!$end_datetime) {
+ notify($ERRORS{'WARNING'}, 0, "end time argument was not passed correctly");
+ return;
+ }
+ if (!$expire_datetime) {
+ notify($ERRORS{'WARNING'}, 0, "expire time argument was not passed correctly");
+ return;
+ }
+
+ # Get the current time in epoch seconds
+ my $current_time_epoch_seconds = time();
+
+ my $expire_time_epoch_seconds = convert_to_epoch_seconds($expire_datetime);
+ my $expire_delta_minutes = int(($expire_time_epoch_seconds - $current_time_epoch_seconds) / 60);
+ #notify($ERRORS{'DEBUG'}, 0, "expire: $expire_datetime, epoch: $expire_time_epoch_seconds, delta: $expire_delta_minutes minutes");
+
+ # If expire time is in the past, remove it
+ if ($expire_delta_minutes < 0) {
+ # Block request has expired
+ notify($ERRORS{'OK'}, 0, "block request expired " . abs($expire_delta_minutes) . " minutes ago, returning 'expire'");
+ return "expire";
+ }
+
+ if ($start_datetime =~ /^-?\d*$/ || $end_datetime =~ /^-?\d*$/) {
+ notify($ERRORS{'DEBUG'}, 0, "block request is not expired but has no block times assigned to it, returning 0");
+ return 0;
+ }
+
+ # Convert the argument datetimes to epoch seconds for easy calculation
+ my $start_time_epoch_seconds = convert_to_epoch_seconds($start_datetime);
+ my $end_time_epoch_seconds = convert_to_epoch_seconds($end_datetime);
+
+ # Calculate # of seconds away start, end, and expire times are from now
+ # Positive value means time is in the future
+ my $start_delta_minutes = int(($start_time_epoch_seconds - $current_time_epoch_seconds) / 60);
+ my $end_delta_minutes = int(($end_time_epoch_seconds - $current_time_epoch_seconds) / 60);
+
+ #notify($ERRORS{'DEBUG'}, 0, "start: $start_datetime, epoch: $start_time_epoch_seconds, delta: $start_delta_minutes minutes");
+ #notify($ERRORS{'DEBUG'}, 0, "end: $end_datetime, epoch: $end_time_epoch_seconds, delta: $end_delta_minutes minutes");
+
+ # 4:00 to 4:15 hours in advance: start assigning resources
+ if ($start_delta_minutes >= (4 * 60) && $start_delta_minutes <= (4 * 60 + 10)) {
+ # Block request within start window
+ notify($ERRORS{'OK'}, 0, "block request start time is within start window ($start_delta_minutes minutes from now), returning 'start'");
+ return "start";
+ }
+
+ # 2:00 to 2:15 hours in advance: start assigning resources
+ if ($start_delta_minutes >= (2 * 60) && $start_delta_minutes <= (2 * 60 + 10)) {
+ # Block request within start window
+ notify($ERRORS{'OK'}, 0, "block request start time is within start window ($start_delta_minutes minutes from now), returning 'start'");
+ return "start";
+ }
+
+ # End time it is less than 1 minute
+ if ($end_delta_minutes < 0) {
+ # Block request end time is near
+ notify($ERRORS{'OK'}, 0, "block request end time has been reached ($end_delta_minutes minutes from now), returning 'end'");
+ return "end";
+ }
+
+ #notify($ERRORS{'DEBUG'}, 0, "block request does not need to be processed now, returning 0");
+ return 0;
+
+} ## end sub check_blockrequest_time
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 check_time
+
+ Parameters : $request_start, $request_end, $reservation_lastcheck, $request_state_name, $request_laststate_name
+ Returns : start, preload, end, poll, old, remove, or 0
+ Description : based on the input return a value used by vcld
+=cut
+
+sub check_time {
+ my ($request_start, $request_end, $reservation_lastcheck, $request_state_name, $request_laststate_name) = @_;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the arguments
+ if (!defined($request_state_name)) {
+ notify($ERRORS{'WARNING'}, 0, "\$request_state_name argument is not defined");
+ return 0;
+ }
+ if (!defined($request_laststate_name)) {
+ notify($ERRORS{'WARNING'}, 0, "\$request_laststate_name argument is not defined");
+ return 0;
+ }
+
+ # If lastcheck isn't set, set it to now
+ if (!defined($reservation_lastcheck) || !$reservation_lastcheck) {
+ $reservation_lastcheck = makedatestring();
+ }
+
+ # First convert to datetime in case epoch seconds was passed
+ if ($reservation_lastcheck !~ /\d{4}-\d{2}-\d{2}\s\d{2}:\d{2}:\d{2}/) {
+ $reservation_lastcheck = convert_to_datetime($reservation_lastcheck);
+ }
+ if ($request_end !~ /\d{4}-\d{2}-\d{2}\s\d{2}:\d{2}:\d{2}/) {
+ $request_end = convert_to_datetime($request_end);
+ }
+ if ($request_start !~ /\d{4}-\d{2}-\d{2}\s\d{2}:\d{2}:\d{2}/) {
+ $request_start = convert_to_datetime($request_start);
+ }
+
+ # Convert times to epoch seconds
+ my $lastcheck_epoch_seconds = convert_to_epoch_seconds($reservation_lastcheck);
+ my $start_time_epoch_seconds = convert_to_epoch_seconds($request_start);
+ my $end_time_epoch_seconds = convert_to_epoch_seconds($request_end);
+
+ # Get the current time epoch seconds
+ my $current_time_epoch_seconds = time();
+
+ # Calculate time differences from now in seconds
+ # These will be positive if in the future, negative if in the past
+ my $lastcheck_diff_seconds = $lastcheck_epoch_seconds - $current_time_epoch_seconds;
+ my $start_diff_seconds = $start_time_epoch_seconds - $current_time_epoch_seconds;
+ my $end_diff_seconds = $end_time_epoch_seconds - $current_time_epoch_seconds;
+
+ # Calculate the time differences from now in minutes
+ # These will be positive if in the future, negative if in the past
+ my $lastcheck_diff_minutes = round($lastcheck_diff_seconds / 60);
+ my $start_diff_minutes = round($start_diff_seconds / 60);
+ my $end_diff_minutes = round($end_diff_seconds / 60);
+
+ # Print the time differences
+ #notify($ERRORS{'OK'}, 0, "reservation lastcheck difference: $lastcheck_diff_minutes minutes");
+ #notify($ERRORS{'OK'}, 0, "request start time difference: $start_diff_minutes minutes");
+ #notify($ERRORS{'OK'}, 0, "request end time difference: $end_diff_minutes minutes");
+
+ # Check the state, and then figure out the return code
+ if ($request_state_name =~ /new|imageprep|reload|tomaintenance|tovmhostinuse/) {
+ if ($start_diff_minutes > 0) {
+ # Start time is either now or in future, $start_diff_minutes is positive
+
+ if ($start_diff_minutes > 35) {
+ #notify($ERRORS{'DEBUG'}, 0, "reservation will start in more than 35 minutes ($start_diff_minutes)");
+ return "0";
+ }
+ elsif ($start_diff_minutes >= 25 && $start_diff_minutes <= 35) {
+ notify($ERRORS{'DEBUG'}, 0, "reservation will start in 25-35 minutes ($start_diff_minutes)");
+ return "preload";
+ }
+ else {
+ #notify($ERRORS{'DEBUG'}, 0, "reservation will start less than 25 minutes ($start_diff_minutes)");
+ return "0";
+ }
+ } ## end if ($start_diff_minutes > 0)
+ else {
+ # Start time is in past, $start_diff_minutes is negative
+
+ if ($start_diff_minutes >= -17) {
+ notify($ERRORS{'DEBUG'}, 0, "reservation start time was in the past 17 minutes ($start_diff_minutes)");
+ return "start";
+ }
+ else {
+ notify($ERRORS{'DEBUG'}, 0, "reservation start time was more than 17 minutes ago ($start_diff_minutes)");
+ return "old";
+ }
+ } ## end else [ if ($start_diff_minutes > 0)
+ } ## end if ($request_state_name =~ /new|imageprep|reload|tomaintenance|tovmhostinuse/)
+
+ elsif ($request_state_name =~ /inuse|imageinuse/) {
+ if ($end_diff_minutes <= 10) {
+ #notify($ERRORS{'DEBUG'}, 0, "reservation will end in 10 minutes or less ($end_diff_minutes)");
+ return "end";
+ }
+ else {
+ # End time is more than 10 minutes in the future
+ #notify($ERRORS{'DEBUG'}, 0, "reservation will end in more than 10 minutes ($end_diff_minutes)");
+
+ if ($lastcheck_diff_minutes <= -5) {
+ #notify($ERRORS{'DEBUG'}, 0, "reservation was last checked more than 5 minutes ago ($lastcheck_diff_minutes)");
+ return "poll";
+ }
+ else {
+ #notify($ERRORS{'DEBUG'}, 0, "reservation has been checked within the past 5 minutes ($lastcheck_diff_minutes)");
+ return 0;
+ }
+ } ## end else [ if ($end_diff_minutes <= 10)
+ } ## end elsif ($request_state_name =~ /inuse|imageinuse/) [ if ($request_state_name =~ /new|imageprep|reload|tomaintenance|tovmhostinuse/)
+
+ elsif ($request_state_name =~ /complete|failed/) {
+ # Don't need to keep requests in database if laststate was...
+ if ($request_laststate_name =~ /image|deleted|makeproduction|reload|tomaintenance|tovmhostinuse/) {
+ return "remove";
+ }
+
+ if ($end_diff_minutes < 0) {
+ notify($ERRORS{'DEBUG'}, 0, "reservation end time was in the past ($end_diff_minutes)");
+ return "remove";
+ }
+ else {
+ # End time is now or in the future
+ #notify($ERRORS{'DEBUG'}, 0, "reservation end time is either right now or in the future ($end_diff_minutes)");
+ return "0";
+ }
+ } # Close if state is complete or failed
+
+ # Just return start for all other states
+ else {
+ return "start";
+ }
+
+} ## end sub check_time
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 time_exceeded
+
+ Parameters : $time_slice, $limit
+ Returns : 1(success) or 0(failure)
+ Description : preform a difference check,
+ if delta of now and input $time_slice
+ is less than input $limit return 1(true)
+=cut
+
+sub time_exceeded {
+
+ my ($time_slice, $limit) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ my $now = time();
+ my $diff = $now - $time_slice;
+ if ($diff > ($limit * 60)) {
+ #time exceeded
+ return 1;
+ }
+ else {
+ return 0;
+ }
+} ## end sub time_exceeded
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 mail
+
+ Parameters : $to, $subject, $mailstring, $from
+ Returns : 1(success) or 0(failure)
+ Description : send an email
+=cut
+
+sub mail {
+ my ($to, $subject, $mailstring, $from) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Mail::Mailer relies on sendmail as written, this causes a "die" on Windows
+ # TODO: Reqork this subroutine to not rely on sendmail
+ my $osname = lc($^O);
+ if ($osname =~ /win/i) {
+ notify($ERRORS{'OK'}, 0, "sending mail from Windows not yet supported\n-----\nTo: $to\nSubject: $subject\nFrom: $from\n$mailstring\n-----");
+ return;
+ }
+
+ # Wrap text for lines longer than 72 characters
+ #$Text::Wrap::columns = 72;
+ #$mailstring = wrap('', '', $mailstring);
+
+ # compare requestor and owner, if same only mail one
+ if (!(defined($from))) {
+ $from = "vcl_help\@ncsu.edu";
+ }
+ my $mailer = Mail::Mailer->new("sendmail", "-fitecs-vclsysroot\@engr.ncsu.edu");
+
+ if ($SHARED_MAILBOX) {
+ my $bcc = $SHARED_MAILBOX;
+ if ($mailer->open({From => $from,
+ To => $to,
+ Bcc => $bcc,
+ Subject => $subject,}))
+ {
+ print $mailer $mailstring;
+ $mailer->close();
+ notify($ERRORS{'OK'}, 0, "SUCCESS -- Sending mail To: $to, $subject");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "NOTICE -- Problem sending mail to: $to From");
+ }
+ } ## end if ($SHARED_MAILBOX)
+ else {
+ if ($mailer->open({From => $from,
+ To => $to,
+ Subject => $subject,}))
+ {
+ print $mailer $mailstring;
+ $mailer->close();
+ notify($ERRORS{'OK'}, 0, "SUCCESS -- Sending mail To: $to, $subject");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "NOTICE -- Problem sending mail to: $to From");
+ }
+ } ## end else [ if ($SHARED_MAILBOX)
+} ## end sub mail
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 setstaticaddress
+
+ Parameters : $node, $osname, $IPaddress
+ Returns : 1,0 -- success failure
+ Description : assigns statically assigned IPaddress
+=cut
+
+sub setstaticaddress {
+ my ($node, $osname, $IPaddress) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'OK'}, 0, "nodename not set") if (!defined($node));
+ notify($ERRORS{'OK'}, 0, "osname not set") if (!defined($osname));
+ notify($ERRORS{'CRITICAL'}, 0, "IPaddress not set") if (!defined($IPaddress));
+ #collect private address -- read hosts file only useful if running
+ # xcat setup and private addresses are listsed in the local
+ # /etc/hosts file
+ #should also store/pull private address from the database
+ my $privateIP;
+ if (open(HOSTS, "/etc/hosts")) {
+ my @hosts = <HOSTS>;
+ close(HOSTS);
+ foreach my $line (@hosts) {
+ if ($line =~ /([0-9]*.[0-9]*.[0-9]*.[0-9]*)\s+($node)/) {
+ $privateIP = $1;
+ notify($ERRORS{'OK'}, 0, "PrivateIP address for $node collected $privateIP");
+ last;
+ }
+ }
+ } ## end if (open(HOSTS, "/etc/hosts"))
+ if (!defined($privateIP)) {
+ notify($ERRORS{'WARNING'}, 0, "private IP address not found for $node, possible issue with regex");
+
+ }
+
+ my $identity;
+ my @sshcmd;
+ if ($osname =~ /^(rh|fc|esx)/) {
+ $identity = $IDENTITY_bladerhel;
+ #create local tmp file
+ # down interface
+ #copy tmpfile to /etc/sysconfig/network-scripts/ifcfg-eth1
+ # up interface
+ #set route for correct gateway
+ my @eth1file;
+ my $tmpfile = "/tmp/ifcfg-eth_device-$node";
+ push(@eth1file, "DEVICE=eth1\n");
+ push(@eth1file, "BOOTPROTO=static\n");
+ push(@eth1file, "IPADDR=$IPaddress\n");
+ push(@eth1file, "NETMASK=$NETMASK\n");
+ push(@eth1file, "STARTMODE=onboot\n");
+ push(@eth1file, "ONBOOT=yes\n");
+
+ #write to tmpfile
+ if (open(TMP, ">$tmpfile")) {
+ print TMP @eth1file;
+ close(TMP);
+ }
+ else {
+ #print "could not write $tmpfile $!\n";
+
+ }
+ @sshcmd = run_ssh_command($node, $identity, "/etc/sysconfig/network-scripts/ifdown $ETHDEVICE", "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l) {
+ #potential problem
+ notify($ERRORS{'OK'}, 0, "sshcmd outpuer ifdown $node $l");
+ }
+ }
+ #copy new ifcfg-Device
+ if (run_scp_command($tmpfile, "$node:/etc/sysconfig/network-scripts/ifcfg-$ETHDEVICE", $identity)) {
+
+ #confirm it got there
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($node, $identity, "cat /etc/sysconfig/network-scripts/ifcfg-$ETHDEVICE", "root");
+ my $success = 0;
+ foreach my $i (@{$sshcmd[1]}) {
+ if ($i =~ /$IPaddress/) {
+ notify($ERRORS{'OK'}, 0, "SUCCESS - copied ifcfg_$ETHDEVICE\n");
+ $success = 1;
+ }
+ }
+ if (unlink($tmpfile)) {
+ notify($ERRORS{'OK'}, 0, "unlinking $tmpfile");
+ }
+
+ if (!$success) {
+ notify($ERRORS{'WARNING'}, 0, "unable to copy $tmpfile to $node file ifcfg-$ETHDEVICE did get updated with $IPaddress ");
+ return 0;
+ }
+ } ## end if (run_scp_command($tmpfile, "$node:/etc/sysconfig/network-scripts/ifcfg-$ETHDEVICE"...
+
+ #bring device up
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($node, $identity, "/etc/sysconfig/network-scripts/ifup $ETHDEVICE", "root");
+ #should be empty
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l) {
+ #potential problem
+ notify($ERRORS{'OK'}, 0, "possible problem with ifup $ETHDEVICE $l");
+ }
+ }
+ #correct route table - delete old default and add new in same line
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($node, $identity, "/sbin/route del default", "root");
+ #should be empty
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /Usage:/) {
+ #potential problem
+ notify($ERRORS{'OK'}, 0, "possible problem with route del default $l");
+ }
+ if ($l =~ /No such process/) {
+ notify($ERRORS{'OK'}, 0, "$l - ok just no default route since we downed eth device");
+ }
+ }
+
+ notify($ERRORS{'OK'}, 0, "Setting default route");
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($node, $identity, "/sbin/route add default gw $GATEWAY metric 0 $ETHDEVICE", "root");
+ #should be empty
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /Usage:/) {
+ #potential problem
+ notify($ERRORS{'OK'}, 0, "possible problem with route add default gw $GATEWAY metric 0 $ETHDEVICE");
+ }
+ if ($l =~ /No such process/) {
+ notify($ERRORS{'CRITICAL'}, 0, "problem with $node $l add default gw $GATEWAY metric 0 $ETHDEVICE ");
+ return 0;
+ }
+ } ## end foreach my $l (@{$sshcmd[1]})
+
+ #correct external sshd file
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($node, $identity, "cat /etc/ssh/external_sshd_config", "root");
+ foreach my $i (@{$sshcmd[1]}) {
+ if ($i =~ /No such file or directory/) {
+ notify($ERRORS{'OK'}, 0, "possible problem $i could not read $node /etc/ssh/external_sshd_config");
+ #problem
+ }
+
+ if ($i =~ s/ListenAddress (.*)/ListenAddress $IPaddress/) {
+ notify($ERRORS{'OK'}, 0, "changed Listen Address on $node");
+ }
+
+ } ## end foreach my $i (@{$sshcmd[1]})
+
+ #Write contents to tmp file
+ my $extsshtmpfile = "/tmp/extsshtmpfile$node";
+ if (open(TMPFILE, ">$extsshtmpfile")) {
+ print TMPFILE @{$sshcmd[1]};
+ close(TMPFILE);
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "could not write tmpfile $extsshtmpfile $!");
+ }
+
+ #copy back to host
+ if (run_scp_command($extsshtmpfile, "$node:/etc/ssh/external_sshd_config", $identity)) {
+ notify($ERRORS{'OK'}, 0, "success copied $extsshtmpfile to $node");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "could not write copy $extsshtmpfile to $node");
+ }
+ if (unlink($extsshtmpfile)) {
+ notify($ERRORS{'OK'}, 0, "unlinking $extsshtmpfile");
+ }
+
+ #modify /etc/resolve.conf
+ my $search;
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($node, $identity, "cat /etc/resolv.conf", "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ chomp($l);
+ if ($l =~ /search/) {
+ $search = $l;
+ }
+ }
+
+ if (defined($search)) {
+ my @resolvconf;
+ push(@resolvconf, "$search\n");
+ my ($s1, $s2, $s3);
+ if ($DNSserver =~ /,/) {
+ ($s1, $s2, $s3) = split(/,/, $DNSserver);
+ }
+ else {
+ $s1 = $DNSserver;
+ }
+ push(@resolvconf, "nameserver $s1\n");
+ push(@resolvconf, "nameserver $s2\n") if (defined($s2));
+ push(@resolvconf, "nameserver $s3\n") if (defined($s3));
+ my $rtmpfile = "/tmp/resolvconf$node";
+ if (open(RES, ">$rtmpfile")) {
+ print RES @resolvconf;
+ close(RES);
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "could not write to $rtmpfile $!");
+ }
+ #put resolve.conf file back on node
+ notify($ERRORS{'OK'}, 0, "copying in new resolv.conf");
+ if (run_scp_command($rtmpfile, "$node:/etc/resolv.conf", $identity)) {
+ notify($ERRORS{'OK'}, 0, "SUCCESS copied new resolv.conf to $node");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "FALIED to copied new resolv.conf to $node");
+ return 0;
+ }
+
+ if (unlink($rtmpfile)) {
+ notify($ERRORS{'OK'}, 0, "unlinking $rtmpfile");
+ }
+ } ## end if (defined($search))
+ else {
+ notify($ERRORS{'WARNING'}, 0, "pulling resolve.conf from $node failed output= @{ $sshcmd[1] }");
+ }
+ } ## end if ($osname =~ /^(rh|fc|esx)/)
+ elsif ($osname =~ /^(win|vmwarewin|vista)/) {
+ $identity = $IDENTITY_wxp;
+ #scan adapter list to figure out which adapter is public
+ # run netsh command to set the public adapter to static
+ # correct the route table
+
+ my $myadapter;
+ my %ip;
+ my ($privateadapter, $publicadapter);
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($node, $identity, "ipconfig -all", "root");
+ # build hash of needed info and set the correct private adapter.
+ my $id = 1;
+ foreach my $a (@{$sshcmd[1]}) {
+ if ($a =~ /Ethernet adapter (.*):/) {
+ $myadapter = $1;
+ $ip{$myadapter}{"id"} = $id;
+ $ip{$myadapter}{"private"} = 0;
+ }
+ if ($a =~ /IP Address([\s.]*): $privateIP/) {
+ $ip{$myadapter}{"private"} = 1;
+ }
+ if ($a =~ /Physical Address([\s.]*): ([-0-9]*)/) {
+ $ip{$myadapter}{"MACaddress"} = $2;
+ }
+
+ $id++;
+ } ## end foreach my $a (@{$sshcmd[1]})
+
+
+ foreach my $key (keys %ip) {
+ if (defined($ip{$key}{private})) {
+ if (!($ip{$key}{private})) {
+ $publicadapter = "\"$key\"";
+ }
+ }
+ }
+
+ #Make sure we have publicadapter defined
+ if (!defined($publicadapter)) {
+ notify($ERRORS{'WARNING'}, 0, "publicadapter not detected from $node");
+ return 0;
+ }
+
+ #setting publicadapter to static
+ notify($ERRORS{'OK'}, 0, "executing netsh interface ip set address name=\\\"$publicadapter\\\" source=static addr=$IPaddress mask=$NETMASK gateway=$GATEWAY gwmetric=2\n");
+ undef @sshcmd;
+ my $cmdstring = "netsh interface ip set address name=\\\"$publicadapter\\\" source=static addr=$IPaddress mask=$NETMASK gateway=$GATEWAY gwmetric=2";
+ @sshcmd = run_ssh_command($node, $identity, $cmdstring, "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /Ok/) {
+ notify($ERRORS{'OK'}, 0, "successfully set $publicadapter to static");
+ }
+ }
+
+ #set dns
+ my ($s1, $s2, $s3);
+ if ($DNSserver =~ /,/) {
+ ($s1, $s2, $s3) = split(/,/, $DNSserver);
+ }
+ else {
+ $s1 = $DNSserver;
+ }
+ notify($ERRORS{'OK'}, 0, "executing setting DNS netsh interface ip set dns name=\\\"$publicadapter\\\" source=static addr=$s1 register=none\n");
+ undef @sshcmd;
+ $cmdstring = "netsh interface ip set dns name=\\\"$publicadapter\\\" source=static addr=$s1 register=none";
+ @sshcmd = run_ssh_command($node, $identity, $cmdstring, "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /Ok/) {
+ notify($ERRORS{'OK'}, 0, "successfully set dns $publicadapter ");
+ }
+ }
+
+ #correct route table - delete old default and add new in same line
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($node, $identity, "route del 0.0.0.0", "root");
+ #should be empty
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l) {
+ #potential problem
+ notify($ERRORS{'OK'}, 0, "possible problem with route del default $l");
+ }
+ }
+
+ notify($ERRORS{'OK'}, 0, "Setting default route");
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($node, $identity, "route -p ADD 0.0.0.0 MASK 0.0.0.0 $GATEWAY METRIC 2", "root");
+ #should be empty
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l) {
+ #potential problem
+ notify($ERRORS{'OK'}, 0, "possible problem with route add default gw $GATEWAY metric 0 $ETHDEVICE");
+ }
+ }
+
+ } ## end elsif ($osname =~ /^(win|vmwarewin|vista)/) [ if ($osname =~ /^(rh|fc|esx)/)
+ else {
+
+ # osname not defined
+ }
+
+
+} ## end sub setstaticaddress
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 getdynamicaddress
+
+ Parameters : $node, $osname
+ Returns : assigned ipaddress
+ Description : collects the dynamically assigned ipaddress
+=cut
+
+sub getdynamicaddress {
+ my ($node, $osname) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'OK'}, 0, "nodename not set") if (!defined($node));
+ notify($ERRORS{'OK'}, 0, "osname not set") if (!defined($osname));
+
+ #collect private address -- read hosts file only useful if running
+ # xcat setup and private addresses are listsed in the local
+ # /etc/hosts file
+ #should also store/pull private address from the database
+ my $privateIP;
+ my @sshcmd;
+ if (open(HOSTS, "/etc/hosts")) {
+ my @hosts = <HOSTS>;
+ close(HOSTS);
+ foreach my $line (@hosts) {
+ if ($line =~ /([0-9]*.[0-9]*.[0-9]*.[0-9]*)\s+($node)/) {
+ $privateIP = $1;
+ notify($ERRORS{'OK'}, 0, "PrivateIP address for $node collected $privateIP");
+ last;
+ }
+ }
+ } ## end if (open(HOSTS, "/etc/hosts"))
+ if (!defined($privateIP)) {
+ notify($ERRORS{'WARNING'}, 0, "private IP address not found for $node, possible issue with regex");
+ }
+
+ my $identity;
+ my $dynaIPaddress = 0;
+ if ($osname =~ /win|vmwarewin/) {
+ $identity = $IDENTITY_wxp;
+
+ @sshcmd = run_ssh_command($node, $identity, "netsh diag show ip", "root");
+ for my $l (@{$sshcmd[1]}) {
+ next if ($l =~ /IPAddress = $privateIP/);
+ if ($l =~ /IPAddress = ([.0-9]*)/) {
+ if ($l !~ /IPAddress = $privateIP/) {
+ #to cover sites using eth0 as public
+ $dynaIPaddress = $1;
+ }
+ }
+ }
+
+ } ## end if ($osname =~ /win|vmwarewin/)
+ elsif ($osname =~ /^(rh|fc)/) {
+ $identity = $IDENTITY_bladerhel;
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($node, $identity, "/sbin/ifconfig \|grep inet", "root");
+ for my $l (@{$sshcmd[1]}) {
+ # skip class a,b,c private addresses
+ next if ($l =~ /inet addr:$privateIP/);
+ next if ($l =~ /inet addr:10.([.0-9]*)/);
+ next if ($l =~ /inet addr:127([.0-9]*)/);
+ next if ($l =~ /inet addr:172([.0-9]*)/);
+ next if ($l =~ /inet addr:192.168([.0-9]*)/);
+ if ($l =~ /inet addr:([.0-9]*)/) {
+ if ($l !~ /inet addr:$privateIP/) {
+ #to cover sites using eth0 as public
+ $dynaIPaddress = $1;
+ }
+ }
+ } ## end for my $l (@{$sshcmd[1]})
+
+ } ## end elsif ($osname =~ /^(rh|fc)/) [ if ($osname =~ /win|vmwarewin/)
+ else {
+ notify($ERRORS{'WARNING'}, 0, "OSname $osname not supported ");
+ return 0;
+ }
+ return $dynaIPaddress;
+
+} ## end sub getdynamicaddress
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _set_sshd_startmode
+
+ Parameters : $node, $mode
+ Returns : 1 or 0
+ Description : sets the sshd service on winxp images to auto or manual
+=cut
+
+sub _set_sshd_startmode {
+ my ($node, $mode) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'OK'}, 0, "nodename not set") if (!defined($node));
+ notify($ERRORS{'OK'}, 0, "ipaddress not set") if (!defined($mode));
+
+ #specific to sc command
+ $mode = "demand" if ($mode eq "manual");
+
+ # start using sc to change the start mode
+ my $cmd = "cmd /c C:\/WINDOWS\/system32\/sc config sshd start= $mode";
+ my @SC = run_ssh_command($node, $IDENTITY_wxp, $cmd);
+ for my $line (@{$SC[1]}) {
+ if ($line =~ /ChangeServiceConfig SUCCESS/) {
+ notify($ERRORS{'OK'}, 0, "successfully set sshd on $node to $mode");
+ return 1;
+ }
+ }
+ notify($ERRORS{'WARNING'}, 0, "_set_sshd_startmode failed return status $SC[0] array= @{ $SC[1] }");
+
+ return 0;
+} ## end sub _set_sshd_startmode
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _checknstartservice
+
+ Parameters : $service name
+ Returns : 1 or 0
+ Description : checks for running local service attempts to restart
+ xCAT specific
+=cut
+
+sub _checknstartservice {
+ my $service = $_[0];
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'OK'}, 0, "service not set") if (!defined($service));
+ my $status = 0;
+ if (open(SERVICE, "/sbin/service $service status |")) {
+ while (<SERVICE>) {
+ chomp($_);
+ #notify($ERRORS{'OK'},0,"_checknstartservice: $_");
+ if ($_ =~ /running/) {
+ $status = 1;
+ notify($ERRORS{'OK'}, 0, "_checknstartservice: $service is running");
+ }
+ }
+ close(SERVICE);
+ if ($status == 1) {
+ return 1;
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "_checknstartservice: $service is not running will try to start");
+ # try to start service
+ if (open(SERVICE, "/sbin/service $service start |")) {
+ while (<SERVICE>) {
+ chomp($_);
+ notify($ERRORS{'WARNING'}, 0, "_checknstartservice: $_");
+ if ($_ =~ /started/) {
+ $status = 1;
+ last;
+ }
+ }
+ close(SERVICE);
+ if ($status == 1) {
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "_checknstartservice: $service could not start");
+ return 0;
+ }
+ } ## end if (open(SERVICE, "/sbin/service $service start |"...
+ else {
+ notify($ERRORS{'WARNING'}, 0, "_checknstartservice: WARNING -- could not run service command for $service start. $! ");
+ return 0;
+ }
+ } ## end else [ if ($status == 1)
+ } ## end if (open(SERVICE, "/sbin/service $service status |"...
+ else {
+ notify($ERRORS{'WARNING'}, 0, "_checknstartservice: WARNING -- could not run service command for $service check. $! ");
+ return 0;
+ }
+} ## end sub _checknstartservice
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 check_connection
+
+ Parameters : $nodename, $ipaddress, $type, $remoteIP, $time_limit, $osname, $dbh, $requestid, $user
+ Returns : value - deleted failed timeout connected conn_wrong_ip
+ Description : uses ssh to log into remote node and preform checks on user connection
+=cut
+
+sub check_connection {
+ my ($nodename, $ipaddress, $type, $remoteIP, $time_limit, $osname, $dbh, $requestid, $user) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'OK'}, 0, "nodename not set") if (!defined($nodename));
+ notify($ERRORS{'OK'}, 0, "ipaddress not set") if (!defined($ipaddress));
+ notify($ERRORS{'OK'}, 0, "type not set") if (!defined($type));
+ notify($ERRORS{'OK'}, 0, "remoteIP not set") if (!defined($remoteIP));
+ notify($ERRORS{'OK'}, 0, "time_limit not set") if (!defined($time_limit));
+ notify($ERRORS{'OK'}, 0, "osname not set") if (!defined($osname));
+ notify($ERRORS{'OK'}, 0, "dbh not set") if (!defined($dbh));
+ notify($ERRORS{'OK'}, 0, "requestid not set") if (!defined($requestid));
+ notify($ERRORS{'OK'}, 0, "user not set") if (!defined($user));
+
+ my $start_time = time();
+ my $time_exceeded = 0;
+ my $break = 0;
+ my $ret_val = "no";
+
+ $dbh = getnewdbh() if !$dbh;
+ my $identity;
+ if ($osname =~ /win|vmwarewin|vmwareesxwin|vista/) {
+ $identity = $IDENTITY_wxp;
+ }
+ elsif ($osname =~ /^(rh[0-9]image|rhel[0-9]|fc[0-9]image|rhfc[0-9]|rhas[0-9]|centos)/) {
+ $identity = $IDENTITY_bladerhel;
+ }
+ # Figure out number of loops for log messates
+ my $maximum_loops = $time_limit * 2;
+ my $loop_count = 0;
+ my @SSHCMD;
+
+ while (!$break) {
+ $loop_count++;
+
+ notify($ERRORS{'OK'}, 0, "checking for connection by $user on $nodename, attempt $loop_count ");
+
+ # confirm we still have an active db handle
+ if (!$dbh || !($dbh->ping)) {
+ notify($ERRORS{'WARNING'}, 0, "database handle died, trying to create another one");
+ $dbh = getnewdbh();
+ notify($ERRORS{'OK'}, 0, "database handle re-set") if ($dbh->ping);
+ notify($ERRORS{'WARNING'}, 0, "inuse process: database handle NOT re-set") if (!($dbh->ping));
+ }
+ if (is_request_deleted($requestid)) {
+ notify($ERRORS{'OK'}, 0, "user has deleted request");
+ $break = 1;
+ $ret_val = "deleted";
+ return $ret_val;
+ }
+ #notify($ERRORS{'OK'},0,"comparing wait time for connection");
+ $time_exceeded = time_exceeded($start_time, $time_limit);
+ if ($time_exceeded) {
+ notify($ERRORS{'OK'}, 0, "$time_limit minute time limit exceeded begin cleanup process");
+ #time_exceeded, begin cleanup process
+ $break = 1;
+ if ($package =~ /reserved/) {
+ notify($ERRORS{'OK'}, 0, "user never logged in returning nologin");
+ $ret_val = "nologin";
+ }
+ else {
+ $ret_val = "timeout";
+ }
+ return $ret_val;
+ } ## end if ($time_exceeded)
+ else { #time not exceeded check for connection
+ if ($type =~ /blade|virtualmachine/) {
+ my $shortnodename = $nodename;
+ $shortnodename = $1 if ($nodename =~ /([-_a-zA-Z0-9]*)\./);
+ if ($osname =~ /win|vmwarewin/) {
+ undef @SSHCMD;
+ @SSHCMD = run_ssh_command($shortnodename, $identity, "netstat -an", "root", 22, 1);
+ foreach my $line (@{$SSHCMD[1]}) {
+ #check for rdp and ssh connections
+ # rdp:3389,ssh:22
+ #check for connection refused, if ssh is gone something
+ #has happenned put in timeout state
+ if ($line =~ /Connection refused|Permission denied/) {
+ chomp($line);
+ notify($ERRORS{'WARNING'}, 0, "$line");
+ if ($package =~ /reserved/) {
+ $ret_val = "failed";
+ }
+ else {
+ $ret_val = "timeout";
+ }
+ return $ret_val;
+ } ## end if ($line =~ /Connection refused|Permission denied/)
+ if ($line =~ /\s+($ipaddress:3389)\s+([.0-9]*):([0-9]*)\s+(ESTABLISHED)/) {
+ if ($2 eq $remoteIP) {
+ $break = 1;
+ $ret_val = "connected";
+ return $ret_val;
+ }
+ else {
+ #this isn't the remoteIP
+ $ret_val = "conn_wrong_ip";
+ return $ret_val;
+ }
+ } ## end if ($line =~ /\s+($ipaddress:3389)\s+([.0-9]*):([0-9]*)\s+(ESTABLISHED)/)
+ } #foreach
+
+ } ## end if ($osname =~ /win|vmwarewin/)
+ #elsif($osname =~ /^(rhel|rh3image|rh4image|rhfc|fc)/){
+ elsif ($osname =~ /^(rh[0-9]image|rhel[0-9]|fc[0-9]image|rhfc[0-9]|rhas[0-9]|centos)/) {
+ #run two checks
+ # 1:check connected IP address
+ # 2:simply check who ouput
+ my @lines;
+ undef @SSHCMD;
+ @SSHCMD = run_ssh_command($shortnodename, $identity, "netstat -an", "root", 22, 1);
+ foreach my $line (@{$SSHCMD[1]}) {
+ if ($line =~ /Connection refused|Permission denied/) {
+ chomp($line);
+ notify($ERRORS{'WARNING'}, 0, "$line");
+ if ($package =~ /reserved/) {
+ $ret_val = "failed";
+ }
+ else {
+ $ret_val = "timeout";
+ }
+ return $ret_val;
+ } ## end if ($line =~ /Connection refused|Permission denied/)
+ if ($line =~ /tcp\s+([0-9]*)\s+([0-9]*)\s($ipaddress:22)\s+([.0-9]*):([0-9]*)(.*)(ESTABLISHED)/) {
+ if ($4 eq $remoteIP) {
+ $break = 1;
+ $ret_val = "connected";
+ return $ret_val;
+ }
+ else {
+ #this isn't the remoteIP
+ $ret_val = "conn_wrong_ip";
+ return $ret_val;
+ }
+ } # tcp check
+ } #foreach
+ #who; too make sure we didn't miss it through netstat
+ undef @SSHCMD;
+ @SSHCMD = run_ssh_command($shortnodename, $identity, "who", "root");
+ foreach my $w (@{$SSHCMD[1]}) {
+ if ($w =~ /$user/) {
+ $break = 1;
+ notify($ERRORS{'CRITICAL'}, 0, "found user connected through who command on node $nodename , strange that netstat missed it\nnetstat output:\n @lines");
+ $ret_val = "connected";
+ return $ret_val;
+ }
+ }
+
+ } ## end elsif ($osname =~ /^(rh[0-9]image|rhel[0-9]|fc[0-9]image|rhfc[0-9]|rhas[0-9]|centos)/) [ if ($osname =~ /win|vmwarewin/)
+ } ## end if ($type =~ /blade|virtualmachine/)
+ elsif ($type eq "lab") {
+ my $identity;
+ if ($osname =~ /sun4x_/) {
+ $identity = $IDENTITY_solaris_lab;
+ }
+ elsif ($osname =~ /rhel/) {
+ $identity = $IDENTITY_linux_lab;
+ }
+ else {
+ #if all else fails
+ $identity = $IDENTITY_solaris_lab;
+ }
+ undef @SSHCMD;
+ @SSHCMD = run_ssh_command($nodename, $identity, "netstat -an", "vclstaff", 24, 1);
+ foreach my $line (@{$SSHCMD[1]}) {
+ chomp($line);
+ if ($line =~ /Connection refused|Permission denied/) {
+ notify($ERRORS{'WARNING'}, 0, "$line");
+ if ($package =~ /reserved/) {
+ $ret_val = "failed";
+ }
+ else {
+ $ret_val = "timeout";
+ }
+ return $ret_val;
+ } ## end if ($line =~ /Connection refused|Permission denied/)
+ if ($osname =~ /sun4x_/) {
+ if ($line =~ /\s*($ipaddress\.22)\s+([.0-9]*)\.([0-9]*)(.*)(ESTABLISHED)/) {
+ if ($2 eq $remoteIP) {
+ $break = 1;
+ $ret_val = "connected";
+ return $ret_val;
+ }
+ else {
+ #this isn't the remoteIP
+ $ret_val = "conn_wrong_ip";
+ return $ret_val;
+ }
+ } ## end if ($line =~ /\s*($ipaddress\.22)\s+([.0-9]*)\.([0-9]*)(.*)(ESTABLISHED)/)
+ } ## end if ($osname =~ /sun4x_/)
+ elsif ($osname =~ /rhel/) {
+ if ($line =~ /tcp\s+([0-9]*)\s+([0-9]*)\s($ipaddress:22)\s+([.0-9]*):([0-9]*)(.*)(ESTABLISHED)/) {
+ if ($4 eq $remoteIP) {
+ $break = 1;
+ $ret_val = "connected";
+ return $ret_val;
+ }
+ else {
+ #this isn't the remoteIP
+ $ret_val = "conn_wrong_ip";
+ return $ret_val;
+ }
+ } ## end if ($line =~ /tcp\s+([0-9]*)\s+([0-9]*)\s($ipaddress:22)\s+([.0-9]*):([0-9]*)(.*)(ESTABLISHED)/)
+ if ($line =~ /tcp\s+([0-9]*)\s+([0-9]*)\s::ffff:($ipaddress:22)\s+::ffff:([.0-9]*):([0-9]*)(.*)(ESTABLISHED) /) {
+ if ($4 eq $remoteIP) {
+ $break = 1;
+ $ret_val = "connected";
+ return $ret_val;
+ }
+ else {
+ #this isn't the remoteIP
+ $ret_val = "conn_wrong_ip";
+ return $ret_val;
+ }
+ } ## end if ($line =~ /tcp\s+([0-9]*)\s+([0-9]*)\s::ffff:($ipaddress:22)\s+::ffff:([.0-9]*):([0-9]*)(.*)(ESTABLISHED) /)
+ } ## end elsif ($osname =~ /rhel/) [ if ($osname =~ /sun4x_/)
+ } #foreach
+ } #if lab
+ } #else
+ #sleep 30;
+ sleep 20;
+ } #while
+ return $ret_val;
+} ## end sub check_connection
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 isconnected
+
+ Parameters : $nodename, $type, $remoteIP, $osname, $ipaddress
+ Returns : 1 connected 0 not connected
+ Description : confirms user is connected to node
+ assumes port 3389 for windows and port 22 for linux/solaris
+=cut
+
+sub isconnected {
+ my ($nodename, $type, $remoteIP, $osname, $ipaddress) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'OK'}, 0, "nodename not set") if (!defined($nodename));
+ notify($ERRORS{'OK'}, 0, "type not set") if (!defined($type));
+ notify($ERRORS{'OK'}, 0, "remoteIP not set") if (!defined($remoteIP));
+ notify($ERRORS{'OK'}, 0, "osname not set") if (!defined($osname));
+ notify($ERRORS{'OK'}, 0, "ipaddress not set") if (!defined($ipaddress));
+
+ my @netstat;
+ my @SSHCMD;
+ if ($type =~ /blade|virtualmachine/) {
+ my $shortname = 0;
+ $shortname = $1 if ($nodename =~ /([-_a-zA-Z0-9]*)\./);
+ if ($shortname) {
+ #convert shortname
+ $nodename = $shortname;
+ }
+
+ if ($osname =~ /win|vmwarewin/) {
+ #notify($ERRORS{'OK'},0,"checking $nodename $ipaddress");
+ undef @SSHCMD;
+ @SSHCMD = run_ssh_command($shortname, $IDENTITY_wxp, "netstat -an", "root", 22, 1);
+ foreach my $line (@{$SSHCMD[1]}) {
+ chomp($line);
+ if ($line =~ /Connection refused/) {
+ notify($ERRORS{'WARNING'}, 0, "$line");
+ return 0;
+ }
+ #if($line =~ /\s+($ipaddress:3389)\s+([.0-9]*):([0-9]*)\s+(ESTABLISHED)/){
+ if ($line =~ /\s+(TCP\s+[.0-9]*:3389)\s+([.0-9]*):([0-9]*)\s+(ESTABLISHED)/) {
+ #notify($ERRORS{'WARNING'},0,"$line");
+ return 1 if ($2 eq $remoteIP);
+ if ($2 ne $remoteIP) {
+ notify($ERRORS{'WARNING'}, 0, "not correct remote IP is connected");
+ return 1;
+ }
+ }
+ } ## end foreach my $line (@{$SSHCMD[1]})
+ } ## end if ($osname =~ /win|vmwarewin/)
+ elsif ($osname =~ /^(rh[0-9]image|rhel[0-9]|fc[0-9]image|rhfc[0-9]|rhas[0-9])/) {
+ undef @SSHCMD;
+ @SSHCMD = run_ssh_command($nodename, $IDENTITY_bladerhel, "netstat -an", "root", 22, 1);
+ foreach my $line (@{$SSHCMD[1]}) {
+ chomp($line);
+ if ($line =~ /Warning/) {
+ if (known_hosts($nodename, "linux", $ipaddress)) {
+ #good
+ }
+ next;
+ }
+ if ($line =~ /Connection refused/) {
+ notify($ERRORS{'WARNING'}, 0, "$line");
+ return 0;
+ }
+ if ($line =~ /tcp\s+([0-9]*)\s+([0-9]*)\s($ipaddress:22)\s+([.0-9]*):([0-9]*)(.*)(ESTABLISHED)/) {
+ return 1 if ($4 eq $remoteIP);
+ if ($4 ne $remoteIP) {
+ notify($ERRORS{'WARNING'}, 0, "not correct remote IP connected: $line");
+ return 1;
+ }
+ }
+ } ## end foreach my $line (@{$SSHCMD[1]})
+ } ## end elsif ($osname =~ /^(rh[0-9]image|rhel[0-9]|fc[0-9]image|rhfc[0-9]|rhas[0-9])/) [ if ($osname =~ /win|vmwarewin/)
+ return 0;
+ } ## end if ($type =~ /blade|virtualmachine/)
+ elsif ($type eq "lab") {
+ my $identity;
+ if ($osname =~ /sun4x_/) {
+ $identity = $IDENTITY_solaris_lab;
+ }
+ elsif ($osname =~ /realmrhel/) {
+ $identity = $IDENTITY_linux_lab;
+ }
+ else {
+ #if all else fails
+ notify($ERRORS{'OK'}, 0, "osname $osname not found setting identity file to default");
+ $identity = $IDENTITY_solaris_lab;
+ }
+ undef @SSHCMD;
+ @SSHCMD = run_ssh_command($nodename, $identity, "netstat -an", "vclstaff", 24, 1);
+ foreach my $line (@{$SSHCMD[1]}) {
+ chomp($line);
+ if ($line =~ /Connection refused/) {
+ notify($ERRORS{'WARNING'}, 0, "$nodename $line");
+ return 0;
+ }
+ if ($osname =~ /sun4x_/) {
+ if ($line =~ /\s*($ipaddress\.22)\s+([.0-9]*)\.([0-9]*)(.*)(ESTABLISHED)/) {
+ return 1 if ($2 eq $remoteIP);
+ if ($2 ne $remoteIP) {
+ notify($ERRORS{'WARNING'}, 0, "not correct remote IP connected $4");
+ return 1;
+ }
+ }
+ }
+ elsif ($osname =~ /realmrhel3/) {
+ if ($line =~ /tcp\s+([0-9]*)\s+([0-9]*)\s($ipaddress:22)\s+([.0-9]*):([0-9]*)(.*)(ESTABLISHED)/) {
+ return 1 if ($4 eq $remoteIP);
+ if ($4 ne $remoteIP) {
+ notify($ERRORS{'WARNING'}, 0, "not correct remote IP connected $4");
+ return 1;
+ }
+ }
+ }
+ } ## end foreach my $line (@{$SSHCMD[1]})
+ return 0;
+ } ## end elsif ($type eq "lab") [ if ($type =~ /blade|virtualmachine/)
+} ## end sub isconnected
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 update_preload_fla
+
+ Parameters : request id, flag 1,0
+ Returns : 1 success 0 failure
+ Description : update preload flag
+
+=cut
+
+sub update_preload_flag {
+ my ($request_id, $flag) = @_;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ notify($ERRORS{'WARNING'}, 0, "request id is not defined") unless (defined($request_id));
+ notify($ERRORS{'WARNING'}, 0, "preload flag is not defined") unless (defined($flag));
+
+ my $update_statement = "
+ UPDATE
+ request
+ SET
+ preload = $flag
+ WHERE
+ id = $request_id
+ ";
+
+ # Call the database execute subroutine
+ if (database_execute($update_statement)) {
+ # Update successful
+ notify($ERRORS{'OK'}, $LOGFILE, "preload flag updated for request_id $request_id ");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to update preload flag updated for request_id $request_id");
+ return 0;
+ }
+} ## end sub update_preload_flag
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 update_request_state
+
+ Parameters : request id, state name, last state(optional), log(optional)
+ Returns : 1 success 0 failure
+ Description : update states
+
+=cut
+
+sub update_request_state {
+ my ($request_id, $state_name, $laststate_name, $log) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameters
+ if (!defined($request_id)) {
+ notify($ERRORS{'WARNING'}, $log, "unable to update request state, request id is not defined");
+ return 0;
+ }
+ if (!defined($state_name)) {
+ notify($ERRORS{'WARNING'}, $log, "unable to update request $request_id state, state name not defined");
+ return 0;
+ }
+
+ my $update_statement;
+
+ # Determine whether or not to update laststate, construct the SQL statement
+ if (defined $laststate_name && $laststate_name ne "") {
+ $update_statement = "
+ UPDATE
+ request,
+ state state,
+ state laststate
+ SET
+ request.stateid = state.id,
+ request.laststateid = laststate.id
+ WHERE
+ state.name = \'$state_name\'
+ AND laststate.name = \'$laststate_name\'
+ AND request.id = $request_id
+ ";
+ } ## end if (defined $laststate_name && $laststate_name...
+ else {
+ $update_statement = "
+ UPDATE
+ request,
+ state state
+ SET
+ request.stateid = state.id
+ WHERE
+ state.name = \'$state_name\'
+ AND request.id = $request_id
+ ";
+
+ $laststate_name = 'unchanged';
+ } ## end else [ if (defined $laststate_name && $laststate_name...
+
+ # Call the database execute subroutine
+ if (database_execute($update_statement)) {
+ # Update successful
+ notify($ERRORS{'OK'}, $LOGFILE, "request $request_id state updated to: $state_name, laststate to: $laststate_name");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to update states for request $request_id");
+ return 0;
+ }
+} ## end sub update_request_state
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 update_computer_state
+
+ Parameters : $computer_id, $state_name, $log
+ Returns : 1 success 0 failure
+ Description : update computer state
+
+=cut
+
+sub update_computer_state {
+ my ($computer_id, $state_name, $log) = @_;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ notify($ERRORS{'WARNING'}, $log, "computer id is not defined") unless (defined($computer_id));
+ notify($ERRORS{'WARNING'}, $log, "statename is not defined") unless (defined($state_name));
+ return 0 unless (defined $computer_id && defined $state_name);
+
+ my $update_statement = "
+ UPDATE
+ computer,
+ state
+ SET
+ computer.stateid = state.id
+ WHERE
+ state.name = \'$state_name\'
+ AND computer.id = $computer_id
+ ";
+
+ # Call the database execute subroutine
+ if (database_execute($update_statement)) {
+ # Update successful
+ notify($ERRORS{'OK'}, $LOGFILE, "computer $computer_id state updated to: $state_name");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to update states for computer $computer_id");
+ return 0;
+ }
+} ## end sub update_computer_state
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 update_request_password
+
+ Parameters : $reservation_id, $password
+ Returns : 1 success 0 failure
+ Description : updates password field for reservation id
+
+=cut
+
+sub update_request_password {
+ my ($reservation_id, $password) = @_;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ notify($ERRORS{'WARNING'}, 0, "reservation id is not defined") unless (defined($reservation_id));
+ notify($ERRORS{'WARNING'}, 0, "password is not defined") unless (defined($password));
+
+ my $update_statement = "
+ UPDATE
+ reservation
+ SET
+ pw = \'$password\'
+ WHERE
+ id = $reservation_id
+ ";
+
+ # Call the database execute subroutine
+ if (database_execute($update_statement)) {
+ # Update successful
+ notify($ERRORS{'OK'}, $LOGFILE, "password updated for reservation_id $reservation_id ");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to update password for reservation $reservation_id");
+ return 0;
+ }
+} ## end sub update_request_password
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 is_request_deleted
+
+ Parameters : $request_id
+ Returns : return 1 if request state or laststate is set to deleted or if request does not exist
+ return 0 if request exists and neither request state nor laststate is set to deleted1 success 0 failure
+ Description : checks if request has been deleted
+
+=cut
+
+sub is_request_deleted {
+
+ my ($request_id) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameter
+ if (!(defined($request_id))) {
+ notify($ERRORS{'WARNING'}, 0, "request ID was not specified");
+ return 0;
+ }
+
+ # Create the select statement
+ my $select_statement = "
+ SELECT
+ request.stateid AS currentstate_id,
+ request.laststateid AS laststate_id,
+ currentstate.name AS currentstate_name,
+ laststate.name AS laststate_name
+ FROM
+ request, state currentstate, state laststate
+ WHERE
+ request.id = $request_id
+ AND request.stateid = currentstate.id
+ AND request.laststateid = laststate.id
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @selected_rows = database_select($select_statement);
+
+ # Check to make sure 1 row was returned
+ if (scalar @selected_rows == 0) {
+ return 1;
+ }
+ elsif (scalar @selected_rows > 1) {
+ notify($ERRORS{'WARNING'}, 0, "" . scalar @selected_rows . " rows were returned from database select");
+ return 0;
+ }
+
+ my $state_name = $selected_rows[0]{currentstate_name};
+ my $laststate_name = $selected_rows[0]{laststate_name};
+
+ #notify($ERRORS{'DEBUG'}, 0,"state=$state_name, laststate=$laststate_name");
+
+ if ($state_name eq 'deleted' || $laststate_name eq 'deleted') {
+ return 1;
+ }
+
+ return 0;
+} ## end sub is_request_deleted
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 is_reservation_deleted
+
+ Parameters : $reservation_id
+ Returns : return 1 if reservation's request state or laststate is set to deleted or if reservation does not exist
+ return 0 if reservation exists and neither request state nor laststate is set to deleted: 1 success, 0 failure
+ Description : checks if reservation has been deleted
+
+=cut
+
+sub is_reservation_deleted {
+ my ($reservation_id) = @_;
+
+ # Check the passed parameter
+ if (!(defined($reservation_id))) {
+ notify($ERRORS{'WARNING'}, 0, "reservation ID was not specified");
+ return 0;
+ }
+
+ # Create the select statement
+ my $select_statement = "
+ SELECT
+ reservation.id AS reservation_id,
+ request.stateid AS currentstate_id,
+ request.laststateid AS laststate_id,
+ currentstate.name AS currentstate_name,
+ laststate.name AS laststate_name
+ FROM
+ reservation, request, state currentstate, state laststate
+ WHERE
+ reservation.id = $reservation_id
+ AND reservation.requestid = request.id
+ AND request.stateid = currentstate.id
+ AND request.laststateid = laststate.id
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @selected_rows = database_select($select_statement);
+
+ # Check to make sure 1 row was returned
+ if (scalar @selected_rows == 0) {
+ return 1;
+ }
+ elsif (scalar @selected_rows > 1) {
+ notify($ERRORS{'WARNING'}, 0, "" . scalar @selected_rows . " rows were returned from database select");
+ return 0;
+ }
+
+ my $state_name = $selected_rows[0]{currentstate_name};
+ my $laststate_name = $selected_rows[0]{laststate_name};
+
+ #notify($ERRORS{'DEBUG'}, 0,"state=$state_name, laststate=$laststate_name");
+
+ if ($state_name eq 'deleted' || $laststate_name eq 'deleted') {
+ return 1;
+ }
+
+ return 0;
+} ## end sub is_reservation_deleted
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 is_request_imaging
+
+ Parameters : $request_id
+ Returns : return 1 if request state or laststate is set to image or if request does not exist
+ return 0 if request exists and neither request state nor laststate is set to image success 0 failure
+ Description : checks if request is in imaging mode
+
+=cut
+
+sub is_request_imaging {
+
+ my ($request_id) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameter
+ if (!(defined($request_id))) {
+ notify($ERRORS{'WARNING'}, 0, "request ID was not specified");
+ return 0;
+ }
+
+ # Create the select statement
+ my $select_statement = "
+ SELECT
+ request.stateid AS currentstate_id,
+ request.laststateid AS laststate_id,
+ currentstate.name AS currentstate_name,
+ laststate.name AS laststate_name
+ FROM
+ request, state currentstate, state laststate
+ WHERE
+ request.id = $request_id
+ AND request.stateid = currentstate.id
+ AND request.laststateid = laststate.id
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @selected_rows = database_select($select_statement);
+
+ # Check to make sure 1 row was returned
+ if (scalar @selected_rows == 0) {
+ return 1;
+ }
+ elsif (scalar @selected_rows > 1) {
+ notify($ERRORS{'WARNING'}, 0, "" . scalar @selected_rows . " rows were returned from database select");
+ return 0;
+ }
+
+ my $state_name = $selected_rows[0]{currentstate_name};
+ my $laststate_name = $selected_rows[0]{laststate_name};
+
+ notify($ERRORS{'DEBUG'}, 0, "is_request_imaging currentstate= $state_name laststate= $laststate_name");
+
+ if ($state_name eq 'image' || $laststate_name eq 'image') {
+ return 1;
+ }
+
+ return 0;
+} ## end sub is_request_imaging
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_next_image_default
+
+ Parameters : $computerid
+ Returns : imageid,imagerevisionid,imagename
+ Description : Looks for any upcoming reservations
+ for supplied computerid, if starttime is
+ within 50 minutes return that imageid. Else
+ fetch and return preferred image
+=cut
+
+sub get_next_image_default {
+ my ($computerid) = @_;
+ my ($calling_package, $calling_filename, $calling_line, $calling_sub) = caller(0);
+
+ if (!defined($computerid)) {
+ notify($ERRORS{'WARNING'}, 0, "$calling_sub $calling_package missing mandatory variable: computerid ");
+ return 0;
+ }
+
+ my $select_statement = "
+ SELECT DISTINCT
+ req.start AS starttime,
+ ir.imagename AS imagename,
+ res.imagerevisionid AS imagerevisionid,
+ res.imageid AS imageid
+ FROM
+ reservation res,
+ request req,
+ image i,
+ state s,
+ imagerevision ir
+ WHERE
+ res.requestid = req.id
+ AND req.stateid = s.id
+ AND i.id = res.imageid
+ AND ir.id = res.imagerevisionid
+ AND res.computerid = $computerid
+ AND (s.name = \'new\' OR s.name = \'reload\' OR s.name = \'imageprep\')
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @selected_rows = database_select($select_statement);
+ my @ret_array;
+
+ # Check to make sure 1 or more rows were returned
+ if (scalar @selected_rows > 0) {
+ # Loop through list of upcoming reservations
+ # Based on the start time load the next one
+
+ my $now = time();
+
+ # It contains a hash
+ for (@selected_rows) {
+ my %reservation_row = %{$_};
+ # $reservation_row{starttime}
+ # $reservation_row{imagename}
+ # $reservation_row{imagerevisionid}
+ # $reservation_row{imageid}
+ my $epoch_start = convert_to_epoch_seconds($reservation_row{starttime});
+ my $diff = $epoch_start - $now;
+ # If start time is less than 50 minutes from now return this image
+ notify($ERRORS{'OK'}, 0, "get_next_image_default : diff= $diff image= $reservation_row{imagename} imageid=$reservation_row{imageid}");
+ if ($diff < (50 * 60)) {
+ notify($ERRORS{'OK'}, 0, "get_next_image_default : future reservation detected diff= $diff image= $reservation_row{imagename} imageid=$reservation_row{imageid}");
+ push(@ret_array, $reservation_row{imagename}, $reservation_row{imageid}, $reservation_row{imagerevisionid});
+ return @ret_array;
+ }
+ } ## end for (@selected_rows)
+ } ## end if (scalar @selected_rows > 0)
+
+ # No upcoming reservations - fetch preferred image information
+ my $select_preferredimage = "
+ SELECT DISTINCT
+ imagerevision.imagename AS imagename,
+ imagerevision.id AS imagerevisionid,
+ image.id AS imageid
+ FROM
+ image,
+ computer,
+ imagerevision
+ WHERE
+ imagerevision.imageid = computer.preferredimageid
+ AND imagerevision.production = 1
+ AND computer.preferredimageid = image.id
+ AND computer.id = $computerid
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @preferred_selected_rows = database_select($select_preferredimage);
+
+ # Check to make sure at least 1 row were returned
+ if (scalar @preferred_selected_rows == 0) {
+ notify($ERRORS{'WARNING'}, 0, "get_next_image_default failed to fetch preferred image for computerid $computerid");
+ return 0;
+ }
+ elsif (scalar @preferred_selected_rows > 1) {
+ notify($ERRORS{'WARNING'}, 0, "" . scalar @preferred_selected_rows . " rows were returned from database select");
+ return 0;
+ }
+ notify($ERRORS{'OK'}, 0, "get_next_image_default : returning preferredimage image=$preferred_selected_rows[0]{imagename} imageid=$preferred_selected_rows[0]{imageid}");
+ push(@ret_array, $preferred_selected_rows[0]{imagename}, $preferred_selected_rows[0]{imageid}, $preferred_selected_rows[0]{imagerevisionid});
+ return @ret_array;
+
+} ## end sub get_next_image
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 setimagid
+
+ Parameters : $dbh, $computerid, $image, $imageid, $imagerevisionid
+ Returns : 1
+ Description : updates imageid and imagerevisionid on provided computerid
+
+sub setimageid {
+ my ($dbh, $computerid, $image, $imageid, $imagerevisionid) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "setimageid: computerid is not defined") if (!(defined($computerid)));
+ notify($ERRORS{'WARNING'}, 0, "setimageid: image is not defined") if (!(defined($image)));
+ notify($ERRORS{'WARNING'}, 0, "setimageid: imageid is not defined") if (!(defined($imageid)));
+ $imagerevisionid = 0 if (!(defined($imagerevisionid)));
+
+
+ my $update_statement="UPDATE computer c SET c.currentimageid = $imageid,c.imagerevisionid = $imagerevisionid WHERE c.id = $computerid" ;
+ # Call the database execute subroutine
+ if (database_execute($update_statement)) {
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to update preferredimageid");
+ return 0;
+ }
+} ## end sub setimageid
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 setpreferredimage
+
+ Parameters : $computerid, $image
+ Returns : 1 success, 0 failed
+ Description : updates preferredimageid on provided computerid
+=cut
+
+sub setpreferredimage {
+ my ($computerid, $imageid) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "computerid: node is not defined") if (!(defined($computerid)));
+ notify($ERRORS{'WARNING'}, 0, "imageid: node is not defined") if (!(defined($imageid)));
+
+ my $update_statement = " UPDATE computer SET preferredimageid = $imageid WHERE id = $computerid ";
+
+ # Call the database execute subroutine
+ if (database_execute($update_statement)) {
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to update preferredimageid");
+ return 0;
+ }
+} ## end sub setpreferredimage
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _getcurrentimage
+
+ Parameters : $node
+ Returns : retrieve the currentimage from currentimage.txt file on the node
+ Description :
+
+=cut
+
+sub _getcurrentimage {
+
+ my $node = $_[0];
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "node is not defined") if (!(defined($node)));
+ # TODO - loop through the available ssh keys to figure out which one works
+ my $identity = $IDENTITY_bladerhel;
+ my @sshcmd = run_ssh_command($node, $identity, "cat currentimage.txt");
+ foreach my $s (@{$sshcmd[1]}) {
+ if ($s =~ /Warning: /) {
+ #need to run makesshgkh
+ #if (VCL::Module::Provisioning::xCAT::makesshgkh($node)) {
+ #success
+ #not worth output here
+ #}
+ #else {
+ #}
+ }
+ if ($s =~ /^(rh|win|fc|vmware)/) {
+ chomp($s);
+ if ($s =~ s/\x0d//) {
+ notify($ERRORS{'OK'}, 0, "stripped dos newline $s");
+ }
+ return $s;
+ }
+ } ## end foreach my $s (@{$sshcmd[1]})
+ return 0;
+} ## end sub _getcurrentimage
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 check_ssh
+
+ Parameters : $node, $port, $log
+ Returns : 1(active) or 0(inactive)
+ Description : uses check_ssh binary from tools dir to check
+ the sshd statuse on the remote node
+=cut
+
+sub check_ssh {
+ my ($node, $port, $log) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ $log = 0 if (!(defined($log)));
+ notify($ERRORS{'WARNING'}, $log, "node is not defined") if (!(defined($node)));
+ notify($ERRORS{'WARNING'}, $log, "port is not defined") if (!(defined($port)));
+
+ if (!defined($node)) {
+ return 0;
+ }
+ if (!defined($port)) {
+ $port = 22;
+ }
+ if (open(CHECKSSH, "$TOOLS/check_ssh -t 5 -p $port -H $node 2>&1 |")) {
+ my @ssh = <CHECKSSH>;
+ close(CHECKSSH);
+ foreach my $l (@ssh) {
+ if ($l =~ /SSH OK/) {
+ chomp($l);
+ notify($ERRORS{'OK'}, $log, " $node check_ssh module $l");
+ return 1;
+ }
+ if ($l =~ /check_ssh|No such file|Permission|socket/) {
+ chomp($l);
+ notify($ERRORS{'CRITICAL'}, $log, "$node $TOOLS/check_ssh problem $l");
+ return 0;
+ }
+ } ## end foreach my $l (@ssh)
+ return 0;
+ } ## end if (open(CHECKSSH, "$TOOLS/check_ssh -t 5 -p $port -H $node 2>&1 |"...
+
+} ## end sub check_ssh
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _sshd_status
+
+ Parameters : $node, $imagename, $log
+ Returns : on or off
+ Description : actually logs into remote node
+=cut
+
+sub _sshd_status {
+ my ($node, $imagename, $log) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ $log = 0 if (!defined($log));
+ notify($ERRORS{'WARNING'}, $log, "node is not defined") if (!(defined($node)));
+
+ if (!nmap_port($node, 22)) {
+ return "off";
+ }
+
+ if (!(check_ssh($node, 22))) {
+ return "off";
+ }
+
+ my $identity = $IDENTITY_wxp;
+ if (defined($imagename)) {
+ $identity = $IDENTITY_bladerhel if ($imagename =~ /^(rh[0-9]image|rhel[0-9]|fc[0-9]image|rhfc[0-9]|rhas[0-9]|esx[0-9]+)/);
+ }
+ #notify($ERRORS{'OK'},$log,"identity file $identity for imagename $imagename");
+ my @sshcmd = run_ssh_command($node, $identity, "uname -s", "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /^Warning:/) {
+ #if (VCL::Module::Provisioning::xCAT::makesshgkh($node)) {
+ #}
+ }
+ return "off" if ($l =~ /noping/);
+ return "off" if ($l =~ /No route to host/);
+ return "off" if ($l =~ /Connection refused/);
+ return "off" if ($l =~ /Permission denied/);
+ } ## end foreach my $l (@{$sshcmd[1]})
+ return "on";
+} ## end sub _sshd_status
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _machine_os
+
+ Parameters : $node, $imagename, $log
+ Returns : 0 or system type name
+ Description : actually logs into remote node
+=cut
+
+sub _machine_os {
+ my ($node, $imagename) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "node is not defined") if (!(defined($node)));
+ if (!nmap_port($node, 22)) {
+ notify($ERRORS{'OK'}, 0, "ssh port not open cannot check $node OS");
+ return 0;
+ }
+ my $identity;
+ if (defined($imagename)) {
+ $identity = $IDENTITY_bladerhel if ($imagename =~ /^(rhel|rh3image|fc|rh|esx)/);
+ }
+ else {
+ $identity = $IDENTITY_wxp;
+ }
+ my @sshcmd = run_ssh_command($node, $identity, "uname -s", "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /CYGWIN_NT-5\.1/) {
+ return "WinXp";
+ }
+ elsif ($l =~ "CYGWIN_NT-5\.2") {
+ return "win2003";
+ }
+ elsif ($l =~ /Linux/) {
+ return "Linux";
+ }
+ elsif ($l =~ /Connection refused/) {
+ return 0;
+ }
+ elsif ($l =~ /No route to host/) {
+ return 0;
+ }
+ elsif ($l =~ /Permission denied/) {
+ return 0;
+ }
+ else {
+ return 0;
+ }
+ } ## end foreach my $l (@{$sshcmd[1]})
+} ## end sub _machine_os
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _is_user_added
+
+ Parameters : $node, $user, $type, $os
+ Returns : 1 yes user exists - 0 no
+ Description : logs into remote node checks to see if
+ supplied user account exists
+=cut
+
+sub _is_user_added {
+ my ($node, $user, $type, $os) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "node is not defined") if (!(defined($node)));
+ notify($ERRORS{'WARNING'}, 0, "user is not defined") if (!(defined($user)));
+ notify($ERRORS{'WARNING'}, 0, "type is not defined") if (!(defined($type)));
+ notify($ERRORS{'WARNING'}, 0, "os is not defined") if (!(defined($os)));
+
+ my @lines;
+ my $l;
+ my @SSHCMD;
+
+ if ($type =~ /blade|virtualmachine/) {
+
+ if ($os =~ /^win|winxp|wxp|win2003|vmwarewin|vmwareesxwin/) {
+ undef @SSHCMD;
+ @SSHCMD = run_ssh_command($node, $IDENTITY_wxp, "cscript.exe //Nologo list_users.vbs", "root");
+ foreach $l (@{$SSHCMD[1]}) {
+ return 1 if ($l =~ /$user/);
+ }
+ return 0;
+ }
+ elsif ($os =~ /^(rhel|rh3image|rh|fc|esx)/) {
+ undef @SSHCMD;
+ @SSHCMD = run_ssh_command($node, $IDENTITY_bladerhel, "cat /etc/passwd", "root");
+ foreach $l (@{$SSHCMD[1]}) {
+ return 1 if ($l =~ /$user/);
+ }
+ return 0;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "osname is not defined or supported $os");
+ return 0;
+ }
+ } ## end if ($type =~ /blade|virtualmachine/)
+ elsif ($type eq "lab") {
+ #tobe done later
+
+ }
+} ## end sub _is_user_added
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 add_user
+
+ Parameters : $node, $user, $uid, $passwd, $hostname, $os, $remoteip, $grpflag, @group
+ Returns : 1 success, 0 failed
+ Description : logs into remote node adds supplied user account
+
+=cut
+
+sub add_user {
+ my ($node, $user, $uid, $passwd, $hostname, $os, $remoteip, $grpflag, @group) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "node is not defined") if (!(defined($node)));
+ notify($ERRORS{'WARNING'}, 0, "user is not defined") if (!(defined($user)));
+ notify($ERRORS{'OK'}, 0, "uid is not defined") if (!(defined($uid)));
+ notify($ERRORS{'WARNING'}, 0, "passwd is not defined") if (!(defined($passwd)));
+ notify($ERRORS{'WARNING'}, 0, "os is not defined") if (!(defined($os)));
+ notify($ERRORS{'OK'}, 0, "remoteip is not defined") if (!(defined($remoteip)));
+ notify($ERRORS{'OK'}, 0, "grpflag is not defined") if (!(defined($grpflag)));
+
+ if (!(defined($grpflag))) {
+ $grpflag = 0;
+ }
+ elsif ($grpflag > 0) {
+ notify($ERRORS{'OK'}, 0, "group access memberlist= @group ");
+ }
+
+ # set common linux useradd string
+ my $useradd_string;
+ if (!(defined($uid))) { # check for uid if not let OS set one
+ $useradd_string = "/usr/sbin/useradd -d /home/$user -m $user -g ncsu";
+ }
+ else {
+ $useradd_string = "/usr/sbin/useradd -u $uid -d /home/$user -m $user -g ncsu";
+ }
+
+ if ($os =~ /win|vmwarewin/) {
+ my @sshcmd1 = run_ssh_command($node, $IDENTITY_wxp, "cscript.exe //Nologo add_user.vbs $user $passwd", "root");
+ my $delete_user = 0;
+ foreach my $l (@{$sshcmd1[1]}) {
+ if ($l =~ /The filename, directory name, or volume label syntax is incorrect/) {
+ #ok, user is already there must have been a problem earlier
+ #let delete the user and continue
+ $delete_user = 1;
+ }
+
+ }
+ if ($delete_user) {
+ notify($ERRORS{'OK'}, 0, "error $user may already be listed");
+ if (del_user($node, $user, "blade", $os)) {
+ notify($ERRORS{'OK'}, 0, "$user deleted");
+ }
+
+ #rerun command
+ if (run_ssh_command($node, $IDENTITY_wxp, "cscript.exe //Nologo add_user.vbs $user $passwd", "root")) {
+ #good
+ }
+ } ## end if ($delete_user)
+
+ return _is_user_added($node, $user, "blade", $os);
+
+ notify($ERRORS{'OK'}, 0, "prep $node $user $passwd");
+
+ } ## end if ($os =~ /win|vmwarewin/)
+ elsif ($os =~ /^(rh[0-9]image|rhel[0-9]|fc[0-9]image|rhfc[0-9]|rhas[0-9]|esx)/) {
+
+ # two methods: single user or group of users
+ if ($grpflag) {
+ #assumes owner is already member of group
+ #ok group flag set proceed
+ my $allowuserstring = "AllowUsers";
+ foreach my $u (@group) {
+ #$u in form of unity:uid
+ my ($user_unityid, $uid) = split(":", $u);
+ my $cmd = "/usr/sbin/useradd -u $uid -d /home/$user_unityid -m $user_unityid -g ncsu";
+ if (run_ssh_command($node, $IDENTITY_bladerhel, $cmd, "root")) {
+ notify($ERRORS{'OK'}, 0, "added user $user_unityid to $node");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to execute $cmd");
+ return 0;
+ }
+ #append to ssh string
+ $allowuserstring .= " $user_unityid";
+ } ## end foreach my $u (@group)
+
+ # modify external_sshd config
+ my $cmdstring = "echo \"$allowuserstring\" >> /etc/ssh/external_sshd_config";
+ my @sshcmd;
+ if (run_ssh_command($node, $IDENTITY_bladerhel, $cmdstring, "root")) {
+ notify($ERRORS{'OK'}, 0, "adding user string to sshd conf $allowuserstring");
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($node, $IDENTITY_bladerhel, "/etc/init.d/ext_sshd restart", "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /Stopping ext_sshd:/i) {
+ #notify($ERRORS{'OK'},0,"stopping sshd on $node ");
+ }
+ if ($l =~ /Starting ext_sshd:[ OK ]/i) {
+ notify($ERRORS{'OK'}, 0, "ext_sshd on $node started");
+ }
+ } #foreach
+ notify($ERRORS{'OK'}, 0, "started ext_sshd on $node");
+ return 1;
+ } ## end if (run_ssh_command($node, $IDENTITY_bladerhel...
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "failed to add $allowuserstring to external_sshd_config on $node ");
+ return 0;
+ }
+
+ } ## end if ($grpflag)
+ else {
+ #single user proceed
+ my @sshcmd = run_ssh_command($node, $IDENTITY_bladerhel, $useradd_string, "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /user $user exists/) {
+ notify($ERRORS{'OK'}, 0, "detected user already has account, deleting");
+ #FIXME - if type or project is not HPC related.
+ if (del_user($node, $user, "blade", $os)) {
+ notify($ERRORS{'OK'}, 0, "$user deleted");
+ }
+ if (run_ssh_command($node, $IDENTITY_bladerhel, $useradd_string, "root")) {
+ notify($ERRORS{'OK'}, 0, "user $user added");
+ }
+ } ## end if ($l =~ /user $user exists/)
+
+ } ## end foreach my $l (@{$sshcmd[1]})
+ if (_is_user_added($node, $user, "blade", $os)) {
+ notify($ERRORS{'OK'}, 0, "added user account $user to $node");
+ undef @sshcmd;
+ my $cmd = "echo \"AllowUsers $user\" >> /etc/ssh/external_sshd_config";
+ if (run_ssh_command($node, $IDENTITY_bladerhel, $cmd, "root")) {
+ notify($ERRORS{'DEBUG'}, 0, "added AllowUsers $user to external_sshd_config");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "failed to add AllowUsers $user to external_sshd_config");
+ return 0;
+ }
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($node, $IDENTITY_bladerhel, "/etc/init.d/ext_sshd restart", "root");
+
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /Stopping ext_sshd:/i) {
+ #notify($ERRORS{'OK'},0,"stopping sshd on $node ");
+ }
+ if ($l =~ /Starting ext_sshd:[ OK ]/i) {
+ notify($ERRORS{'OK'}, 0, "ext_sshd on $node started");
+ }
+ } #foreach
+ notify($ERRORS{'OK'}, 0, "started ext_sshd on $node");
+ return 1;
+ } ## end if (_is_user_added($node, $user, "blade", ...
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "PROBLEM added user $user to $node @{ $sshcmd[1] }");
+ return 0;
+ }
+ # add user to external_sshd config
+ } # grpflag true
+ } # rhel
+ else {
+ return 0;
+ }
+} ## end sub add_user
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 add_users_by_group
+
+ Parameters : computer_short_name,pw,computer_hostname,OSname,%usergrpmembers
+ Returns : 1 sucess,0 failed
+ Description : adds a group users to remote machine
+
+=cut
+
+sub add_users_by_group {
+ my ($computer_short_name, $passwd, $computer_hostname, $OSname, %usermembers) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "computer_short_name is not defined") if (!(defined($computer_short_name)));
+ notify($ERRORS{'WARNING'}, 0, "pw is not defined") if (!(defined($passwd)));
+ notify($ERRORS{'WARNING'}, 0, "computer_hostname is not defined") if (!(defined($computer_hostname)));
+ notify($ERRORS{'WARNING'}, 0, "OSname is not defined") if (!(defined($OSname)));
+
+ #make sure we have something in our hash
+ if (scalar keys %usermembers < 2) {
+ notify($ERRORS{'WARNING'}, 0, "the supplied user group had 1 or less member");
+ }
+
+ foreach my $user (keys %usermembers) {
+ if ($OSname =~ /win|vmwarewin/) {
+ my $cmd = "cscript.exe //Nologo add_user.vbs $usermembers{$user}{username} $passwd";
+ my @cmdout = run_ssh_command($computer_short_name, $IDENTITY_wxp, $cmd, "root");
+ foreach my $line (@{$cmdout[1]}) {
+ #check for errors
+ notify($ERRORS{'DEBUG'}, 0, "return status $cmdout[0] output= $line");
+ }
+ }
+ } ## end foreach my $user (keys %usermembers)
+
+ return 1;
+} ## end sub add_users_by_group
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 del_user
+
+ Parameters : $node, $user, $type, $osname
+ Returns : 1 success 0 failure
+ Description : removes user account from specificed node
+
+=cut
+
+sub del_user {
+ my ($node, $user, $type, $osname) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "node is not defined") if (!(defined($node)));
+ notify($ERRORS{'WARNING'}, 0, "user is not defined") if (!(defined($user)));
+ notify($ERRORS{'WARNING'}, 0, "type is not defined") if (!(defined($type)));
+ notify($ERRORS{'WARNING'}, 0, "osname is not defined") if (!(defined($osname)));
+ #set variables to use
+ my $cmd;
+ my @sshcmd;
+ if ($type =~ /blade|virtualmachine/) {
+ #my $os = _machine_os($node);
+ if ($osname =~ /wxp|win|vmware/) {
+ $cmd = "cscript.exe //Nologo del_user.vbs $user";
+ @sshcmd = run_ssh_command($node, $IDENTITY_wxp, $cmd, "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /The filename, directory name, or volume label syntax is incorrect/) {
+ # user account not listed. no need to confirm
+ return 1;
+ }
+
+ }
+ notify($ERRORS{'DEBUG'}, 0, "cscript.exe //Nologo del_user.vbs $user produced output: " . join("\n", @{$sshcmd[1]}));
+
+ if (!(_is_user_added($node, $user, $type, $osname))) {
+ return 1;
+ }
+ else {
+ return 0;
+ }
+
+ #make sure user home dir is deleted
+ undef $cmd;
+ undef @sshcmd;
+ $cmd = "/bin/rm -rf /cygdrive/c/Documents\ and\ Settings/$user";
+ @sshcmd = run_ssh_command($node, $IDENTITY_wxp, $cmd, "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ #shouldn't have any output - report if necessary
+ notify($ERRORS{'DEBUG'}, 0, "$cmd produced output $l");
+ }
+
+ } ## end if ($osname =~ /wxp|win|vmware/)
+ elsif ($osname =~ /^(rh[0-9]image|rhel[0-9]|fc[0-9]image|rhfc[0-9]|rhas[0-9]|esx[0-9]+)/) {
+ #remove user from machine
+ my @file;
+ my $l;
+ undef $cmd;
+ undef @sshcmd;
+ # do not currently use userdel -r will affect HPC user storage for HPC installs
+ $cmd = "/usr/sbin/userdel $user";
+ @sshcmd = run_ssh_command($node, $IDENTITY_bladerhel, $cmd, "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /currently logged in/) {
+ notify($ERRORS{'WARNING'}, 0, "$user currently logged in returning 0");
+ return 0;
+ }
+ }
+ #user successfully deleted
+ my $path1 = "$node:/etc/ssh/external_sshd_config";
+ my $path2 = "/tmp/$node.sshd";
+ if (run_scp_command($path1, $path2, $IDENTITY_bladerhel)) {
+ notify($ERRORS{'DEBUG'}, 0, "scp success retrieved $path1");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to retrieve $path1");
+ return 0;
+ }
+ #remove from sshd
+ if (open(SSHDCFG, "/tmp/$node.sshd")) {
+ @file = <SSHDCFG>;
+ close SSHDCFG;
+ foreach $l (@file) {
+ $l = "" if ($l =~ /AllowUsers/);
+ }
+ if (open(SCP, ">/tmp/$node.sshd")) {
+ print SCP @file;
+ close SCP;
+ }
+ undef $path1;
+ undef $path2;
+ $path1 = "/tmp/$node.sshd";
+ $path2 = "$node:/etc/ssh/external_sshd_config";
+ if (run_scp_command($path1, $path2, $IDENTITY_bladerhel)) {
+ notify($ERRORS{'DEBUG'}, 0, "scp success copied $path1 to $path2");
+ unlink $path1;
+ #turn off external sshd
+ if (run_ssh_command($node, $IDENTITY_bladerhel, "/etc/init.d/ext_sshd stop")) {
+ notify($ERRORS{'DEBUG'}, 0, "turned off ext_sshd on $node");
+ }
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to copy $path1 to $path2");
+ return 0;
+ }
+ } ## end if (open(SSHDCFG, "/tmp/$node.sshd"))
+ } ## end elsif ($osname =~ /^(rh[0-9]image|rhel[0-9]|fc[0-9]image|rhfc[0-9]|rhas[0-9]|esx[0-9]+)/) [ if ($osname =~ /wxp|win|vmware/)
+ else {
+ notify($ERRORS{'WARNING'}, 0, "$osname does not exist ");
+ return 0;
+ }
+ } ## end if ($type =~ /blade|virtualmachine/)
+
+} ## end sub del_user
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 disablesshd
+
+ Parameters : $hostname, $unityname, $remoteIP, $state, $osname, $log
+ Returns : 1 success 0 failure
+ Description : using ssh identity key log into remote lab machine
+ and set flag for vclclientd to disable sshd for remote user
+
+=cut
+
+sub disablesshd {
+ my ($hostname, $unityname, $remoteIP, $state, $osname, $log) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ $log = 0 if (!(defined($log)));
+ notify($ERRORS{'WARNING'}, $log, "hostname is not defined") if (!(defined($hostname)));
+ notify($ERRORS{'WARNING'}, $log, "unityname is not defined") if (!(defined($unityname)));
+ notify($ERRORS{'WARNING'}, $log, "remoteIP is not defined") if (!(defined($remoteIP)));
+ notify($ERRORS{'WARNING'}, $log, "state is not defined") if (!(defined($state)));
+ notify($ERRORS{'WARNING'}, $log, "osname is not defined") if (!(defined($osname)));
+
+ if (!(defined($remoteIP))) {
+ $remoteIP = "127.0.0.1";
+ }
+ my @lines;
+ my $l;
+ my $identity;
+ if ($osname =~ /sun4x_/) {
+ $identity = $IDENTITY_solaris_lab;
+ }
+ elsif ($osname =~ /rhel/) {
+ $identity = $IDENTITY_linux_lab;
+ }
+ else {
+ #if all else fails
+ $identity = $IDENTITY_solaris_lab;
+ }
+ # create clientdata file
+ my $clientdata = "/tmp/clientdata.$hostname";
+ if (open(CLIENTDATA, ">$clientdata")) {
+ print CLIENTDATA "$state\n";
+ print CLIENTDATA "$unityname\n";
+ print CLIENTDATA "$remoteIP\n";
+ close CLIENTDATA;
+
+ # scp to hostname
+ my $target = "vclstaff\@$hostname:/home/vclstaff/clientdata";
+ if (run_scp_command($clientdata, $target, $identity, "24")) {
+ notify($ERRORS{'OK'}, $log, "Success copied $clientdata to $target");
+ unlink($clientdata);
+
+ # send flag to activate changes
+ my @sshcmd = run_ssh_command($hostname, $identity, "echo 1 > /home/vclstaff/flag", "vclstaff", "24");
+ notify($ERRORS{'OK'}, $log, "setting flag to 1 on $hostname");
+
+ my $nmapchecks = 0;
+ # return nmap check
+
+ NMAPPORT:
+ if (!(nmap_port($hostname, 22))) {
+ return 1;
+ }
+ else {
+ if ($nmapchecks < 5) {
+ $nmapchecks++;
+ sleep 1;
+ notify($ERRORS{'OK'}, $log, "port 22 not closed yet calling NMAPPORT code block");
+ goto NMAPPORT;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, $log, "port 22 never closed on client $hostname");
+ return 0;
+ }
+ } ## end else [ if (!(nmap_port($hostname, 22)))
+ } ## end if (run_scp_command($clientdata, $target, ...
+ else {
+ notify($ERRORS{'OK'}, $log, "could not copy src=$clientdata to target=$target");
+ return 0;
+ }
+ } ## end if (open(CLIENTDATA, ">$clientdata"))
+ else {
+ notify($ERRORS{'WARNING'}, $log, "could not open /tmp/clientdata.$hostname $! ");
+ return 0;
+ }
+} ## end sub disablesshd
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 enablesshd
+
+ Parameters : $hostname, $unityname, $remoteIP, $state, $osname, $log
+ Returns : 1 success 0 failure
+ Description : using ssh identity key log into remote lab machine
+ and set flag for vclclientd to enable ssh access for remote user
+
+=cut
+
+sub enablesshd {
+ my ($hostname, $unityname, $remoteIP, $state, $osname, $log) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ $log = 0 if (!(defined($log)));
+ notify($ERRORS{'WARNING'}, $log, "hostname is not defined") if (!(defined($hostname)));
+ notify($ERRORS{'WARNING'}, $log, "unityname is not defined") if (!(defined($unityname)));
+ notify($ERRORS{'WARNING'}, $log, "remoteIP is not defined") if (!(defined($remoteIP)));
+ notify($ERRORS{'WARNING'}, $log, "state is not defined") if (!(defined($state)));
+ notify($ERRORS{'WARNING'}, $log, "osname is not defined") if (!(defined($osname)));
+ my $identity;
+
+ if ($osname =~ /sun4x_/) {
+ $identity = $IDENTITY_solaris_lab;
+ }
+ elsif ($osname =~ /rhel/) {
+ $identity = $IDENTITY_linux_lab;
+ }
+ # create clientdata file
+ my $clientdata = "/tmp/clientdata.$hostname";
+ if (open(CLIENTDATA, ">$clientdata")) {
+ print CLIENTDATA "$state\n";
+ print CLIENTDATA "$unityname\n";
+ print CLIENTDATA "$remoteIP\n";
+ close CLIENTDATA;
+
+ # scp to hostname
+ my $target = "vclstaff\@$hostname:/home/vclstaff/clientdata";
+ if (run_scp_command($clientdata, $target, $identity, "24")) {
+ notify($ERRORS{'OK'}, $log, "Success copied $clientdata to $target");
+ unlink($clientdata);
+
+ # send flag to activate changes
+ my @sshcmd = run_ssh_command($hostname, $identity, "echo 1 > /home/vclstaff/flag", "vclstaff", "24");
+ notify($ERRORS{'OK'}, $log, "setting flag to 1 on $hostname");
+
+ my $nmapchecks = 0;
+ # return nmap check
+
+ NMAPPORT:
+ if (nmap_port($hostname, 22)) {
+ notify($ERRORS{'OK'}, $log, "sshd opened");
+ return 1;
+ }
+ else {
+ if ($nmapchecks < 6) {
+ $nmapchecks++;
+ sleep 1;
+ #notify($ERRORS{'OK'},0,"calling NMAPPORT code block");
+ goto NMAPPORT;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, $log, "port 22 never opened on client $hostname");
+ return 0;
+ }
+ } ## end else [ if (nmap_port($hostname, 22))
+ } ## end if (run_scp_command($clientdata, $target, ...
+ else {
+ notify($ERRORS{'WARNING'}, $log, "could not copy src=$clientdata to target= $target");
+ return 0;
+ }
+ } ## end if (open(CLIENTDATA, ">$clientdata"))
+ else {
+ notify($ERRORS{'WARNING'}, $log, "could not open /tmp/clientdata.$hostname $! ");
+ return 0;
+ }
+} ## end sub enablesshd
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 nmap_port
+
+ Parameters : $hostname, $port
+ Returns : 1 open 0 closed
+ Description : use nmap port scanning tool to determine if port is open
+
+=cut
+
+sub nmap_port {
+ my ($hostname, $port) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "hostname is not defined") if (!(defined($hostname)));
+ notify($ERRORS{'WARNING'}, 0, "port is not defined") if (!(defined($port)));
+ my @file;
+ my $l;
+ if (open(NMAP, "/usr/bin/nmap $hostname -P0 -p $port -T Aggressive |")) {
+ @file = <NMAP>;
+ close NMAP;
+ foreach $l (@file) {
+ if ($l =~ /open/) {
+ return 1;
+ }
+ elsif ($l =~ /is: closed/) {
+ return 0;
+ }
+ elsif ($l =~ /Host seems down/) {
+ return 0;
+ }
+ elsif ($l =~ /filtered/) {
+ return 0;
+ }
+ } ## end foreach $l (@file)
+ } ## end if (open(NMAP, "/usr/bin/nmap $hostname -P0 -p $port -T Aggressive |"...
+ else {
+ notify($ERRORS{'WARNING'}, 0, "problems executing /usr/bin/nmap $hostname -P0 -p $port $!");
+ return 0;
+ }
+ return 0;
+} ## end sub nmap_port
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _pingnode
+
+ Parameters : $hostname
+ Returns : 1 pingable 0 not-pingable
+ Description : using Net::Ping to check if node is pingable
+ assumes icmp echo is allowed
+=cut
+
+sub _pingnode {
+ my ($hostname) = $_[0];
+
+ my $p = Net::Ping->new("icmp");
+ my $result = $p->ping($hostname, 1);
+ $p->close();
+
+ if (!$result) {
+ return 0;
+ }
+ else {
+ return 1;
+ }
+} ## end sub _pingnode
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 virtual_status_unix
+
+ Parameters : $hostname, $os, $mnOS, $ipaddress, $log
+ Returns : array of values - pingable,sshd,vclclientd running
+ Description : runs status check on supplied node
+=cut
+
+sub virtual_status_unix {
+ my ($hostname, $os, $mnOS, $ipaddress, $log) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ $log = 0 if (!(defined($log)));
+ notify($ERRORS{'WARNING'}, $log, "hostname is not defined") if (!(defined($hostname)));
+ notify($ERRORS{'WARNING'}, $log, "os is not defined") if (!(defined($os)));
+ notify($ERRORS{'WARNING'}, $log, "ManagementNode OS is not defined") if (!(defined($mnOS)));
+ notify($ERRORS{'WARNING'}, $log, "ipaddress is not defined") if (!(defined($ipaddress)));
+ my @status;
+ # status[0] = pingable
+ # status[1] = port 24 accessible
+ # status[2] = vclclientd running
+ # status[3] =
+ my @file;
+ my $p;
+ my $osname = lc($^O);
+ $mnOS = $osname;
+ notify($ERRORS{'DEBUG'}, $log, "virtual_status_unix MNos= $mnOS");
+
+
+ #is host listed in our local known_hosts file?
+ if (known_hosts($hostname, $mnOS, $ipaddress)) {
+ notify($ERRORS{'OK'}, $log, "$hostname pub key added to local known_hosts");
+ }
+ else {
+ notify($ERRORS{'OK'}, $log, "failed to add $hostname pub rsa key to local known_hosts");
+ }
+
+ #is pingable
+ $status[0] = _pingnode($ipaddress);
+
+ #is ssh open on admin port
+ my @ssh;
+ my ($n, $identity);
+
+ if ($os =~ /sun4x/) {
+ $identity = $IDENTITY_solaris_lab;
+ }
+ elsif ($os =~ /rhel/) {
+ $identity = $IDENTITY_linux_lab;
+ }
+ else {
+ notify($ERRORS{'OK'}, $log, "os $os set but not something I can handle yet, will attempt the unix identity.");
+
+ $identity = $IDENTITY_solaris_lab;
+ }
+ $status[1] = 0;
+ if (check_ssh($ipaddress, 24, $log)) {
+ my $shortname = $1 if ($hostname =~ /([-_a-zA-Z0-9]*)\./);
+ $shortname = $hostname if (!defined($shortname));
+
+ my @ssh = run_ssh_command($ipaddress, $identity, "echo testing", "vclstaff", 24);
+ foreach $n (@{$ssh[1]}) {
+ next if ($n =~ /Warning: Permanently added/);
+ notify($ERRORS{'OK'}, $log, "$n");
+ if ($n =~ /testing/) {
+ $status[1] = 1;
+ notify($ERRORS{'OK'}, $log, "SUCCESS $ipaddress port 24 is accessible");
+ }
+ }
+ if ($status[1]) {
+ #is vclclientd running
+ $status[2] = 0;
+ my @file = run_ssh_command($ipaddress, $identity, "pgrep vclclient", "vclstaff", 24);
+ foreach my $f (@{$file[1]}) {
+ chomp($f);
+ next if ($f =~ /Warning: Permanently added/);
+ if ($f =~ /[0-9]+/) {
+ #notify($ERRORS{'OK'},$log,"SUCCESS vclclientd is running on $hostname");
+ $status[2] = 1;
+ }
+ }
+ } ## end if ($status[1])
+ else {
+ # hrm -p24 is not accessible
+ # return so caller can try to get another machine
+ notify($ERRORS{'WARNING'}, $log, "FAILURE $hostname port 24 is NOT accessible ssh output @ssh");
+ $status[2] = 0;
+ }
+ } ## end if (check_ssh($ipaddress, 24, $log))
+ return @status;
+} ## end sub virtual_status_unix
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 getnewdbh
+
+ Parameters : none
+ Returns : 0 failed or database handle
+ Description : gets a databasehandle
+
+=cut
+
+sub getnewdbh {
+ #my $caller_trace = get_caller_trace(7, 1);
+ #notify($ERRORS{'DEBUG'}, 0, "called from: $caller_trace");
+
+ my ($database) = @_;
+ $database = $DATABASE if !$database;
+
+ my $dbh;
+
+ # Try to use the existing database handle
+ if (defined $ENV{dbh} && $ENV{dbh} && $ENV{dbh}->ping) {
+ #notify($ERRORS{'DEBUG'}, 0, "using database handle stored in \$ENV{dbh}");
+ return $ENV{dbh};
+ }
+ elsif (defined $ENV{dbh}) {
+ notify($ERRORS{'DEBUG'}, 0, "unable to use database handle stored in \$ENV{dbh}");
+ }
+ else {
+ #notify($ERRORS{'DEBUG'}, 0, "\$ENV{dbh} is not defined, creating new database handle");
+ }
+
+ my $attempt = 0;
+ my $max_attempts = 5;
+ my $retry_delay = 2;
+
+ # Assemble the data source string
+ my $data_source;
+ if ($MYSQL_SSL) {
+ $data_source = "$database:$SERVER;mysql_ssl=1;mysql_ssl_ca_file=$MYSQL_SSL_CERT";
+ }
+ else {
+ $data_source = "$database:$SERVER";
+ }
+
+ # Attempt to connect to the data source and get a database handle object
+ my $dbi_result;
+ while (!$dbh && $attempt < $max_attempts) {
+ $attempt++;
+
+ # Attempt to connect
+ #notify($ERRORS{'DEBUG'}, 0, "attempting to connect to data source: $data_source, user: " . string_to_ascii($WRTUSER) . ", pass: " . string_to_ascii($WRTPASS));
+ $dbh = DBI->connect(qq{dbi:mysql:$data_source}, $WRTUSER, $WRTPASS, {PrintError => 0});
+
+ # Check if connect was successful
+ if ($dbh && $dbh->ping) {
+ # Set InactiveDestroy = 1 for all dbh's belonging to child processes
+ # Set InactiveDestroy = 0 for all dbh's belonging to vcld
+ if (!defined $ENV{vcld} || !$ENV{vcld}) {
+ $dbh->{InactiveDestroy} = 1;
+ }
+ else {
+ $dbh->{InactiveDestroy} = 0;
+ }
+
+ # Increment the dbh count environment variable if it is defined
+ # This is only for development and testing to see how many handles a process creates
+ $ENV{dbh_count}++ if defined($ENV{dbh_count});
+
+ # Store the newly created database handle in an environment variable
+ # Only store it if $ENV{dbh} is already defined
+ # It's up to other modules to determine if $ENV{dbh} is defined, they must initialize it
+ if (defined $ENV{dbh}) {
+ $ENV{dbh} = $dbh;
+ notify($ERRORS{'DEBUG'}, 0, "database handle stored in \$ENV{dbh} ($ENV{dbh_count})");
+ }
+
+ return $dbh;
+ } ## end if ($dbh && $dbh->ping)
+
+ # Something went wrong, construct a DBI result string
+ $dbi_result = "DBI result: ";
+ if (defined(DBI::err())) {
+ $dbi_result = "(" . DBI::err() . ")";
+ }
+ if (defined(DBI::errstr())) {
+ $dbi_result .= " " . DBI::errstr();
+ }
+
+ # Check for access denied
+ if (DBI::err() == 1045 || DBI::errstr() =~ /access denied/i) {
+ notify($ERRORS{'WARNING'}, 0, "unable to connect to database, $dbi_result");
+ return 0;
+ }
+
+ # Either connect or ping failed
+ if ($dbh && !$dbh->ping) {
+ notify($ERRORS{'DEBUG'}, 0, "database connect succeeded but ping failed, attempt $attempt/$max_attempts, $dbi_result");
+ $dbh->disconnect;
+ }
+ else {
+ notify($ERRORS{'DEBUG'}, 0, "database connect failed, attempt $attempt/$max_attempts, $dbi_result");
+ }
+
+ notify($ERRORS{'DEBUG'}, 0, "sleeping for $retry_delay seconds");
+ sleep $retry_delay;
+ next;
+ } ## end while (!$dbh && $attempt < $max_attempts)
+
+ # Maximum number of attempts was reached
+ notify($ERRORS{'WARNING'}, 0, "failed to connect to database, attempts made: $attempt/$max_attempts, $dbi_result");
+ return 0;
+} ## end sub getnewdbh
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 notify_via_wall
+
+ Parameters : empty
+ Returns : 0 or 1
+ Description : talks to user at the console using wall
+
+=cut
+
+sub notify_via_wall {
+ my ($hostname, $username, $string, $OSname, $type) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "hostname is not defined") if (!(defined($hostname)));
+ notify($ERRORS{'WARNING'}, 0, "username is not defined") if (!(defined($username)));
+ notify($ERRORS{'WARNING'}, 0, "string is not defined") if (!(defined($string)));
+ notify($ERRORS{'WARNING'}, 0, "OSname is not defined") if (!(defined($OSname)));
+ notify($ERRORS{'WARNING'}, 0, "type is not defined") if (!(defined($type)));
+ my @ssh;
+ my $n;
+ my $identity;
+ #create file, copy to remote host, then run wall
+ if (open(TMP, ">/tmp/wall.$hostname")) {
+ print TMP $string;
+ close TMP;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "could not open tmp file $!");
+ }
+ if ($type eq "blade") {
+ #this is only going to be rhel
+ if (run_scp_command("/tmp/wall.$hostname", "$hostname:/root/wall.txt", $IDENTITY_bladerhel)) {
+ unlink "/tmp/wall.$hostname";
+ if (run_ssh_command($hostname, $IDENTITY_bladerhel, " cat /root/wall.txt \| wall; /bin/rm -v /root/wall.txt", "root")) {
+ notify($ERRORS{'OK'}, 0, "successfully sent wall notification to $hostname");
+ return 1;
+ }
+ }
+ } ## end if ($type eq "blade")
+ elsif ($type eq "lab") {
+ if ($OSname =~ /sun4x_/) {
+ $identity = $IDENTITY_solaris_lab;
+ }
+ elsif ($OSname =~ /rhel/) {
+ $identity = $IDENTITY_linux_lab;
+ }
+ else {
+ #all else fails
+ $identity = $IDENTITY_solaris_lab;
+ }
+
+ if (run_scp_command("/tmp/wall.$hostname", "vclstaff\@$hostname:/home/vclstaff/wall.txt", $identity, 24)) {
+ unlink "/tmp/wall.$hostname";
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "could not scp tmp file for wall notification$!");
+ }
+
+ if ($OSname =~ /sun4x_/) {
+ if (run_ssh_command($hostname, $identity, "wall -a /home/vclstaff/wall.txt; /bin/rm -v /home/vclstaff/wall.txt", "vclstaff", "24")) {
+ notify($ERRORS{'OK'}, 0, "successfully sent wall notification to $hostname");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "wall notification $hostname failed ");
+ }
+ }
+ elsif ($OSname =~ /rhel/) {
+ if (run_ssh_command($hostname, $identity, "cat /home/vclstaff/wall.txt \| wall ; /bin/rm -v /home/vclstaff/wall.txt", "vclstaff", "24")) {
+ notify($ERRORS{'OK'}, 0, "successfully sent wall notification to $hostname");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "wall notification $hostname failed ");
+ }
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "not an OS I can handle, os is $OSname");
+ }
+ return 1;
+ } ## end elsif ($type eq "lab") [ if ($type eq "blade")
+} ## end sub notify_via_wall
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 isfilelocked
+
+ Parameters : $file - file path
+ Returns : 0 no or 1 yes
+ Description : looks for supplied file
+ appends .lock to the end of supplied file
+
+=cut
+
+sub isfilelocked {
+ my ($file) = $_[0];
+ my $lockfile = $file . ".lock";
+ if (-r $lockfile) {
+ return 1;
+ }
+ else {
+ return 0;
+ }
+} ## end sub isfilelocked
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 lockfile
+
+ Parameters : $file
+ Returns : 0 failed or 1 success
+ Description : creates $file.lock
+
+=cut
+
+sub lockfile {
+ my ($file) = $_[0];
+ my $lockfile = $file . ".lock";
+ while (!(-r $lockfile)) {
+ if (open(LOCK, ">$lockfile")) {
+ print LOCK "1";
+ close LOCK;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "could not create $lockfile $!");
+ return 0;
+ }
+ return 1;
+ } ## end while (!(-r $lockfile))
+} ## end sub lockfile
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 unlockfile
+
+ Parameters : $file
+ Returns : 0 or 1
+ Description : removes file if exists
+
+=cut
+
+sub unlockfile {
+ my ($file) = $_[0];
+ my $lockfile = $file . ".lock";
+ if (-r $lockfile) {
+ unlink $lockfile;
+ }
+ else {
+ # no lock file exists
+ }
+ return 1;
+} ## end sub unlockfile
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 notify_via_msg
+
+ Parameters : $node, $user, $message
+ Returns : 0 or 1
+ Description : using windows msg.exe cmd writes supplied $message
+ to windows user console
+
+=cut
+
+sub notify_via_msg {
+ my ($node, $user, $message) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ my $osname = lc($^O);
+ if ($osname =~ /win/i) {
+ notify($ERRORS{'OK'}, 0, "notifying from Windows not yet supported\n-----\nTo: $user\nNode: $node\n$message\n-----");
+ return;
+ }
+ notify($ERRORS{'WARNING'}, 0, "node is not defined") if (!(defined($node)));
+ notify($ERRORS{'WARNING'}, 0, "message is not defined") if (!(defined($message)));
+ notify($ERRORS{'WARNING'}, 0, "user is not defined") if (!(defined($user)));
+
+ # Escape new lines
+ $message =~ s/\n/ /gs;
+ $message =~ s/\'/\\\\\\\'/gs;
+ notify($ERRORS{'DEBUG'}, 0, "message:\n$message");
+
+ my $command = "msg $user /TIME:180 '$message'";
+
+ if (run_ssh_command($node, $IDENTITY_wxp, $command)) {
+ notify($ERRORS{'OK'}, 0, "successfully sent message to Windows user $user on $node");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to send message to Windows user $user on $node");
+ return 0;
+ }
+
+} ## end sub notify_via_msg
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 getpw
+
+ Parameters : length(optional) - if not defined sets to 6
+ Returns : randomized password
+ Description : called for standalone accounts and used in randomizing
+ privileged account passwords
+=cut
+
+sub getpw {
+
+ my $length = $_[0];
+ $length = 6 if (!(defined($length)));
+ my @a = ("A" .. "H", "J" .. "N", "P" .. "Z", "a" .. "k", "m" .. "z", "2" .. "9");
+ my $b;
+ srand;
+ for (1 .. $length) {
+ $b .= $a[rand(57)];
+ }
+ return $b;
+
+} ## end sub getpw
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 changewindowspasswd
+
+ Parameters : node, account
+ Returns : 0 or 1
+ Description : changes windows password on given node for given account
+
+=cut
+
+sub changewindowspasswd {
+ # change the privileged account passwords on the blade images
+ my ($node, $account, $passwd) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "node is not defined") if (!(defined($node)));
+ notify($ERRORS{'WARNING'}, 0, "account is not defined") if (!(defined($account)));
+
+
+ #copy setpass.vbs to blade
+ #set password for root and administrator accounts
+ #remove setpass.vbs from blade
+ my @ssh;
+ my $l;
+ my @sshcmd;
+ #if not a predefined password, get one!
+ if (!(defined($passwd))) {
+ $passwd = getpw(15);
+ }
+ if (run_scp_command("$TOOLS/setpass.vbs", "$node:setpass.vbs", $IDENTITY_wxp)) {
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($node, $IDENTITY_wxp, "cscript.exe //Nologo setpass.vbs $account $passwd", "root");
+ for $l (@{$sshcmd[1]}) {
+ if ($l =~ /Input Error/) {
+ notify($ERRORS{'WARNING'}, 0, "$node: could not run setpass.vbs");
+ return 0;
+ }
+ }
+ if ($account eq "root") {
+ #must set sshd service password also...
+ my $cmd = "cmd /c C:\/WINDOWS\/system32\/sc config sshd password= $passwd";
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($node, $IDENTITY_wxp, "$cmd", "root");
+ foreach $l (@{$sshcmd[1]}) {
+ if ($l =~ /ChangeServiceConfig SUCCESS/) {
+ notify($ERRORS{'OK'}, 0, "$node: serviceConfig sshd password change success");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "$node: serviceConfig $l");
+ }
+ }
+ } ## end if ($account eq "root")
+ #remove setpass.vbs
+ if (run_ssh_command($node, $IDENTITY_wxp, "/bin/rm -v setpass.vbs", "root")) {
+ #good removed setpass.vbs
+ }
+ return 1;
+ } ## end if (run_scp_command("$TOOLS/setpass.vbs", ...
+ return 0;
+} ## end sub changewindowspasswd
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 _killsysprep
+
+ Parameters : node
+ Returns : 0 failed or 1 success
+ Description : stops ssh initiated sysprep command,
+ because the the box reboots and the command hangs
+
+=cut
+
+sub _killsysprep {
+ my $node = $_[0];
+ if (open(PS, "ps -ef |")) {
+ notify($ERRORS{'DEBUG'}, 0, "_killsysprep: listing processes sysprep for $node");
+ my @ps = <PS>;
+ close(PS);
+ foreach my $p (@ps) {
+ if (($p =~ /sysprep.cmd/) && ($p =~ /$node/)) {
+ notify($ERRORS{'DEBUG'}, 0, "_killsysprep: found sysprep.cmd on $node");
+ if ($p =~ /(root)\s+([0-9]*)/) {
+ notify($ERRORS{'DEBUG'}, 0, "_killsysprep: located pid $2");
+ if (open(KILLIT, "kill -9 $2 |")) {
+ close(KILLIT);
+ notify($ERRORS{'OK'}, 0, "killed -9 $2 : $p");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "could not execute kill -9 $!");
+ }
+ } ## end if ($p =~ /(root)\s+([0-9]*)/)
+ } ## end if (($p =~ /sysprep.cmd/) && ($p =~ /$node/...
+ } ## end foreach my $p (@ps)
+
+ } ## end if (open(PS, "ps -ef |"))
+ else {
+ notify($ERRORS{'WARNING'}, 0, "could not execute ps $!");
+ }
+
+ return 1;
+
+} ## end sub _killsysprep
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 remotedesktopport
+
+ Parameters : node,state,remoteaddress
+ Returns : 0 failed or 1 success
+ Description : routine to enable or disable remotedesktop port on xp blades
+ only currently works with windows XP service pack 2
+=cut
+
+sub remotedesktopport {
+ my ($node, $state, $remoteaddress) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'CRITICAL'}, 0, "$node is not defined") if (!(defined($node)));
+ notify($ERRORS{'CRITICAL'}, 0, "$state is not defined") if (!(defined($state)));
+
+
+ #machine must have the ability to edit firewall service using netsh firewall set service...
+ my @list;
+ my $RDopen = 0;
+ my @sshcmd = run_ssh_command($node, $IDENTITY_wxp, "netsh firewall show state", "root");
+ if (!($sshcmd[0])) {
+ #notify($ERRORS{'WARNING'}, 0, "failed to run netsh firewall show state on $node");
+ }
+ for my $l (@{$sshcmd[1]}) {
+ if ($l =~ /The following command was not found: firewall show/) {
+ notify($ERRORS{'OK'}, 0, "firewall support is not available on $node returning true");
+ return 1;
+ }
+ if ($l =~ /3389/) {
+ #it's open
+ $RDopen = 1;
+ }
+ } ## end for my $l (@{$sshcmd[1]})
+
+ if ($state eq "ENABLE") {
+ my ($netsh, $breakdown);
+ if (defined($remoteaddress)) {
+ # if(open(HOST,"/usr/bin/host $remoteaddress 2>&1 |")){
+ # my @host =<HOST>;
+ # close(HOST);
+ # foreach my $h (@host) {
+ # #sas environment users make http reservation through load-balanced set of outgoing servers but
+ # # connection is attempted through a nat server with different address
+ # # this could be the case at other locations as well
+ # $breakdown=1 if($h =~ /sas.com/);
+ # }
+ # }
+ if (!($remoteaddress)) {
+ #should really check if a valid address
+ #it's defined but equals 0 just open
+ #no address was provided, just open it
+ #$netsh = "netsh firewall set service REMOTEDESKTOP ENABLE";
+ $netsh = "netsh firewall set portopening TCP 3389 RDP enable ALL";
+ notify($ERRORS{'OK'}, 0, "no address provided, $node remotedesktop port enable executing");
+ }
+ else {
+ $breakdown = 1;
+ if ($breakdown) {
+ #break down address
+ my ($q1, $q2, $q3, $q4) = split(/[.]/, $remoteaddress);
+ if ($q1) {
+ $remoteaddress = "$q1.$q2.0.0/255.255.0.0";
+ notify($ERRORS{'OK'}, 0, "enabling broad scope address $remoteaddress");
+ $netsh = "netsh firewall set portopening TCP 3389 RDP enable CUSTOM $remoteaddress";
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "detected sas.com but could not break appart $remoteaddress, leaving empty");
+ $netsh = "netsh firewall set portopening TCP 3389 RDP enable ALL";
+ }
+ } ## end if ($breakdown)
+ else {
+ $netsh = "netsh firewall set portopening TCP 3389 RDP enable CUSTOM $remoteaddress";
+ #$netsh = "netsh firewall set service REMOTEDESKTOP ENABLE CUSTOM $remoteaddress";
+ notify($ERRORS{'OK'}, 0, "$node remotedesktop port enable custom address $remoteaddress executing");
+ }
+ } ## end else [ if (!($remoteaddress))
+ } ## end if (defined($remoteaddress))
+ else {
+ #no address was provided, just open it
+ #$netsh = "netsh firewall set service REMOTEDESKTOP ENABLE";
+ $netsh = "netsh firewall set portopening TCP 3389 RDP enable ALL";
+ notify($ERRORS{'OK'}, 0, "no address provided, $node remotedesktop port enable executing");
+ }
+
+ my $RDopen = 0;
+ my @enable = run_ssh_command($node, $IDENTITY_wxp, $netsh, "root");
+ foreach my $e (@{$enable[1]}) {
+ if ($e =~ /Ok/i) {
+ notify($ERRORS{'DEBUG'}, 0, "netsh command $netsh executed ");
+ }
+ }
+ #dbl check
+ @sshcmd = run_ssh_command($node, $IDENTITY_wxp, "netsh firewall show state", "root");
+ for my $l (@{$sshcmd[1]}) {
+ $RDopen = 1 if ($l =~ /3389/);
+ }
+ if ($RDopen) {
+ notify($ERRORS{'OK'}, 0, "$node remotedesktop port opened");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "$node remotedesktop port not opened");
+ return 0;
+ }
+ } ## end if ($state eq "ENABLE")
+ if ($state eq "DISABLE") {
+ if ($RDopen) {
+ $RDopen = 0;
+ #Disable it
+ undef @sshcmd;
+ if (run_ssh_command($node, $IDENTITY_wxp, "netsh firewall set service REMOTEDESKTOP DISABLE", "root")) {
+ notify($ERRORS{'OK'}, 0, "$node remotedesktop port disabled");
+ }
+ #dbl check
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($node, $IDENTITY_wxp, "netsh firewall show state", "root");
+ if (!@sshcmd) {
+ notify($ERRORS{'WARNING'}, 0, "failed to run netsh firewall show state on $node");
+ }
+ for my $l (@{$sshcmd[1]}) {
+ $RDopen = 1 if ($l =~ /3389/);
+ }
+ } ## end if ($RDopen)
+ #is it closed or open
+ if ($RDopen) {
+ notify($ERRORS{'OK'}, 0, "$node remotedesktop port still open");
+ return 0;
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "$node remotedesktop port closed");
+ return 1;
+ }
+ } ## end if ($state eq "DISABLE")
+} ## end sub remotedesktopport
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 hostname
+
+ Parameters : NA
+ Returns : hostname of this machine
+ Description : attempts to check local hostname using hostname cmd
+ if global FQDN is set the routine returns this instead
+=cut
+
+sub hostname {
+ my ($package, $filename, $line, $sub) = caller(0);
+ my @host;
+ my $h;
+ #hack
+ my $osname = lc($^O);
+
+ if ($osname eq 'linux') {
+ if ($FQDN) {
+ @host = ($FQDN, "linux");
+ return @host;
+ }
+ if (open(HOST, "/bin/hostname -f 2>&1 |")) {
+ @host = <HOST>;
+ close(HOST);
+ foreach $h (@host) {
+ if ($h =~ /([-a-z0-9]*)([.a-z]*)/) {
+ chomp($h);
+ if ($h !~ /ncsu.edu/) {
+ #hack
+ #$h .= ".hpc.ncsu.edu";
+ }
+ @host = ($h, "linux");
+ return @host;
+ }
+ } ## end foreach $h (@host)
+ } ## end if (open(HOST, "/bin/hostname -f 2>&1 |"))
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "can't $!");
+ return 0;
+ }
+ } ## end if ($osname eq 'linux')
+ elsif ($osname eq 'solaris') {
+ if ($FQDN) {
+ @host = ($FQDN, "linux");
+ return @host;
+ }
+ if (open(NODENAME, "< /etc/nodename")) {
+ @host = <NODENAME>;
+ close(NODENAME);
+ foreach $h (@host) {
+ if ($h =~ /([-a-z0-9]*)([.a-z]*)/) {
+ chomp($h);
+ my @host = ($h, "solaris");
+ return @host;
+ }
+ }
+ } ## end if (open(NODENAME, "< /etc/nodename"))
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "can't open /etc/nodename $!");
+ return 0;
+ }
+ } ## end elsif ($osname eq 'solaris') [ if ($osname eq 'linux')
+ elsif ($osname eq 'mswin32') {
+ if ($FQDN) {
+ @host = ($FQDN, "windows");
+ return @host;
+ }
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "unknown OS type: $osname");
+ return 0;
+ }
+ return 0;
+} ## end sub hostname
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 known_hosts
+
+ Parameters : $node , management OS, $ipaddress
+ Returns : 0 or 1
+ Description : check for or add nodenames public rsa key to local known_hosts file
+
+=cut
+
+sub known_hosts {
+ my ($node, $mnOS, $ipaddress) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'CRITICAL'}, 0, "node is not defined") if (!(defined($node)));
+ notify($ERRORS{'CRITICAL'}, 0, "mnOS is not defined") if (!(defined($mnOS)));
+ notify($ERRORS{'CRITICAL'}, 0, "ipaddress is not defined") if (!(defined($ipaddress)));
+
+ my ($known_hosts, $existed, $ssh_keyscan, $port);
+ #set up dependiences
+ if ($mnOS eq "solaris") {
+ $known_hosts = "/.ssh/known_hosts";
+ $ssh_keyscan = "/local/openssh/bin/ssh-keyscan";
+ $port = 24;
+ }
+ elsif ($mnOS eq "linux") {
+ $known_hosts = "/root/.ssh/known_hosts";
+ $ssh_keyscan = "/usr/bin/ssh-keyscan";
+ $port = 24;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unsupported management node OS: $mnOS");
+ return 0;
+ }
+
+ #remove key
+ my @known_hosts_file;
+ if (open(KNOWNHOSTS, "< $known_hosts")) {
+ @known_hosts_file = <KNOWNHOSTS>;
+ close(KNOWNHOSTS);
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "could not read $known_hosts $!");
+ }
+ foreach my $l (@known_hosts_file) {
+ if ($l =~ /$node|$ipaddress/) {
+ $l = "";
+ $existed = 1;
+ }
+ }
+ #write back
+ if ($existed) {
+ if (open(KNOWNHOSTS, ">$known_hosts")) {
+ print KNOWNHOSTS @known_hosts_file;
+ close(KNOWNHOSTS);
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "could not write to $known_hosts file $!");
+ }
+ }
+ #proceed to get public rsa key
+ #notify($ERRORS{'OK'},0,"executing $ssh_keyscan -t rsa -p $port $node >> $known_hosts");
+ if (open(KEYSCAN, "$ssh_keyscan -t rsa -p $port $node >> $known_hosts 2>&1|")) {
+ my @ret = <KEYSCAN>;
+ close(KEYSCAN);
+ foreach my $r (@ret) {
+ notify($ERRORS{'OK'}, 0, "$r");
+ return 0 if ($r =~ /Name or service not known/);
+
+ }
+ return 1;
+ } ## end if (open(KEYSCAN, "$ssh_keyscan -t rsa -p $port $node >> $known_hosts 2>&1|"...
+ else {
+ notify($ERRORS{'WARNING'}, 0, "could not execute append of $node public key to $known_hosts file $!");
+ return 0;
+ }
+} ## end sub known_hosts
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 changelinuxpassword
+
+ Parameters : $node, $account, $passwd
+ Returns : 0 or 1
+ Description : changes linux root password on stock blade installs
+
+=cut
+
+sub changelinuxpassword {
+# change the privileged account passwords on the blade images
+ my ($node, $account, $passwd) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "node is not defined") if (!(defined($node)));
+ notify($ERRORS{'WARNING'}, 0, "account is not defined") if (!(defined($account)));
+
+ #set password for root and administrator accounts
+ #remove setpass.vbs from blade
+ my @ssh;
+ my $l;
+ if ($account eq "root") {
+
+
+ #if not a predefined password, get one!
+ $passwd = getpw(15) if (!(defined($passwd)));
+ notify($ERRORS{'OK'}, 0, "password for $node is $passwd");
+
+ if (open(OPENSSL, "openssl passwd -1 $passwd 2>&1 |")) {
+ $passwd = <OPENSSL>;
+ chomp $passwd;
+ close(OPENSSL);
+ if ($passwd =~ /command not found/) {
+ notify($ERRORS{'CRITICAL'}, 0, "failed $passwd ");
+ return 0;
+ }
+ my $tmpfile = "/tmp/shadow.$node";
+ if (open(TMP, ">$tmpfile")) {
+ print TMP "$account:$passwd:13061:0:99999:7:::\n";
+ close(TMP);
+ if (run_ssh_command($node, $IDENTITY_bladerhel, "cat /etc/shadow \|grep -v $account >> $tmpfile", "root")) {
+ notify($ERRORS{'DEBUG'}, 0, "collected /etc/shadow file from $node");
+ if (run_scp_command($tmpfile, "$node:/etc/shadow", $IDENTITY_bladerhel)) {
+ notify($ERRORS{'DEBUG'}, 0, "copied updated /etc/shadow file to $node");
+ if (run_ssh_command($node, $IDENTITY_bladerhel, "chmod 600 /etc/shadow", "root")) {
+ notify($ERRORS{'DEBUG'}, 0, "updated permissions to 600 on /etc/shadow file on $node");
+ unlink $tmpfile;
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to change file permissions on $node /etc/shadow");
+ unlink $tmpfile;
+ return 0;
+ }
+ } ## end if (run_scp_command($tmpfile, "$node:/etc/shadow"...
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to copy contents of shadow file on $node ");
+ }
+ } ## end if (run_ssh_command($node, $IDENTITY_bladerhel...
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to copy contents of shadow file on $node ");
+ unlink $tmpfile;
+ return 0;
+ }
+ } ## end if (open(TMP, ">$tmpfile"))
+ else {
+ notify($ERRORS{'OK'}, 0, "failed could open $tmpfile $!");
+ }
+ } ## end if (open(OPENSSL, "openssl passwd -1 $passwd 2>&1 |"...
+ return 0;
+ } ## end if ($account eq "root")
+ else {
+ #actual user
+ #push it through passwd cmd stdin
+ my @sshcmd = run_ssh_command($node, $IDENTITY_bladerhel, "echo $passwd \| /usr/bin/passwd -f $account --stdin", "root");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /authentication tokens updated successfully/) {
+ notify($ERRORS{'OK'}, 0, "successfully changed local password account $account");
+ return 1;
+ }
+ }
+
+ } ## end else [ if ($account eq "root")
+} ## end sub changelinuxpassword
+
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 getanothermachine
+
+ Parameters : useid,imagename
+ Returns : available machine if successful or 0 on failure
+ Description : NOT COMPLETED - to be used in case of a failure on reservation,
+ if the box is reloading or failed in some fashion
+ using rpc call to php on webserver
+
+=cut
+
+sub getanothermachine {
+ my ($userid, $imageid) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "userid is not defined") if (!(defined($userid)));
+ notify($ERRORS{'WARNING'}, 0, "imagid is not defined") if (!(defined($imageid)));
+
+ my $function = "getUserResources";
+ #Parameters for getUserResources function :
+ #$userprivs - array of privileges to look for (such as imageAdmin, imageCheckOut, etc); don't include 'block' or 'cascade'
+ #$resourceprivs- array of privileges to look for (such as available, administer, manageGroup); don't include 'block' or 'cascade'
+ #$onlygroups - (optional) if 1, return the resource groups instead of the resources
+ #$includedeleted - (optional) included deleted resources if 1, don't if 0
+ #$userid - (optional) id from the user table, if not given, use the id of the currently logged in user
+
+ my $arg1 = "imageAdmin:imageCheckOut";
+ my $arg2 = "available:";
+ my $arg3 = 0;
+ my $arg4 = 0;
+ my $arg5 = $userid;
+
+ eval {
+ my $doc = get("https://vcl.ncsu.edu/scheduling/index.php?mode=vcldquery&key=$VCLDRPCQUERYKEY&query=$function,$arg1,$arg2,$arg3,$arg4,$arg5");
+
+ }
+
+} ## end sub getanothermachine
+
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 getusergroupmembers
+
+ Parameters : usergroupid
+ Returns : array of user group memebers
+ Description : queries database and collects user members of supplied usergroupid
+
+=cut
+
+sub getusergroupmembers {
+ my $usergroupid = $_[0];
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "usergroupid is not defined") if (!(defined($usergroupid)));
+
+ if (!(defined($usergroupid))) {
+ return ();
+ }
+
+ my $select_statement = "
+ SELECT
+
+ user.unityid,
+ user.uid
+
+ FROM
+ user,
+ usergroupmembers
+
+ WHERE
+ user.id = usergroupmembers.userid
+ AND usergroupmembers.usergroupid = '$usergroupid'
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @selected_rows = database_select($select_statement);
+ if (scalar @selected_rows == 0) {
+ notify($ERRORS{'OK'}, 0, "no data returned for usergroupid $usergroupid returning empty lists");
+ return ();
+ }
+
+ my %hash;
+ my (@retarray);
+
+ for (@selected_rows) {
+ my %hash = %{$_};
+ push(@retarray, "$hash{unityid}:$hash{uid}");
+ }
+
+ return @retarray;
+
+} ## end sub getusergroupmembers
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 getimagesize
+
+ Parameters : imagename
+ Returns : 0 failure or size of image
+ Description : in size of Kilobytes
+
+=cut
+
+sub getimagesize {
+ my $imagename = $_[0];
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "imagename is not defined") if (!(defined($imagename)));
+
+ if (!(defined($imagename))) {
+ return 0;
+ }
+ my $IMAGEREPOSITORY;
+ if ($imagename =~ /^(win|rh3image)/) {
+ $IMAGEREPOSITORY = "/install/image/x86";
+ }
+ elsif ($imagename =~ /^(rh([0-9])image|fc([0-9])image)/) {
+ $IMAGEREPOSITORY = "/install/$LINUX_IMAGE/x86";
+ }
+ elsif ($imagename =~ /^(vmware)/) {
+ $IMAGEREPOSITORY = "$VMWAREREPOSITORY/$imagename";
+ }
+ else {
+ return 0;
+ }
+
+ #list files in image directory, account for main .gz file and any .gz.00X files
+ if (open(FILELIST, "/bin/ls -s1 $IMAGEREPOSITORY 2>&1 |")) {
+ my @filelist = <FILELIST>;
+ close(FILELIST);
+ my $size = 0;
+ foreach my $f (@filelist) {
+ if ($f =~ /$imagename.gz|vmdk/) {
+ my ($presize, $blah) = split(" ", $f);
+ $size += $presize;
+ }
+ }
+ if ($size == 0) {
+ #strange imagename not found
+ return 0;
+ }
+ return int($size / 1024);
+ } ## end if (open(FILELIST, "/bin/ls -s1 $IMAGEREPOSITORY 2>&1 |"...
+
+ return 0;
+} ## end sub getimagesize
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 doesimageexists
+
+ Parameters : imagename
+ Returns : 0 or 1
+ Description : scans our image local image library for requested image
+ returns 1 if found or 0 if not
+ attempts to scp image files from peer management nodes
+=cut
+
+sub doesimageexists {
+ my $imagename = $_[0];
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "node is not defined") if (!(defined($imagename)));
+ if (!(defined($imagename))) {
+ return 0;
+ }
+ my ($IMAGEREPOSITORY, $TMPLREPOSITORY, $basetmpl);
+ if ($imagename =~ /^(win|rh3image)/) {
+ $IMAGEREPOSITORY = "/install/image/x86";
+ $TMPLREPOSITORY = "$XCATROOT/install/image/x86";
+ $basetmpl = "wxp2-base.tmpl";
+ }
+ elsif ($imagename =~ /^(rh([0-9])image|fc([0-9])image)/) {
+ $IMAGEREPOSITORY = "/install/$LINUX_IMAGE/x86";
+ $TMPLREPOSITORY = "$XCATROOT/install/$LINUX_IMAGE/x86";
+ $basetmpl = "rhel4-base-v0.tmpl";
+ }
+ elsif ($imagename =~ /^rhel([0-9])/) {
+ $IMAGEREPOSITORY = "$XCATROOT/install/rhas$1/x86";
+ $TMPLREPOSITORY = "$XCATROOT/install/rhas$1/x86";
+ $basetmpl = "rhel$1-base-v0.tmpl";
+ }
+ elsif ($imagename =~ /^rhfc([0-9])/) {
+ $IMAGEREPOSITORY = "$XCATROOT/install/rhfc$1/x86";
+ $TMPLREPOSITORY = "$XCATROOT/install/rhfc$1/x86";
+ $basetmpl = "rhfc$1-base-v0.tmpl";
+ }
+ elsif ($imagename =~ /^esx([0-9]+)/) {
+ $IMAGEREPOSITORY = "$XCATROOT/install/esx$1/x86";
+ $TMPLREPOSITORY = "$XCATROOT/install/esx$1/x86";
+ $basetmpl = "esx$1-base-v0.tmpl";
+ }
+ elsif ($imagename =~ /^(vmware)/) {
+ $IMAGEREPOSITORY = "$VMWAREREPOSITORY";
+ goto IMAGEREPOSCHK;
+ }
+
+ #does template file exist
+ if (-e "$TMPLREPOSITORY/$imagename.tmpl") {
+ #good
+ notify($ERRORS{'OK'}, 0, "template $imagename.tmpl exists");
+ }
+ else {
+ #try to create it.
+ if (open(IMAGE, "/bin/cp $TMPLREPOSITORY/$basetmpl $TMPLREPOSITORY/$imagename.tmpl |")) {
+ my @Images = <IMAGE>;
+ close(IMAGE);
+ if (-e "$TMPLREPOSITORY/$imagename.tmpl") {
+ #good
+ notify($ERRORS{'OK'}, 0, "template $imagename.tmpl exists");
+ }
+ foreach my $i (@Images) {
+ #if anything could mean failure
+ if ($i) {
+ notify($ERRORS{'OK'}, 0, "@Images");
+ }
+ }
+ } ## end if (open(IMAGE, "/bin/cp $TMPLREPOSITORY/$basetmpl $TMPLREPOSITORY/$imagename.tmpl |"...
+ } ## end else [ if (-e "$TMPLREPOSITORY/$imagename.tmpl")
+
+ IMAGEREPOSCHK:
+ if (open(IMAGES, "/bin/ls -1 $IMAGEREPOSITORY 2>&1 |")) {
+ my @images = <IMAGES>;
+ close(IMAGES);
+ foreach my $i (@images) {
+ if ($i =~ /$imagename/) {
+ notify($ERRORS{'OK'}, 0, "image $imagename exists");
+ return 1;
+ }
+ }
+ } ## end if (open(IMAGES, "/bin/ls -1 $IMAGEREPOSITORY 2>&1 |"...
+
+ notify($ERRORS{'OK'}, 0, "IMAGELIBENABLE= $IMAGELIBENABLE ");
+ if ($IMAGELIBENABLE) {
+ #proceed to copy image from other management nodes
+ notify($ERRORS{'OK'}, 0, "image $IMAGEREPOSITORY/$imagename does NOT exists attempting to pull from other management nodes");
+ #globals being used - $IMAGELIBENABLE,$IMAGESERVERS,$IMAGELIBUSER,$IMAGELIBKEY
+ my @serverlist = split(/,/, $IMAGESERVERS);
+ my $length = @serverlist;
+ if ($length == 0) {
+ notify($ERRORS{'CRITICAL'}, 0, "imageservers variable is not listed correctly or does not contain any information");
+ return 0;
+ }
+
+ foreach my $s (@serverlist) {
+ #first pass - use my current repository paths
+ notify($ERRORS{'OK'}, 0, "checking for $imagename on $s");
+ my @sshcmd = run_ssh_command($s, $IMAGELIBKEY, "ls -1 $IMAGEREPOSITORY", $IMAGELIBUSER);
+ foreach my $i (@{$sshcmd[1]}) {
+ if ($i =~ /Permission denied/) {
+ notify($ERRORS{'CRITICAL'}, 0, "identity key $IMAGELIBKEY not valid for $IMAGELIBUSER @ $s");
+ }
+ if ($i =~ /$imagename/) {
+ notify($ERRORS{'OK'}, 0, "SUCCESS image $imagename exists on $s, attempting to copy");
+ #great - fetch it
+ if (run_scp_command("$IMAGELIBUSER\@$s:$IMAGEREPOSITORY/$imagename*", $IMAGEREPOSITORY, $IMAGELIBKEY)) {
+ #double check our image set has been copied
+ if (open(IMAGES, "/bin/ls -1 $IMAGEREPOSITORY 2>&1 |")) {
+ my @images = <IMAGES>;
+ close(IMAGES);
+ foreach my $i (@images) {
+ if ($i =~ /$imagename/) {
+ notify($ERRORS{'OK'}, 0, "image $imagename exists");
+ return 1;
+ }
+ }
+ } ## end if (open(IMAGES, "/bin/ls -1 $IMAGEREPOSITORY 2>&1 |"...
+ } ## end if (run_scp_command("$IMAGELIBUSER\@$s:$IMAGEREPOSITORY/$imagename*"...
+ } ## ($i =~ /$imagename/)
+ } ## foreach my $i
+ } ## end foreach my $s (@serverlist)
+ } ## end if ($IMAGELIBENABLE)
+ else {
+ notify($ERRORS{'OK'}, 0, "imagelibenable disabled");
+ }
+
+ notify($ERRORS{'WARNING'}, 0, "image $IMAGEREPOSITORY/$imagename does NOT exists");
+ return 0;
+
+} ## end sub doesimageexists
+
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 collectsshkeys
+
+ Parameters : node
+ Returns : 0 or 1
+ Description : collects ssh keys from client
+
+=cut
+
+sub collectsshkeys {
+ my $node = $_[0];
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "node is not defined") if (!(defined($node)));
+ if (!(defined($node))) {
+ return 0;
+ }
+ my ($id, $ipaddress, $type, $hostname, $currentimage, $osname);
+ #if lab client and OS is linux or solaris fetch ssh keys
+ #store repective key into computer table for the node
+ my $dbh = getnewdbh;
+ #collect a little information about the node.
+ my $sel = $dbh->prepare("SELECT c.id,c.IPaddress,c.hostname,c.type,o.name,i.name FROM computer c, OS o, image i WHERE c.currentimageid=i.id AND i.OSid=o.id AND c.hostname REGEXP ?") or notify($ERRORS{'WARNING'}, 0, "could not prepare collect computer detail statement" . $dbh->errstr());
+ $sel->execute($node) or notify($ERRORS{'WARNING'}, 0, "Problem could not execute on computer detail : " . $dbh->errstr);
+ my $rows = $sel->rows;
+ $sel->bind_columns(\($id, $ipaddress, $hostname, $type, $osname, $currentimage));
+
+ if ($rows) {
+ if ($sel->fetch) {
+ print "$id,$ipaddress,$hostname,$type,$osname,$currentimage\n";
+ }
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "no information found in computer table for $node ");
+ $dbh->disconnect if !defined $ENV{dbh};
+ return 0;
+ }
+
+ #what identity do we use
+ my $key;
+ if ($type =~ /lab/) {
+ if ($osname =~ /rhel/) {
+ $key = $IDENTITY_linux_lab;
+ }
+ else {
+ $key = $IDENTITY_solaris_lab;
+ }
+ }
+ #send fetch keys flag to node
+ my @sshcmd = run_ssh_command($ipaddress, $key, "echo fetch > /home/vclstaff/clientdata; echo 1 > /home/vclstaff/flag", "vclstaff", "24");
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /Warning|denied|No such/) {
+ notify($ERRORS{'CRITICAL'}, 0, "node $node ouput @{ $sshcmd[1] }");
+ }
+ }
+ #retrieve the keys
+ #sleep 6, node flag check is every 5 sec
+ sleep 6;
+ my ($loop, $ct) = 0;
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($ipaddress, $key, "ls -1", "vclstaff", "24");
+ foreach my $l (@{$sshcmd[1]}) {
+ chomp($l);
+
+ if ($l =~ /ssh_host/) {
+ #print "$l\n";
+ if (!(-d "/tmp/$id")) {
+ notify($ERRORS{'OK'}, 0, "creating /tmp/$id") if (mkdir("/tmp/$id"));
+ }
+ if (run_scp_command("vclstaff\@$ipaddress:/home/vclstaff/$l", "/tmp/$id/$l", $key, "24")) {
+ $ct++;
+ }
+ }
+ } #foreach
+ if ($ct < 6) {
+ notify($ERRORS{'OK'}, 0, "count copied, is less than 6 trying again");
+ if ($loop > 2) {
+ notify($ERRORS{'CRITICAL'}, 0, "could not copy 6 ssh keys from $node");
+ $dbh->disconnect if !defined $ENV{dbh};
+ return 0;
+ }
+ $loop++;
+ goto COLLECT;
+ } ## end if ($ct < 6)
+ #read in key files
+ my $dsa;
+ my $dsapub;
+ my $rsa;
+ my $rsapub;
+ my $hostbuffer = "";
+ my $hostpub;
+
+ if (open(DSA, "/tmp/$id/ssh_host_dsa_key")) {
+ print "slurping dsa_key\n";
+ #@dsa=<DSA>;
+ read(DSA, $dsa, 1024);
+ close(DSA);
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not open dsa file $!");
+ }
+
+ if (open(DSAPUB, "/tmp/$id/ssh_host_dsa_key.pub")) {
+ print "slurping dsa_pub_key\n";
+ #@dsapub=<DSAPUB>;
+ read(DSAPUB, $dsapub, 1024);
+ close(DSAPUB);
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not open dsa.pub file $!");
+ }
+
+ if (open(RSA, "/tmp/$id/ssh_host_rsa_key")) {
+ print "slurping rsa_key\n";
+ #@rsa=<RSA>;
+ read(RSA, $rsa, 1024);
+ close(RSA);
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not open rsa file $!");
+ }
+
+ if (open(RSAPUB, "/tmp/$id/ssh_host_rsa_key.pub")) {
+ print "slurping rsa_pub_key\n";
+ #@rsapub=<RSAPUB>;
+ read(RSAPUB, $rsapub, 1024);
+ close(RSAPUB);
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not open rsa.pub file $!");
+ }
+
+ if (open(HOSTPUB, "/tmp/$id/ssh_host_key.pub")) {
+ print "slurping host_pub_key\n";
+ #@hostpub=<HOSTPUB>;
+ read(HOSTPUB, $hostpub, 1024);
+ close(HOSTPUB);
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not open host.pub file $!");
+ }
+
+ #binary file
+ if (open(HOST, "/tmp/$id/ssh_host_key.pub")) {
+ print "slurping host_key\n";
+ binmode(HOST);
+ my $r = read(HOST, $hostbuffer, 1024);
+ #@hostbuffer=<HOST>;
+ close(HOST);
+ if (defined($r)) {
+ #print "read $r k chunks on binary file ssh_host_key.pub\n";
+ #notify($ERRORS{'OK'},0,"read $r k chunks on binary file ssh_host_key.pub");
+ #print "uploading: $dsa\n $dsapub\n$rsa\n$rsapub\n$hostbuffer\n$hostpub \n $id\n";
+ }
+ else {
+ #print "could not read binary file ssh_host_key.pub\n";
+ notify($ERRORS{'CRITICAL'}, 0, "could not read binary file ssh_host_key.pub");
+ }
+ } ## end if (open(HOST, "/tmp/$id/ssh_host_key.pub"...
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not open host binary file $!");
+ }
+
+ #print "uploading: @dsa\n @dsapub\n @rsa\n @rsapub\n $hostbuffer \n,@hostpub \n $id\n";
+ #upload keys to db
+
+ my $update = $dbh->prepare("UPDATE computer SET dsa=?,dsapub=?,rsa=?,rsapub=?,hostpub=? WHERE id=?") or print "could not prepare update key statement node= $node id= $id" . $dbh->errstr();
+ $update->execute($dsa, $dsapub, $rsa, $rsapub, $hostpub, $id) or print "Problem could not execute on update key statement node= $node id= $id: " . $dbh->errstr;
+
+ $dbh->disconnect if !defined $ENV{dbh};
+
+} ## end sub collectsshkeys
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 restoresshkeys
+
+ Parameters : node
+ Returns : 0 or 1
+ Description : NOT COMPLETED
+ connects to node and replaces ssh keys with keys stored in db
+=cut
+
+sub restoresshkeys {
+ my $node = $_[0];
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "node is not defined") if (!(defined($node)));
+ if (!(defined($node))) {
+ return 0;
+ }
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 notifyviaIM
+
+ Parameters : IM type, IM user ID, message string
+ Returns : 0 or 1
+ Description : if Jabber enabled - send IM to user
+ currently only supports jabber
+
+=cut
+
+sub notify_via_IM {
+ my ($im_type, $im_id, $im_message) = @_;
+
+ notify($ERRORS{'WARNING'}, 0, "IM type is not defined") if (!(defined($im_type)));
+ notify($ERRORS{'WARNING'}, 0, "IM id is not defined") if (!(defined($im_id)));
+ notify($ERRORS{'WARNING'}, 0, "IM message is not defined") if (!(defined($im_message)));
+
+ if ($im_type eq "jabber") {
+ # Check if jabber functions are disabled on this management node
+ if ($JABBER) {
+ notify($ERRORS{'DEBUG'}, 0, "jabber functions are enabled on this management node");
+ }
+ else {
+ notify($ERRORS{'DEBUG'}, 0, "jabber functions are disabled on this management node");
+ return 1;
+ }
+
+ # Create a jabber client object
+ my $jabber_client = new Net::Jabber::Client();
+ if ($jabber_client) {
+ notify($ERRORS{'DEBUG'}, 0, "jabber client object created");
+ }
+ else {
+ notify($ERRORS{'DEBUG'}, 0, "failed to created jabber client object");
+ return;
+ }
+
+ # Attempt to connect to the jabber server
+ my $jabber_connect_result = $jabber_client->Connect(hostname => $jabServer, port => $jabPort);
+ if (!$jabber_connect_result) {
+ notify($ERRORS{'DEBUG'}, 0, "connected to jabber server: $jabServer, port: $jabPort, result: $jabber_connect_result");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to connect to jabber server: $jabServer, port: $jabPort, result: $jabber_connect_result");
+ return;
+ }
+
+ # Attempt to authenticate to jabber
+ my @jabber_auth_result = $jabber_client->AuthSend(
+ username => $jabUser,
+ password => $jabPass,
+ resource => $jabResource
+ );
+
+ # Check the jabber authentication result
+ if ($jabber_auth_result[0] && $jabber_auth_result[0] eq "ok") {
+ notify($ERRORS{'DEBUG'}, 0, "authenticated to jabber server: $jabServer, user: $jabUser, resource: $jabResource");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to authenticate to jabber server: $jabServer, user: $jabUser, resource: $jabResource");
+ return;
+ }
+
+ # Create jabber message
+ my $jabber_message = Net::Jabber::Message->new();
+ $jabber_message->SetMessage(
+ to => $im_id,
+ subject => "Notification",
+ type => "chat",
+ body => $im_message
+ );
+
+ # Attempt to send the jabber message
+ my $jabber_send_result = $jabber_client->Send($jabber_message);
+ if ($jabber_send_result) {
+ notify($ERRORS{'OK'}, 0, "jabber message sent to $im_id");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to send jabber message to $jabUser");
+ return;
+ }
+
+ } ## end if ($im_type eq "jabber" && defined $jabberready)
+
+ else {
+ notify($ERRORS{'WARNING'}, 0, "IM type is not supported: $im_type");
+ return 0;
+ }
+
+ return 1;
+} ## end sub notify_via_IM
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 check_uptime
+
+ Parameters : $node, $IPaddress, $OSname, $type, $log
+ Returns : value or 0(failed) + failure message
+ Description : fetchs uptime of remote node
+
+=cut
+
+sub check_uptime {
+ my ($node, $IPaddress, $OSname, $type, $log) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ $log = 0 if (!(defined($log)));
+ notify($ERRORS{'WARNING'}, $log, "node is not defined") if (!(defined($node)));
+ notify($ERRORS{'WARNING'}, $log, "IPaddress is not defined") if (!(defined($IPaddress)));
+ notify($ERRORS{'WARNING'}, $log, "OSname is not defined") if (!(defined($OSname)));
+ notify($ERRORS{'WARNING'}, $log, "type is not defined") if (!(defined($type)));
+
+ if ($type eq "lab") {
+ my $identity;
+ if ($OSname =~ /sun4x/) {
+ $identity = $IDENTITY_solaris_lab;
+ }
+ elsif ($OSname =~ /rhel/) {
+ $identity = $IDENTITY_linux_lab;
+ }
+ else {
+ return (0, "failure : OSname not match");
+ }
+ my @sshcmd = run_ssh_command($node, $identity, "uptime", "vclstaff", "24");
+ my $l;
+ foreach $l (@{$sshcmd[1]}) {
+ if ($l =~ /(\s*\d*:\d*:\d*\s*up\s*)(\d*)(\s*days,)/) {
+ return $2;
+ }
+ if ($l =~ /^(\s*\d*:\d*)(am|pm)(\s*up\s*)(\d*)(\s*day)/) {
+ return $4;
+ }
+ if ($l =~ /(\s*\d*:\d*:\d*\s*up)/) {
+ return 1;
+ }
+ if ($l =~ /password/) {
+ notify($ERRORS{'WARNING'}, $log, "@{ $sshcmd[1] }");
+ return (0, $l);
+ }
+ } ## end foreach $l (@{$sshcmd[1]})
+
+
+ } ## end if ($type eq "lab")
+ elsif ($type eq "blade") {
+ return 0;
+ }
+ elsif ($type eq "virtualmachine") {
+ return 0;
+ }
+
+} ## end sub check_uptime
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 timefloor15interval
+
+ Parameters : time string(optional)
+ Returns : the nearest 15 minute interval 0,15,30,45 less than the current time and zero seconds
+ Description :
+
+=cut
+
+sub timefloor15interval {
+ my $time = $_[0];
+ # we got nothing set to current time
+ if (!defined($time)) {
+ $time = makedatestring;
+ }
+ #we got a null timestamp, set it to current time
+ if ($time =~ /0000-00-00 00:00:00/) {
+ $time = makedatestring;
+ }
+
+ #format received: year-mon-mday hr:min:sec
+ my ($vardate, $vartime) = split(/ /, $time);
+ my ($yr, $mon, $mday) = split(/-/, $vardate);
+ my ($hr, $min, $sec) = split(/:/, $vartime);
+ $sec = "0";
+ if ($min < 15) {
+ $min = 0;
+ }
+ elsif ($min < 30) {
+ $min = 15;
+ }
+ elsif ($min < 45) {
+ $min = 30;
+ }
+ elsif ($min < 60) {
+ $min = 45;
+ }
+
+ my $datestring = sprintf("%04d-%02d-%02d %02d:%02d:%02d", $yr, $mon, $mday, $hr, $min, $sec);
+ return $datestring;
+
+} ## end sub timefloor15interval
+
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 system_monitoring
+
+ Parameters : $nodename, $imagename, $action, $type
+ Returns : 0 or 1
+ Description : primarily used for ITM -
+ if windows ITM servicce exist start or stop it
+
+=cut
+
+sub system_monitoring {
+ my ($nodename, $imagename, $action, $type) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "nodename is not defined") if (!(defined($nodename)));
+ notify($ERRORS{'WARNING'}, 0, "imagename is not defined") if (!(defined($imagename)));
+ notify($ERRORS{'WARNING'}, 0, "action is not defined") if (!(defined($action)));
+ notify($ERRORS{'WARNING'}, 0, "type is not defined") if (!(defined($type)));
+
+ my ($identity, $imagetype, $l);
+ my @out;
+ if ($imagename =~ /^(win|vmware)/) {
+ $imagetype = "windows";
+ $identity = $IDENTITY_wxp;
+ }
+ elsif ($imagename =~ /^(rh|fc[0-9]image|esx)/) {
+ $imagetype = "linux";
+ $identity = $IDENTITY_bladerhel;
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "could not determin OS for $imagename : $type monitoring on $nodename for $imagename");
+ return 0;
+ }
+ my @sshcmd;
+ if ($type eq "ITM" && $imagetype eq "windows") {
+ #check and start monitoring for ITM
+ my $exists = 0;
+ @sshcmd = run_ssh_command($nodename, $identity, "cmd /c C:\/WINDOWS\/system32\/sc qc KNTCMA_Primary", "root");
+ foreach $l (@{$sshcmd[1]}) {
+ next if ($l =~ /Warning: Permanently added/);
+ if ($l =~ /The specified service does not exist/) {
+ #not there skip and return
+ return 0;
+ }
+ if ($l =~ /SERVICE_NAME: KNTCMA_Primary/) {
+ $exists = 1;
+ }
+ } ## end foreach $l (@{$sshcmd[1]})
+
+ #preform action
+ if ($action =~ /start|stop/) {
+ undef @sshcmd;
+ @sshcmd = run_ssh_command($nodename, $identity, "cmd /c C:\/WINDOWS\/system32\/sc $action KNTCMA_Primary", "root");
+ foreach $l (@{$sshcmd[1]}) {
+ next if ($l =~ /Warning: Permanently added/);
+ if ($l =~ /SERVICE_NAME: KNTCMA_Primary/) {
+ return 1;
+ }
+ if ($l =~ /The service has not been started/) {
+ return 1 if ($action eq "stop");
+ }
+ if ($l =~ /service is already running/) {
+ return 1 if ($action eq "start");
+ }
+ #can run more checks to determine if it is running, stopped or start|stop pending
+ #
+ } ## end foreach $l (@{$sshcmd[1]})
+ } ## end if ($action =~ /start|stop/)
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "skipping start up, $action not a supported action for ITM service KNTCMA_Primary");
+ return 0;
+ }
+ } ## end if ($type eq "ITM" && $imagetype eq "windows")
+ elsif ($imagetype eq "linux") {
+ #TODO - insert code for Linux related monitoring agents
+ }
+ return 0;
+
+} ## end sub system_monitoring
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 monitorloading
+
+ Parameters : $reservationid, $requestedimagename, $computerid, $nodename, $ert
+ Returns : 0 or 1
+ Description : using database loadlog table,
+ monitor given node for available state
+
+=cut
+
+
+sub monitorloading {
+ my ($reservationid, $requestedimagename, $computerid, $nodename, $ert) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ notify($ERRORS{'WARNING'}, 0, "reservationid is not defined") if (!(defined($reservationid)));
+ notify($ERRORS{'WARNING'}, 0, "requestedimagename is not defined") if (!(defined($requestedimagename)));
+ notify($ERRORS{'WARNING'}, 0, "computerid is not defined") if (!(defined($computerid)));
+ notify($ERRORS{'WARNING'}, 0, "nodename is not defined") if (!(defined($nodename)));
+ notify($ERRORS{'WARNING'}, 0, "ert is not defined") if (!(defined($ert)));
+ #get start time of this wait period
+ my $mystarttime = convert_to_epoch_seconds;
+ my $currentime = 0;
+
+ my $mydbhandle = getnewdbh();
+ my $selhdl = $mydbhandle->prepare(
+ "SELECT s.loadstatename,c.additionalinfo,c.timestamp
+ FROM computerloadlog c, computerloadstate s
+ WHERE s.id = c.loadstateid AND c.loadstateid=s.id AND c.reservationid =? AND c.computerid=?") or notify($ERRORS{'WARNING'}, 0, "could not prepare statement to monitor for available stat" . $mydbhandle->errstr());
+
+ my $selhdl2 = $mydbhandle->prepare("SELECT s.name FROM computer c,state s WHERE c.stateid=s.id AND c.id =?") or notify($ERRORS{'WARNING'}, 0, "could not prepare statement check node for available state" . $mydbhandle->errstr());
+
+ #get est reload time of image
+
+ my $available = 0;
+ my $stillrunnning = 1;
+ my $state;
+ my $s1 = 0;
+ my $s2 = 0;
+ my $s3 = 0;
+ my $s4 = 0;
+ my $s5 = 0;
+ my $s6 = 0;
+ my $s7 = 0;
+ my $s8 = 0;
+ my $s1time = 0;
+ my $s2time = 0;
+ my $s3time = 0;
+ my $s4time = 0;
+ my $s5time = 0;
+ my $s6time = 0;
+ my $s7time = 0;
+
+ MONITORLOADCHECKS:
+ $selhdl->execute($reservationid, $computerid) or notify($ERRORS{'WARNING'}, 0, "could not execute statement to monitor for available stat" . $mydbhandle->errstr());
+ my $rows = $selhdl->rows;
+ #check state of machine
+ $selhdl2->execute($computerid) or notify($ERRORS{'WARNING'}, 0, "could not execute statement to check state of blade " . $mydbhandle->errstr());
+ my $irows = $selhdl2->rows;
+ notify($ERRORS{'OK'}, 0, "checking if $nodename is available");
+ if ($irows) {
+ if (my @irow = $selhdl2->fetchrow_array) {
+ if ($irow[0] =~ /available/) {
+ #good machine is available
+ notify($ERRORS{'OK'}, 0, "good $nodename is now available");
+ return 1;
+ }
+ elsif ($irow[0] =~ /failed/) {
+ notify($ERRORS{'WARNING'}, 0, "$nodename reported failure");
+ return 0;
+ }
+ } ## end if (my @irow = $selhdl2->fetchrow_array)
+ } ## end if ($irows)
+ else {
+ notify($ERRORS{'WARNING'}, 0, "strange no records found for computerid $computerid $nodename - possible issue with query");
+ return 0;
+ }
+ my @row;
+ while (@row = $selhdl->fetchrow_array) {
+ if (!$s1) {
+ if ($row[0] =~ /loadimage|loadimagevmware/) {
+ notify($ERRORS{'OK'}, 0, "detected s1");
+ $s1 = 1;
+ $s1time = convert_to_epoch_seconds($row[2]);
+ }
+ }
+ if (!$s2) {
+ if ($row[0] =~ /startload/) {
+ notify($ERRORS{'OK'}, 0, "detected startload state");
+ if ($row[1] =~ /$requestedimagename/) {
+ notify($ERRORS{'OK'}, 0, "good $nodename is loading $requestedimagename");
+ $s2 = 1;
+ $s2time = convert_to_epoch_seconds($row[2]);
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "$nodename is not loading desired image");
+ return 0;
+ }
+ } ## end if ($row[0] =~ /startload/)
+ } ## end if (!$s2)
+ if (!$s3) {
+ if ($row[0] =~ /rinstall|transfervm/) {
+ notify($ERRORS{'OK'}, 0, "detected $row[0] for $nodename");
+ $s3 = 1;
+ $s3time = convert_to_epoch_seconds($row[2]);
+ }
+
+ }
+ if (!$s4) {
+ if ($row[0] =~ /xcatstage5|startvm/) {
+ notify($ERRORS{'OK'}, 0, "detected $row[0] for $nodename");
+ $s4 = 1;
+ $s4time = convert_to_epoch_seconds($row[2]);
+ }
+ }
+ if (!$s5) {
+ if ($row[0] =~ /bootstate|vmstage1/) {
+ notify($ERRORS{'OK'}, 0, "detected $row[0] for $nodename");
+ $s5 = 1;
+ $s5time = convert_to_epoch_seconds($row[2]);
+ }
+ }
+ if (!$s6) {
+ if ($row[0] =~ /xcatround3|vmstage5/) {
+ notify($ERRORS{'OK'}, 0, "detected $row[0] for $nodename");
+ $s6 = 1;
+ $s6time = convert_to_epoch_seconds($row[2]);
+ }
+ }
+ if (!$s7) {
+ if ($row[0] =~ /xcatREADY|vmwareready/) {
+ notify($ERRORS{'OK'}, 0, "detected $row[0] for $nodename");
+ $s7 = 1;
+ $s7time = convert_to_epoch_seconds($row[2]);
+ }
+ }
+ if (!$s8) {
+ if ($row[0] =~ /loadimagecomplete|nodeready/) {
+ notify($ERRORS{'OK'}, 0, "detected $row[0] returning to calling process");
+ $s8 = 1;
+ #ready to return
+ return 1;
+ }
+ }
+ if ($row[0] =~ /failed/) {
+ return 0;
+ }
+ } ## end while (@row = $selhdl->fetchrow_array)
+
+ notify($ERRORS{'OK'}, 0, "current stages passed s1='$s1' s2='$s2' s3='$s3' s4='$s4' s5='$s5' s6='$s6' s7='$s7' going to sleep 15");
+ sleep 15;
+ #prevent infinite loop - check how long we've waited
+ $currentime = convert_to_epoch_seconds;
+ my $delta = $currentime - $mystarttime;
+ #check some state times
+ #if($s5){
+ # if(!$s6){
+ # #how long has it been since $s5 was set
+ # my $s5diff = ($currentime-$s5time);
+ # if($s5diff > 5*60){
+ # #greater than 5 minutes
+ # notify($ERRORS{'OK'},0,"waited over 5 minutes - $s5diff seconds for stage 6 to complete, returning");
+ # return 0;
+ # }
+ # }
+ # if(!$s7){
+ # #how long has it been since $s6 was set
+ # my $s6diff = $currentime-$s6time;
+ # if($s6diff > 6*60){
+ # #greater than 4 minutes
+ # notify($ERRORS{'OK'},0,"waited over 6 minutes - $s6diff seconds for stage 7 to be reached, returning");
+ # return 0;
+ # }
+#
+# }
+# }
+
+ if ($delta > ($ert * 60)) {
+ notify($ERRORS{'OK'}, 0, "waited $delta seconds and we have exceeded our ert of $ert, returning");
+ #just return at this point - it should have been completed by now
+ return 0;
+ }
+
+ goto MONITORLOADCHECKS;
+
+} ## end sub monitorloading
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 insertloadlog
+
+ Parameters : $resid, $computerid, $loadstatename, $additionalinfo
+ Returns : 0 or 1
+ Description : accepts info from processes to update the loadlog table
+
+=cut
+
+sub insertloadlog {
+ my ($resid, $computerid, $loadstatename, $additionalinfo) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the parameters
+ if (!(defined($resid))) {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to insert into computerloadlog, reservation id is not defined");
+ return 0;
+ }
+ elsif (!($resid)) {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to insert into computerloadlog, reservation id is 0");
+ return 0;
+ }
+
+ if (!(defined($computerid))) {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to insert into computerloadlog, computer id is not defined");
+ return 0;
+ }
+ elsif (!($computerid)) {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to insert into computerloadlog, computer id is 0");
+ return 0;
+ }
+
+ if (!(defined($additionalinfo)) || !$additionalinfo) {
+ notify($ERRORS{'WARNING'}, 0, "additionalinfo is either not defined or 0, using 'no additional info'");
+ $additionalinfo = 'no additional info';
+ }
+
+ my $loadstateid;
+ if (!(defined($loadstatename)) || !$loadstatename) {
+ notify($ERRORS{'WARNING'}, 0, "loadstatename is either not defined or 0, using NULL");
+ $loadstatename = 'NULL';
+ $loadstateid = 'NULL';
+ }
+ else {
+ # loadstatename was specified as a parameter
+ # Check if the loadstatename exists in the computerloadstate table
+ my $select_statement = "
+ SELECT DISTINCT
+ computerloadstate.id
+ FROM
+ computerloadstate
+ WHERE
+ computerloadstate.loadstatename = '$loadstatename'
+ ";
+
+ my @selected_rows = database_select($select_statement);
+ if ((scalar @selected_rows) == 0) {
+ notify($ERRORS{'WARNING'}, 0, "computerloadstate table entry does not exist: $loadstatename, using NULL");
+ $loadstateid = 'NULL';
+ $loadstatename = 'NULL';
+ }
+ else {
+ $loadstateid = $selected_rows[0]{id};
+ #notify($ERRORS{'DEBUG'}, 0, "computerloadstate id found: id=$loadstateid, name=$loadstatename");
+ }
+ } ## end else [ if (!(defined($loadstatename)) || !$loadstatename)
+
+ # Escape any single quotes in additionalinfo
+ $additionalinfo =~ s/\'/\\\'/g;
+
+ # Check to make sure the reservation has not been deleted
+ # The INSERT statement will fail if it has been deleted because of the key constraint on reservationid
+ if (is_reservation_deleted($resid)) {
+ notify($ERRORS{'OK'}, 0, "computerloadlog entry not inserted, reservation has been deleted");
+ return 1;
+ }
+
+ # Assemble the SQL statement
+ my $insert_loadlog_statement = "
+ INSERT INTO
+ computerloadlog
+ (
+ reservationid,
+ computerid,
+ loadstateid,
+ timestamp,
+ additionalinfo
+ )
+ VALUES
+ (
+ '$resid',
+ '$computerid',
+ '$loadstateid',
+ NOW(),
+ '$additionalinfo'
+ )
+ ";
+
+ # Execute the insert statement, the return value should be the id of the computerloadlog row that was inserted
+ my $loadlog_id = database_execute($insert_loadlog_statement);
+ if ($loadlog_id) {
+ notify($ERRORS{'OK'}, 0, "inserted computer=$computerid, $loadstatename, $additionalinfo");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to insert entry into computerloadlog table");
+ return 0;
+ }
+
+ return 1;
+} ## end sub insertloadlog
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 checkonprocess
+
+ Parameters : $state, $requestid
+ Returns : 0 or 1
+ Description : checks the process list to confirm the process for given request is actually running
+ in case the process dies for some reason
+
+=cut
+
+
+sub checkonprocess {
+ my ($request_state_name, $request_id) = @_;
+
+ notify($ERRORS{'WARNING'}, 0, "state is not defined") if (!(defined($request_state_name)));
+ notify($ERRORS{'WARNING'}, 0, "requestid is not defined") if (!(defined($request_id)));
+ return if (!(defined($request_state_name)));
+ return if (!(defined($request_id)));
+
+ # Use the pgrep utility to find processes matching the state and request ID
+ if (open(PGREP, "/bin/pgrep -fl '$request_state_name $request_id' 2>&1 |")) {
+ my @process_list = <PGREP>;
+ close(PGREP);
+ notify($ERRORS{'DEBUG'}, 0, "pgrep found " . scalar @process_list . " processes matching state=$request_state_name and request=$request_id");
+ return scalar @process_list;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to open handle for pgrep process");
+ return;
+ }
+} ## end sub checkonprocess
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 kill_reservation_process
+
+ Parameters : $request_state_name, $reservation_id
+ Returns : 0 or 1
+ Description :
+
+=cut
+
+sub kill_reservation_process {
+ my ($reservation_id) = @_;
+
+ notify($ERRORS{'WARNING'}, 0, "reservation id is not defined") if (!(defined($reservation_id)));
+ return if (!(defined($reservation_id)));
+
+ notify($ERRORS{'OK'}, 0, "attempting to kill process for reservation $reservation_id");
+
+ # Use the pkill utility to find processes matching the reservation ID
+ my $pkill_command = "pkill -f ':$reservation_id ' 2>&1";
+ notify($ERRORS{'DEBUG'}, 0, "executing pkill command: $pkill_command");
+
+ my $pkill_output = `$pkill_command`;
+ my $pkill_exit_status = $?;
+
+ # Check the pgrep exit status
+ if ($pkill_exit_status == 0) {
+ notify($ERRORS{'DEBUG'}, 0, "reservation $reservation_id process was killed, returning 1");
+ return 1;
+ }
+ elsif ($pkill_exit_status == 1) {
+ notify($ERRORS{'WARNING'}, 0, "process was not found for reservation $reservation_id, returning 0");
+ return 0;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "pkill error occurred, returning undefined, output:\n$pkill_output");
+ return;
+ }
+
+} ## end sub kill_reservation_process
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 database_select
+
+ Parameters : SQL select statement
+ Returns : array containing hash references to rows returned
+ Description : gets information from the database
+
+=cut
+
+sub database_select {
+ my ($select_statement, $database) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ my $dbh;
+ if (!($dbh = getnewdbh($database))) {
+ # Try again if first attempt failed
+ if (!($dbh = getnewdbh($database))) {
+ notify($ERRORS{'WARNING'}, 0, "unable to obtain database handle, " . DBI::errstr());
+ return ();
+ }
+ }
+
+ # Prepare the select statement handle
+ my $select_handle;
+ $select_handle = $dbh->prepare($select_statement);
+
+ # Check the select statement handle
+ if (!$select_handle) {
+ notify($ERRORS{'WARNING'}, 0, "could not prepare select statement, $select_statement, " . $dbh->errstr());
+ $dbh->disconnect if !defined $ENV{dbh};
+ return ();
+ }
+
+ # Execute the statement handle
+ if (!($select_handle->execute())) {
+ notify($ERRORS{'WARNING'}, 0, "could not execute statement, $select_statement, " . $dbh->errstr());
+ $select_handle->finish;
+ $dbh->disconnect if !defined $ENV{dbh};
+ return ();
+ }
+
+ # Fetch all the rows returned by the select query
+ # An array reference is created containing hash refs because {} is passed to fetchall_arrayref
+ my @return_rows = @{$select_handle->fetchall_arrayref({})};
+ $select_handle->finish;
+ $dbh->disconnect if !defined $ENV{dbh};
+ return @return_rows;
+} ## end sub database_select
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 database_execute
+
+ Parameters : SQL statement
+ Returns : 1 if successful, 0 if failed
+ Description : Executes an SQL statement
+
+=cut
+
+sub database_execute {
+ my ($sql_statement, $database) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ my $dbh;
+ if (!($dbh = getnewdbh($database))) {
+ # Try again if first attempt failed
+ if (!($dbh = getnewdbh($database))) {
+ notify($ERRORS{'WARNING'}, 0, "unable to obtain database handle, " . DBI::errstr());
+ return;
+ }
+ }
+
+ # Prepare the statement handle
+ my $statement_handle = $dbh->prepare($sql_statement);
+
+ # Check the statement handle
+ if (!$statement_handle) {
+ notify($ERRORS{'WARNING'}, 0, "could not prepare SQL statement, $sql_statement, " . $dbh->errstr());
+ $dbh->disconnect if !defined $ENV{dbh};
+ return;
+ }
+
+ # Execute the statement handle
+ if (!($statement_handle->execute())) {
+ notify($ERRORS{'WARNING'}, 0, "could not execute SQL statement, $sql_statement, " . $dbh->errstr());
+ $statement_handle->finish;
+ $dbh->disconnect if !defined $ENV{dbh};
+ return;
+ }
+
+ # Get the id of the last inserted record if this is an INSERT statement
+ if ($sql_statement =~ /insert/i) {
+ my $sql_insertid = $statement_handle->{'mysql_insertid'};
+ $statement_handle->finish;
+ $dbh->disconnect if !defined $ENV{dbh};
+ return $sql_insertid;
+ }
+ else {
+ $statement_handle->finish;
+ $dbh->disconnect if !defined $ENV{dbh};
+ return 1;
+ }
+
+} ## end sub database_execute
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_request_info
+
+ Parameters : databasehandle, management node id
+ Returns : hash0 or 1
+ Description : gets all reservation related information
+
+=cut
+
+
+sub get_request_info {
+ my ($request_id) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ if (!(defined($request_id))) {
+ notify($ERRORS{'WARNING'}, 0, "request ID was not specified");
+ return 0;
+ }
+
+ my $select_statement = "
+ SELECT DISTINCT
+
+ request.id AS request_id,
+ request.stateid AS request_stateid,
+ request.userid AS request_userid,
+ request.laststateid AS request_laststateid,
+ request.logid AS request_logid,
+ request.forimaging AS request_forimaging,
+ request.test AS request_test,
+ request.preload AS request_preload,
+ request.start AS request_start,
+ request.end AS request_end,
+ request.daterequested AS request_daterequested,
+ request.datemodified AS request_datemodified,
+
+ requeststate.name AS requeststate_name,
+
+ requestlaststate.name AS requestlaststate_name,
+
+ reservation.id AS reservation_id,
+ reservation.requestid AS reservation_requestid,
+ reservation.computerid AS reservation_computerid,
+ reservation.imageid AS reservation_imageid,
+ reservation.imagerevisionid AS reservation_imagerevisionid,
+ reservation.managementnodeid AS reservation_managementnodeid,
+ reservation.remoteIP AS reservation_remoteIP,
+ reservation.lastcheck AS reservation_lastcheck,
+ reservation.pw AS reservation_pw,
+
+ image.id AS image_id,
+ image.name AS image_name,
+ image.prettyname AS image_prettyname,
+ image.ownerid AS image_ownerid,
+ image.deptid AS image_deptid,
+ image.platformid AS image_platformid,
+ image.OSid AS image_OSid,
+ image.imagemetaid AS image_imagemetaid,
+ image.minram AS image_minram,
+ image.minprocnumber AS image_minprocnumber,
+ image.minprocspeed AS image_minprocspeed,
+ image.minnetwork AS image_minnetwork,
+ image.maxconcurrent AS image_maxconcurrent,
+ image.reloadtime AS image_reloadtime,
+ image.deleted AS image_deleted,
+ image.test AS image_test,
+ image.lastupdate AS image_lastupdate,
+ image.forcheckout AS image_forcheckout,
+ image.maxinitialtime AS image_maxinitialtime,
+ image.project AS image_project,
+ image.size AS image_size,
+ image.architecture AS image_architecture,
+
+ imagerevision.id AS imagerevision_id,
+ imagerevision.imageid AS imagerevision_imageid,
+ imagerevision.revision AS imagerevision_revision,
+ imagerevision.userid AS imagerevision_userid,
+ imagerevision.datecreated AS imagerevision_datecreated,
+ imagerevision.deleted AS imagerevision_deleted,
+ imagerevision.production AS imagerevision_production,
+ imagerevision.comments AS imagerevision_comments,
+ imagerevision.imagename AS imagerevision_imagename,
+
+ imagedept.name AS imagedept_name,
+ imagedept.prettyname AS imagedept_prettyname,
+
+ imageplatform.name AS imageplatform_name,
+
+ OS.name AS OS_name,
+ OS.prettyname AS OS_prettyname,
+ OS.type AS OS_type,
+ OS.installtype AS OS_installtype,
+ OS.sourcepath AS OS_sourcepath,
+
+ imageOSmodule.name AS imageOSmodule_name,
+ imageOSmodule.prettyname AS imageOSmodule_prettyname,
+ imageOSmodule.description AS imageOSmodule_description,
+ imageOSmodule.perlpackage AS imageOSmodule_perlpackage,
+
+ user.id AS user_id,
+ user.uid AS user_uid,
+ user.unityid AS user_unityid,
+ user.affiliationid AS user_affiliationid,
+ user.firstname AS user_firstname,
+ user.middlename AS user_middlename,
+ user.lastname AS user_lastname,
+ user.preferredname AS user_preferredname,
+ user.email AS user_email,
+ user.emailnotices AS user_emailnotices,
+ user.IMtypeid AS user_IMtypeid,
+ user.IMid AS user_IMid,
+ user.adminlevelid AS user_adminlevelid,
+ user.width AS user_width,
+ user.height AS user_height,
+ user.bpp AS user_bpp,
+ user.audiomode AS user_audiomode,
+ user.mapdrives AS user_mapdrives,
+ user.mapprinters AS user_mapprinters,
+ user.mapserial AS user_mapserial,
+ user.showallgroups AS user_showallgroups,
+ user.lastupdated AS user_lastupdated,
+
+ adminlevel.name AS adminlevel_name,
+
+ affiliation.name AS affiliation_name,
+ affiliation.dataUpdateText AS affiliation_dataUpdateText,
+ affiliation.sitewwwaddress AS affiliation_sitewwwaddress,
+ affiliation.helpaddress AS affiliation_helpaddress,
+
+
+ IMtype.name AS IMtype_name,
+
+ computer.id AS computer_id,
+ computer.stateid AS computer_stateid,
+ computer.ownerid AS computer_ownerid,
+ computer.deptid AS computer_deptid,
+ computer.platformid AS computer_platformid,
+ computer.scheduleid AS computer_scheduleid,
+ computer.currentimageid AS computer_currentimageid,
+ computer.preferredimageid AS computer_preferredimageid,
+ computer.imagerevisionid AS computer_imagerevisionid,
+ computer.RAM AS computer_RAM,
+ computer.procnumber AS computer_procnumber,
+ computer.procspeed AS computer_procspeed,
+ computer.network AS computer_network,
+ computer.hostname AS computer_hostname,
+ computer.IPaddress AS computer_IPaddress,
+ computer.privateIPaddress AS computer_privateIPaddress,
+ computer.eth0macaddress AS computer_eth0macaddress,
+ computer.eth1macaddress AS computer_eth1macaddress,
+ computer.type AS computer_type,
+ computer.provisioningid AS computer_provisioningid,
+ computer.drivetype AS computer_drivetype,
+ computer.deleted AS computer_deleted,
+ computer.notes AS computer_notes,
+ computer.lastcheck AS computer_lastcheck,
+ computer.location AS computer_location,
+ computer.dsa AS computer_dsa,
+ computer.dsapub AS computer_dsapub,
+ computer.rsa AS computer_rsa,
+ computer.rsapub AS computer_rsapub,
+ computer.host AS computer_host,
+ computer.hostpub AS computer_hostpub,
+ computer.vmhostid AS computer_vmhostid,
+
+ computerdept.name AS computerdept_name,
+ computerdept.prettyname AS computerdept_prettyname,
+
+ computerplatform.name AS computerplatform_name,
+
+ computerstate.name AS computerstate_name,
+
+ computerschedule.name AS computerschedule_name,
+
+ computerprovisioning.name AS computerprovisioning_name,
+ computerprovisioning.prettyname AS computerprovisioning_prettyname,
+ computerprovisioning.moduleid AS computerprovisioning_moduleid,
+
+ computerprovisioningmodule.name AS computerprovisioningmodule_name,
+ computerprovisioningmodule.prettyname AS computerprovisioningmodule_prettyname,
+ computerprovisioningmodule.description AS computerprovisioningmodule_description,
+ computerprovisioningmodule.perlpackage AS computerprovisioningmodule_perlpackage
+
+ FROM
+ request,
+ user,
+ adminlevel,
+ affiliation,
+ IMtype,
+ reservation,
+ image,
+ dept imagedept,
+ platform imageplatform,
+ imagerevision,
+ OS,
+ module imageOSmodule,
+ computer,
+ provisioning computerprovisioning,
+ module computerprovisioningmodule,
+ dept computerdept,
+ platform computerplatform,
+ schedule computerschedule,
+ state requeststate,
+ state requestlaststate,
+ state computerstate
+
+ WHERE
+ request.id = $request_id
+ AND user.id = request.userid
+ AND adminlevel.id = user.adminlevelid
+ AND affiliation.id = user.affiliationid
+ AND reservation.requestid = request.id
+ AND image.id = imagerevision.imageid
+ AND imagedept.id = image.deptid
+ AND imageplatform.id = image.platformid
+ AND imagerevision.id = reservation.imagerevisionid
+ AND OS.id = image.OSid
+ AND imageOSmodule.id = OS.moduleid
+ AND computer.id = reservation.computerid
+ AND computerdept.id = computer.deptid
+ AND computerplatform.id = computer.platformid
+ AND computerschedule.id = computer.scheduleid
+ AND computerstate.id = computer.stateid
+ AND computerprovisioning.id = computer.provisioningid
+ AND computerprovisioningmodule.id = computerprovisioning.moduleid
+ AND requeststate.id = request.stateid
+ AND requestlaststate.id = request.laststateid
+ AND IMtype.id = user.IMtypeid
+
+ GROUP BY
+ reservation.id
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @selected_rows = database_select($select_statement);
+
+ # Check to make sure 1 or more rows were returned
+ if (scalar @selected_rows == 0) {
+ notify($ERRORS{'WARNING'}, 0, "request id $request_id information could not be retrieved");
+ return ();
+ }
+
+ # Build the hash
+ my %request_info;
+
+ for (@selected_rows) {
+ my %reservation_row = %{$_};
+
+ # Grab the reservation ID to make the code a little cleaner
+ my $reservation_id = $reservation_row{reservation_id};
+
+ # If this request only has 1 reservation, populate the RESERVATIONID key
+ # This is mainly for testing convenience
+ # Calling program is responsible for setting this based on which reservation it's processing
+ $request_info{RESERVATIONID} = $reservation_id if (scalar @selected_rows == 1);
+
+ # Check if the image associated with this reservation has meta data
+ # get_imagemeta_info will return default values if image_imagemetaid is undefined
+ my %imagemeta_info = get_imagemeta_info($reservation_row{image_imagemetaid});
+ # Make sure metadata was located if imagemetaid was specified for the image
+ if (!%imagemeta_info) {
+ notify($ERRORS{'WARNING'}, 0, "imagemetaid=" . $reservation_row{image_imagemetaid} . " was specified for image id=" . $reservation_row{image_id} . " but imagemeta could not be found");
+ }
+ else {
+ # Image meta data found, add it to the hash
+ $request_info{reservation}{$reservation_id}{image}{imagemeta} = \%imagemeta_info;
+ }
+
+ # Check if the computer associated with this reservation has a vmhostid set
+ if ($reservation_row{computer_vmhostid}) {
+ my %vmhost_info = get_vmhost_info($reservation_row{computer_vmhostid});
+ # Make sure vmhost was located if vmhostid was specified for the image
+ if (!%vmhost_info) {
+ notify($ERRORS{'WARNING'}, 0, "vmhostid=" . $reservation_row{computer_vmhostid} . " was specified for computer id=" . $reservation_row{computer_id} . " but vmhost could not be found");
+ }
+ else {
+ # Image meta data found, add it to the hash
+ $request_info{reservation}{$reservation_id}{computer}{vmhost} = \%vmhost_info;
+ }
+ } ## end if ($reservation_row{computer_vmhostid})
+
+ # Get the computer's current image information
+ if ($reservation_row{computer_currentimageid}) {
+ my %computer_currentimage_info;
+ if (%computer_currentimage_info = get_image_info($reservation_row{computer_currentimageid})) {
+ $request_info{reservation}{$reservation_id}{computer}{currentimage} = \%computer_currentimage_info;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to get current image info for computer");
+ }
+ }
+ else {
+ # currentimageid wasn't set for the computer
+ notify($ERRORS{'WARNING'}, 0, "currentimageid is not set for computer id=" . $reservation_row{computer_id});
+ }
+
+ # Get the computer's preferred image information
+ if ($reservation_row{computer_preferredimageid}) {
+ my %computer_preferredimage_info;
+ if (%computer_preferredimage_info = get_image_info($reservation_row{computer_preferredimageid})) {
+ $request_info{reservation}{$reservation_id}{computer}{preferredimage} = \%computer_preferredimage_info;
+
+ # For preferred imageid get the production imagerevision info
+ my %preferred_imagerevision_info;
+ if (%preferred_imagerevision_info = get_production_imagerevision_info($reservation_row{computer_preferredimageid})) {
+ $request_info{reservation}{$reservation_id}{computer}{preferredimagerevision} = \%preferred_imagerevision_info;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to get preferred image revision info for computer, image revision ID is not set, tried to get production image for image ID " . $reservation_row{computer_preferredimageid});
+ }
+ } ## end if (%computer_preferredimage_info = get_image_info...
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to get preferredimage image info for computer");
+ }
+ } ## end if ($reservation_row{computer_preferredimageid...
+ else {
+ # currentimageid wasn't set for the computer
+ notify($ERRORS{'WARNING'}, 0, "preferredimageid is not set for computer id=" . $reservation_row{computer_id});
+ }
+
+ # Get the computer's current imagemeta information
+ my %computer_currentimagerevision_info;
+ if ($reservation_row{computer_imagerevisionid} > 0) {
+ # imagerevisionid is set for computer, get the info for that specific revision
+ if (%computer_currentimagerevision_info = get_imagerevision_info($reservation_row{computer_imagerevisionid})) {
+ $request_info{reservation}{$reservation_id}{computer}{currentimagerevision} = \%computer_currentimagerevision_info;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to get current image revision info for computer, image revision ID is set to " . $reservation_row{computer_imagerevisionid});
+ }
+ }
+ else {
+ # imagerevisionid is not set for computer, get the info for the production revision of currentimageid
+ if (%computer_currentimagerevision_info = get_production_imagerevision_info($reservation_row{computer_currentimageid})) {
+ $request_info{reservation}{$reservation_id}{computer}{currentimagerevision} = \%computer_currentimagerevision_info;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to get current image revision info for computer, image revision ID is not set, tried to get production image for image ID " . $reservation_row{computer_currentimageid});
+ }
+ }
+
+
+ # Loop through all the columns returned for the reservation
+ foreach my $key (keys %reservation_row) {
+ my $value = $reservation_row{$key};
+
+ # Create another variable by stripping off the column_ part of each key
+ # This variable stores the original (correct) column name
+ (my $original_key = $key) =~ s/^.+_//;
+
+ if ($key =~ /request_/) {
+ # Set the top-level key if not already set
+ $request_info{$original_key} = $value if (!$request_info{$original_key});
+ }
+ elsif ($key =~ /requeststate_/) {
+ $request_info{state}{$original_key} = $value if (!$request_info{state}{$original_key});
+ }
+ elsif ($key =~ /requestlaststate_/) {
+ $request_info{laststate}{$original_key} = $value if (!$request_info{laststate}{$original_key});
+ }
+ elsif ($key =~ /user_/) {
+ $request_info{user}{$original_key} = $value;
+ }
+ elsif ($key =~ /reservation_/) {
+ $request_info{reservation}{$reservation_id}{$original_key} = $value;
+ }
+ elsif ($key =~ /image_/) {
+ $request_info{reservation}{$reservation_id}{image}{$original_key} = $value;
+ }
+ elsif ($key =~ /imagedept_/) {
+ $request_info{reservation}{$reservation_id}{image}{dept}{$original_key} = $value;
+ }
+ elsif ($key =~ /imageplatform_/) {
+ $request_info{reservation}{$reservation_id}{image}{platform}{$original_key} = $value;
+ }
+ elsif ($key =~ /imagerevision_/) {
+ $request_info{reservation}{$reservation_id}{imagerevision}{$original_key} = $value;
+ }
+ elsif ($key =~ /OS_/) {
+ $request_info{reservation}{$reservation_id}{image}{OS}{$original_key} = $value;
+ }
+ elsif ($key =~ /imageOSmodule_/) {
+ $request_info{reservation}{$reservation_id}{image}{OS}{module}{$original_key} = $value;
+ }
+ elsif ($key =~ /adminlevel_/) {
+ $request_info{user}{adminlevel}{$original_key} = $value;
+ }
+ elsif ($key =~ /affiliation_/) {
+ $request_info{user}{affiliation}{$original_key} = $value;
+ }
+ elsif ($key =~ /IMtype_/) {
+ $request_info{user}{IMtype}{$original_key} = $value;
+ }
+ elsif ($key =~ /computer_/) {
+ $request_info{reservation}{$reservation_id}{computer}{$original_key} = $value;
+ }
+ elsif ($key =~ /computerdept_/) {
+ $request_info{reservation}{$reservation_id}{computer}{dept}{$original_key} = $value;
+ }
+ elsif ($key =~ /computerplatform_/) {
+ $request_info{reservation}{$reservation_id}{computer}{platform}{$original_key} = $value;
+ }
+ elsif ($key =~ /computerschedule_/) {
+ $request_info{reservation}{$reservation_id}{computer}{schedule}{$original_key} = $value;
+ }
+ elsif ($key =~ /computerstate_/) {
+ $request_info{reservation}{$reservation_id}{computer}{state}{$original_key} = $value;
+ }
+ elsif ($key =~ /computerprovisioning_/) {
+ $request_info{reservation}{$reservation_id}{computer}{provisioning}{$original_key} = $value;
+ }
+ elsif ($key =~ /computerprovisioningmodule_/) {
+ $request_info{reservation}{$reservation_id}{computer}{provisioning}{module}{$original_key} = $value;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unknown key found in SQL data: $key");
+ }
+
+ } # Close foreach key in reservation row
+ } # Close loop through selected rows
+
+ # Set some default non-database values for the entire request
+ # All data ever added to the hash should be initialized here
+ $request_info{PID} = '';
+ $request_info{PPID} = '';
+ $request_info{PARENTIMAGE} = '';
+ $request_info{PRELOADONLY} = '0';
+ $request_info{SUBIMAGE} = '';
+ $request_info{user}{STANDALONE} = '0';
+ $request_info{CHECKTIME} = '';
+ $request_info{NOTICEINTERVAL} = '';
+ $request_info{RESERVATIONCOUNT} = scalar keys %{$request_info{reservation}};
+ $request_info{UPDATED} = '0';
+
+ # Each selected row represents a reservation associated with this request
+
+ # Fix some of the data
+
+ # Set the user's preferred name to the first name if it isn't defined
+ if (!defined($request_info{user}{preferredname}) || !$request_info{user}{preferredname}) {
+ $request_info{user}{preferredname} = $request_info{user}{firstname};
+ }
+
+ # Set the user's uid to -1 if it's NULL
+ if (!defined($request_info{user}{uid}) || !$request_info{user}{uid}) {
+ $request_info{user}{uid} = -1;
+ }
+
+ # Set the user's IMid to '' if it's NULL
+ if (!defined($request_info{user}{IMid}) || !$request_info{user}{IMid}) {
+ $request_info{user}{IMid} = '';
+ }
+
+ # Fix the unityid if non-NCSU account
+ if ($request_info{user}{uid} >= 1000000) {
+ my ($correct_unity_id, $user_domain) = split /@/, $request_info{user}{unityid};
+ notify($ERRORS{'OK'}, 0, "non-NCSU user found: $request_info{user}{unityid}, $correct_unity_id from $user_domain");
+ $request_info{user}{unityid} = $correct_unity_id;
+ $request_info{user}{STANDALONE} = 1;
+ }
+
+ # Affiliation specific changes
+ if ($request_info{user}{affiliation}{name} ne "NCSU") {
+ notify($ERRORS{'OK'}, 0, "non-NCSU user affiliation found: $request_info{user}{affiliation}{name}");
+ $request_info{user}{STANDALONE} = 1;
+ }
+
+ # For test account only
+ if ($request_info{user}{unityid} =~ /vcladmin/) {
+ $request_info{user}{STANDALONE} = 1;
+ }
+
+ # Set the user's affiliation sitewwwaddress and help address if not defined or blank
+ if (!defined($request_info{user}{affiliation}{sitewwwaddress}) || !$request_info{user}{affiliation}{sitewwwaddress}) {
+ $request_info{user}{affiliation}{sitewwwaddress} = 'http://vcl.ncsu.edu';
+ }
+ if (!defined($request_info{user}{affiliation}{helpaddress}) || !$request_info{user}{affiliation}{helpaddress}) {
+ $request_info{user}{affiliation}{helpaddress} = 'vcl_help@ncsu.edu';
+ }
+
+
+
+ # Loop through all the reservations
+ foreach my $reservation_id (keys %{$request_info{reservation}}) {
+
+ # Confirm lastcheck time is not NULL
+ if (!defined($request_info{reservation}{$reservation_id}{lastcheck})) {
+ $request_info{reservation}{$reservation_id}{lastcheck} = 0;
+ }
+
+ # Set the reservation remote IP to 0 if it's NULL
+ if (!defined($request_info{reservation}{$reservation_id}{remoteIP})) {
+ $request_info{reservation}{$reservation_id}{remoteIP} = 0;
+ }
+
+ # Set the short name of the computer based on the hostname
+ my $computer_hostname = $request_info{reservation}{$reservation_id}{computer}{hostname};
+ $computer_hostname =~ /([-_a-zA-Z0-9]*)(\.?)/;
+ my $computer_shortname = $1;
+ $request_info{reservation}{$reservation_id}{computer}{SHORTNAME} = $computer_shortname;
+
+ # Add the managementnode info to the hash
+ my $management_node_id = $request_info{reservation}{$reservation_id}{managementnodeid};
+ my $management_node_info = get_management_node_info($management_node_id);
+ if (!$management_node_info) {
+ notify($ERRORS{'WARNING'}, 0, "failed to retrieve management node info");
+ $request_info{reservation}{$reservation_id}{managementnode} = 0;
+ }
+ else {
+ $request_info{reservation}{$reservation_id}{managementnode} = $management_node_info;
+ }
+
+ # Set the node name based on the type of computer
+ my $computer_type = $request_info{reservation}{$reservation_id}{computer}{type};
+
+ # Figure out the nodename based on the type of computer
+ my $computer_nodename;
+ if ($computer_type eq "blade") {
+ $computer_nodename = $computer_shortname;
+ }
+ elsif ($computer_type eq "lab") {
+ $computer_nodename = $computer_hostname;
+ }
+ elsif ($computer_type eq "virtualmachine") {
+ $computer_nodename = $computer_shortname;
+ }
+ else {
+ my $computer_id = $request_info{reservation}{$reservation_id}{computer}{id};
+ notify($ERRORS{'WARNING'}, 0, "computer=$computer_id is of an unknown or unusual type=$computer_type");
+ }
+ $request_info{reservation}{$reservation_id}{computer}{NODENAME} = $computer_nodename;
+
+ # Set the image identity file path
+ my $imagerevision_imagename = $request_info{reservation}{$reservation_id}{imagerevision}{imagename};
+ my $identity_file_path;
+ if ($imagerevision_imagename =~ /^(win|vmwarewin|vmwareesxwin)/) {
+ $identity_file_path = $IDENTITY_wxp;
+ }
+ elsif ($imagerevision_imagename =~ /^(rh|fc|esx)/) {
+ $identity_file_path = $IDENTITY_bladerhel;
+ }
+ #elsif ($imagerevision_imagename =~ /vmimage|vmwarewin|vmwareesxwin/) {
+ # $identity_file_path = $IDENTITY_wxp;
+ #}
+ elsif ($imagerevision_imagename =~ /realmrh|i386_linux26/) {
+ $identity_file_path = $IDENTITY_linux_lab;
+ }
+ elsif ($imagerevision_imagename =~ /sun/) {
+ $identity_file_path = $IDENTITY_solaris_lab;
+ }
+ elsif ($imagerevision_imagename =~ /^mpls/) {
+ notify($ERRORS{'OK'}, 0, "MPLS reservation: $request_id:$reservation_id");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unsupported image type: $imagerevision_imagename");
+ }
+ $request_info{reservation}{$reservation_id}{image}{IDENTITY} = $identity_file_path;
+
+ # Set some non-database defaults
+ # All data ever added to the hash should be initialized here
+ $request_info{reservation}{$reservation_id}{READY} = '0';
+ $request_info{reservation}{$reservation_id}{image}{SETTESTFLAG} = '';
+ $request_info{reservation}{$reservation_id}{image}{UPDATEIMAGENAME} = '';
+
+ # If machine type is virtual machine - build out a vmclient subhash
+ # Allows for ease of use with existing vm subroutines
+ if ($request_info{reservation}{$reservation_id}{computer}{type} eq "virtualmachine") {
+ $request_info{reservation}{$reservation_id}{computer}{"vmclient"}{"drivetype"} = $request_info{reservation}{$reservation_id}{computer}{drivetype};
+ $request_info{reservation}{$reservation_id}{computer}{"vmclient"}{"shortname"} = $request_info{reservation}{$reservation_id}{computer}{SHORTNAME};
+ $request_info{reservation}{$reservation_id}{computer}{"vmclient"}{"hostname"} = $request_info{reservation}{$reservation_id}{computer}{hostname};
+ $request_info{reservation}{$reservation_id}{computer}{"vmclient"}{"eth0MAC"} = $request_info{reservation}{$reservation_id}{computer}{eth0macaddress};
+ $request_info{reservation}{$reservation_id}{computer}{"vmclient"}{"eth1MAC"} = $request_info{reservation}{$reservation_id}{computer}{eth1macaddress};
+ $request_info{reservation}{$reservation_id}{computer}{"vmclient"}{"publicIPaddress"} = $request_info{reservation}{$reservation_id}{computer}{IPaddress};
+ $request_info{reservation}{$reservation_id}{computer}{"vmclient"}{"privateIPaddress"} = $request_info{reservation}{$reservation_id}{computer}{privateIPaddress};
+ $request_info{reservation}{$reservation_id}{computer}{"vmclient"}{"imageminram"} = $request_info{reservation}{$reservation_id}{image}{minram};
+ $request_info{reservation}{$reservation_id}{computer}{"vmclient"}{"requestedimagename"} = $request_info{reservation}{$reservation_id}{imagerevision}{imagename};
+ $request_info{reservation}{$reservation_id}{computer}{"vmclient"}{"imageid"} = $request_info{reservation}{$reservation_id}{image}{id};
+ $request_info{reservation}{$reservation_id}{computer}{"vmclient"}{"reloadtime"} = $request_info{reservation}{$reservation_id}{image}{reloadtime};
+ $request_info{reservation}{$reservation_id}{computer}{"vmclient"}{"project"} = $request_info{reservation}{$reservation_id}{image}{project};
+ $request_info{reservation}{$reservation_id}{computer}{"vmclient"}{"OSname"} = $request_info{reservation}{$reservation_id}{image}{OS}{name};
+ $request_info{reservation}{$reservation_id}{computer}{"vmclient"}{"forimaging"} = $request_info{forimaging};
+ $request_info{reservation}{$reservation_id}{computer}{"vmclient"}{"persistent"} = $request_info{forimaging};
+ $request_info{reservation}{$reservation_id}{computer}{"vmclient"}{"currentimageid"} = $request_info{reservation}{$reservation_id}{computer}{currentimageid};
+ $request_info{reservation}{$reservation_id}{computer}{"vmclient"}{"reservationid"} = $reservation_id;
+ $request_info{reservation}{$reservation_id}{computer}{"vmclient"}{"computerid"} = $request_info{reservation}{$reservation_id}{computer}{id};
+ $request_info{reservation}{$reservation_id}{computer}{"vmclient"}{"state"} = $request_info{state}{name};
+ } ## end if ($request_info{reservation}{$reservation_id...
+ } ## end foreach my $reservation_id (keys %{$request_info...
+
+ return %request_info;
+} ## end sub get_request_info
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_requests
+
+ Parameters : management node id
+ Returns : hash
+ Description : gets request information for a particular management node
+
+=cut
+
+
+sub get_management_node_requests {
+ my ($management_node_id) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ if (!(defined($management_node_id))) {
+ notify($ERRORS{'WARNING'}, 0, "management node ID was not specified");
+ return ();
+ }
+
+ my $select_statement = "
+ SELECT DISTINCT
+
+ request.id AS request_id,
+ request.stateid AS request_stateid,
+ request.reservationid AS request_reservationid,
+ request.laststateid AS request_laststateid,
+ request.logid AS request_logid,
+ request.start AS request_start,
+ request.end AS request_end,
+ request.daterequested AS request_daterequested,
+ request.datemodified AS request_datemodified,
+ request.preload AS request_preload,
+
+ requeststate.name AS requeststate_name,
+
+ requestlaststate.name AS requestlaststate_name,
+
+ reservation.id AS reservation_id,
+ reservation.requestid AS reservation_requestid,
+ reservation.managementnodeid AS reservation_managementnodeid,
+ reservation.lastcheck AS reservation_lastcheck
+
+ FROM
+ request,
+ reservation,
+ state requeststate,
+ state requestlaststate
+
+ WHERE
+ reservation.managementnodeid = $management_node_id
+ AND reservation.requestid = request.id
+ AND requeststate.id = request.stateid
+ AND requestlaststate.id = request.laststateid
+
+ GROUP BY
+ reservation.id
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @selected_rows = database_select($select_statement);
+
+ # Check to make sure 1 or more rows were returned
+ if (scalar @selected_rows == 0) {
+ return ();
+ }
+
+ # Build the hash
+ my %requests;
+
+ for (@selected_rows) {
+ my %reservation_row = %{$_};
+
+ # Grab the request and reservation IDs to make the code a little cleaner
+ my $request_id = $reservation_row{request_id};
+ my $reservation_id = $reservation_row{reservation_id};
+
+ # Loop through all the columns returned for the reservation
+ foreach my $key (keys %reservation_row) {
+ my $value = $reservation_row{$key};
+
+ # Create another variable by stripping off the column_ part of each key
+ # This variable stores the original (correct) column name
+ (my $original_key = $key) =~ s/^.+_//;
+
+ if ($key =~ /request_/) {
+ # Set the top-level key if not already set
+ $requests{$request_id}{$original_key} = $value if (!$requests{$request_id}{$original_key});
+ }
+ elsif ($key =~ /requeststate_/) {
+ $requests{$request_id}{state}{$original_key} = $value if (!$requests{$request_id}{state}{$original_key});
+ }
+ elsif ($key =~ /requestlaststate_/) {
+ $requests{$request_id}{laststate}{$original_key} = $value if (!$requests{$request_id}{laststate}{$original_key});
+ }
+ elsif ($key =~ /reservation_/) {
+ $requests{$request_id}{reservation}{$reservation_id}{$original_key} = $value;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unknown key found in SQL data: $key");
+ }
+
+ } # Close foreach key in reservation row
+ } # Close loop through selected rows
+
+ # Each selected row represents a reservation associated with this request
+
+ return %requests;
+} ## end sub get_management_node_requests
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_image_info
+
+ Parameters : Image ID
+ Returns : Hash containing image data
+ Description : collects data from database on supplied image_id
+
+=cut
+
+
+sub get_image_info {
+ my ($image_id) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameter
+ if (!(defined($image_id))) {
+ notify($ERRORS{'WARNING'}, 0, "image ID was not specified");
+ return ();
+ }
+
+ # If imagemetaid isnt' NULL, perform another query to get the meta info
+ my $select_statement = "
+ SELECT
+ image.*
+ FROM
+ image
+ WHERE
+ image.id = '$image_id'
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @selected_rows = database_select($select_statement);
+
+ # Check to make sure 1 row was returned
+ if (scalar @selected_rows == 0) {
+ notify($ERRORS{'OK'}, 0, "image id $image_id does not exist in the database, 0 rows were returned");
+ return ();
+ }
+ elsif (scalar @selected_rows > 1) {
+ notify($ERRORS{'WARNING'}, 0, "" . scalar @selected_rows . " rows were returned from database select");
+ return ();
+ }
+
+ # A single row was returned (good)
+ # Return the hash
+ return %{$selected_rows[0]};
+} ## end sub get_image_info
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_imagerevision_info
+
+ Parameters : Imagerevision ID
+ Returns : Hash containing image data
+ Description : collects data from database on supplied $imagerevision_id
+
+=cut
+
+
+sub get_imagerevision_info {
+ my ($imagerevision_id) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameter
+ if (!(defined($imagerevision_id))) {
+ notify($ERRORS{'WARNING'}, 0, "imagerevision ID was not specified");
+ return ();
+ }
+
+ # If imagemetaid isnt' NULL, perform another query to get the meta info
+ my $select_statement = "
+ SELECT
+ imagerevision.*
+ FROM
+ imagerevision
+ WHERE
+ imagerevision.id = '$imagerevision_id'
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @selected_rows = database_select($select_statement);
+
+ # Check to make sure 1 row was returned
+ if (scalar @selected_rows == 0) {
+ notify($ERRORS{'OK'}, 0, "imagerevision id $imagerevision_id was not found in the database, 0 rows were returned");
+ return ();
+ }
+ elsif (scalar @selected_rows > 1) {
+ notify($ERRORS{'WARNING'}, 0, "" . scalar @selected_rows . " rows were returned from database select");
+ return ();
+ }
+
+ # A single row was returned (good)
+ # Return the hash
+ return %{$selected_rows[0]};
+} ## end sub get_imagerevision_info
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_production_imagerevision_info
+
+ Parameters : $image_id
+ Returns : Hash containing imagerevision data for the production revision of an image
+ Description :
+
+=cut
+
+
+sub get_production_imagerevision_info {
+ my ($image_id) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameter
+ if (!(defined($image_id))) {
+ notify($ERRORS{'WARNING'}, 0, "image ID was not specified");
+ return ();
+ }
+
+ # If imagemetaid isnt' NULL, perform another query to get the meta info
+ my $select_statement = "
+ SELECT
+ imagerevision.*
+ FROM
+ imagerevision
+ WHERE
+ imagerevision.imageid = '$image_id'
+ AND imagerevision.production = '1'
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @selected_rows = database_select($select_statement);
+
+ # Check to make sure 1 row was returned
+ if (scalar @selected_rows == 0) {
+ notify($ERRORS{'OK'}, 0, "production imagerevision for image id $image_id was not found in the database, 0 rows were returned");
+ return ();
+ }
+ elsif (scalar @selected_rows > 1) {
+ notify($ERRORS{'WARNING'}, 0, "" . scalar @selected_rows . " rows were returned from database select");
+ return ();
+ }
+
+ # A single row was returned (good)
+ # Return the hash
+ return %{$selected_rows[0]};
+} ## end sub get_production_imagerevision_info
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_imagemeta_info
+
+ Parameters : Imagemata ID
+ Returns : Hash containing imagemeta columns
+ Description :
+
+=cut
+
+
+sub get_imagemeta_info {
+ my ($imagemeta_id) = @_;
+
+ # Create a hash with the default values in case imagemeta data can't be found
+ my %default_usergroupmembers = ();
+ my %default_imagemeta = ('id' => '',
+ 'checkuser' => '1',
+ 'subimages' => '0',
+ 'usergroupid' => '',
+ 'sysprep' => '1',
+ 'postoption' => '',
+ 'USERGROUPMEMBERS' => \%default_usergroupmembers,
+ 'USERGROUPMEMBERCOUNT' => 0);
+
+ # Return defaults if nothing was passed as the imagemeta id
+ if (!defined($imagemeta_id) || $imagemeta_id eq '') {
+ #notify($ERRORS{'DEBUG'}, 0, "imagemeta data does not exist for image, default values will be used");
+ return %default_imagemeta;
+ }
+
+ # If imagemetaid isnt' NULL, perform another query to get the meta info
+ my $select_statement = "
+ SELECT
+ imagemeta.*
+ FROM
+ imagemeta
+ WHERE
+ imagemeta.id = '$imagemeta_id'
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @selected_rows = database_select($select_statement);
+
+ # Check to make sure 1 row was returned
+ if (scalar @selected_rows == 0) {
+ notify($ERRORS{'OK'}, 0, "imagemeta data does not exist for image, using default values", \%default_imagemeta);
+ return %default_imagemeta;
+ }
+ elsif (scalar @selected_rows > 1) {
+ notify($ERRORS{'WARNING'}, 0, "" . scalar @selected_rows . " rows were returned from database select, using default values", \%default_imagemeta);
+ return %default_imagemeta;
+ }
+
+ my %imagemeta = %{$selected_rows[0]};
+
+ # Collect additional information
+ if (defined($imagemeta{usergroupid})) {
+ my @userlist = getusergroupmembers($imagemeta{usergroupid});
+ if (scalar @userlist > 0) {
+ foreach my $userstring (@userlist) {
+ my ($username, $uid) = split(/:/, $userstring);
+ $imagemeta{"usergrpmembers"}{$uid}{"username"} = $username;
+ $imagemeta{"usergrpmembers"}{$uid}{"uid"} = $uid;
+ $imagemeta{USERGROUPMEMBERS}{$uid} = $username;
+ }
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "imagemeta data has usergroupid set $imagemeta{usergroupid} - user group was not found");
+ }
+ } ## end if (defined($imagemeta{usergroupid}))
+
+ # Set values to 0 if database values are null to avoid DataStructure warnings and concat errors
+ $imagemeta{usergroupid} = 0 if !defined($imagemeta{usergroupid});
+ $imagemeta{postoption} = 0 if !defined($imagemeta{postoption});
+ $imagemeta{architecture} = 0 if !defined($imagemeta{architecture});
+
+ # Populate the count of user group members
+ $imagemeta{USERGROUPMEMBERCOUNT} = scalar(keys(%{$imagemeta{USERGROUPMEMBERS}}));
+
+ # Return the hash
+ return %imagemeta;
+} ## end sub get_imagemeta_info
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_vmhost_info
+
+ Parameters : vmhost ID
+ Returns : Hash containing vmhost, vmprofile, and vmtype data
+ Description :
+
+=cut
+
+
+sub get_vmhost_info {
+ my ($vmhost_id) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameter
+ if (!(defined($vmhost_id))) {
+ notify($ERRORS{'WARNING'}, 0, "vmhost ID was not specified");
+ return ();
+ }
+
+ # If imagemetaid isnt' NULL, perform another query to get the meta info
+ my $select_statement = "
+ SELECT
+
+ vmhost.id AS vmhost_id,
+ vmhost.computerid AS vmhost_computerid,
+ vmhost.vmprofileid AS vmhost_vmprofileid,
+ vmhost.vmlimit AS vmhost_vmlimit,
+ vmhost.vmkernalnic AS vmhost_vmkernalnic,
+
+ vmprofile.id AS vmprofile_id,
+ vmprofile.profilename AS vmprofile_profilename,
+ vmprofile.vmtypeid AS vmprofile_vmtypeid,
+ vmprofile.nasshare AS vmprofile_nasshare,
+ vmprofile.datastorepath AS vmprofile_datastorepath,
+ vmprofile.vmpath AS vmprofile_vmpath,
+ vmprofile.virtualswitch0 AS vmprofile_virtualswitch0,
+ vmprofile.virtualswitch1 AS vmprofile_virtualswitch1,
+ vmprofile.vmdisk AS vmprofile_vmdisk,
+
+ vmtype.id AS vmtype_id,
+ vmtype.name AS vmtype_name,
+
+ state.name AS vmhost_state,
+ image.name AS vmhost_imagename,
+ computer.RAM AS vmhost_RAM,
+ computer.hostname AS vmhost_hostname,
+ computer.type AS vmhost_type
+
+ FROM
+ vmhost,
+ vmprofile,
+ vmtype,
+ computer,
+ state,
+ image
+
+ WHERE
+ vmhost.id = '$vmhost_id'
+ AND vmprofile.id = vmhost.vmprofileid
+ AND vmtype.id = vmprofile.vmtypeid
+ AND computer.id = vmhost.computerid
+ AND state.id = computer.stateid
+ AND image.id = computer.currentimageid
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @selected_rows = database_select($select_statement);
+
+ # Check to make sure 1 row was returned
+ if (scalar @selected_rows == 0) {
+ notify($ERRORS{'WARNING'}, 0, "zero rows were returned from database select");
+ return ();
+ }
+ elsif (scalar @selected_rows > 1) {
+ notify($ERRORS{'WARNING'}, 0, "" . scalar @selected_rows . " rows were returned from database select");
+ return ();
+ }
+
+ # Get the single returned row
+ my %vmhost_row = %{$selected_rows[0]};
+
+ # Create a hash
+ my %vmhost_info;
+
+ # Loop through all the columns returned for the reservation
+ foreach my $key (keys %vmhost_row) {
+ my $value = $vmhost_row{$key};
+
+ # Create another variable by stripping off the column_ part of each key
+ # This variable stores the original (correct) column name
+ (my $original_key = $key) =~ s/^.+_//;
+ #notify($ERRORS{'OK'}, 0, "key=$key original_key=$original_key value=$value");
+
+ if ($key =~ /vmhost_/) {
+ $vmhost_info{$original_key} = $value;
+ }
+ elsif ($key =~ /vmprofile_/) {
+ #$vmhost_info{vmprofile}{$original_key} = $value;
+ $vmhost_info{"vmprofile"}{$original_key} = $value;
+ }
+ elsif ($key =~ /vmtype_/) {
+ $vmhost_info{"vmprofile"}{"vmtype"}{$original_key} = $value;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unknown key found in SQL data: $key");
+ }
+ } # Close loop through hash keys (columns)
+
+ $vmhost_info{vmprofile}{"datastorepath4vmx"} = $vmhost_info{vmprofile}{datastorepath};
+ $vmhost_info{vmprofile}{"vmpath"} = $vmhost_info{vmprofile}{datastorepath} if (!(defined($vmhost_info{vmprofile}{vmpath})));
+ #$vmhost_info{vmprofile}{datastorepath} =~ s/(\s+)/\\\\ /g; #detect/handle any spaces;
+ #$vmhost_info{vmprofile}{vmpath} =~ s/(\s+)/\\\\ /g; #detect/handle any spaces;
+ $vmhost_info{vmprofile}{datastorepath} =~ s/(\s+)/\\ /g; #detect/handle any spaces;
+ $vmhost_info{vmprofile}{vmpath} =~ s/(\s+)/\\ /g; #detect/handle any spaces;
+
+ #for legacy datastructure
+ #$vmhost_info{"datastorepath4vmx"} = $vmhost_info{vmhost}{datastorepath};
+ #$vmhost_info{"vmpath"} = $vmhost_info{datastorepath} if(!(defined($vmhost_info{vmpath})));
+ #$vmhost_info{datastorepath} =~ s/(\s+)/\\\\ /g; #detect/handle any spaces;
+ #$vmhost_info{vmpath} =~ s/(\s+)/\\\\ /g; #detect/handle any spaces;
+ #$vmhost_info{datastorepath} =~ s/(\s+)/\\ /g; #detect/handle any spaces;
+ #$vmhost_info{vmpath} =~ s/(\s+)/\\ /g; #detect/handle any spaces;
+
+
+ return %vmhost_info;
+} ## end sub get_vmhost_info
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 run_ssh_command
+
+ Parameters : $node, $identity_path, $command, $user, $port
+ Returns : If ssh command completed successfully, an array containing
+ the exit status and a reference to an array containing the
+ lines of output of the command specified is returned.
+ $array[0] = the exit status of the command
+ $array[1] = reference to array containing lines of output
+ generated by the command
+ If the ssh command fails, an empty array is returned. You can
+ therefore use "if (run_ssh_command())", true means the command
+ executed, false means it failed.
+ Description : Runs an SSH command on the specified node.
+
+=cut
+
+sub run_ssh_command {
+ my ($node, $identity_paths, $command, $user, $port, $no_output) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the arguments
+ if (!defined($node) || !$node) {
+ notify($ERRORS{'WARNING'}, 0, "computer node was not specified");
+ return 0;
+ }
+ if (!defined($command) || !$command) {
+ notify($ERRORS{'WARNING'}, 0, "command was not specified");
+ return 0;
+ }
+
+ # Set default values if not passed as an argument
+ $user = "root" if (!defined($user) || !$user);
+ $port = 22 if (!defined($port) || !$port);
+
+ # TODO: Add ssh path to config file and set global variable
+ # Locate the path to the ssh binary
+ my $ssh_path;
+ if (-f '/usr/bin/ssh') {
+ $ssh_path = '/usr/bin/ssh';
+ }
+ elsif (-f 'C:/cygwin/bin/ssh.exe') {
+ $ssh_path = 'C:/cygwin/bin/ssh.exe';
+ }
+ elsif (-f 'D:/cygwin/bin/ssh.exe') {
+ $ssh_path = 'D:/cygwin/bin/ssh.exe';
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to locate the SSH executable in the usual places");
+ return 0;
+ }
+
+ # Format the identity path string
+ if ($identity_paths) {
+ $identity_paths =~ s/^\s*/-i /;
+ $identity_paths =~ s/\s*,\s*/ -i /g;
+ $identity_paths .= ' ';
+ }
+
+ #notify($ERRORS{'DEBUG'}, 0, "node: $node, identity file path: $identity_path, user: $user, port: $port");
+ #notify($ERRORS{'DEBUG'}, 0, "command: $command");
+
+ # Assemble the SSH command
+ # -i <identity_file>, Selects the file from which the identity (private key) for RSA authentication is read.
+ # -l <login_name>, Specifies the user to log in as on the remote machine.
+ # -p <port>, Port to connect to on the remote host.
+ # -x, Disables X11 forwarding.
+ # Dont use: -q, Quiet mode. Causes all warning and diagnostic messages to be suppressed.
+ my $ssh_command = "$ssh_path $identity_paths -l $user -p $port -x $node '$command'";
+
+ # Redirect standard output and error output so all messages are captured
+ $ssh_command .= ' 2>&1';
+
+ # Execute the command
+ my $ssh_output;
+ my $ssh_output_formatted;
+ my $attempts = 0;
+ my $max_attempts = 3;
+ my $exit_status = 255;
+
+ # Make multiple attempts if failure occurs
+ while ($attempts < $max_attempts) {
+ $attempts++;
+
+ ## Add -v (verbose) argument to command if this is the 2nd attempt
+ #$ssh_command =~ s/$ssh_path/$ssh_path -v/ if $attempts == 2;
+
+ # Print the SSH command, only display the attempt # if > 1
+ if ($attempts == 1) {
+ notify($ERRORS{'DEBUG'}, 0, "executing SSH command on $node: $command");
+ }
+ else {
+ notify($ERRORS{'DEBUG'}, 0, "attempt $attempts/$max_attempts: executing SSH command on $node: $ssh_command");
+ }
+
+ # Execute the command
+ $ssh_output = `$ssh_command`;
+
+ # Bits 0-7 of $? are set to the signal the child process received that caused it to die
+ my $signal_number = $? & 127;
+
+ # Bit 8 of $? will be true if a core dump occurred
+ my $core_dump = $? & 128;
+
+ # Bits 9-16 of $? contain the child process exit status
+ $exit_status = $? >> 8;
+
+ notify($ERRORS{'DEBUG'}, 0, "\$?: $?, signal: $signal_number, core dump: $core_dump, exit status: $exit_status");
+
+ ## For some reason the SSH exit status is sometimes right-padded with 8 0's
+ ## Shift right 8 bits to get the real value if it's > 255
+ #if ($ssh_exit_status > 255) {
+ # $ssh_exit_status = ($ssh_exit_status >> 8);
+ #}
+
+ # Strip out the key warning message
+ $ssh_output =~ s/\@{10,}.*man-in-the-middle attacks\.//igs;
+ $ssh_output =~ s/^\s+|\s+$//g;
+ chomp $ssh_output;
+
+ # Set the output string to none if no output was produced
+ $ssh_output = 'none' if !$ssh_output;
+
+ # Replace line breaks in the output with \n$pid| SSH output:
+ my $pid = $$;
+ $ssh_output_formatted = $ssh_output;
+
+ # Get a slice of the SSH output if there are many lines
+ my @ssh_output_formatted_lines = split("\n", $ssh_output_formatted);
+ my $ssh_output_formatted_line_count = scalar @ssh_output_formatted_lines;
+ if ($ssh_output_formatted_line_count > 50) {
+ @ssh_output_formatted_lines = @ssh_output_formatted_lines[0 .. 49];
+ push(@ssh_output_formatted_lines, "displayed first 50 of $ssh_output_formatted_line_count SSH output lines");
+ $ssh_output_formatted = join("\n", @ssh_output_formatted_lines);
+ }
+
+ my $command_prefix = substr($command, 0, 10);
+ $command_prefix .= "..." if (length($command) > 10);
+ $ssh_output_formatted =~ s/\r//g;
+ $ssh_output_formatted =~ s/^/ssh output ($command_prefix): /g;
+ $ssh_output_formatted =~ s/\n/\nssh output ($command_prefix): /g;
+
+ # Check the exit status
+ # ssh exits with the exit status of the remote command or with 255 if an error occurred.
+ if ($exit_status == 255 || $ssh_output_formatted =~ /lost connection|reset by peer|no route to host|connection refused|connection timed out/i) {
+ notify($ERRORS{'WARNING'}, 0, "attempt $attempts/$max_attempts: failed to execute SSH command on $node: $command, exit status: $exit_status, SSH exits with the exit status of the remote command or with 255 if an error occurred, output:\n$ssh_output_formatted");
+ next;
+ }
+ else {
+ # SSH command was executed successfully, actual command on node may have succeeded or failed
+
+ # Split the output up into an array of lines
+ my @output_lines = split(/\n/, $ssh_output);
+
+ # Print the output unless no_output is set
+ notify($ERRORS{'DEBUG'}, 0, "run_ssh_command output: $ssh_output") unless $no_output;
+
+ # Print the command and exit status
+ notify($ERRORS{'OK'}, 0, "SSH command executed on $node: $command, returning ($exit_status, output)");
+
+ # Return the exit status and output
+ return ($exit_status, \@output_lines);
+ }
+ } ## end while ($attempts < $max_attempts)
+
+ # Failure, SSH command did not run at all
+ notify($ERRORS{'WARNING'}, 0, "failed to run SSH command after $attempts attempts, command: $ssh_command, exit status: $exit_status, output:\n$ssh_output_formatted");
+ return ();
+
+} ## end sub run_ssh_command
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 run_scp_command
+
+ Parameters : $path1, $path2, $identity_path, $port, $options
+ Returns : 1 success
+ Description : assumes path1 or path2 contains the src and target
+ example: copy from remote node to local file
+ path1 = $user\@$node:<filename>
+ path2 = <localfilename>
+
+ example: copy local file to remote node
+ path1 = <localfilename>
+ path2 = $user\@$node:<filename>
+
+=cut
+
+sub run_scp_command {
+ my ($path1, $path2, $identity_paths, $port, $options) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ if (!defined($path1) || !$path1) {
+ notify($ERRORS{'WARNING'}, 0, "path1 was not specified");
+ return 0;
+ }
+ if (!defined($path2) || !$path2) {
+ notify($ERRORS{'WARNING'}, 0, "path2 was not specified");
+ return 0;
+ }
+
+ # Format the identity path string
+ if ($identity_paths) {
+ $identity_paths =~ s/^\s*/-i /;
+ $identity_paths =~ s/\s*,\s*/ -i /g;
+ $identity_paths .= ' ';
+ }
+ else {
+ $identity_paths = '';
+ }
+
+ # Set default values if not passed as an argument
+ $port = 22 if (!defined($port));
+
+ # TODO: Add SCP path to config file and set global variable
+ # Locate the path to the SCP binary
+ my $scp_path;
+ if (-f '/usr/bin/scp') {
+ $scp_path = '/usr/bin/scp';
+ }
+ elsif (-f 'C:/cygwin/bin/scp.exe') {
+ $scp_path = 'C:/cygwin/bin/scp.exe';
+ }
+ elsif (-f 'D:/cygwin/bin/scp.exe') {
+ $scp_path = 'D:/cygwin/bin/scp.exe';
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to locate the SCP executable in the usual places");
+ return 0;
+ }
+
+ # could be hazardous not confirming optional input flags
+ if (defined($options)) {
+ $scp_path .= " $options ";
+ }
+
+ # Print the configuration if $VERBOSE
+ if ($VERBOSE) {
+ #notify($ERRORS{'OK'}, 0, "path1: $path1, path2: $path2 identity file path: $identity_path, port: $port");
+ #notify($ERRORS{'OK'}, 0, "node: $node, identity file path: $identity_path, user: $user, port: $port");
+ #notify($ERRORS{'OK'}, 0, "source path: $source_path");
+ #notify($ERRORS{'OK'}, 0, "destination path: $destination_path");
+ }
+
+ # Assemble the SCP command
+ # -B, Selects batch mode (prevents asking for passwords or passphrases).
+ # -i <identity_file>, Selects the file from which the identity (private key) for RSA authentication is read.
+ # -P <port>, Specifies the port to connect to on the remote host.
+ # -p, Preserves modification times, access times, and modes from the original file.
+ # -r, Recursively copy entire directories.
+ # -v, Verbose mode. Causes scp and ssh to print debugging messages about their progress.
+ # Don't use -q, Disables the progress meter. Error messages are more descriptive without it
+ my $scp_command = "$scp_path -B $identity_paths-P $port -p -r $path1 $path2";
+
+ # Redirect standard output and error output so all messages are captured
+ $scp_command .= ' 2>&1';
+
+ # Execute the command
+ my $scp_output;
+ my $attempts = 0;
+ my $max_attempts = 3;
+ my $scp_exit_status = 0;
+
+ # Make multiple attempts if failure occurs
+ while ($attempts < $max_attempts) {
+ $attempts++;
+
+ ## Add -v (verbose) argument to command if this is the 2nd attempt
+ #$scp_command =~ s/$scp_path/$scp_path -v/ if $attempts == 2;
+
+ notify($ERRORS{'DEBUG'}, 0, "attempt $attempts/$max_attempts: executing SCP command: $scp_command");
+
+ $scp_output = `$scp_command`;
+
+ # Save the exit status
+ $scp_exit_status = $?;
+
+ # Strip out the key warning message
+ $scp_output =~ s/\@{10,}.*man-in-the-middle attacks\.//igs;
+ $scp_output =~ s/^\s+|\s+$//g;
+
+ if ($scp_output && length($scp_output) > 0) {
+ # Add a newline to the beginning of the output if something was generated
+ # This is to make multi-line output more readable
+ $scp_output = "\n" . $scp_output;
+ }
+ else {
+ # Indicate there was no output if it is blank
+ $scp_output = 'none';
+ }
+
+ # Get a slice of the SCP output if there are many lines
+ my @scp_output_formatted_lines = split("\n", $scp_output);
+ my $scp_output_formatted_line_count = scalar @scp_output_formatted_lines;
+ if ($scp_output_formatted_line_count > 50) {
+ @scp_output_formatted_lines = @scp_output_formatted_lines[0 .. 49];
+ push(@scp_output_formatted_lines, "displayed first 50 of $scp_output_formatted_line_count SCP output lines");
+ $scp_output = join("\n", @scp_output_formatted_lines);
+ }
+
+ # Check the output for known error messages
+ # Check the exit status
+ # scp exits with 0 on success or >0 if an error occurred
+ if ($scp_exit_status > 0 || $scp_output =~ /lost connection|failed|reset by peer|no route to host/i) {
+ notify($ERRORS{'WARNING'}, 0, "scp error occurred: attempt $attempts/$max_attempts, command: $scp_command, exit status: $scp_exit_status, output: $scp_output");
+ next;
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "scp successful: attempt $attempts/$max_attempts, exit status: $scp_exit_status, output: $scp_output");
+ return 1;
+ }
+ } ## end while ($attempts < $max_attempts)
+
+ # Failure
+ notify($ERRORS{'WARNING'}, 0, "failed to copy files using scp after $attempts attempts, command: $scp_command, exit status: $scp_exit_status, output: $scp_output");
+ return 0;
+} ## end sub run_scp_command
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 write_currentimage_txt
+
+ Parameters : hash of hashes hash{image} contains image info
+ Returns : 0 failed or 1 successful
+ Description : runs an ssh command on the specified node and returns the output
+
+=cut
+
+sub write_currentimage_txt {
+ my ($data) = @_;
+
+ # Store some hash variables into local variables
+ my $computer_node_name = $data->get_computer_node_name();
+ my $computer_host_name = $data->get_computer_host_name();
+ my $computer_id = $data->get_computer_id();
+ my $image_identity = $data->get_image_identity();
+ my $image_id = $data->get_image_id();
+ my $image_name = $data->get_image_name();
+ my $image_prettyname = $data->get_image_prettyname();
+ my $imagerevision_id = $data->get_imagerevision_id();
+ my $imagerevision_date_created = $data->get_imagerevision_date_created();
+
+ my @current_image_lines;
+ push @current_image_lines, "$image_name";
+ push @current_image_lines, "id=$image_id";
+ push @current_image_lines, "prettyname=$image_prettyname";
+ push @current_image_lines, "imagerevision_id=$imagerevision_id";
+ push @current_image_lines, "imagerevision_datecreated=$imagerevision_date_created";
+ push @current_image_lines, "computer_id=$computer_id";
+ push @current_image_lines, "computer_hostname=$computer_host_name";
+
+ my $current_image_contents = join('\\r\\n', @current_image_lines);
+
+ my $command = 'echo -e "' . $current_image_contents . '" > currentimage.txt & cat currentimage.txt';
+
+ # Copy the temp file to the node as currentimage.txt
+ my ($ssh_exit_status, $ssh_output) = run_ssh_command($computer_node_name, $image_identity, $command);
+
+ if (defined($ssh_exit_status) && $ssh_exit_status == 0) {
+ notify($ERRORS{'OK'}, 0, "created currentimage.txt file on $computer_node_name:\n" . join "\n", @{$ssh_output});
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "failed to create currentimage.txt file on $computer_node_name:\n" . join "\n", @{$ssh_output});
+ return;
+ }
+
+} ## end sub write_currentimage_txt
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 vmwareclone
+
+ Parameters : $hostnode, $identity, $srcDisk, $dstDisk, $dstDir
+ Returns : 1 if successful, 0 if error occurred
+ Description : using vm tools clone srcdisk to dstdisk
+ currently using builtin vmkfstools
+
+=cut
+
+=pod
+
+sub vmwareclone {
+ my ($hostnode, $identity, $srcDisk, $dstDisk, $dstDir) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ #TODO - add checks for VI toolkit - then use vmclone.pl instead
+ #vmclone.pl would need additional parameters
+
+ my @list = run_ssh_command($hostnode, $identity, "ls -1 $srcDisk", "root");
+ my $srcDiskexist = 0;
+
+ foreach my $l (@{ $list[1] }) {
+ $srcDiskexist = 1 if ($l =~ /($srcDisk)$/);
+ $srcDiskexist = 0 if ($l =~ /No such file or directory/);
+ notify($ERRORS{'OK'}, 0, "$l");
+ }
+ my @ssh;
+ if ($srcDiskexist) {
+ #make dir for dstdisk
+ my @mkdir = run_ssh_command($hostnode, $identity, "mkdir -m 755 $dstDir", "root");
+ notify($ERRORS{'OK'}, 0, "srcDisk is exists $srcDisk ");
+ notify($ERRORS{'OK'}, 0, "starting clone process vmkfstools -d thin -i $srcDisk $dstDisk");
+ if (open(SSH, "/usr/bin/ssh -x -q -i $identity -l root $hostnode \"vmkfstools -i $srcDisk -d thin $dstDisk\" 2>&1 |")) {
+ #@ssh=<SSH>;
+ #close(SSH);
+ #foreach my $l (@ssh) {
+ # notify($ERRORS{'OK'},0,"$l");
+ #}
+ while (<SSH>) {
+ notify($ERRORS{'OK'}, 0, "started $_") if ($_ =~ /Destination/);
+ notify($ERRORS{'OK'}, 0, "started $_") if ($_ =~ /Cloning disk/);
+ notify($ERRORS{'OK'}, 0, "status $_") if ($_ =~ /Clone:/);
+ }
+ close(SSH);
+ } ## end if (open(SSH, "/usr/bin/ssh -x -q -i $identity -l root $hostnode \"vmkfstools -i $srcDisk -d thin $dstDisk\" 2>&1 |"...
+ } ## end if ($srcDiskexist)
+ else {
+ notify($ERRORS{'OK'}, 0, "srcDisk $srcDisk does not exists");
+ }
+ #confirm
+ @list = 0;
+ @list = run_ssh_command($hostnode, $identity, "ls -1 $dstDisk", "root");
+ my $dstDiskexist = 0;
+ foreach my $l (@{ $list[1] }) {
+ $dstDiskexist = 1 if ($l =~ /($dstDisk)$/);
+ $dstDiskexist = 0 if ($l =~ /No such file or directory/);
+ }
+ if ($dstDiskexist) {
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "clone process failed dstDisk $dstDisk does not exist");
+ return 0;
+ }
+} ## end sub vmwareclone
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_management_node_id
+
+ Parameters : Either a management node hostname or database ID
+ Returns : Hash containing data contained in the managementnode table
+ Description :
+
+=cut
+
+sub get_management_node_info {
+ my ($management_node_identifier) = @_;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameter
+ if (!(defined($management_node_identifier))) {
+ # If nothing was passed, assume management node is this machine
+ # Try to get the hostname of this machine
+ unless ($management_node_identifier = (hostname())[0]) {
+ notify($ERRORS{'WARNING'}, 0, "management node hostname or ID was not specified and hostname could not be determined");
+ return ();
+ }
+ }
+
+ my $select_statement = "
+ SELECT
+ managementnode.*,
+ predictivemodule.name AS predictive_name,
+ predictivemodule.prettyname AS predictive_prettyname,
+ predictivemodule.description AS predictive_description,
+ predictivemodule.perlpackage AS predictive_perlpackage,
+ state.name AS statename
+ FROM
+ managementnode,
+ module predictivemodule,
+ state
+ WHERE
+ managementnode.predictivemoduleid = predictivemodule.id
+ AND managementnode.stateid = state.id
+ AND
+ ";
+
+ # Figure out if the ID or hostname was passed as the identifier and complete the SQL statement
+ # Check if it only contains digits
+ chomp $management_node_identifier;
+ if ($management_node_identifier =~ /^\d+$/) {
+ $select_statement .= "managementnode.id = $management_node_identifier";
+ }
+ else {
+ $select_statement .= "managementnode.hostname like \'$management_node_identifier%\'";
+ }
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @selected_rows = database_select($select_statement);
+
+ # Check to make sure 1 row was returned
+ if (scalar @selected_rows == 0) {
+ notify($ERRORS{'WARNING'}, 0, "zero rows were returned from database select");
+ return ();
+ }
+ elsif (scalar @selected_rows > 1) {
+ notify($ERRORS{'WARNING'}, 0, "" . scalar @selected_rows . " rows were returned from database select");
+ return ();
+ }
+
+ # Get the single returned row
+ # It contains a hash
+ my $management_node_info = $selected_rows[0];
+
+ # Move the state name to a subkey to match get_request_info
+ $management_node_info->{state}{name} = $management_node_info->{statename};
+ delete $management_node_info->{statename};
+
+ $management_node_info->{hostname} =~ /([-_a-zA-Z0-9]*)(\.?)/;
+ my $shortname = $1;
+ $management_node_info->{SHORTNAME} = $shortname;
+
+ # Get the image library partner info if imagelibenable=1 and imagelibgroupid>0
+ my $imagelib_enable = $management_node_info->{imagelibenable};
+ my $imagelib_group_id = $management_node_info->{imagelibgroupid};
+ my $management_node_id = $management_node_info->{id};
+ if ($imagelib_enable && defined($imagelib_group_id) && $imagelib_group_id) {
+ my $imagelib_statement = "
+ SELECT DISTINCT
+ managementnode.IPAddress
+ FROM
+ managementnode,
+ resource,
+ resourcegroup,
+ resourcegroupmembers
+ WHERE
+ resourcegroup.id = $imagelib_group_id
+ AND resourcegroupmembers.resourcegroupid = resourcegroup.id
+ AND resource.id = resourcegroupmembers.resourceid
+ AND resource.subid = managementnode.id
+ AND managementnode.id != $management_node_id
+ ";
+
+ # Call the database select subroutine
+ my @imagelib_rows = database_select($imagelib_statement);
+
+ # Check to make sure 1 row was returned
+ if (scalar @imagelib_rows == 0) {
+ notify($ERRORS{'WARNING'}, 0, "zero rows were returned from database select, image library functions will be disabled");
+ $management_node_info->{imagelibenable} = 0;
+ }
+ else {
+ #notify($ERRORS{'DEBUG'}, 0, "imagelib partners found: " . scalar @imagelib_rows);
+ # Loop through the rows, assemble a string separated by commas
+ my $imagelib_ipaddress_string;
+ for my $imagelib_row (@imagelib_rows) {
+ $imagelib_ipaddress_string .= "$imagelib_row->{IPAddress},";
+ }
+ # Remove the trailing comma
+ $imagelib_ipaddress_string =~ s/,$//;
+ #notify($ERRORS{'DEBUG'}, 0, "image library partner IP address string: $imagelib_ipaddress_string");
+ $management_node_info->{IMAGELIBPARTNERS} = $imagelib_ipaddress_string;
+ } ## end else [ if (scalar @imagelib_rows == 0)
+ } ## end if ($imagelib_enable && defined($imagelib_group_id...
+ else {
+ $management_node_info->{IMAGELIBPARTNERS} = 0;
+ #notify($ERRORS{'DEBUG'}, 0, "image library sharing functions are disabled");
+ }
+
+ # Get the OS name
+ my $os_name = lc($^O);
+ $management_node_info->{OSNAME} = $os_name;
+
+ notify($ERRORS{'DEBUG'}, 0, "management node info retrieved from database for $shortname");
+ return $management_node_info;
+} ## end sub get_management_node_info
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 update_currentimage
+
+ Parameters : $computerid, $imageid, $imagerevisionid, $preferredimagid(optional)
+ Returns : 0 failed or 1 success
+ Description : Updates currentimage on a node, preferredimageid = optional
+
+=cut
+
+sub update_currentimage {
+ my ($computerid, $imageid, $imagerevisionid, $preferredimagid) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameters
+ if (!(defined($computerid))) {
+ notify($ERRORS{'WARNING'}, 0, "computer ID was not specified");
+ return ();
+ }
+ if (!(defined($imageid))) {
+ notify($ERRORS{'WARNING'}, 0, "image ID was not specified");
+ return ();
+ }
+ if (!(defined($imagerevisionid))) {
+ notify($ERRORS{'WARNING'}, 0, "image revision ID was not specified");
+ return ();
+ }
+
+ notify($ERRORS{'OK'}, 0, "updating computer $computerid: image=$imageid, imagerevision=$imagerevisionid");
+
+ # Construct the update statement
+ # If $preferredimageid defined and set build slightly different statement
+ my $update_statement = "
+ UPDATE
+ computer c, image i
+ SET
+ c.currentimageid = $imageid,
+ c.imagerevisionid= $imagerevisionid
+ WHERE
+ c.id = $computerid
+ ";
+
+ if (defined($preferredimagid) && ($preferredimagid)) {
+ $update_statement = "
+ UPDATE
+ computer c, image i
+ SET
+ c.currentimageid = $imageid,
+ c.preferredimageid = $imageid,
+ c.imagerevisionid= $imagerevisionid
+ WHERE
+ c.id = $computerid
+ ";
+ } ## end if (defined($preferredimagid) && ($preferredimagid...
+
+ # Call the database execute subroutine
+ if (database_execute($update_statement)) {
+ # Update successful, return timestamp
+ notify($ERRORS{'OK'}, 0, "updated currentimageid and imagerevision id for computer id $computerid");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to update database, computerid $computerid currentimageid $imageid");
+ return 0;
+ }
+} ## end sub update_currentimage
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 is_inblockrequest
+
+ Parameters : Updates currentimage on a node
+ Returns : 1 if successful, 0 otherwise
+ Description : checks blockComputers table for supplied computerid
+
+=cut
+
+
+sub is_inblockrequest {
+ my ($computerid) = @_;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameters
+ if (!(defined($computerid))) {
+ notify($ERRORS{'WARNING'}, 0, "computer ID was not specified");
+ return ();
+ }
+ # Construct the select statement
+ my $select_statement = "
+ SELECT
+ b.blockRequestid,c.blockTimeid
+ FROM blockTimes b, blockComputers c
+ WHERE
+ c.blockTimeid=b.id AND c.computerid = $computerid
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @selected_rows = database_select($select_statement);
+
+ # Check on what we return
+ if (scalar @selected_rows == 0) {
+ notify($ERRORS{'OK'}, 0, "zero rows were returned from database select");
+ return 0;
+ }
+ elsif (scalar @selected_rows => 1) {
+ notify($ERRORS{'OK'}, 0, "" . scalar @selected_rows . " rows were returned from database select");
+ return 1;
+ }
+} ## end sub is_inblockrequest
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 update_lastcheckin
+
+ Parameters : $management_node_id
+ Returns : 0 or 1
+ Description : Updates lastcheckin for a management node
+
+=cut
+
+
+sub update_lastcheckin {
+ my ($management_node_id) = @_;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameter
+ if (!(defined($management_node_id))) {
+ notify($ERRORS{'WARNING'}, 0, "management node ID was not specified");
+ return ();
+ }
+
+ # Get current timestamp
+ my $timestamp = makedatestring();
+
+ # Construct the update statement
+ my $update_statement = "
+ UPDATE
+ managementnode
+ SET
+ lastcheckin = \'$timestamp\'
+ WHERE
+ id = $management_node_id
+ ";
+
+ # Call the database execute subroutine
+ if (database_execute($update_statement)) {
+ # Update successful, return timestamp
+ return $timestamp;
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to update database, management node id $management_node_id");
+ return 0;
+ }
+} ## end sub update_lastcheckin
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 update_computer_ipaddress
+
+ Parameters : $computer_id, $IPaddress
+ Returns : 0 failed or 1 success
+ Description : Updates computer's ipaddress - used in dynamic dhcp setup
+
+=cut
+
+
+sub update_computer_address {
+ my ($computer_id, $IPaddress) = @_;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameter
+ if (!(defined($computer_id))) {
+ notify($ERRORS{'WARNING'}, 0, "computer ID was not specified");
+ return ();
+ }
+ # Check the passed parameter
+ if (!(defined($IPaddress))) {
+ notify($ERRORS{'WARNING'}, 0, "IPaddress was not specified");
+ return ();
+ }
+
+ # Construct the update statement
+ my $update_statement = "
+ UPDATE
+ computer
+ SET
+ IPaddress = \'$IPaddress\'
+ WHERE
+ id = $computer_id
+ ";
+
+ # Call the database execute subroutine
+ if (database_execute($update_statement)) {
+ # Update successful, return timestamp
+ notify($ERRORS{'OK'}, $LOGFILE, "computer $computer_id IP address $IPaddress updated in database");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "unable to update database, computer IPaddress $computer_id,$IPaddress");
+ return 0;
+ }
+} ## end sub update_computer_address
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_request_end
+
+ Parameters : $request_id
+ Returns : Scalar containing end value for given request ID
+ Description :
+
+=cut
+
+sub get_request_end {
+ my ($request_id) = @_;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameter
+ if (!(defined($request_id))) {
+ notify($ERRORS{'WARNING'}, 0, "request ID was not specified");
+ return ();
+ }
+
+ # Create the select statement
+ my $select_statement = "
+ SELECT
+ request.end AS end
+ FROM
+ request
+ WHERE
+ request.id = $request_id
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @selected_rows = database_select($select_statement);
+
+ # Check to make sure 1 row was returned
+ if (scalar @selected_rows == 0) {
+ notify($ERRORS{'WARNING'}, 0, "zero rows were returned from database select");
+ return ();
+ }
+ elsif (scalar @selected_rows > 1) {
+ notify($ERRORS{'WARNING'}, 0, "" . scalar @selected_rows . " rows were returned from database select");
+ return ();
+ }
+
+ # Get the single returned row
+ # It contains a hash
+ my $end;
+
+ # Make sure we return undef if the column wasn't found
+ if (defined $selected_rows[0]{end}) {
+ $end = $selected_rows[0]{end};
+ return $end;
+ }
+ else {
+ return undef;
+ }
+} ## end sub get_request_end
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_request_by_computerid
+
+ Parameters : $computer_id
+ Returns : hash containing values of assigned request/reservation
+ Description :
+
+=cut
+
+
+sub get_request_by_computerid {
+ my ($computer_id) = @_;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameter
+ if (!(defined($computer_id))) {
+ notify($ERRORS{'WARNING'}, 0, "computer ID was not specified");
+ return ();
+ }
+
+ # Create the select statement
+ my $select_statement = "
+ SELECT DISTINCT
+ res.id AS reservationid,
+ s.name AS currentstate,
+ ls.name AS laststate,
+ req.id AS requestid,
+ req.start AS requeststart
+ FROM
+ request req,reservation res,state s,state ls
+ WHERE
+ req.stateid=s.id AND
+ req.laststateid = ls.id AND
+ req.id=res.requestid AND
+ res.computerid = $computer_id
+
+ ORDER BY
+ res.id
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @selected_rows = database_select($select_statement);
+
+ # Check to make sure 1 row was returned
+ if (scalar @selected_rows == 0) {
+ notify($ERRORS{'WARNING'}, 0, "zero rows were returned from database select $computer_id");
+ return ();
+ }
+
+ my %returnhash;
+
+ # It contains a hash
+ for (@selected_rows) {
+ my %reservation_row = %{$_};
+ # Grab the reservation ID to make the code a little cleaner
+ my $reservation_id = $reservation_row{reservationid};
+ $returnhash{$reservation_id}{"reservationid"} = $reservation_id;
+ $returnhash{$reservation_id}{"currentstate"} = $reservation_row{currentstate};
+ $returnhash{$reservation_id}{"laststate"} = $reservation_row{laststate};
+ $returnhash{$reservation_id}{"requestid"} = $reservation_row{requestid};
+ $returnhash{$reservation_id}{"requeststart"} = $reservation_row{requeststart};
+ } ## end for (@selected_rows)
+
+ return %returnhash;
+} ## end sub get_request_by_computerid
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_computer_current_state_name
+
+ Parameters : $computer_id
+ Returns : String containing state name for a particular computer
+ Description :
+
+=cut
+
+
+sub get_computer_current_state_name {
+ my ($computer_id) = @_;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameter
+ if (!(defined($computer_id))) {
+ notify($ERRORS{'WARNING'}, 0, "computer ID was not specified");
+ return ();
+ }
+
+ # Create the select statement
+ my $select_statement = "
+ SELECT DISTINCT
+ state.name AS name
+ FROM
+ state,
+ computer
+ WHERE
+ computer.stateid = state.id
+ AND computer.id = $computer_id
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @selected_rows = database_select($select_statement);
+
+ # Check to make sure 1 row was returned
+ if (scalar @selected_rows == 0) {
+ notify($ERRORS{'WARNING'}, 0, "zero rows were returned from database select");
+ return ();
+ }
+ elsif (scalar @selected_rows > 1) {
+ notify($ERRORS{'WARNING'}, 0, "" . scalar @selected_rows . " rows were returned from database select");
+ return ();
+ }
+
+ # Make sure we return undef if the column wasn't found
+ if (defined $selected_rows[0]{name}) {
+ return $selected_rows[0]{name};
+ }
+ else {
+ return undef;
+ }
+} ## end sub get_computer_current_state_name
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 construct_image_name
+
+ Parameters : $image_name, $specified_version
+ Returns : String containing a new image name.
+ If no number is specified, version is incremented by 1.
+ If number is specified, version is set to that number
+ Description :
+
+=cut
+
+
+sub construct_image_name {
+ my ($image_name, $specified_version, $os_name) = @_;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameter
+ if (!(defined($image_name))) {
+ notify($ERRORS{'WARNING'}, 0, "image name was not specified");
+ return 0;
+ }
+
+ # If version was specified, check to make sure it's just numerical digits
+ if (defined($specified_version) && $specified_version !~ /^\d+$/) {
+ notify($ERRORS{'WARNING'}, 0, "specified version is not in the correct format: $specified_version");
+ return 0;
+ }
+
+ # Image Name Format: osname-longnameid-v#
+ # Example: winxp-Thisistheimagename23-v0
+
+ # Split the image name by dashes
+ my @name_sections = split(/-/, $image_name);
+ my $section_count = scalar @name_sections;
+
+ # Check to make sure at least 3 sections were found (separated by "-")
+ if ($section_count < 3) {
+ notify($ERRORS{'WARNING'}, 0, "image name is in the wrong format, cannot construct: $image_name");
+ return 0;
+ }
+
+ # The OS should be the first section
+ my $os_section = $name_sections[0];
+
+ # If an OS name was passed as an argument use it, otherwise use the OS name from the previous image name
+ if (defined $os_name && $os_name ne '') {
+ $os_section = $os_name;
+ }
+
+ # The version should be the last section
+ my $version_section = $name_sections[$section_count - 1];
+
+ # Everything in between should be the image name and version
+ my $name_section = join('-', @name_sections[1 .. ($section_count - 2)]);
+
+ # Check to make sure the version number is valid
+ if ($version_section =~ /^([v|V])([0-9]+)/) {
+ my $v = $1;
+ my $version_number = $2;
+
+ # Increment version number or use the specified version if it was passed
+ if (defined($specified_version)) {
+ $version_number = $specified_version;
+ }
+ else {
+ $version_number++;
+ }
+
+ return $os_section . "-" . "$name_section" . "-" . $v . $version_number;
+ } ## end if ($version_section =~ /^([v|V])([0-9]+)/)
+
+ else {
+ notify($ERRORS{'WARNING'}, 0, "could not detect version number from image name: $image_name");
+ return 0;
+ }
+
+} ## end sub construct_image_name
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_reservation_remote_ip
+
+ Parameters : $reservation_id
+ Returns : String containing remoteIP value for specified reservation ID, 0 if reservation was not found
+ Description :
+
+=cut
+
+
+sub get_reservation_remote_ip {
+ my ($reservation_id) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameter
+ if (!(defined($reservation_id))) {
+ notify($ERRORS{'WARNING'}, 0, "reservation ID was not specified");
+ return 0;
+ }
+
+ # Create the select statement
+ my $select_statement = "
+ SELECT
+ remoteIP
+ FROM
+ reservation
+ WHERE
+ id = $reservation_id
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @selected_rows = database_select($select_statement);
+
+ # Check to make sure 1 row was returned
+ if (scalar @selected_rows == 0) {
+ notify($ERRORS{'WARNING'}, 0, "zero rows were returned from database select");
+ return 0;
+ }
+ elsif (scalar @selected_rows > 1) {
+ notify($ERRORS{'WARNING'}, 0, "" . scalar @selected_rows . " rows were returned from database select");
+ return 0;
+ }
+
+ # Get the single returned row
+ # It contains a hash
+ my $remote_ip;
+
+ # Make sure we return undef if the column wasn't found
+ if (defined $selected_rows[0]{remoteIP}) {
+ $remote_ip = $selected_rows[0]{remoteIP};
+ }
+ else {
+ return undef;
+ }
+
+ # Make sure we return undef if remote IP is blank
+ if ($remote_ip eq '') {
+ return undef;
+ }
+ else {
+ return $remote_ip;
+ }
+} ## end sub get_reservation_remote_ip
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 update_log_ending
+
+ Parameters : $log_id, $ending
+ Returns : 0 or 1
+ Description : Updates the finalend and ending fields
+ in the log table for the specified log ID
+
+=cut
+
+sub update_log_ending {
+ my ($log_id, $ending) = @_;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameter
+ if (!(defined($log_id))) {
+ notify($ERRORS{'WARNING'}, 0, "$0: log ID was not specified");
+ return ();
+ }
+
+ # Check the passed parameter
+ if (!(defined($ending))) {
+ notify($ERRORS{'WARNING'}, 0, "$0: ending string was not specified");
+ return ();
+ }
+
+ my $datestring = makedatestring();
+
+ # Construct the update statement
+ my $update_statement = "
+ UPDATE
+ log
+ SET
+ finalend = \'$datestring\',
+ ending = \'$ending\'
+ WHERE
+ id = $log_id
+ ";
+
+ # Call the database execute subroutine
+ if (database_execute($update_statement)) {
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to update database, log id $log_id");
+ return 0;
+ }
+} ## end sub update_log_ending
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 update_reservation_lastcheck
+
+ Parameters : Updates the finalend and ending fields in the log table for the specified log ID
+ Returns : date string if successful, 0 if failed
+ Description :
+
+=cut
+
+sub update_reservation_lastcheck {
+ my ($reservation_id) = @_;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameter
+ if (!(defined($reservation_id))) {
+ notify($ERRORS{'WARNING'}, 0, "reservation ID was not specified");
+ return ();
+ }
+
+ my $datestring = makedatestring();
+
+ # Construct the update statement
+ my $update_statement = "
+ UPDATE
+ reservation
+ SET
+ lastcheck = \'$datestring\'
+ WHERE
+ id = $reservation_id
+ ";
+
+ # Call the database execute subroutine
+ if (database_execute($update_statement)) {
+ return $datestring;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to update database, reservation id $reservation_id");
+ return 0;
+ }
+} ## end sub update_reservation_lastcheck
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 update_log_loaded_time
+
+ Parameters : $request_logid
+ Returns : 0 or 1
+ Description : Updates the finalend and ending fields in the log table for the specified log ID
+
+=cut
+
+sub update_log_loaded_time {
+ my ($request_logid) = @_;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameter
+ if (!(defined($request_logid))) {
+ notify($ERRORS{'WARNING'}, 0, "request log ID was not specified");
+ return ();
+ }
+
+ # Construct the update statement
+ # Use an IF clause to only update log.loaded if it is NULL
+ # It should only be updated once to capture the time the image load was done
+ my $update_statement = "
+ UPDATE
+ log
+ SET
+ log.loaded = IF(log.loaded IS NULL, NOW(), log.loaded)
+ WHERE
+ id = $request_logid
+ ";
+
+ # Call the database execute subroutine
+ if (database_execute($update_statement)) {
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to update database, request log ID $request_logid");
+ return 0;
+ }
+} ## end sub update_log_loaded_time
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 update_image_name
+
+ Parameters : $image_id,$imagerevision_revision_id,$new_image_name
+ Returns : 0 or 1
+ Description : Updates the name in the image and imagerevision table
+
+=cut
+
+sub update_image_name {
+ my ($image_id, $imagerevision_revision_id, $new_image_name) = @_;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameter
+ if (!(defined($image_id))) {
+ notify($ERRORS{'WARNING'}, 0, "image ID was not specified");
+ return ();
+ }
+
+ # Construct the update statement
+ my $update_statement = "
+ UPDATE
+ image,
+ imagerevision
+ SET
+ name = \'$new_image_name\',
+ imagename = \'$new_image_name\'
+ WHERE
+ image.id = $image_id AND
+ imagerevision.id = $imagerevision_revision_id
+ ";
+
+ # Call the database execute subroutine
+ if (database_execute($update_statement)) {
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to update database, imageID = $image_id imagerevisionID = $imagerevision_revision_id");
+ return 0;
+ }
+} ## end sub update_image_name
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 windowsroutetable
+
+ Parameters : $node, $identity, $privateIP, $clearallPersistent
+ Returns : 0 or 1
+ Description : scan route table and remove inactive persistent routes
+ if clearallPersistent 1 remove all persistent routes
+
+=cut
+
+sub windowsroutetable {
+ my ($node, $identity, $privateIP, $clearallPersistent) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ $clearallPersistent = 0 if (!defined($clearallPersistent));
+ my ($myadapter, $publicgateway);
+ my %ip;
+ my $id = 0;
+ my ($privateadapter, $publicadapter);
+ my @ssh = run_ssh_command($node, $identity, "ipconfig", "root");
+ foreach my $a (@{$ssh[1]}) {
+ if ($a =~ /Ethernet adapter (.*):/) {
+ $myadapter = $1;
+ $ip{$myadapter}{"id"} = $id;
+ $ip{$myadapter}{"private"} = 0;
+ }
+ if ($a =~ /IP Address([\s.]*): $privateIP/) {
+ $ip{$myadapter}{"private"} = 1;
+ print "privateadapter $a\n";
+ }
+ if ($a =~ /Default Gateway([\s.]*): ([.0-9]*)/) {
+ $ip{$myadapter}{"gateway"} = $2;
+ }
+ $id++;
+ } ## end foreach my $a (@{$ssh[1]})
+ #get public gateway
+ foreach my $key (keys %ip) {
+ if (!($ip{$key}{private})) {
+ if (defined($ip{$key}{gateway})) {
+ $publicgateway = $ip{$key}{gateway};
+ notify($ERRORS{'OK'}, 0, "setting publicgateway= $publicgateway");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "warning no gateway for $key");
+ return 0;
+ }
+ } ## end if (!($ip{$key}{private}))
+ } ## end foreach my $key (keys %ip)
+ my @proutes;
+ my @rte = run_ssh_command($node, $identity, "route print", "root");
+ my $inproute = 0;
+ foreach my $r (@{$rte[1]}) {
+ $inproute = 1 if ($r =~ /Persistent Routes:/);
+ if ($inproute) {
+ if ($r =~ /\s+(0.0.0.0)\s+(0.0.0.0)\s+([0-9\..]*)\s+([0-9]+)/) {
+ if (($3 != $publicgateway) || ($clearallPersistent)) {
+ my $cmd = "route -p DELETE $1 MASK $2 $3 METRIC $4";
+ my @rtedel = run_ssh_command($node, $identity, "$cmd", "root");
+ notify($ERRORS{'OK'}, 0, "found inactive persistent route deleting $3");
+ foreach my $line (@{$rtedel[1]}) {
+ if ($line =~ /A matching persistent route was deleted/) {
+ notify($ERRORS{'OK'}, 0, "$3 was successfully deleted");
+ return 1;
+ }
+ if ($line =~ /The route specified was not found/) {
+ notify($ERRORS{'OK'}, 0, "no route was found $cmd");
+ return 0;
+ }
+ } ## end foreach my $line (@{$rtedel[1]})
+ } ## end if (($3 != $publicgateway) || ($clearallPersistent...
+ } ## end if ($r =~ /\s+(0.0.0.0)\s+(0.0.0.0)\s+([0-9\..]*)\s+([0-9]+)/)
+ } ## end if ($inproute)
+ } ## end foreach my $r (@{$rte[1]})
+ notify($ERRORS{'OK'}, 0, "no inactive persistent routes found");
+ return 1;
+} ## end sub windowsroutetable
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 delete_computerloadlog_reservation
+
+ Parameters : $reservation_id, optional loadstatename
+ Returns : 0 failed or 1 success
+ Description : Deletes rows from the computerloadlog table
+
+=cut
+
+
+sub delete_computerloadlog_reservation {
+ my ($reservation_id, $loadstatename) = @_;
+
+ # Check the passed parameter
+ if (!(defined($reservation_id))) {
+ notify($ERRORS{'WARNING'}, 0, "reservation ID was not specified");
+ return ();
+ }
+
+ # Construct the SQL statement
+ my $sql_statement;
+ # Check if loadstateid was specified
+ # If so, only delete rows matching the loadstateid
+ if ($loadstatename) {
+ $sql_statement = "
+ DELETE
+ computerloadlog
+ FROM
+ computerloadlog,
+ computerloadstate
+ WHERE
+ computerloadlog.reservationid = $reservation_id
+ AND computerloadlog.loadstateid = computerloadstate.id
+ AND computerloadstate.loadstatename = \'$loadstatename\'
+ ";
+ }
+ else {
+ $loadstatename = 'all';
+ $sql_statement = "
+ DELETE
+ computerloadlog
+ FROM
+ computerloadlog
+ WHERE
+ computerloadlog.reservationid = $reservation_id
+ ";
+ }
+
+ # Call the database execute subroutine
+ if (database_execute($sql_statement)) {
+ notify($ERRORS{'OK'}, 0, "deleted rows from computerloadlog table where reservation id=$reservation_id, loadstatename=$loadstatename");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to delete from computerloadlog table where reservation id=$reservation_id, loadstatename=$loadstatename");
+ return 0;
+ }
+} ## end sub delete_computerloadlog_reservation
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 delete_request
+
+ Parameters : $request_id
+ Returns : 0 or 1
+ Description : Deletes request and all associated reservations for a given request
+ ID. This also deletes all computerloadlog rows associated with any
+ of the reservations.
+
+=cut
+
+sub delete_request {
+ my ($request_id) = @_;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameter
+ if (!(defined($request_id))) {
+ notify($ERRORS{'WARNING'}, 0, "request ID was not specified");
+ return 0;
+ }
+
+ # Construct the SQL statement
+ my $sql_computerloadlog_delete = "
+ DELETE
+ computerloadlog.*
+ FROM
+ request,
+ reservation,
+ computerloadlog
+ WHERE
+ request.id = $request_id
+ AND reservation.requestid = request.id
+ AND computerloadlog.reservationid = reservation.id
+ ";
+
+ # Construct the SQL statement
+ my $sql_request_delete = "
+ DELETE
+ request.*,
+ reservation.*
+ FROM
+ request,
+ reservation
+ WHERE
+ request.id = $request_id
+ AND reservation.requestid = request.id
+ ";
+
+ # Try to delete any associated entries in the computerloadlog table
+ # There may not be any entries, but database_execute should still return 1
+ if (!database_execute($sql_computerloadlog_delete)) {
+ notify($ERRORS{'WARNING'}, 0, "unable to delete from computerloadlog table where request id=$request_id");
+ }
+
+ # Try to delete any associated entries in the request and reservation tables
+ if (database_execute($sql_request_delete)) {
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to delete from request and reservation tables where request id=$request_id");
+ return 0;
+ }
+} ## end sub delete_request
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 clearfromblockrequest
+
+ Parameters : $computer_id
+ Returns : 0 or 1
+ Description : removes provided computerid and blcok request id from blockcomputer table
+
+=cut
+
+
+sub clearfromblockrequest {
+ my ($computer_id) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ # Check the passed parameter
+ if (!(defined($computer_id))) {
+ notify($ERRORS{'WARNING'}, 0, "computer_id was not specified");
+ return 0;
+ }
+
+ # Construct the SQL statement
+ my $sql_statement = "
+ DELETE
+ blockComputers
+ FROM
+ blockComputers
+ WHERE
+ computerid = $computer_id
+ ";
+
+ # Call the database execute subroutine
+ if (database_execute($sql_statement)) {
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to delete from computerloadlog table where computerid = $computer_id");
+ return 0;
+ }
+} ## end sub clearfromblockrequest
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 update_sublog_ipaddress
+
+ Parameters : $computer_id
+ Returns : 0 or 1
+ Description : updates log table with IPaddress of node
+ when dynamic dhcp is enabled there is no way to track which IP was used
+=cut
+
+
+sub update_sublog_ipaddress {
+ my ($logid, $computer_ip_address) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ # Check the passed parameter
+ if (!(defined($computer_ip_address))) {
+ notify($ERRORS{'WARNING'}, 0, "computer_ip_address was not specified");
+ return 0;
+ }
+ if (!(defined($logid))) {
+ notify($ERRORS{'WARNING'}, 0, "logid was not specified");
+ return 0;
+ }
+
+ # Construct the SQL statement
+ my $sql_statement = "UPDATE sublog SET IPaddress = \'$computer_ip_address\' WHERE logid=$logid";
+
+ # Call the database execute subroutine
+ if (database_execute($sql_statement)) {
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to update sublog table logid = $logid with ipaddress $computer_ip_address");
+ return 0;
+ }
+} ## end sub update_sublog_ipaddress
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 set_hash_process_id
+
+ Parameters : Reference to a hash
+ Returns : 0 or 1
+ Description : Sets the process ID of the current process and parent process ID
+ in a hash, to which a reference was passed.
+ $hash{PID} = process ID
+ $hash{PPID} = parent process ID
+
+=cut
+
+sub set_hash_process_id {
+ my ($hash_ref) = @_;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameter
+ if (!(defined($hash_ref))) {
+ notify($ERRORS{'WARNING'}, 0, "hash reference was not specified");
+ return 0;
+ }
+
+ # Make sure it's a hash reference
+ if (ref($hash_ref) ne "HASH") {
+ notify($ERRORS{'WARNING'}, 0, "passed parameter is not a hash reference");
+ return 0;
+ }
+
+ # Get the parent PID and this process's PID
+ # getppid() doesn't work under Windows so just set it to 0
+ my $ppid = 0;
+ $ppid = getppid() if ($^O !~ /win/i);
+ $hash_ref->{PPID} = $ppid;
+ my $pid = $$;
+ $hash_ref->{PID} = $pid;
+
+ return 1;
+} ## end sub set_hash_process_id
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 rename_vcld_process
+
+ Parameters : hash - Reference to hash containing request data
+ Returns : 0 or 1
+ Description : Renames running process based on request information. Appends the state
+ name, request ID, and reservation ID to the process name.
+ Sets PARENTIMAGE and SUBIMAGE in the hash depending on whether or
+ reservation ID is the lowest for a request.
+
+=cut
+
+sub rename_vcld_process {
+ my ($input_data, $process_name) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ $filename =~ s/.*\///;
+
+ # IMPORTANT: if you change the process name, check the checkonprocess subroutine
+ # It looks for running reservation processes based on the process name
+
+ # Check the argument
+ my $data_structure;
+ if (defined($input_data) && (ref $input_data) =~ /HASH/) {
+ # Get a new data structure object
+ eval {
+ $data_structure = new VCL::DataStructure({request_data => $input_data, reservation_id => $input_data->{RESERVATIONID}});
+ notify($ERRORS{'OK'}, 0, "created DataStructure object from passed hash");
+ };
+ if (my $e = Exception::Class::Base->caught()) {
+ notify($ERRORS{'WARNING'}, 0, "hash was passed but could not be turned into a DataStructure, " . $e->message);
+ $data_structure = undef;
+ }
+ } ## end if (defined($input_data) && (ref $input_data...
+ elsif (defined($input_data) && (ref $input_data) !~ /DataStructure/) {
+ notify($ERRORS{'WARNING'}, 0, "passed parameter (" . ref($input_data) . ") is not a reference to a hash or DataStructure, it will be ignored");
+ $data_structure = undef;
+ }
+ else {
+ $data_structure = $input_data;
+ }
+
+ # Begin assembling a new process name
+ my $new_process_name = "$PROCESSNAME";
+
+ # Append the class name or file name to the process name
+ if (defined($ENV{class_name})) {
+ $new_process_name .= (" " . $ENV{class_name});
+ }
+ elsif ($filename) {
+ $new_process_name .= " $filename";
+ }
+
+ # Check if DataStructure, assemble process name with additional information
+ if (defined $data_structure) {
+ my $state_name = $data_structure->get_state_name();
+
+ if ($state_name ne 'blockrequest') {
+ my $request_id = $data_structure->get_request_id();
+ my $request_state_name = $data_structure->get_request_state_name();
+ my $reservation_id = $data_structure->get_reservation_id();
+ my $request_forimaging = $data_structure->get_request_forimaging();
+ my $reservation_count = $data_structure->get_reservation_count();
+ my $reservation_is_parent = $data_structure->is_parent_reservation();
+
+ # Append the request and reservation IDs if they are set
+ $new_process_name .= " $request_id:$reservation_id";
+ $new_process_name .= " $request_state_name" if $request_state_name;
+ $new_process_name .= " imaging" if $request_forimaging;
+
+ # Append cluster if there are multiple reservations for this request
+ notify($ERRORS{'OK'}, 0, "reservation count: $reservation_count");
+
+ if ($reservation_count > 1) {
+ if ($reservation_is_parent) {
+ $data_structure->get_request_data->{PARENTIMAGE} = 1;
+ $data_structure->get_request_data->{SUBIMAGE} = 0;
+ $new_process_name .= " cluster=parent";
+ }
+ else {
+ $data_structure->get_request_data->{PARENTIMAGE} = 0;
+ $data_structure->get_request_data->{SUBIMAGE} = 1;
+ $new_process_name .= " cluster=child";
+ }
+ } ## end if ($reservation_count > 1)
+ else {
+ $data_structure->get_request_data->{PARENTIMAGE} = 1;
+ $data_structure->get_request_data->{SUBIMAGE} = 0;
+ }
+
+ notify($ERRORS{'OK'}, 0, "PARENTIMAGE: " . $data_structure->get_request_data->{PARENTIMAGE});
+ notify($ERRORS{'OK'}, 0, "SUBIMAGE: " . $data_structure->get_request_data->{SUBIMAGE});
+ } ## end if ($state_name ne 'blockrequest')
+ else {
+ my $blockrequest_id = $data_structure->get_blockrequest_id();
+ my $blockrequest_name = $data_structure->get_blockrequest_name();
+ my $blocktime_id = $data_structure->get_blocktime_id();
+
+ # Append the IDs if they are set
+ $new_process_name .= " $blockrequest_id:$blocktime_id";
+ $new_process_name .= " '$blockrequest_name'";
+ }
+ } ## end if (defined $data_structure)
+ else {
+ #notify($ERRORS{'DEBUG'}, 0, "DataStructure object is NOT defined");
+ }
+
+ # Rename this process
+ $0 = $new_process_name;
+ notify($ERRORS{'OK'}, 0, "renamed process to \'$0\'");
+} ## end sub rename_vcld_process
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 round
+
+ Parameters : number
+ Returns : rounded number
+ Description : rounds to the nearest whole number
+
+=cut
+
+
+sub round {
+ my ($number) = @_;
+ if ($number >= 0) {
+ return int($number + .5);
+ }
+ else {
+ return int($number - .5);
+ }
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 set_logfile_path
+
+ Parameters : file path
+ Returns : 0 or 1
+ Description : This subroutine is for testing purposes. It sets vcld's logfile
+ path to the parameter passed. It is useful when running automated
+ tests to isoloate logfile output.
+=cut
+
+sub set_logfile_path {
+ my ($package, $filename, $line, $sub) = caller(0);
+ ($LOGFILE) = @_;
+ print STDOUT "log file path changed to \'$LOGFILE\'\n";
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_highest_imagerevision_info
+
+ Parameters : $image_id
+ Returns : Hash containing image revision data
+ Description :
+
+=cut
+
+
+sub get_highest_imagerevision_info {
+ my ($image_id) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameter
+ if (!(defined($image_id))) {
+ notify($ERRORS{'WARNING'}, 0, "image ID was not specified");
+ return ();
+ }
+
+ # Select the highest image revision id for the specified image id
+ my $select_statement = "
+ SELECT
+ MAX(imagerevision.id) AS id
+ FROM
+ imagerevision
+ WHERE
+ imagerevision.imageid = '$image_id'
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @selected_rows = database_select($select_statement);
+
+ # Check to make sure 1 row was returned
+ if (scalar @selected_rows == 0) {
+ notify($ERRORS{'OK'}, 0, "image revision data for image id $image_id was not found in the database, 0 rows were returned");
+ return -1;
+ }
+ elsif (scalar @selected_rows > 1) {
+ notify($ERRORS{'WARNING'}, 0, "" . scalar @selected_rows . " rows were returned from database select");
+ return ();
+ }
+
+ # A single row was returned (good)
+ my $imagerevision_id = $selected_rows[0]{id};
+
+ return get_imagerevision_info($imagerevision_id);
+
+} ## end sub get_highest_imagerevision_info
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 switch_state
+
+ Parameters : $request_data, $request_state_name_new, $computer_state_name_new, $request_log_ending, $exit
+ Returns : 0 if something goes wrong, exits if successful
+ Description : Changes the state of this request to the state specified
+ terminates. The vcld process will then pick up the switched
+ request. It is important that this process sets the request
+ laststate to the original state and that vcld does not alter it.
+
+=cut
+
+#/////////////////////////////////////////////////////////////////////////////
+
+sub switch_state {
+ my ($request_data, $request_state_name_new, $computer_state_name_new, $request_log_ending, $exit) = @_;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+ my ($caller_package, $caller_filename, $caller_line, $caller_sub) = caller(1);
+
+ my $caller_info = "$caller_sub($line)";
+
+ my $caller = scalar caller;
+ notify($ERRORS{'OK'}, 0, "called from $caller_info");
+
+ # Check the arguments
+ if (!defined($request_data)) {
+ notify($ERRORS{'CRITICAL'}, 0, "request data hash reference is undefined");
+ return 0;
+ }
+ elsif (!ref($request_data) eq "HASH") {
+ notify($ERRORS{'CRITICAL'}, 0, "1st argument is not a hash reference to the request data");
+ return 0;
+ }
+
+ # Set the default value for exit
+ $exit = 0 if (!defined($exit));
+
+ # Store some hash variables into local variables
+ my $request_id = $request_data->{id};
+ my $request_logid = $request_data->{logid};
+ my $reservation_id = $request_data->{RESERVATIONID};
+ my $request_state_name_old = $request_data->{state}{name};
+ my $request_laststate_name_old = $request_data->{laststate}{name};
+ my $computer_id = $request_data->{reservation}{$reservation_id}{computer}{id};
+ my $computer_type = $request_data->{reservation}{$reservation_id}{computer}{type};
+ my $computer_state_name_old = $request_data->{reservation}{$reservation_id}{computer}{state}{name};
+ my $computer_shortname = $request_data->{reservation}{$reservation_id}{computer}{SHORTNAME};
+
+ # Figure out if this is the parent reservation
+ my @reservation_ids = sort keys %{$request_data->{reservation}};
+ # The parent reservation has the lowest ID
+ my $parent_reservation_id = min @reservation_ids;
+ my $is_parent_reservation;
+ if ($reservation_id == $parent_reservation_id) {
+ notify($ERRORS{'DEBUG'}, 0, "parent: parent reservation ID for this request: $parent_reservation_id");
+ $is_parent_reservation = 1;
+ }
+ else {
+ notify($ERRORS{'DEBUG'}, 0, "child: parent reservation ID for this request: $parent_reservation_id");
+ $is_parent_reservation = 0;
+ }
+
+ # Update the notify prefix now that we have request info
+ my $notify_prefix = "req=$request_id:";
+
+ # Check if new request state was passed
+ if (!$request_state_name_new) {
+ notify($ERRORS{'DEBUG'}, 0, "$notify_prefix request state was not specified, state not changed");
+ }
+ elsif (!$is_parent_reservation) {
+ notify($ERRORS{'DEBUG'}, 0, "$notify_prefix child reservation, request state not changed");
+ }
+ else {
+ # Add an entry to the loadlog
+ insertloadlog($reservation_id, $computer_id, "info", "$caller: switching request state to $request_state_name_new");
+
+ # Update the request state to $request_state_name_new and set laststate to current state
+ if (update_request_state($request_id, $request_state_name_new, $request_state_name_old)) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix request state changed: $request_state_name_old->$request_state_name_new, laststate: $request_laststate_name_old->$request_state_name_old");
+ insertloadlog($reservation_id, $computer_id, "info", "$caller: request state changed to $request_state_name_new, laststate to $request_state_name_old");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "$notify_prefix request state could not be changed: $request_state_name_old --> $request_state_name_new, laststate: $request_laststate_name_old->$request_state_name_old");
+ insertloadlog($reservation_id, $computer_id, "info", "$caller: unable to change request state to $request_state_name_new, laststate to $request_state_name_old");
+ }
+ } ## end else [ if (!$request_state_name_new) [elsif (!$is_parent_reservation)
+
+ # Update the computer state
+ if (!$computer_state_name_new) {
+ notify($ERRORS{'DEBUG'}, 0, "$notify_prefix computer state not specified, $computer_shortname state not changed");
+ }
+ else {
+ # Add an entry to the loadlog
+ insertloadlog($reservation_id, $computer_id, "info", "$caller: switching computer state to $computer_state_name_new");
+
+ # Update the computer state
+ if (update_computer_state($computer_id, $computer_state_name_new)) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix computer $computer_shortname state changed: $computer_state_name_old->$computer_state_name_new");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "$notify_prefix unable to computer $computer_shortname state: $computer_state_name_old->$computer_state_name_new");
+ }
+ } ## end else [ if (!$computer_state_name_new)
+
+ # Update log table for this request
+ # Ending can be deleted, released, failed, noack, nologin, timeout, EOR, none
+ if (!$request_log_ending) {
+ notify($ERRORS{'DEBUG'}, 0, "$notify_prefix log table id=$request_logid will not be updated");
+ }
+ elsif (!$is_parent_reservation) {
+ notify($ERRORS{'DEBUG'}, 0, "$notify_prefix child reservation, log table id=$request_logid will not be updated");
+ }
+ elsif (update_log_ending($request_logid, $request_log_ending)) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix log table id=$request_logid, ending set to $request_log_ending");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "$notify_prefix unable to set log table id=$request_logid, ending to $request_log_ending");
+ }
+
+ # Call exit if the state changed, return otherwise
+ if ($exit) {
+ insertloadlog($reservation_id, $computer_id, "info", "$caller: process exiting");
+ notify($ERRORS{'OK'}, 0, "$notify_prefix process exiting");
+ exit;
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix returning");
+ return;
+ }
+
+} ## end sub switch_state
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_ip_address_from_hosts
+
+ Parameters : $host_name
+ Returns : IP address of specified node if successful, 0 if failed
+ Description : Searches the local hosts file for a line containing the host
+ name specified. Returns the corresponding IP address.
+
+=cut
+
+sub get_ip_address_from_hosts {
+ my ($host_name) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the argument
+ if (!defined($host_name) || !$host_name) {
+ notify($ERRORS{'WARNING'}, 0, "computer host name was not specified");
+ return 0;
+ }
+
+ # Check the OS of the machine running this, set the hosts file accordingly
+ my $hosts_file_path;
+ if (lc($^O) =~ /win/i) {
+ $hosts_file_path = $ENV{SystemRoot} . '\\system32\\drivers\\etc\\hosts';
+ }
+ else {
+ $hosts_file_path = '/etc/hosts';
+ }
+
+ # Retrieve the node's private IP address from the hosts file
+ # Try to open the hosts file
+ if (open(HOSTS, $hosts_file_path)) {
+ notify($ERRORS{'OK'}, 0, "opened hosts file: $hosts_file_path") if $VERBOSE;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to open the hosts file: $hosts_file_path");
+ return 0;
+ }
+
+ # Find all lines in the hosts file containing the host name
+ # Make sure the host name has a space in front of it so that host1 != xhost1
+ # If host name being searched for is followed by a space or period, ignore rest of line
+ # This accounts for full DNS host names, host1.unity...
+ # If host name isn't followed by space or period, make sure the end of sting is immediately following
+ # This accounts for host1 != host1x
+ # This also accounts for the end of file immediately following the host name
+ my @hosts_matching_lines = grep(/\s$host_name([\s\.].*)*$/i, <HOSTS>);
+
+ # Close the HOSTS file
+ close HOSTS;
+
+ # Make sure only 1 line was returned
+ if (scalar @hosts_matching_lines == 0) {
+ notify($ERRORS{'WARNING'}, 0, "unable to find line containing $host_name in hosts file");
+ return 0;
+ }
+ elsif (scalar @hosts_matching_lines > 1) {
+ notify($ERRORS{'OK'}, 0, "found " . scalar @hosts_matching_lines . " lines containing $host_name in hosts file, first valid match will be used");
+ }
+
+ # Find the IP address
+ my $ip_address;
+ for (@hosts_matching_lines) {
+ my $line = $_;
+ chomp $line;
+
+ # Check for IPv4 address pattern
+ if ($line =~ /^\s*(([0-9]{1,3}\.{0,1}){4})\s/) {
+ $ip_address = $1;
+ notify($ERRORS{'OK'}, 0, "found IPv4 address: $ip_address") if $VERBOSE;
+ }
+ # Check for IPv6 address pattern
+ elsif ($line =~ /^\s*(([0-9a-f]{0,4}:{0,2}){1,8})\s/i) {
+ $ip_address = $1;
+ notify($ERRORS{'OK'}, 0, "found IPv6 address: $ip_address") if $VERBOSE;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "hosts file line does not contain a valid IP address: $line");
+ next;
+ }
+
+ # Check if the line is a comment
+ if ($line =~ /^\s*#/) {
+ notify($ERRORS{'OK'}, 0, "host name found in commented line: $line");
+ # Proceed to try other matches, hoping for a non-commented match
+ next;
+ }
+ else {
+ # Line is not commented, return the IP address
+ return $ip_address;
+ }
+ } ## end for (@hosts_matching_lines)
+
+ # Check if an IP address was found
+ if ($ip_address) {
+ # This should only happen if the host name was found in a commented line
+ return $ip_address;
+ }
+ else {
+ # Address was not found
+ notify($ERRORS{'WARNING'}, 0, "unable to find any valid matching address in hosts file");
+ return 0;
+ }
+} ## end sub get_ip_address_from_hosts
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 firewall_compare_update
+
+ Parameters : $node,$reote_IP, $identity, $type
+ Returns : 0 or 1 (nochange or updated)
+ Description : compares and updates the firewall for rdp port, specfically for windows
+ Currently only handles windows and allows two seperate scopes
+
+=cut
+
+sub firewall_compare_update {
+ my ($node, $remote_IP, $identity, $type) = @_;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the arguments
+ if (!defined($node)) {
+ notify($ERRORS{'WARNING'}, 0, "node was not specified");
+ return 0;
+ }
+ if (!defined($remote_IP)) {
+ notify($ERRORS{'WARNING'}, 0, "remote_IP was not specified");
+ return 0;
+ }
+ if (!defined($identity)) {
+ notify($ERRORS{'WARNING'}, 0, "$identity was not specified");
+ return 0;
+ }
+ if (!defined($type)) {
+ notify($ERRORS{'WARNING'}, 0, "$type was not specified");
+ return 0;
+ }
+
+ # Collect settings on node
+ if ($type =~ /windows/) {
+ my $cmd = "netsh firewall show portopening enable";
+ my @sshcmd = run_ssh_command($node, $identity, $cmd, "root");
+ my $update_scope = 0;
+ my $scopelook = 0;
+
+ foreach my $l (@{$sshcmd[1]}) {
+ if ($l =~ /^3389\s*TCP/) {
+ $scopelook = 1;
+ #print "$l\n";
+ next;
+ }
+ if ($scopelook) {
+ $scopelook = 0;
+ if ($l =~ /(\s*Scope:\s*)([.0-9]*)(\/)([.0-9]*)/) {
+ # addresses into their quads
+ # current scope
+ my ($a1q1, $a1q2, $a1q3, $a1q4) = split(/[.]/, $2);
+ my ($a2q1, $a2q2, $a2q3, $a2q4) = split(/[.]/, $remote_IP);
+ #start comparing
+ if ($a1q1 ne $a2q1) {
+ $update_scope = 1;
+ notify($ERRORS{'DEBUG'}, 0, "update_scope required addressquad1= $a1q1 addressquad2= $a2q1");
+ }
+ if ($a1q2 ne $a2q2) {
+ $update_scope = 1;
+ notify($ERRORS{'DEBUG'}, 0, "update_scope required address1uad2= $a1q2 address2quad2= $a2q2");
+ }
+ if ($update_scope) {
+ my $scopeaddress = "$a1q1.$a1q2.0.0/255.255.0.0,$a2q1.$a2q2.0.0/255.255.0.0";
+ my $netshcmd = "netsh firewall set portopening TCP 3389 RDP enable CUSTOM $scopeaddress";
+ my @sshcmd1 = run_ssh_command($node, $identity, $netshcmd, "root");
+ foreach my $line (@{$sshcmd1[1]}) {
+ if ($line =~ /Ok./) {
+ notify($ERRORS{'OK'}, 0, "firewall_compare_update: firewall updated with $scopeaddress");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'DEBUG'}, 0, "firewall_compare_update netsh output $line ");
+ }
+ }
+ } ## end if ($update_scope)
+ else {
+ notify($ERRORS{'DEBUG'}, 0, "firewall_compare_update scope of ipaddess matches no change needed");
+ }
+ } ## end if ($l =~ /(\s*Scope:\s*)([.0-9]*)(\/)([.0-9]*)/)
+ } ## end if ($scopelook)
+ } ## end foreach my $l (@{$sshcmd[1]})
+ } ## end if ($type =~ /windows/)
+ else {
+ #other types go here
+ return 0;
+ }
+
+} ## end sub firewall_compare_update
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 update_log_ending
+
+ Parameters : $blockrequest_id, $processing
+ Returns : 0 or 1
+ Description : Updates the finalend and ending fields in the log table for the specified log ID
+
+=cut
+
+sub update_blockrequest_processing {
+ my ($blockrequest_id, $processing) = @_;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the arguments
+ if (!defined($blockrequest_id)) {
+ notify($ERRORS{'WARNING'}, 0, "blockrequest ID was not specified");
+ return 0;
+ }
+ if (!defined($processing)) {
+ notify($ERRORS{'WARNING'}, 0, "processing was not specified");
+ return 0;
+ }
+
+ # Construct the update statement
+ my $update_statement = "
+ UPDATE
+ blockRequest
+ SET
+ blockRequest.processing = $processing
+ WHERE
+ blockRequest.id = $blockrequest_id
+ ";
+
+ # Call the database execute subroutine
+ if (database_execute($update_statement)) {
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to update blockRequest table, id=$blockrequest_id, processing=$processing");
+ return 0;
+ }
+} ## end sub update_blockrequest_processing
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_management_node_blockrequests
+
+ Parameters : $managementnode_id
+ Returns : hash containing block request info
+ Description :
+
+=cut
+
+sub get_management_node_blockrequests {
+ my ($managementnode_id) = @_;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+
+ # Check the passed parameter
+ if (!defined($managementnode_id)) {
+ notify($ERRORS{'WARNING'}, 0, "management node ID was not specified");
+ return;
+ }
+
+ # Create the select statement
+ my $select_statement = "
+ SELECT
+ blockRequest.id AS blockRequest_id,
+ blockRequest.name AS blockRequest_name,
+ blockRequest.imageid AS blockRequest_imageid,
+ blockRequest.numMachines AS blockRequest_numMachines,
+ blockRequest.groupid AS blockRequest_groupid,
+ blockRequest.repeating AS blockRequest_repeating,
+ blockRequest.ownerid AS blockRequest_ownerid,
+ blockRequest.admingroupid AS blockRequest_admingroupid,
+ blockRequest.managementnodeid AS blockRequest_managementnodeid,
+ blockRequest.expireTime AS blockRequest_expireTime,
+ blockRequest.processing AS blockRequest_processing,
+
+ blockTimes.id AS blockTimes_id,
+ blockTimes.blockRequestid AS blockTimes_blockRequestid,
+ blockTimes.start AS blockTimes_start,
+ blockTimes.end AS blockTimes_end,
+ blockTimes.processed AS blockTimes_processed
+
+ FROM
+ blockRequest
+
+ LEFT JOIN
+ blockTimes ON (
+ blockRequest.id = blockTimes.blockRequestid
+ )
+
+ WHERE
+ blockRequest.managementnodeid = $managementnode_id
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @selected_rows = database_select($select_statement);
+
+ # Check to make sure 1 or more rows were returned
+ if (scalar @selected_rows == 0) {
+ return 0;
+ }
+
+ # Build the hash
+ my %blockrequests;
+
+ for (@selected_rows) {
+ my %blockrequest_row = %{$_};
+
+ # Get the blockRequest id and blockTimes id
+ my $blockrequest_id = $blockrequest_row{blockRequest_id};
+ my $blocktimes_id = $blockrequest_row{blockTimes_id};
+ $blocktimes_id = -1 if !$blocktimes_id;
+
+ # Loop through all the columns returned for the blockrequest
+ foreach my $key (keys %blockrequest_row) {
+ my $value = $blockrequest_row{$key};
+
+ # Create another variable by stripping off the column_ part of each key
+ # This variable stores the original (correct) column name
+ (my $original_key = $key) =~ s/^.+_//;
+
+ $value = '-1' if (!defined($value));
+
+ if ($key =~ /blockRequest_/) {
+ $blockrequests{$blockrequest_id}{$original_key} = $value;
+ }
+ elsif ($key =~ /blockTimes_/) {
+ $blockrequests{$blockrequest_id}{blockTimes}{$blocktimes_id}{$original_key} = $value;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unknown key found in SQL data: $key");
+ }
+ } ## end foreach my $key (keys %blockrequest_row)
+
+ } ## end for (@selected_rows)
+
+ return \%blockrequests;
+
+} ## end sub get_management_node_blockrequests
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 insert_request
+
+ Parameters : $managementnode_id, $request_state_name, $request_laststate_name, $end_minutes_in_future, $user_unityid, $computer_id, $image_id, $imagerevision_id
+ Returns : 1 if successful, 0 if failed
+ Description :
+
+=cut
+
+sub insert_request {
+ my ($managementnode_id, $request_state_name, $request_laststate_name, $request_logid, $user_unityid, $computer_id, $image_id, $imagerevision_id, $start_minutes_in_future, $end_minutes_in_future) = @_;
+
+
+ if (!$request_state_name) {
+ notify($ERRORS{'WARNING'}, 0, "missing mandatory request key: state_name");
+ return 0;
+ }
+ if (!$request_laststate_name) {
+ notify($ERRORS{'WARNING'}, 0, "missing mandatory request key: laststate_name");
+ return 0;
+ }
+ if (!$user_unityid) {
+ notify($ERRORS{'WARNING'}, 0, "missing mandatory request key: user_unityid");
+ return 0;
+ }
+
+ if (!$computer_id) {
+ notify($ERRORS{'WARNING'}, 0, "missing mandatory reservation key: computer_id");
+ return 0;
+ }
+ if (!$image_id) {
+ notify($ERRORS{'WARNING'}, 0, "missing mandatory reservation key: image_id");
+ return 0;
+ }
+ if (!$imagerevision_id) {
+ notify($ERRORS{'WARNING'}, 0, "missing mandatory reservation key: imagerevision_id");
+ return 0;
+ }
+ if (!$managementnode_id) {
+ notify($ERRORS{'WARNING'}, 0, "missing mandatory reservation key: managementnode_id");
+ return 0;
+ }
+
+ my $insert_request_statment = "
+ INSERT INTO
+ request
+ (
+ request.stateid,
+ request.laststateid,
+ request.userid,
+ request.logid,
+ request.forimaging,
+ request.test,
+ request.preload,
+ request.start,
+ request.end,
+ request.daterequested
+ )
+ VALUES
+ (
+ (SELECT id FROM state WHERE state.name = '$request_state_name'),
+ (SELECT id FROM state WHERE state.name = '$request_laststate_name'),
+ (SELECT id FROM user WHERE user.unityid = '$user_unityid'),
+ '$request_logid',
+ '0',
+ '0',
+ '0',
+ TIMESTAMPADD(MINUTE, $start_minutes_in_future, NOW()),
+ TIMESTAMPADD(MINUTE, $end_minutes_in_future, NOW()),
+ NOW()
+ )
+ ";
+
+ # Execute the request insert statement
+ # If successful, the id of the newly inserted row is returned
+ my $request_id = database_execute($insert_request_statment);
+ if ($request_id) {
+ notify($ERRORS{'OK'}, 0, "inserted new reload request into request table, request id=$request_id");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "failed to insert new reload request into request table");
+ return 0;
+ }
+
+ my $insert_reservation_statment = "
+ INSERT INTO
+ reservation
+ (
+ reservation.requestid,
+ reservation.computerid,
+ reservation.imageid,
+ reservation.imagerevisionid,
+ reservation.managementnodeid
+ )
+ VALUES
+ (
+ '$request_id',
+ '$computer_id',
+ '$image_id',
+ '$imagerevision_id',
+ '$managementnode_id'
+ )
+ ";
+
+ # Execute the reservation insert statement
+ # If successful, the id of the newly inserted row is returned
+ my $reservation_id = database_execute($insert_reservation_statment);
+ if ($reservation_id) {
+ notify($ERRORS{'OK'}, 0, "inserted new reload request into reservation table, reservation id=$reservation_id");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "failed to insert new reload request into reservation table");
+ return 0;
+ }
+
+ return ($request_id, $reservation_id);
+} ## end sub insert_request
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 insert_reload_request
+
+ Parameters : $request_data_hash_reference
+ Returns : nothing, always calls exit
+ Description : Changes this request to a reload request then
+ terminates. The vcld process will then pick up the reload
+ request. It is important that this process sets the request
+ laststate to 'reclaim' and that vcld does not alter it.
+
+=cut
+
+sub insert_reload_request {
+ my ($request_data) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ my ($calling_package, $calling_filename, $calling_line, $calling_sub) = caller(0);
+
+ # Store some hash variables into local variables
+ my $request_id = $request_data->{id};
+ my $request_state_name = $request_data->{state}{name};
+ my $request_laststate_name = $request_data->{laststate}{name};
+ my $reservation_id = $request_data->{RESERVATIONID};
+ my $computer_id = $request_data->{reservation}{$reservation_id}{computer}{id};
+ my $computer_type = $request_data->{reservation}{$reservation_id}{computer}{type};
+ my $managementnode_id = $request_data->{reservation}{$reservation_id}{managementnode}{id};
+ my $request_logid = $request_data->{logid};
+ my $user_unityid = $request_data->{user}{unityid};
+ my $image_id = $request_data->{reservation}{$reservation_id}{imageid};
+ my $imagerevision_id = $request_data->{reservation}{$reservation_id}{imagerevisionid};
+
+ # Assemble a consistent prefix for notify messages
+ my $notify_prefix = "req=$request_id:";
+
+ # Add an entry to the loadlog
+ if ($computer_type eq "blade") {
+ insertloadlog($reservation_id, $computer_id, "loadimageblade", "$calling_sub: switching request state to reload");
+ }
+ elsif ($computer_type eq "virtualmachine") {
+ insertloadlog($reservation_id, $computer_id, "loadimagevmware", "$calling_sub: switching request state to reload");
+ }
+ else {
+ insertloadlog($reservation_id, $computer_id, "info", "$calling_sub: switching request state to reload");
+ }
+
+ # Check to make sure computer state is not currently reload or reloading
+ # It's possible for reclaimed cluster reservations to attempt to insert multiple reloads for child reservations
+ # because only the parent can update the request state
+ my $current_computer_state_name = get_computer_current_state_name($computer_id);
+ if ($current_computer_state_name =~ /reload/) {
+ notify($ERRORS{'WARNING'}, 0, "$notify_prefix current computer state is $current_computer_state_name, reload request will not be inserted");
+ return 0;
+ }
+
+ # Modify computer state so reload will process
+ if (update_computer_state($computer_id, "reload")) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix setting computerid $computer_id into reload state");
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "$notify_prefix unable to set computerid $computer_id reload state");
+ }
+
+ # Attempt to create a new reload request
+ my $request_id_reload;
+ if ($request_id_reload = insert_request($managementnode_id, 'reload', $request_laststate_name, $request_logid, 'vclreload', $computer_id, $image_id, $imagerevision_id, '0', '30')) {
+ notify($ERRORS{'OK'}, 0, "$notify_prefix inserted new reload request, id=$request_id_reload nodeid=$computer_id, imageid=$image_id, imagerevision_id=$imagerevision_id");
+ insertloadlog($reservation_id, $computer_id, "info", "$calling_sub: created new reload request");
+ }
+ else {
+ notify($ERRORS{'CRITICAL'}, 0, "$notify_prefix failed to insert new reload request");
+ return 0;
+ }
+
+ return 1;
+} ## end sub insert_reload_request
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 update_cluster_info
+
+ Parameters :data hash
+ Returns : 0 or 1
+ Description :
+
+=cut
+
+sub update_cluster_info {
+
+ my ($request_data) = @_;
+ my ($package, $filename, $line, $sub) = caller(0);
+ my ($calling_package, $calling_filename, $calling_line, $calling_sub) = caller(0);
+
+ my $reservation_id = $request_data->{RESERVATIONID};
+ my $computer_short_name = $request_data->{reservation}{$reservation_id}{computer}{SHORTNAME};
+ my $image_OS_type = $request_data->{reservation}{$reservation_id}{image}{OS}{type};
+
+ my $cluster_info = "/tmp/$computer_short_name.cluster_info";
+ my @cluster_string = "";
+ foreach my $rid (keys %{$request_data->{reservation}}) {
+ if ($rid == $reservation_id) {
+ push(@cluster_string, "parent= $request_data->{reservation}{$rid}{computer}{IPaddress}" . "\n");
+ }
+ else {
+ push(@cluster_string, "child= $request_data->{reservation}{$rid}{computer}{IPaddress}" . "\n");
+ }
+ }
+
+ if (open(CLUSTERFILE, ">$cluster_info")) {
+ print CLUSTERFILE @cluster_string;
+ close(CLUSTERFILE);
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "could not write to $cluster_info");
+ }
+
+ my $identity;
+ #scp cluster file to each node
+ my $targetpath;
+ foreach my $rid (keys %{$request_data->{reservation}}) {
+ $identity = $request_data->{reservation}{$rid}{image}{IDENTITY};
+ my $node_name = $request_data->{reservation}{$rid}{computer}{SHORTNAME};
+ if ($image_OS_type =~ /linux/i) {
+ $targetpath = "$node_name:/etc/cluster_info";
+ }
+ elsif ($image_OS_type =~ /windows/i) {
+ $targetpath = "$node_name:C:\/cluster_info";
+ }
+ else {
+ $targetpath = "$node_name:/etc/cluster_info";
+ }
+
+ if (run_scp_command($cluster_info, $targetpath, $identity)) {
+ notify($ERRORS{'OK'}, 0, " successfully copied cluster_info file to $node_name");
+ }
+ } ## end foreach my $rid (keys %{$request_data->{reservation...
+
+ unlink $cluster_info;
+
+ return 1;
+
+} ## end sub update_cluster_info
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 format_data
+
+ Parameters :
+ Returns : 0 or 1
+ Description :
+
+=cut
+
+sub format_data {
+
+ my $return_string;
+
+ my $level = 0;
+ $level = $_[scalar(@_) - 2] if (scalar(@_) > 2 && !ref($_[scalar(@_) - 2]));
+
+ my $name = '';
+ $name = $_[scalar(@_) - 1] if (scalar(@_) > 1 && !ref($_[scalar(@_) - 1]));
+
+ my $type;
+ my $data;
+
+ if (ref($_[0]) eq "HASH") {
+ $data = $_[0];
+ $type = '%';
+ }
+ elsif (ref($_[0]) eq "ARRAY") {
+ my $index = 0;
+ for (@{$_[0]}) {
+ $data->{$index} = $_;
+ $index++;
+ }
+ $type = '@';
+ }
+ elsif (ref($_[0]) eq "SCALAR") {
+ $data = $_[0];
+ $type = '$';
+ }
+ else {
+ $data = \$_[0];
+ $type = '$';
+
+ $return_string .= "ref: " . ref($_[0]) . "\n";
+ $return_string .= "data: " . $_[0] . "\n";
+
+ return $return_string;
+ }
+
+ $data = 'NULL' if (!defined $data);
+
+ $return_string .= "$type$name\n";
+
+ # Loop through values
+ foreach my $key (sort {lc($a) cmp lc($b)} keys(%{$data})) {
+ my $value = $data->{$key};
+
+ $value = 'NULL' if (!defined $value);
+
+ for (my $count = 0; $count < $level; $count++) {
+ $return_string .= " " if ($count < $level);
+ }
+ $return_string .= "|--";
+
+ if (ref($value) eq 'SCALAR') {
+ $value = "\\'$$value'";
+ }
+ elsif (!ref($value) && $value ne 'NULL') {
+ $value = "'$value'";
+ }
+
+ if (!ref($value)) {
+ if ($type eq '@') {
+ $return_string .= "[$key] = $value\n";
+ }
+ elsif ($type eq '%') {
+ $return_string .= "{$key} = $value\n";
+ }
+ }
+ else {
+ if ($type eq '@') {
+ #$return_string .= "\[$key\]\n";
+ $return_string .= format_data($value, $level + 1, "$name\[$key\]");
+ }
+ elsif ($type eq '%') {
+ #$return_string .= "\{$key\} $name\n";
+ $return_string .= format_data($value, $level + 1, "$name\{$key\}");
+ }
+ } ## end else [ if (!ref($value))
+
+ } ## end foreach my $key (sort {lc($a) cmp lc($b)} keys(...
+
+ return $return_string;
+} ## end sub format_data
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_caller_trace
+
+ Parameters : $level_limit - number of previous calls to return
+ Returns : multi-line string containing subroutine caller information
+ Description :
+
+=cut
+
+sub get_caller_trace {
+ my ($level_limit, $brief_output) = @_;
+ $level_limit = 4 if !$level_limit;
+
+ # Add one to make the argument usage more intuitive
+ # One of the levels is the subroutine which called this
+ $level_limit++;
+
+ my $caller_trace = "";
+ for (1 .. $level_limit) {
+ my $caller_index = $_;
+ if (caller($caller_index)) {
+ my ($package_last, $filename_last, $line_last, $sub_last) = caller($caller_index - 1);
+ my ($package, $filename, $line, $sub) = caller($caller_index);
+
+ $filename_last =~ s/.*\///;
+ $sub =~ s/.*:://;
+ if ($brief_output) {
+ $caller_trace .= (($caller_index - 1) * -1) . ":$filename_last:$sub:$line_last;";
+ }
+ else {
+ $caller_trace .= "(" . sprintf("% d", (($caller_index - 1) * -1)) . ") $filename_last, $sub (line: $line_last)\n";
+ }
+ } ## end if (caller($caller_index))
+ else {
+ last;
+ }
+ } ## end for (1 .. $level_limit)
+
+ # Remove the trailing semicolon if brief output is used
+ $caller_trace =~ s/;$//;
+
+ # Chomp the trailing newline if brief output isn't used
+ chomp $caller_trace;
+
+ return $caller_trace;
+} ## end sub get_caller_trace
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 get_management_node_id
+
+ Parameters :
+ Returns :
+ Description :
+
+=cut
+
+sub get_management_node_id {
+ my $management_node_id;
+
+ # Check the management_node_id environment variable
+ if ($ENV{management_node_id}) {
+ notify($ERRORS{'DEBUG'}, 0, "environment variable: $ENV{management_node_id}");
+ return $ENV{management_node_id};
+ }
+ else {
+ notify($ERRORS{'DEBUG'}, 0, "management_node_id environment variable not set");
+ }
+
+ # If $management_node_id wasn't set using the env variable, try the subroutine
+ my $management_node_info = get_management_node_info();
+ if ($management_node_info && ($management_node_id = $management_node_info->{id})) {
+ notify($ERRORS{'DEBUG'}, 0, "get_managementnode_info(): $management_node_id");
+ $ENV{management_node_id} = $management_node_id;
+ return $management_node_id;
+ }
+ else {
+ notify($ERRORS{'DEBUG'}, 0, "get_management_node_info() failed");
+ }
+
+ notify($ERRORS{'WARNING'}, 0, "management node ID could not be determined");
+ return 0;
+} ## end sub get_management_node_id
+
+#/////////////////////////////////////////////////////////////////////////////
+
+sub get_database_table_columns {
+
+ my $database = 'information_schema';
+
+ my $select_all_table_columns = "
+SELECT DISTINCT
+TABLES.TABLE_NAME,
+COLUMNS.COLUMN_NAME
+FROM
+TABLES,
+COLUMNS
+WHERE
+COLUMNS.TABLE_SCHEMA = \'$DATABASE\'
+AND
+TABLES.TABLE_NAME = COLUMNS.TABLE_NAME
+ ";
+
+ # Call the database select subroutine
+ my @rows = database_select($select_all_table_columns, $database);
+
+ # Check to make sure 1 row was returned
+ if (scalar @rows == 0) {
+ notify($ERRORS{'WARNING'}, 0, "unable to get database table columns, 0 rows were returned from database select");
+ return 0;
+ }
+
+ # Use the map function to populate a hash of arrays
+ # The hash keys are the table names
+ # The hash values are arrays of column names
+ my %return_hash;
+ map({push @{$return_hash{$_->{TABLE_NAME}}}, $_->{COLUMN_NAME}} @rows);
+ return \%return_hash;
+} ## end sub get_database_table_columns
+
+#/////////////////////////////////////////////////////////////////////////////
+
+sub switch_vmhost_id {
+ my ($computer_id, $host_id) = @_;
+
+ my ($package, $filename, $line, $sub) = caller(0);
+ my ($caller_package, $caller_filename, $caller_line, $caller_sub) = caller(1);
+
+ my $caller_info = "$caller_sub($line)";
+
+ my $caller = scalar caller;
+ notify($ERRORS{'OK'}, 0, "called from $caller_info");
+
+ # Check the arguments
+ if (!defined($computer_id)) {
+ notify($ERRORS{'CRITICAL'}, 0, "computer_id is undefined");
+ return 0;
+ }
+
+ if (!(defined($host_id)) || !$host_id) {
+ notify($ERRORS{'WARNING'}, 0, "$host_id is either not defined or 0, using NULL");
+ $host_id = 'NULL';
+ }
+
+ # Construct the update statement
+ my $update_statement = "
+ UPDATE
+ computer
+ SET
+ vmhostid = $host_id
+ WHERE
+ computer.id = $computer_id
+ ";
+
+ # Call the database execute subroutine
+ if (database_execute($update_statement)) {
+ return 1;
+ }
+ else {
+ notify($ERRORS{'WARNING'}, 0, "unable to update computer table, id=$computer_id, vmhostid=$host_id");
+ return 0;
+ }
+} ## end sub switch_vmhost_id
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 reservations_ready
+
+ Parameters : request ID
+ Returns : 1 if all reservations are ready, 0 if any are not ready, undefined if any failed
+ Description :
+
+=cut
+
+sub reservations_ready {
+ my ($request_id) = @_;
+
+ # Make sure request ID was passed
+ if (!$request_id) {
+ notify($ERRORS{'WARNING'}, 0, "request ID argument was not passed");
+ return;
+ }
+
+ my $select_statement = "
+ SELECT
+ reservation.id AS reservation_id,
+ computerloadstate.loadstatename
+
+ FROM
+ request,
+ reservation
+
+ LEFT JOIN
+ computerloadlog
+ ON (
+ computerloadlog.reservationid = reservation.id
+ )
+
+ LEFT JOIN
+ computerloadstate
+ ON (
+ computerloadstate.id = computerloadlog.loadstateid
+ )
+
+ WHERE
+ request.id = $request_id
+ AND reservation.requestid = request.id
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @computerloadlog_rows = database_select($select_statement);
+
+ # Check to make sure 1 row was returned
+ if (scalar @computerloadlog_rows == 0) {
+ notify($ERRORS{'WARNING'}, 0, "reservations associated with request $request_id could not be retrieved from the database, 0 rows were returned");
+ return;
+ }
+
+ my %reservation_status;
+
+ # Loop through the rows, check the loadstate
+ for my $computerloadlog_row (@computerloadlog_rows) {
+ my $reservation_id = $computerloadlog_row->{reservation_id};
+ my $computerloadstate_name = $computerloadlog_row->{loadstatename};
+
+ # Initialize the hash key for the reservation if it isn't defined
+ if (!defined($reservation_status{$reservation_id})) {
+ $reservation_status{$reservation_id} = 'not ready';
+ }
+
+ # Skip if loadstatename is undefined, means no computerloadlog rows exist for the reservation
+ if (!defined($computerloadstate_name)) {
+ next;
+ }
+
+ # Only populate hash keys with loadstatnames we care about
+ # Ignore 'info' and other entries
+ if ($computerloadstate_name =~ /loadimagecomplete|nodeready|failed/i) {
+
+ # Update the reservation hash key, don't overwrite 'failed'
+ if ($reservation_status{$reservation_id} !~ /failed/) {
+ $reservation_status{$reservation_id} = $computerloadstate_name;
+ }
+ }
+ } ## end for my $computerloadlog_row (@computerloadlog_rows)
+
+ # Assemble a string of all of the statuses
+ my $status_string = '';
+ my $failed = 0;
+ my $ready = 1;
+ foreach my $reservation_check_id (sort keys(%reservation_status)) {
+ my $reservation_check_status = $reservation_status{$reservation_check_id};
+ $status_string .= "reservation $request_id:$reservation_check_id: $reservation_check_status\n";
+
+ # Set the failed flag to 1 if any reservations failed
+ if ($reservation_check_status =~ /failed/i) {
+ $failed = 1;
+ }
+
+ # Set the ready flag to 0 if any reservations are set to 0 (matching state wasn't found)
+ if ($reservation_check_status =~ /not ready/) {
+ $ready = 0;
+ }
+ } ## end foreach my $reservation_check_id (sort keys(%reservation_status...
+
+ if ($failed) {
+ notify($ERRORS{'WARNING'}, 0, "request $request_id has failed reservations, returning undefined:\n$status_string");
+ return;
+ }
+
+ if ($ready) {
+ notify($ERRORS{'OK'}, 0, "all reservations for request $request_id are ready, returning $ready:\n$status_string");
+ }
+ else {
+ notify($ERRORS{'OK'}, 0, "not all reservations for request $request_id are ready, returning $ready:\n$status_string");
+ }
+
+ return $ready;
+
+} ## end sub reservations_ready
+
+##/////////////////////////////////////////////////////////////////////////////
+#
+#=head2 reservations_ready
+#
+# Parameters : request ID
+# Returns : 1 if all reservations are ready, 0 if any are not ready, undefined if any failed
+# Description :
+#
+#=cut
+#
+#sub reservations_ready {
+# my ($request_id) = @_;
+#
+# # Make sure request ID was passed
+# if (!$request_id) {
+# notify($ERRORS{'WARNING'}, 0, "request ID argument was not passed");
+# return;
+# }
+#
+# my $select_statement = "
+# SELECT
+# requeststate.name AS request_state,
+# reservation.id AS reservation_id,
+# computerloadstate.loadstatename,
+# computerstate.name AS computer_state
+#
+# FROM
+# request,
+# state requeststate,
+# reservation
+#
+# LEFT JOIN
+# computerloadlog
+# ON (
+# computerloadlog.reservationid = reservation.id
+# )
+#
+# LEFT JOIN
+# computerloadstate
+# ON (
+# computerloadstate.id = computerloadlog.loadstateid
+# ),
+#
+# computer,
+# state computerstate
+#
+# WHERE
+# request.id = $request_id
+# AND reservation.requestid = request.id
+# AND computer.id = reservation.computerid
+# AND computerstate.id = computer.stateid
+# AND requeststate.id = request.stateid
+# ";
+#
+# # Call the database select subroutine
+# # This will return an array of one or more rows based on the select statement
+# my @computerloadlog_rows = database_select($select_statement);
+#
+# # Check to make sure 1 row was returned
+# if (scalar @computerloadlog_rows == 0) {
+# notify($ERRORS{'WARNING'}, 0, "reservations associated with request $request_id could not be retrieved from the database, 0 rows were returned");
+# return;
+# }
+#
+# my %reservation_status;
+#
+# # Loop through the rows, check the loadstate and computer state
+# for my $computerloadlog_row (@computerloadlog_rows) {
+# my $reservation_id = $computerloadlog_row->{reservation_id};
+# my $request_state_name = $computerloadlog_row->{request_state};
+# my $computerloadstate_name = $computerloadlog_row->{loadstatename};
+# my $computer_state_name = $computerloadlog_row->{computer_state};
+#
+# # If request state has been changed to reserved or inuse, assume all reservations are ready
+# if ($request_state_name =~ /^(reserved|inuse)$/i) {
+# notify($ERRORS{'OK'}, 0, "assuming all reservations are ready, request state is $request_state_name");
+# return 1;
+# }
+#
+# # If request state has been changed to failed or maintenance, return fail
+# if ($request_state_name =~ /^(failed|maintenance)$/i) {
+# notify($ERRORS{'WARNING'}, 0, "unable to determine if all reservations are ready, request state = $request_state_name");
+# return;
+# }
+#
+# # If request been deleted, return 0
+# if ($request_state_name =~ /^(deleted)$/i) {
+# notify($ERRORS{'OK'}, 0, "request state = $request_state_name");
+# return 0;
+# }
+#
+#
+# # Check for computerloadstate = failed
+# if ($computerloadstate_name =~ /failed/i) {
+# $reservation_status{$reservation_id} = "failed: computerloadstate = $computerloadstate_name";
+# next;
+# }
+#
+# # Check for bad computer states
+# if ($computer_state_name =~ /^(failed|maintenance|deleted)$/i) {
+# $reservation_status{$reservation_id} = "failed: computer state = $computer_state_name";
+# next
+# }
+#
+#
+# # Skip if loadstatename is undefined, means no computerloadlog rows exist for the reservation
+# if (!defined($computerloadstate_name)) {
+# $reservation_status{$reservation_id} = 'not ready: no computerloadlog entries exist';
+# next;
+# }
+#
+# # Check for loadstatnames we care about
+# if ($computerloadstate_name =~ /^(loadimagecomplete|nodeready|reserved)$/i) {
+# $reservation_status{$reservation_id} = "ready: computerloadstate $computerloadstate_name";
+# next;
+# }
+#
+#
+# # Check if computer state indicates it isn't ready
+# if ($computer_state_name =~ /^(reload|reloading|available)$/i) {
+# $reservation_status{$reservation_id} = "not ready: computer state = $computer_state_name";
+# next;
+# }
+#
+# notify($ERRORS{'WARNING'}, 0, "unexpected situation: reservation $reservation_id, request state: $request_state_name, computer state: $computer_state_name, computerloadstate: $computerloadstate_name");
+# $reservation_status{$reservation_id} = "not ready: unexpected situation";
+#
+# } ## end for my $computerloadlog_row (@computerloadlog_rows)
+#
+#
+# # Assemble a string of all of the statuses
+# my $status_string = '';
+# my $failed = 0;
+# my $ready = 1;
+# foreach my $reservation_check_id (sort keys(%reservation_status)) {
+# my $reservation_check_status = $reservation_status{$reservation_check_id};
+# $status_string .= "reservation $request_id:$reservation_check_id: $reservation_check_status\n";
+#
+# # Set the failed flag to 1 if any reservations failed
+# if ($reservation_check_status =~ /failed/i) {
+# $failed = 1;
+# }
+#
+# # Set the ready flag to 0 if any reservations are set to 0 (matching state wasn't found)
+# if ($reservation_check_status =~ /not ready/) {
+# $ready = 0;
+# }
+# } ## end foreach my $reservation_check_id (sort keys(%reservation_status...
+#
+# if ($failed) {
+# notify($ERRORS{'WARNING'}, 0, "request $request_id has failed reservations, returning undefined:\n$status_string");
+# return;
+# }
+#
+# if ($ready) {
+# notify($ERRORS{'OK'}, 0, "all reservations for request $request_id are ready, returning $ready:\n$status_string");
+# }
+# else {
+# notify($ERRORS{'OK'}, 0, "not all reservations for request $request_id are ready, returning $ready:\n$status_string");
+# }
+#
+# return $ready;
+#
+#} ## end sub reservations_ready
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 reservation_being_processed
+
+ Parameters : reservation ID
+ Returns : true if reservation is avtively being processed, false otherwise
+ Description : Checks the computerloadlog table for rows matching the
+ reservation ID and loadstate = begin. Returns true if any
+ matching rows exist, false otherwise.
+
+=cut
+
+sub reservation_being_processed {
+ my ($reservation_id) = @_;
+
+ # Make sure reservation ID was passed
+ if (!$reservation_id) {
+ notify($ERRORS{'WARNING'}, 0, "reservation ID argument was not passed");
+ return;
+ }
+
+ my $select_statement = "
+ SELECT
+ computerloadlog.*
+
+ FROM
+ computerloadlog,
+ computerloadstate
+
+ WHERE
+ computerloadlog.reservationid = $reservation_id
+ AND computerloadlog.loadstateid = computerloadstate.id
+ AND computerloadstate.loadstatename = \'begin\'
+ ";
+
+ # Call the database select subroutine
+ # This will return an array of one or more rows based on the select statement
+ my @computerloadlog_rows = database_select($select_statement);
+
+ # Check if at least 1 row was returned
+ if (scalar @computerloadlog_rows == 1) {
+ notify($ERRORS{'DEBUG'}, 0, "computerloadlog 'begin' entry exists for reservation");
+ return 1;
+ }
+ elsif (scalar @computerloadlog_rows > 1) {
+ notify($ERRORS{'WARNING'}, 0, "multiple computerloadlog 'begin' entries exist for reservation");
+ return 1;
+ }
+ else {
+ notify($ERRORS{'DEBUG'}, 0, "computerloadlog 'begin' entry does NOT exist for reservation $reservation_id");
+ 0
+ }
+
+ ## Check for any running processes
+ #my $pgrep_command = "pgrep -fl 'VCL::.*:$reservation_id '";
+ #$pgrep_command .= ' 2>&1';
+ #notify($ERRORS{'DEBUG'}, 0, "searching for process via: $pgrep_command");
+ #
+ #my $pgrep_output = `$pgrep_command`;
+ #my $pgrep_exit_status = $?;
+ #notify($ERRORS{'DEBUG'}, 0, "pgrep exit status=$pgrep_exit_status, output: $pgrep_output");
+ #
+ #if ($pgrep_exit_status == 0) {
+ # notify($ERRORS{'DEBUG'}, 0, "reservation is being processed by:\n$pgrep_output");
+ # return 1;
+ #}
+ #elsif ($pgrep_exit_status == 1) {
+ # notify($ERRORS{'DEBUG'}, 0, "did not find any running processes for reservation, returning 0");
+ # return 0;
+ #}
+ #else {
+ # notify($ERRORS{'WARNING'}, 0, "error occurred running command: $pgrep_command, exit status: $pgrep_exit_status"); #, output: $pgrep_output");
+ # return 0;
+ #}
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+=head2 string_to_ascii
+
+ Parameters : string
+ Returns : string with special ASCII characters replaced with character
+ names
+ Description : Takes the string passed, checks each character, and replaces
+ special ASCII characters with the character name. For
+ example, "This is a\r\nstring." would return
+ "This[SP]is[SP]a[CR][LF]string."
+
+=cut
+
+sub string_to_ascii {
+ my $string = shift;
+
+ my %ascii_codes = (
+ 0 => 'NUL',
+ 1 => 'SOH',
+ 2 => 'STX',
+ 3 => 'ETX',
+ 4 => 'EOT',
+ 5 => 'ENQ',
+ 6 => 'ACK',
+ 7 => 'BEL',
+ 8 => 'BS',
+ 9 => 'HT',
+ 10 => 'LF',
+ 11 => 'VT',
+ 12 => 'FF',
+ 13 => 'CR',
+ 14 => 'SO',
+ 15 => 'SI',
+ 16 => 'DLE',
+ 17 => 'DC1',
+ 18 => 'DC2',
+ 19 => 'DC3',
+ 20 => 'DC4',
+ 21 => 'NAK',
+ 22 => 'SYN',
+ 23 => 'ETB',
+ 24 => 'CAN',
+ 25 => 'EM',
+ 26 => 'SUB',
+ 27 => 'ESC',
+ 28 => 'FS',
+ 29 => 'GS',
+ 30 => 'RS',
+ 31 => 'US',
+ 32 => 'SP',
+ 127 => 'DEL',
+ );
+
+ my $ascii_value_string;
+ foreach my $ascii_code (unpack("C*", $string)) {
+ if (defined($ascii_codes{$ascii_code})) {
+ $ascii_value_string .= "[$ascii_codes{$ascii_code}]";
+ }
+ else {
+ $ascii_value_string .= pack("C*", $ascii_code);
+ }
+ }
+
+ return $ascii_value_string;
+}
+
+#/////////////////////////////////////////////////////////////////////////////
+
+1;
+__END__
+
+=head1 BUGS and LIMITATIONS
+
+ There are no known bugs in this module.
+ Please report problems to the VCL team (vcl_help@ncsu.edu).
+
+=head1 AUTHOR
+
+ Aaron Peeler, aaron_peeler@ncsu.edu
+ Andy Kurth, andy_kurth@ncsu.edu
+
+=head1 SEE ALSO
+
+L<http://vcl.ncsu.edu>
+
+=cut
diff --git a/managementnode/tools/Sysprep/Scripts/VCLcleanup.cmd b/managementnode/tools/Sysprep/Scripts/VCLcleanup.cmd
new file mode 100755
index 0000000..6a73be1
--- /dev/null
+++ b/managementnode/tools/Sysprep/Scripts/VCLcleanup.cmd
@@ -0,0 +1,6 @@
+@echo off
+
+del %SystemRoot%\system32\GroupPolicy\User\Scripts\Logon\VCLprepare.cmd
+del "C:\Documents and Settings\Default User\Desktop\Windows Media Player.lnk"
+del "C:\Documents and Settings\root\Desktop\Windows Media Player.lnk"
+
diff --git a/managementnode/tools/Sysprep/Scripts/VCLprepare.cmd b/managementnode/tools/Sysprep/Scripts/VCLprepare.cmd
new file mode 100755
index 0000000..10a7b81
--- /dev/null
+++ b/managementnode/tools/Sysprep/Scripts/VCLprepare.cmd
@@ -0,0 +1,15 @@
+@echo off
+
+cd %APPDATA%/vcl
+
+%SystemRoot%\system32\cscript.exe unsetautologon.vbs
+
+%SystemRoot%\system32\cscript.exe updatecygwin.vbs
+
+%SystemRoot%\system32\cscript.exe postconfig.vbs
+
+copy VCLcleanup.cmd C:\WINDOWS\system32\GroupPolicy\User\Scripts\Logoff\
+
+%SystemRoot%\system32\eventcreate.exe /T INFORMATION /L APPLICATION /SO VCLprepare.cmd /ID 555 /D "%COMPUTERNAME% is READY."
+
+%SystemRoot%\system32\logoff.exe
diff --git a/managementnode/tools/Sysprep/Scripts/VCLrcboot.cmd b/managementnode/tools/Sysprep/Scripts/VCLrcboot.cmd
new file mode 100755
index 0000000..458a5d6
--- /dev/null
+++ b/managementnode/tools/Sysprep/Scripts/VCLrcboot.cmd
@@ -0,0 +1,17 @@
+@echo off
+
+copy "C:\Documents and Settings\root\Application Data\VCL\VCLprepare.cmd" C:\WINDOWS\system32\GroupPolicy\User\Scripts\Logon\
+
+del C:\WINDOWS\system32\GroupPolicy\User\Scripts\Logoff\VCLcleanup.cmd
+
+cd %APPDATA%/vcl
+
+%SystemRoot%\system32\cmd.exe /c C:\WINDOWS\regedit.exe /s nodyndns.reg
+
+%SystemRoot%\system32\cmd.exe /c wsname.exe /N:$DNS /MCN
+
+%SystemRoot%\system32\cmd.exe /c C:\WINDOWS\system32\ping.exe 1.1.1.1 %-n 1 -w 5000 > NUL
+
+%SystemRoot%\system32\cmd.exe /c newsid.exe /a /d 6
+
+del C:\WINDOWS\system32\GroupPolicy\User\Scripts\Logon\VCLrcboot.cmd
diff --git a/managementnode/tools/Sysprep/Scripts/enablepagefile.vbs b/managementnode/tools/Sysprep/Scripts/enablepagefile.vbs
new file mode 100755
index 0000000..c37b746
--- /dev/null
+++ b/managementnode/tools/Sysprep/Scripts/enablepagefile.vbs
@@ -0,0 +1,11 @@
+On Error Resume Next
+Set oWshShell = CreateObject("WScript.Shell")
+
+' turn back on pagefile
+strCommand = "reg.exe add " & Chr(34) & _
+ "HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Memory Management" & Chr(34) &_
+ " /v PagingFiles /d " & Chr(34) & "c:\pagefile.sys 0 0" & Chr(34) & " /t REG_MULTI_SZ /f"
+Set oExec = oWshShell.Exec(strcommand)
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
diff --git a/managementnode/tools/Sysprep/Scripts/networkinfo.bat b/managementnode/tools/Sysprep/Scripts/networkinfo.bat
new file mode 100755
index 0000000..21c6d8c
--- /dev/null
+++ b/managementnode/tools/Sysprep/Scripts/networkinfo.bat
@@ -0,0 +1,115 @@
+@echo off
+
+FOR /f "skip=1 tokens=2,15 " %%a in ('IPCONFIG') do (
+ if %%a==Address. (
+ SET FIRST_IP=%%b
+ GOTO CONTINUE
+ )
+)
+
+:CONTINUE
+
+FOR /f "skip=10 tokens=2,15 " %%a in ('IPCONFIG') do (
+ if %%a==Address. (
+ SET SECOND_IP=%%b
+ )
+)
+
+REM echo FIRST_IP = %FIRST_IP%
+REM echo SECOND_IP = %SECOND_IP%
+
+FOR /f "skip=1 tokens=1,2* " %%a in ('IPCONFIG') do (
+ if %%b==adapter (
+ SET FIRST_NAME=%%c
+ GOTO CONTINUE2
+ )
+)
+
+:CONTINUE2
+
+FOR /f "skip=10 tokens=1,2* " %%a in ('IPCONFIG') do (
+ if %%b==adapter (
+ SET SECOND_NAME=%%c
+ )
+)
+
+FOR /f "tokens=1 delims=:" %%a in ('echo %FIRST_NAME%') do (
+ SET FIRST_NAME=%%a
+)
+
+FOR /f "tokens=1 delims=:" %%a in ('echo %SECOND_NAME%') do (
+ SET SECOND_NAME=%%a
+)
+
+FOR /f "skip=1 tokens=2,13 " %%a in ('IPCONFIG') do (
+ if %%a==Gateway (
+ SET FIRST_GW=%%b
+ GOTO CONTINUE3
+ )
+)
+
+:CONTINUE3
+
+FOR /f "skip=10 tokens=2,13 " %%a in ('IPCONFIG') do (
+ if %%a==Gateway (
+ SET SECOND_GW=%%b
+ )
+)
+
+REM echo FIRST_IP = %FIRST_IP%
+REM echo FIRST_NAME = %FIRST_NAME%
+REM echo SECOND_IP = %SECOND_IP%
+REM echo SECOND_NAME = %SECOND_NAME%
+
+FOR /f "tokens=1,5 delims=. " %%a in ('echo %FIRST_IP%%SECOND_IP%') do (
+ if %%a==10 (
+ if %%b==152 (
+ SET INTERNAL_IP=%FIRST_IP%
+ SET INTERNAL_NAME=%FIRST_NAME%
+ SET INTERNAL_GW=%FIRST_GW%
+ SET EXTERNAL_IP=%SECOND_IP%
+ SET EXTERNAL_NAME=%SECOND_NAME%
+ SET EXTERNAL_GW=%SECOND_GW%
+ ) else (
+ SET INTERNAL_IP=%FIRST_IP%
+ SET INTERNAL_NAME=%FIRST_NAME%
+ SET INTERNAL_GW=%FIRST_GW%
+ SET EXTERNAL_IP=NA
+ SET EXTERNAL_NAME=NA
+ SET EXTERNAL_GW=NA
+ )
+ ) else (
+ if %%a==152 (
+ if %%b==10 (
+ SET EXTERNAL_IP=%FIRST_IP%
+ SET EXTERNAL_NAME=%FIRST_NAME%
+ SET EXTERNAL_GW=%FIRST_GW%
+ SET INTERNAL_IP=%SECOND_IP%
+ SET INTERNAL_NAME=%SECOND_NAME%
+ SET INTERNAL_GW=%SECOND_GW%
+ ) else (
+ SET EXTERNAL_IP=%FIRST_IP%
+ SET EXTERNAL_NAME=%FIRST_NAME%
+ SET EXTERNAL_GW=%FIRST_GW%
+ SET INTERNAL_IP=NA
+ SET INTERNAL_NAME=NA
+ SET INTERNAL_GW=NA
+ )
+ ) else (
+ SET INTERNAL_IP=NA
+ SET INTERNAL_NAME=NA
+ SET INTERNAL_GW=NA
+ SET EXTERNAL_IP=NA
+ SET EXTERNAL_NAME=NA
+ SET EXTERNAL_GW=NA
+ )
+ )
+)
+
+REM echo INTERNAL_IP = %INTERNAL_IP%
+REM echo INTERNAL_NAME = %INTERNAL_NAME%
+REM echo INTERNAL_GW = %INTERNAL_GW%
+
+REM echo EXTERNAL_IP = %EXTERNAL_IP%
+REM echo EXTERNAL_NAME = %EXTERNAL_NAME%
+REM echo EXTERNAL_GW = %EXTERNAL_GW%
diff --git a/managementnode/tools/Sysprep/Scripts/networkinfosetfw.vbs b/managementnode/tools/Sysprep/Scripts/networkinfosetfw.vbs
new file mode 100755
index 0000000..60b9e35
--- /dev/null
+++ b/managementnode/tools/Sysprep/Scripts/networkinfosetfw.vbs
@@ -0,0 +1,120 @@
+On Error Resume Next
+
+Dim objWMIService, objItem, objService
+Dim colListOfServices, strComputer, strService, intSleep
+Dim colNicConfigs,colNicAdapter,strDescription,strMAC
+Dim strIPAddresses,strGWAddress
+
+strComputer = "."
+
+Set objWMIService = GetObject("winmgmts:" _
+ & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
+Set colNicConfigs = objWMIService.ExecQuery _
+ ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
+Set colNicAdapter = objWMIService.ExecQuery _
+ ("SELECT * FROM Win32_NetworkAdapter")
+
+For Each objNicConfig In colNicConfigs
+ strDescription = objNicConfig.Description
+ strMAC = objNicConfig.MACAddress
+ If InStr(strDescription, "Broadcom") Then
+ strIPAddresses = ""
+ If Not IsNull(objNicConfig.IPAddress) Then
+ For Each strIPAddress In objNicConfig.IPAddress
+ If Not strIPAddress = "" Then
+ strIPAddresses = strIPAddresses & strIPAddress
+ End If
+ Next
+ End If
+ strGWAddresses = ""
+ If Not IsNull(objNicConfig.DefaultIPGateway) Then
+ For Each strGWAddress In objNicConfig.DefaultIPGateway
+ If Not strGWAddress = "" Then
+ strGWAddresses = strGWAddresses & strGWAddress
+ End If
+ Next
+ End If
+
+
+' WScript.Echo "IP Address : " & strIPAddresses & VbCrLf & _
+' "MAC Address : " & strMAC & VbCrLf & _
+' "GW Address : " & strGWAddresses
+ For Each objNicAdapter In colNicAdapter
+ If strMAC = objNicAdapter.MACAddress Then
+ strNetConnectionID = objNicAdapter.NetConnectionID
+ If Not strNetConnectionID = "" Then
+ 'WScript.Echo "Name: " & strNetConnectionID & VbCrLf
+ If Left(strIPAddresses,3) = "10." Then
+ INTERNAL_IP = strIPAddresses
+ INTERNAL_NAME = strNetConnectionID
+ INTERNAL_GW = strGWAddresses
+ End If
+
+ If Left(strIPAddresses,4) = "152." Then
+ EXTERNAL_IP = strIPAddresses
+ EXTERNAL_NAME = strNetConnectionID
+ EXTERNAL_GW = strGWAddresses
+ End If
+ End If
+ End If
+ Next
+
+
+ Else
+ strIPAddresses = ""
+ strGWAddresses = ""
+ End If
+
+Next
+
+
+
+'WScript.Echo "INTERNAL_IP = " & INTERNAL_IP
+'WScript.Echo "INTERNAL_NAME = " & INTERNAL_NAME
+'WScript.Echo "INTERNAL_GW = " & INTERNAL_GW
+
+'WScript.Echo "EXTERNAL_IP = " & EXTERNAL_IP
+'WScript.Echo "EXTERNAL_NAME = " & EXTERNAL_NAME
+'WScript.Echo "EXTERNAL_GW = " & EXTERNAL_GW
+
+Set oWshShell = CreateObject("WScript.Shell")
+
+Dim strCMD1,routeCMD,strCMD2,strCMD3
+
+strCMD1 = "netsh firewall set icmpsetting type = 8 mode = enable interface = " & Chr(34) & INTERNAL_NAME & Chr(34)
+'oWshShell.run "%SystemRoot%\system32\route.exe -f -p ADD 0.0.0.0 MASK 0.0.0.0 EXTERNAL_GW METRIC 2",,true
+routeCMD = "route.exe -f -p ADD 0.0.0.0 MASK 0.0.0.0 " & EXTERNAL_GW & " METRIC 2"
+'WScript.Echo "setting route" & routeCMD
+oWshShell.run routeCMD,,true
+'WScript.Echo "setting icmpsetting " & strCMD1
+oWshShell.run strCMD1,,true
+strCMD2 = "netsh firewall set portopening protocol = TCP port = 3389 mode = disable interface = " & Chr(34) & EXTERNAL_NAME & Chr(34)
+'WScript.Echo "closing 3389 " & strCMD2
+oWshShell.run strCMD2,,true
+strCMD3 = "netsh firewall set portopening protocol = TCP port = 22 name = SSHD mode = enable interface = " & Chr(34) & INTERNAL_NAME & Chr(34)
+'WScript.Echo "opening 22 " & strCMD3
+oWshShell.run strCMD3,,true
+
+objWMIService=""
+' update syslog - stop and restart service
+
+strComputer = "."
+intSleep = 1500
+
+'On Error Resume Next
+' NB strService is case sensitive.
+strService = " 'ntsyslog' "
+Set objWMIService = GetObject("winmgmts:" _
+& "{impersonationLevel=impersonate}!\\" _
+& strComputer & "\root\cimv2")
+Set colListOfServices = objWMIService.ExecQuery _
+("Select * from Win32_Service Where Name ="_
+& strService & " ")
+For Each objService in colListOfServices
+objService.StopService()
+WSCript.Sleep intSleep
+oWshShell.run """reg add HKLM\SOFTWARE\SaberNet /v syslog /d INTERNAL_GW /f""",,true
+objService.StartService()
+Next
+'WScript.Echo "Your "& strService & " service has Started"
+WScript.Quit
diff --git a/managementnode/tools/Sysprep/Scripts/postconfig.vbs b/managementnode/tools/Sysprep/Scripts/postconfig.vbs
new file mode 100755
index 0000000..edab803
--- /dev/null
+++ b/managementnode/tools/Sysprep/Scripts/postconfig.vbs
@@ -0,0 +1,125 @@
+On Error Resume Next
+
+Dim objWMIService, objItem, objService
+Dim colListOfServices, strComputer, strService, intSleep
+Dim colNicConfigs,colNicAdapter,strDescription,strMAC
+Dim strIPAddresses,strGWAddress
+
+strComputer = "."
+
+Set objWMIService = GetObject("winmgmts:" _
+ & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
+Set colNicConfigs = objWMIService.ExecQuery _
+ ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
+Set colNicAdapter = objWMIService.ExecQuery _
+ ("SELECT * FROM Win32_NetworkAdapter")
+
+For Each objNicConfig In colNicConfigs
+ strDescription = objNicConfig.Description
+ strMAC = objNicConfig.MACAddress
+ If InStr(strDescription, "Broadcom") Then
+ strIPAddresses = ""
+ If Not IsNull(objNicConfig.IPAddress) Then
+ For Each strIPAddress In objNicConfig.IPAddress
+ If Not strIPAddress = "" Then
+ strIPAddresses = strIPAddresses & strIPAddress
+ End If
+ Next
+ End If
+ strGWAddresses = ""
+ If Not IsNull(objNicConfig.DefaultIPGateway) Then
+ For Each strGWAddress In objNicConfig.DefaultIPGateway
+ If Not strGWAddress = "" Then
+ strGWAddresses = strGWAddresses & strGWAddress
+ End If
+ Next
+ End If
+
+
+ WScript.Echo "IP Address : " & strIPAddresses & VbCrLf & _
+ "MAC Address : " & strMAC & VbCrLf & _
+ "GW Address : " & strGWAddresses
+ For Each objNicAdapter In colNicAdapter
+ If strMAC = objNicAdapter.MACAddress Then
+ strNetConnectionID = objNicAdapter.NetConnectionID
+ If Not strNetConnectionID = "" Then
+ 'WScript.Echo "Name: " & strNetConnectionID & VbCrLf
+ If Left(strIPAddresses,3) = "10." Then
+ INTERNAL_IP = strIPAddresses
+ INTERNAL_NAME = strNetConnectionID
+ INTERNAL_GW = strGWAddresses
+ End If
+
+ If Left(strIPAddresses,4) = "152." Then
+ EXTERNAL_IP = strIPAddresses
+ EXTERNAL_NAME = strNetConnectionID
+ EXTERNAL_GW = strGWAddresses
+ End If
+ End If
+ End If
+ Next
+
+
+ Else
+ strIPAddresses = ""
+ strGWAddresses = ""
+ End If
+
+Next
+
+
+
+'WScript.Echo "INTERNAL_IP = " & INTERNAL_IP
+'WScript.Echo "INTERNAL_NAME = " & INTERNAL_NAME
+'WScript.Echo "INTERNAL_GW = " & INTERNAL_GW
+
+'WScript.Echo "EXTERNAL_IP = " & EXTERNAL_IP
+'WScript.Echo "EXTERNAL_NAME = " & EXTERNAL_NAME
+'WScript.Echo "EXTERNAL_GW = " & EXTERNAL_GW
+
+Set oWshShell = CreateObject("WScript.Shell")
+
+Dim strCMD1,routeCMD,strCMD2,strCMD3,strCMD4
+
+strCMD1 = "netsh firewall set icmpsetting type = 8 mode = enable interface = " & Chr(34) & INTERNAL_NAME & Chr(34)
+'oWshShell.run "%SystemRoot%\system32\route.exe -f -p ADD 0.0.0.0 MASK 0.0.0.0 EXTERNAL_GW METRIC 2",,true
+routeCMD = "route.exe -f -p ADD 0.0.0.0 MASK 0.0.0.0 " & EXTERNAL_GW & " METRIC 2"
+'WScript.Echo "setting route" & routeCMD
+oWshShell.run routeCMD,,true
+'WScript.Echo "setting icmpsetting " & strCMD1
+oWshShell.run strCMD1,,true
+strCMD2 = "netsh firewall set portopening protocol = TCP port = 3389 mode = disable interface = " & Chr(34) & EXTERNAL_NAME & Chr(34)
+'WScript.Echo "closing 3389 " & strCMD2
+oWshShell.run strCMD2,,true
+strCMD3 = "netsh firewall set portopening protocol = TCP port = 22 name = SSHD mode = enable interface = " & Chr(34) & INTERNAL_NAME & Chr(34)
+'WScript.Echo "opening 22 " & strCMD3
+oWshShell.run strCMD3,,true
+
+' Renew address so local private adapter has it's gateway
+strCMD4 = "ipconfig /renew"
+'WScript.Echo "ipconfig /renew " & strCMD3
+oWshShell.run strCMD4,,true
+
+objWMIService=""
+' update syslog - stop and restart service
+
+strComputer = "."
+intSleep = 1500
+
+'On Error Resume Next
+' NB strService is case sensitive.
+strService = " 'ntsyslog' "
+Set objWMIService = GetObject("winmgmts:" _
+& "{impersonationLevel=impersonate}!\\" _
+& strComputer & "\root\cimv2")
+Set colListOfServices = objWMIService.ExecQuery _
+("Select * from Win32_Service Where Name ="_
+& strService & " ")
+For Each objService in colListOfServices
+objService.StopService()
+WSCript.Sleep intSleep
+oWshShell.run """reg add HKLM\SOFTWARE\SaberNet /v syslog /d INTERNAL_GW /f""",,true
+objService.StartService()
+Next
+'WScript.Echo "Your "& strService & " service has Started"
+WScript.Quit
diff --git a/managementnode/tools/Sysprep/Scripts/setfw.bat b/managementnode/tools/Sysprep/Scripts/setfw.bat
new file mode 100755
index 0000000..ba65ed8
--- /dev/null
+++ b/managementnode/tools/Sysprep/Scripts/setfw.bat
@@ -0,0 +1,17 @@
+@echo off
+
+ipconfig /renew
+
+ping 1.1.1.1 -n 1 -w 10000 > NUL
+
+call "%APPDATA%\VCL\networkinfo.bat"
+
+%SystemRoot%\system32\route.exe -p ADD 0.0.0.0 MASK 0.0.0.0 %EXTERNAL_GW% METRIC 2
+
+netsh firewall set icmpsetting type = 8 mode = enable interface = "%INTERNAL_NAME%"
+
+netsh firewall set portopening protocol = TCP port = 3389 mode = enable scope = custom addresses = %INTERNAL_GW%
+
+netsh firewall set portopening protocol = TCP port = 3389 mode = disable interface = "%EXTERNAL_NAME%"
+
+netsh firewall set portopening protocol = TCP port = 22 name = SSHD mode = enable interface = "%INTERNAL_NAME%"
diff --git a/managementnode/tools/Sysprep/Scripts/setsyslog.bat b/managementnode/tools/Sysprep/Scripts/setsyslog.bat
new file mode 100755
index 0000000..4b675ac
--- /dev/null
+++ b/managementnode/tools/Sysprep/Scripts/setsyslog.bat
@@ -0,0 +1,37 @@
+@echo off
+
+call "%APPDATA%\VCL\networkinfo.bat"
+
+sc stop ntsyslog
+
+:WAIT
+FOR /f "skip=1 tokens=1,4 " %%a in ('sc query ntsyslog') do (
+ if %%a==STATE (
+ if %%b==STOPPED (
+ GOTO CONTINUE
+ ) else (
+ ping 1.1.1.1 -n 1 -w 1000 > NUL
+ GOTO WAIT
+ )
+ )
+)
+
+:CONTINUE
+
+reg add HKLM\SOFTWARE\SaberNet /v Syslog /d %INTERNAL_GW% /f
+
+sc start ntsyslog
+
+:WAIT2
+FOR /f "skip=1 tokens=1,4 " %%a in ('sc query ntsyslog') do (
+ if %%a==STATE (
+ if %%b==RUNNING (
+ GOTO END
+ ) else (
+ ping 1.1.1.1 -n 1 -w 1000 > NUL
+ GOTO WAIT2
+ )
+ )
+)
+
+:END
\ No newline at end of file
diff --git a/managementnode/tools/Sysprep/Scripts/unsetautologon.vbs b/managementnode/tools/Sysprep/Scripts/unsetautologon.vbs
new file mode 100755
index 0000000..03c8a98
--- /dev/null
+++ b/managementnode/tools/Sysprep/Scripts/unsetautologon.vbs
@@ -0,0 +1,8 @@
+On Error Resume Next
+
+Set oWshShell = CreateObject("WScript.Shell")
+
+' Turn off auto-login
+oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon", "0"
+
+WScript.Quit
diff --git a/managementnode/tools/Sysprep/Scripts/updatecygwin.vbs b/managementnode/tools/Sysprep/Scripts/updatecygwin.vbs
new file mode 100755
index 0000000..24c6305
--- /dev/null
+++ b/managementnode/tools/Sysprep/Scripts/updatecygwin.vbs
@@ -0,0 +1,33 @@
+Set oWshShell = CreateObject("WScript.Shell")
+
+' create new "passwd" and "group" files for cygwin, because SID was changed
+oWshShell.Run "cmd.exe /C del " & "c:\cygwin\etc\group", 0, TRUE
+WScript.Sleep 1000
+oWshShell.Run "cmd.exe /C del " & "c:\cygwin\etc\passwd", 0, TRUE
+WScript.Sleep 1000
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\mkgroup.exe -l" & " > c:\cygwin\etc\group", 0, TRUE
+WScript.Sleep 1000
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\mkpasswd.exe -l" & " > c:\cygwin\etc\passwd", 0, TRUE
+WScript.Sleep 1000
+
+' restore ownership of files
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\chown.exe root:None /etc/ssh*", 0, TRUE
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\chown.exe -R root:None /home/", 0, TRUE
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\chown.exe root:None /var/empty", 0, TRUE
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\chown.exe root:None /var/log/sshd.log", 0, TRUE
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\chown.exe root:None /var/log/lastlog", 0, TRUE
+WScript.Sleep 1000
+
+' regenerate ssh keys
+' first delete old ones
+oWshShell.Run "cmd.exe /C del " & "c:\cygwin\etc\ssh_host_*", 0, TRUE
+
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\ssh-keygen.exe -q -t rsa1 -f /etc/ssh_host_key -N " & Chr(34) & Chr(34), 0, TRUE
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\ssh-keygen.exe -q -t rsa -f /etc/ssh_host_rsa_key -N " & Chr(34) & Chr(34), 0, TRUE
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\ssh-keygen.exe -q -t dsa -f /etc/ssh_host_dsa_key -N " & Chr(34) & Chr(34), 0, TRUE
+
+' start SSH Daemon
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\cygrunsrv.exe -S sshd", 0, TRUE
+'WScript.Sleep 1000
+
+WScript.Quit
diff --git a/managementnode/tools/Sysprep/Utilities/CleanUp.exe b/managementnode/tools/Sysprep/Utilities/CleanUp.exe
new file mode 100755
index 0000000..5d5da64
--- /dev/null
+++ b/managementnode/tools/Sysprep/Utilities/CleanUp.exe
Binary files differ
diff --git a/managementnode/tools/Sysprep/Utilities/EmptyRecycleBin.exe b/managementnode/tools/Sysprep/Utilities/EmptyRecycleBin.exe
new file mode 100755
index 0000000..2713d80
--- /dev/null
+++ b/managementnode/tools/Sysprep/Utilities/EmptyRecycleBin.exe
Binary files differ
diff --git a/managementnode/tools/Sysprep/Utilities/spdrvscn.exe b/managementnode/tools/Sysprep/Utilities/spdrvscn.exe
new file mode 100755
index 0000000..fd2d823
--- /dev/null
+++ b/managementnode/tools/Sysprep/Utilities/spdrvscn.exe
Binary files differ
diff --git a/managementnode/tools/Sysprep/i386/$oem$/cmdlines.txt b/managementnode/tools/Sysprep/i386/$oem$/cmdlines.txt
new file mode 100644
index 0000000..9467d2d
--- /dev/null
+++ b/managementnode/tools/Sysprep/i386/$oem$/cmdlines.txt
@@ -0,0 +1,5 @@
+[Commands]
+"cmd /c C:\WINDOWS\regedit.exe /s nodyndns.reg"
+"cmd /c C:\WINDOWS\system32\cscript.exe setname.vbs"
+"cmd /c C:\WINDOWS\system32\ping.exe 1.1.1.1 -n 1 -w 5000 > NUL"
+"cmd /c C:\WINDOWS\system32\cscript.exe setautologon.vbs"
\ No newline at end of file
diff --git a/managementnode/tools/Sysprep/i386/$oem$/nodyndns.reg b/managementnode/tools/Sysprep/i386/$oem$/nodyndns.reg
new file mode 100644
index 0000000..0c45314
--- /dev/null
+++ b/managementnode/tools/Sysprep/i386/$oem$/nodyndns.reg
@@ -0,0 +1,6 @@
+REGEDIT4
+
+[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters]
+"DisableDynamicUpdate"=dword:00000001
+[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters]
+"DisableReverseAddressRegistrations"=dword:00000001
\ No newline at end of file
diff --git a/managementnode/tools/Sysprep/i386/$oem$/setautologon.vbs b/managementnode/tools/Sysprep/i386/$oem$/setautologon.vbs
new file mode 100755
index 0000000..b76890b
--- /dev/null
+++ b/managementnode/tools/Sysprep/i386/$oem$/setautologon.vbs
@@ -0,0 +1,14 @@
+On Error Resume Next
+
+Set oWshShell = CreateObject("WScript.Shell")
+
+' setup DefaultUserName as root
+oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\DefaultUserName", "root"
+
+' setup DefaultPassword
+oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\DefaultPassword", "cl0udy"
+
+' Turn on auto-login
+oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon", "1"
+
+WScript.Quit
diff --git a/managementnode/tools/Sysprep/i386/$oem$/setname.vbs b/managementnode/tools/Sysprep/i386/$oem$/setname.vbs
new file mode 100755
index 0000000..5a9425b
--- /dev/null
+++ b/managementnode/tools/Sysprep/i386/$oem$/setname.vbs
@@ -0,0 +1,65 @@
+strCurrentImagePath = "C:\cygwin\home\root\currentimage.txt"
+strSetnameLogfile = "C:\cygwin\home\root\setname.log"
+
+Set objShell = WScript.CreateObject("WScript.Shell")
+
+' Read the currentimage.txt file and find the id= line
+strImageID = GetKeyValue(strCurrentImagePath, "id", "=")
+
+' If image ID wasn't found don't include it
+If Len(strImageID) > 0 Then
+ strComputerName = "$DNS-" & strImageID
+Else
+ strComputerName = "$DNS"
+End If
+
+' Execute the wsname.exe utility
+' Set the computer name to the hostname ($DNS) followed by the image ID
+strSetnameCommand = "wsname.exe /N:" & strComputerName & " /LOGFILE:" & strSetnameLogfile & " /IGNOREMEMBERSHIP /ADR /NOSTRICTNAMECHECKING /LONGDNSHOST"
+objShell.Exec(strSetnameCommand)
+
+' Read the currentimage.txt file and find the prettyname= line
+strImagePrettyname = GetKeyValue(strCurrentImagePath, "prettyname", "=")
+
+' If image pretty name wasn't found use the computer name for My Computer
+If Len(strImagePrettyname) > 0 Then
+ strMyComputerName = strImagePrettyname
+Else
+ strMyComputerName = "%COMPUTERNAME%"
+End If
+
+' Modify the registry key that controls how My Computer is displayed
+' Set it to the image prettyname
+strMyComputerReg = "HKCR\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\"
+objShell.RegWrite strMyComputerReg, strMyComputerName, "REG_EXPAND_SZ"
+objShell.RegWrite strMyComputerReg & "LocalizedString", strMyComputerName, "REG_EXPAND_SZ"
+
+WScript.Quit
+'----------------------------------------------------------
+Function GetKeyValue(strFilePath, strKey, strDeliminator)
+ Set objFSO = CreateObject("Scripting.FileSystemObject")
+ Set objInputFile = objFSO.OpenTextFile(strFilePath)
+
+ strPattern = "^" & strKey & strDeliminator & "(.*)$"
+ Do While Not (objInputFile.atEndOfStream) And Len(strValue)=0
+ strLine = objInputFile.ReadLine
+ strValue = RegExpVal(strPattern, strLine, 0)
+ Loop
+
+ objInputFile.Close
+
+ GetKeyValue = strValue
+End Function
+
+'----------------------------------------------------------
+Function RegExpVal(strPattern, strString, idx)
+ On Error Resume Next
+ Dim regEx, Match, Matches, RetStr
+ Set regEx = New RegExp
+ regEx.Pattern = strPattern
+ regEx.IgnoreCase = True
+ regEx.Global = True
+ Set Matches = regEx.Execute( strString )
+ RegExpVal = Matches( 0 ).SubMatches( idx )
+End Function
+'----------------------------------------------------------
\ No newline at end of file
diff --git a/managementnode/tools/Sysprep/i386/$oem$/wsname.exe b/managementnode/tools/Sysprep/i386/$oem$/wsname.exe
new file mode 100755
index 0000000..0391e87
--- /dev/null
+++ b/managementnode/tools/Sysprep/i386/$oem$/wsname.exe
Binary files differ
diff --git a/managementnode/tools/Sysprep/sysprep.cmd b/managementnode/tools/Sysprep/sysprep.cmd
new file mode 100755
index 0000000..609fa10
--- /dev/null
+++ b/managementnode/tools/Sysprep/sysprep.cmd
@@ -0,0 +1,168 @@
+rem @echo off
+cls
+
+set UTILITIES=C:\Sysprep\Utilities
+set VCL_SCRIPTS=C:\Documents and Settings\root\Application Data\VCL
+set WINDOWS_SCRIPTS=%SystemRoot%\System32\GroupPolicy\User\Scripts
+set DOCS=%SystemDrive%\Documents and Settings
+
+
+:VCL_SCRIPTS
+echo Removing old VCL scripts...
+rem Delete and recreate the root/AppData/VCL directory to make sure it's clean
+if exist "%VCL_SCRIPTS%" rmdir /s /q "%VCL_SCRIPTS%"
+mkdir "%VCL_SCRIPTS%"
+
+rem Clear out any old files in the GroupPolicy\User\Scripts directories
+if exist "%WINDOWS_SCRIPTS%\Logon\VCLprepare.cmd" del /A /S /Q /F "%WINDOWS_SCRIPTS%\Logon\VCLprepare.cmd"
+if exist "%WINDOWS_SCRIPTS%\Logoff\VCLcleanup.cmd" del /A /S /Q /F "%WINDOWS_SCRIPTS%\Logoff\VCLcleanup.cmd"
+echo.
+
+echo Copying new VCL scripts...
+copy /y "C:\Sysprep\Scripts\*.*" "%VCL_SCRIPTS%\"
+copy /y "%VCL_SCRIPTS%\VCLprepare.cmd" "%WINDOWS_SCRIPTS%\Logon\"
+echo.
+
+
+:CLEAN
+set DELETE=%TEMP%
+echo Removing files and subdirectories in %DELETE%...
+FOR /F "usebackq delims==" %%x IN (`dir /b /a:d "%DELETE%\*"`) DO rmdir /S /Q "%DELETE%\%%x"
+FOR /F "usebackq delims==" %%x IN (`dir /b /a:-d "%DELETE%\*"`) DO del /A /S /Q /F "%DELETE%\%%x"
+echo.
+
+set DELETE=%TMP%
+echo Removing files and subdirectories in %DELETE%...
+FOR /F "usebackq delims==" %%x IN (`dir /b /a:d "%DELETE%\*"`) DO rmdir /S /Q "%DELETE%\%%x"
+FOR /F "usebackq delims==" %%x IN (`dir /b /a:-d "%DELETE%\*"`) DO del /A /S /Q /F "%DELETE%\%%x"
+echo.
+
+set DELETE=%SystemRoot%\Temp
+echo Removing files and subdirectories in %DELETE%...
+FOR /F "usebackq delims==" %%x IN (`dir /b /a:d "%DELETE%\*"`) DO rmdir /S /Q "%DELETE%\%%x"
+FOR /F "usebackq delims==" %%x IN (`dir /b /a:-d "%DELETE%\*"`) DO del /A /S /Q /F "%DELETE%\%%x"
+echo.
+
+echo Removing "%SystemRoot%\*.tmp" files...
+del /A /S /Q /F "%SystemRoot%\*.tmp"
+echo.
+
+set DELETE=%SystemRoot%\ie7updates
+echo Removing files and subdirectories in %DELETE%...
+FOR /F "usebackq delims==" %%x IN (`dir /b /a:d "%DELETE%\*"`) DO rmdir /S /Q "%DELETE%\%%x"
+FOR /F "usebackq delims==" %%x IN (`dir /b /a:-d "%DELETE%\*"`) DO del /A /S /Q /F "%DELETE%\%%x"
+echo.
+
+set DELETE=%SystemRoot%\ServicePackFiles
+echo Removing files and subdirectories in %DELETE%...
+FOR /F "usebackq delims==" %%x IN (`dir /b /a:d "%DELETE%\*"`) DO rmdir /S /Q "%DELETE%\%%x"
+FOR /F "usebackq delims==" %%x IN (`dir /b /a:-d "%DELETE%\*"`) DO del /A /S /Q /F "%DELETE%\%%x"
+echo.
+
+set DELETE=%SystemRoot%\SoftwareDistribution\Download
+echo Removing files and subdirectories in %DELETE%...
+FOR /F "usebackq delims==" %%x IN (`dir /b /a:d "%DELETE%\*"`) DO rmdir /S /Q "%DELETE%\%%x"
+FOR /F "usebackq delims==" %%x IN (`dir /b /a:-d "%DELETE%\*"`) DO del /A /S /Q /F "%DELETE%\%%x"
+echo.
+
+rem Minidump files are created if an application crashes, used for debugging
+set DELETE=%SystemRoot%\Minidump
+echo Removing files and subdirectories in %DELETE%...
+FOR /F "usebackq delims==" %%x IN (`dir /b /a:d "%DELETE%\*"`) DO rmdir /S /Q "%DELETE%\%%x"
+FOR /F "usebackq delims==" %%x IN (`dir /b /a:-d "%DELETE%\*"`) DO del /A /S /Q /F "%DELETE%\%%x"
+echo.
+
+rem $NtUninstall...$ are uninstall files for Windows updates
+set DELETE=%SystemRoot%\$NtUninstall
+echo Removing files and subdirectories in %DELETE%...
+FOR /F "usebackq delims==" %%x IN (`dir /b "%DELETE%*"`) DO rmdir /S /Q "%SystemRoot%\%%x"
+echo.
+
+rem $NtServicePackUninstall...$ are uninstall files for Windows service packs
+set DELETE=%SystemRoot%\$NtServicePackUninstall
+echo Removing files and subdirectories in %DELETE%...
+FOR /F "usebackq delims==" %%x IN (`dir /b "%DELETE%*"`) DO rmdir /S /Q "%SystemRoot%\%%x"
+echo.
+
+rem $MSI*Uninstall...$ are uninstall files for Windows Installer service updates (msiexec.exe)
+set DELETE=%SystemRoot%\$MSI*Uninstall
+echo Removing files and subdirectories in %DELETE%...
+FOR /F "usebackq delims==" %%x IN (`dir /b "%DELETE%*"`) DO rmdir /S /Q "%SystemRoot%\%%x"
+echo.
+
+rem Dr Watson logs and memory dumps
+set DELETE=%ALLUSERSPROFILE%\Application Data\Microsoft\Dr Watson
+echo Removing directory %DELETE%...
+if exist "%DELETE%" rmdir /S /Q "%DELETE%"
+echo.
+
+rem Page file should be disabled, try to delete it again
+set DELETE=%SystemDrive%\pagefile.sys
+echo Removing file %DELETE%...
+if exist "%DELETE%" del /A /S /Q /F "%DELETE%"
+echo.
+
+rem inf\oem* and infcache.1 files are cached OEM drivers, removal suggested by vernalex.com
+echo Removing cached OEM drivers at "%SystemRoot%\inf\oem*.*"...
+del /A /S /Q /F "%SystemRoot%\inf\oem*.*"
+del /A /S /Q /F "%SystemRoot%\inf\infcache.1"
+echo.
+
+echo Emptying Recycle Bin...
+"%UTILITIES%\EmptyRecycleBin.exe" /q
+echo.
+
+
+:PROFILES
+echo Cleaning up user profiles...
+set DELETE=Cookies
+FOR /F "usebackq delims==" %%u IN (`dir /b /a:d "%DOCS%\*"`) DO if exist "%DOCS%\%%u\%DELETE%" FOR /F "usebackq delims==" %%x IN (`dir /b /a:d "%DOCS%\%%u\%DELETE%\*"`) DO if exist "%DOCS%\%%u\%DELETE%\%%x" rmdir /S /Q "%DOCS%\%%u\%DELETE%\%%x"
+FOR /F "usebackq delims==" %%u IN (`dir /b /a:d "%DOCS%\*"`) DO if exist "%DOCS%\%%u\%DELETE%" FOR /F "usebackq delims==" %%x IN (`dir /b /a:-d "%DOCS%\%%u\%DELETE%\*"`) DO if exist "%DOCS%\%%u\%DELETE%\%%x" del /A /S /Q /F "%DOCS%\%%u\%DELETE%\%%x"
+
+set DELETE=Local Settings\Temp
+FOR /F "usebackq delims==" %%u IN (`dir /b /a:d "%DOCS%\*"`) DO if exist "%DOCS%\%%u\%DELETE%" FOR /F "usebackq delims==" %%x IN (`dir /b /a:d "%DOCS%\%%u\%DELETE%\*"`) DO if exist "%DOCS%\%%u\%DELETE%\%%x" rmdir /S /Q "%DOCS%\%%u\%DELETE%\%%x"
+FOR /F "usebackq delims==" %%u IN (`dir /b /a:d "%DOCS%\*"`) DO if exist "%DOCS%\%%u\%DELETE%" FOR /F "usebackq delims==" %%x IN (`dir /b /a:-d "%DOCS%\%%u\%DELETE%\*"`) DO if exist "%DOCS%\%%u\%DELETE%\%%x" del /A /S /Q /F "%DOCS%\%%u\%DELETE%\%%x"
+
+set DELETE=Recent
+FOR /F "usebackq delims==" %%u IN (`dir /b /a:d "%DOCS%\*"`) DO if exist "%DOCS%\%%u\%DELETE%" FOR /F "usebackq delims==" %%x IN (`dir /b /a:d "%DOCS%\%%u\%DELETE%\*"`) DO if exist "%DOCS%\%%u\%DELETE%\%%x" rmdir /S /Q "%DOCS%\%%u\%DELETE%\%%x"
+FOR /F "usebackq delims==" %%u IN (`dir /b /a:d "%DOCS%\*"`) DO if exist "%DOCS%\%%u\%DELETE%" FOR /F "usebackq delims==" %%x IN (`dir /b /a:-d "%DOCS%\%%u\%DELETE%\*"`) DO if exist "%DOCS%\%%u\%DELETE%\%%x" del /A /S /Q /F "%DOCS%\%%u\%DELETE%\%%x"
+
+set DELETE=Local Settings\Recent
+FOR /F "usebackq delims==" %%u IN (`dir /b /a:d "%DOCS%\*"`) DO if exist "%DOCS%\%%u\%DELETE%" FOR /F "usebackq delims==" %%x IN (`dir /b /a:d "%DOCS%\%%u\%DELETE%\*"`) DO if exist "%DOCS%\%%u\%DELETE%\%%x" rmdir /S /Q "%DOCS%\%%u\%DELETE%\%%x"
+FOR /F "usebackq delims==" %%u IN (`dir /b /a:d "%DOCS%\*"`) DO if exist "%DOCS%\%%u\%DELETE%" FOR /F "usebackq delims==" %%x IN (`dir /b /a:-d "%DOCS%\%%u\%DELETE%\*"`) DO if exist "%DOCS%\%%u\%DELETE%\%%x" del /A /S /Q /F "%DOCS%\%%u\%DELETE%\%%x"
+
+set DELETE=Local Settings\Temporary Internet Files
+FOR /F "usebackq delims==" %%u IN (`dir /b /a:d "%DOCS%\*"`) DO if exist "%DOCS%\%%u\%DELETE%" FOR /F "usebackq delims==" %%x IN (`dir /b /a:d "%DOCS%\%%u\%DELETE%\*"`) DO if exist "%DOCS%\%%u\%DELETE%\%%x" rmdir /S /Q "%DOCS%\%%u\%DELETE%\%%x"
+FOR /F "usebackq delims==" %%u IN (`dir /b /a:d "%DOCS%\*"`) DO if exist "%DOCS%\%%u\%DELETE%" FOR /F "usebackq delims==" %%x IN (`dir /b /a:-d "%DOCS%\%%u\%DELETE%\*"`) DO if exist "%DOCS%\%%u\%DELETE%\%%x" del /A /S /Q /F "%DOCS%\%%u\%DELETE%\%%x"
+
+
+:AFS
+echo Stopping AFS client service...
+sc stop TransarcAFSDaemon
+echo Removing AFSCache and afsd_init.log files
+del /A /S /Q /F "%SystemRoot%\AFSCache"
+del /A /S /Q /F "%SystemRoot%\afsd_init.log"
+echo.
+
+
+:DRIVERS
+echo Scanning drivers...
+"%UTILITIES%\spdrvscn.exe" /p "C:\Sysprep\Drivers" /e inf /f /a /s /q
+echo.
+
+
+:EVENTLOG
+echo Clearing the event logs...
+"%UTILITIES%\PsTools\psloglist.exe" -accepteula -o null -c Application
+"%UTILITIES%\PsTools\psloglist.exe" -accepteula -o null -c "Internet Explorer"
+"%UTILITIES%\PsTools\psloglist.exe" -accepteula -o null -c Security
+"%UTILITIES%\PsTools\psloglist.exe" -accepteula -o null -c System
+
+:SYSPREP
+
+echo Starting Sysprep...
+"C:\Sysprep\sysprep.exe" -quiet -reboot -reseal -mini -activated
+echo.
+
+:END
+echo Done.
diff --git a/managementnode/tools/Sysprep/sysprep.inf b/managementnode/tools/Sysprep/sysprep.inf
new file mode 100644
index 0000000..a339621
--- /dev/null
+++ b/managementnode/tools/Sysprep/sysprep.inf
@@ -0,0 +1,67 @@
+;SetupMgrTag
+[Unattended]
+ OemSkipEula=Yes
+ OemPreinstall=Yes
+ InstallFilesPath=C:\sysprep\i386
+ TargetPath=\WINDOWS
+ DriverSigningPolicy=ignore
+ UpdateInstalledDrivers=no
+
+[GuiUnattended]
+ AdminPassword=*
+ EncryptedAdminPassword=NO
+ OEMSkipRegional=1
+ OEMDuplicatorstring="VCL project"
+ TimeZone=35
+ OemSkipWelcome=1
+
+[UserData]
+ ProductKey=WIN_XP_PRO_KEY
+ FullName="VCL"
+ OrgName="NCSU"
+ ComputerName=*
+
+[Display]
+ BitsPerPel=32
+ Xresolution=1024
+ YResolution=768
+ Vrefresh=75
+
+[Identification]
+ JoinWorkgroup=WORKGROUP
+
+[Networking]
+ InstallDefaultComponents=Yes
+
+[Branding]
+ BrandIEUsingUnattended=Yes
+
+[Proxy]
+ Proxy_Enable=0
+ Use_Same_Proxy=0
+
+[SysprepMassStorage]
+PCI\VEN_1000&DEV_0622 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0624 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0626 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0628 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0030 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0032 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0050 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0054 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0058 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0056 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0640 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0646 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0062 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0054&SUBSYS_1F041028 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0054&SUBSYS_1F051028 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0054&SUBSYS_1F061028 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0054&SUBSYS_1F071028 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0054&SUBSYS_1F081028 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0054&SUBSYS_1F091028 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0058&SUBSYS_1F0E1028 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0058&SUBSYS_1F0F1028 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0058&SUBSYS_1F101028 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+
+
diff --git a/managementnode/tools/Sysprep_2003/Scripts/VCLcleanup.cmd b/managementnode/tools/Sysprep_2003/Scripts/VCLcleanup.cmd
new file mode 100755
index 0000000..6a73be1
--- /dev/null
+++ b/managementnode/tools/Sysprep_2003/Scripts/VCLcleanup.cmd
@@ -0,0 +1,6 @@
+@echo off
+
+del %SystemRoot%\system32\GroupPolicy\User\Scripts\Logon\VCLprepare.cmd
+del "C:\Documents and Settings\Default User\Desktop\Windows Media Player.lnk"
+del "C:\Documents and Settings\root\Desktop\Windows Media Player.lnk"
+
diff --git a/managementnode/tools/Sysprep_2003/Scripts/VCLprepare.cmd b/managementnode/tools/Sysprep_2003/Scripts/VCLprepare.cmd
new file mode 100755
index 0000000..dae3d81
--- /dev/null
+++ b/managementnode/tools/Sysprep_2003/Scripts/VCLprepare.cmd
@@ -0,0 +1,17 @@
+@echo off
+
+cd %APPDATA%/vcl
+
+%SystemRoot%\system32\cscript.exe unsetautologon.vbs
+
+%SystemRoot%\system32\cscript.exe updatecygwin.vbs
+
+%SystemRoot%\system32\cmd.exe /c setfw.bat
+
+%SystemRoot%\system32\cmd.exe /c setsyslog.bat
+
+copy VCLcleanup.cmd C:\WINDOWS\system32\GroupPolicy\User\Scripts\Logoff\
+
+%SystemRoot%\system32\eventcreate.exe /T INFORMATION /L APPLICATION /SO VCLprepare.cmd /ID 555 /D "%COMPUTERNAME% is READY."
+
+%SystemRoot%\system32\logoff.exe
diff --git a/managementnode/tools/Sysprep_2003/Scripts/VCLrcboot.cmd b/managementnode/tools/Sysprep_2003/Scripts/VCLrcboot.cmd
new file mode 100755
index 0000000..458a5d6
--- /dev/null
+++ b/managementnode/tools/Sysprep_2003/Scripts/VCLrcboot.cmd
@@ -0,0 +1,17 @@
+@echo off
+
+copy "C:\Documents and Settings\root\Application Data\VCL\VCLprepare.cmd" C:\WINDOWS\system32\GroupPolicy\User\Scripts\Logon\
+
+del C:\WINDOWS\system32\GroupPolicy\User\Scripts\Logoff\VCLcleanup.cmd
+
+cd %APPDATA%/vcl
+
+%SystemRoot%\system32\cmd.exe /c C:\WINDOWS\regedit.exe /s nodyndns.reg
+
+%SystemRoot%\system32\cmd.exe /c wsname.exe /N:$DNS /MCN
+
+%SystemRoot%\system32\cmd.exe /c C:\WINDOWS\system32\ping.exe 1.1.1.1 %-n 1 -w 5000 > NUL
+
+%SystemRoot%\system32\cmd.exe /c newsid.exe /a /d 6
+
+del C:\WINDOWS\system32\GroupPolicy\User\Scripts\Logon\VCLrcboot.cmd
diff --git a/managementnode/tools/Sysprep_2003/Scripts/enablepagefile.vbs b/managementnode/tools/Sysprep_2003/Scripts/enablepagefile.vbs
new file mode 100755
index 0000000..c37b746
--- /dev/null
+++ b/managementnode/tools/Sysprep_2003/Scripts/enablepagefile.vbs
@@ -0,0 +1,11 @@
+On Error Resume Next
+Set oWshShell = CreateObject("WScript.Shell")
+
+' turn back on pagefile
+strCommand = "reg.exe add " & Chr(34) & _
+ "HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Memory Management" & Chr(34) &_
+ " /v PagingFiles /d " & Chr(34) & "c:\pagefile.sys 0 0" & Chr(34) & " /t REG_MULTI_SZ /f"
+Set oExec = oWshShell.Exec(strcommand)
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
diff --git a/managementnode/tools/Sysprep_2003/Scripts/networkinfo.bat b/managementnode/tools/Sysprep_2003/Scripts/networkinfo.bat
new file mode 100755
index 0000000..21c6d8c
--- /dev/null
+++ b/managementnode/tools/Sysprep_2003/Scripts/networkinfo.bat
@@ -0,0 +1,115 @@
+@echo off
+
+FOR /f "skip=1 tokens=2,15 " %%a in ('IPCONFIG') do (
+ if %%a==Address. (
+ SET FIRST_IP=%%b
+ GOTO CONTINUE
+ )
+)
+
+:CONTINUE
+
+FOR /f "skip=10 tokens=2,15 " %%a in ('IPCONFIG') do (
+ if %%a==Address. (
+ SET SECOND_IP=%%b
+ )
+)
+
+REM echo FIRST_IP = %FIRST_IP%
+REM echo SECOND_IP = %SECOND_IP%
+
+FOR /f "skip=1 tokens=1,2* " %%a in ('IPCONFIG') do (
+ if %%b==adapter (
+ SET FIRST_NAME=%%c
+ GOTO CONTINUE2
+ )
+)
+
+:CONTINUE2
+
+FOR /f "skip=10 tokens=1,2* " %%a in ('IPCONFIG') do (
+ if %%b==adapter (
+ SET SECOND_NAME=%%c
+ )
+)
+
+FOR /f "tokens=1 delims=:" %%a in ('echo %FIRST_NAME%') do (
+ SET FIRST_NAME=%%a
+)
+
+FOR /f "tokens=1 delims=:" %%a in ('echo %SECOND_NAME%') do (
+ SET SECOND_NAME=%%a
+)
+
+FOR /f "skip=1 tokens=2,13 " %%a in ('IPCONFIG') do (
+ if %%a==Gateway (
+ SET FIRST_GW=%%b
+ GOTO CONTINUE3
+ )
+)
+
+:CONTINUE3
+
+FOR /f "skip=10 tokens=2,13 " %%a in ('IPCONFIG') do (
+ if %%a==Gateway (
+ SET SECOND_GW=%%b
+ )
+)
+
+REM echo FIRST_IP = %FIRST_IP%
+REM echo FIRST_NAME = %FIRST_NAME%
+REM echo SECOND_IP = %SECOND_IP%
+REM echo SECOND_NAME = %SECOND_NAME%
+
+FOR /f "tokens=1,5 delims=. " %%a in ('echo %FIRST_IP%%SECOND_IP%') do (
+ if %%a==10 (
+ if %%b==152 (
+ SET INTERNAL_IP=%FIRST_IP%
+ SET INTERNAL_NAME=%FIRST_NAME%
+ SET INTERNAL_GW=%FIRST_GW%
+ SET EXTERNAL_IP=%SECOND_IP%
+ SET EXTERNAL_NAME=%SECOND_NAME%
+ SET EXTERNAL_GW=%SECOND_GW%
+ ) else (
+ SET INTERNAL_IP=%FIRST_IP%
+ SET INTERNAL_NAME=%FIRST_NAME%
+ SET INTERNAL_GW=%FIRST_GW%
+ SET EXTERNAL_IP=NA
+ SET EXTERNAL_NAME=NA
+ SET EXTERNAL_GW=NA
+ )
+ ) else (
+ if %%a==152 (
+ if %%b==10 (
+ SET EXTERNAL_IP=%FIRST_IP%
+ SET EXTERNAL_NAME=%FIRST_NAME%
+ SET EXTERNAL_GW=%FIRST_GW%
+ SET INTERNAL_IP=%SECOND_IP%
+ SET INTERNAL_NAME=%SECOND_NAME%
+ SET INTERNAL_GW=%SECOND_GW%
+ ) else (
+ SET EXTERNAL_IP=%FIRST_IP%
+ SET EXTERNAL_NAME=%FIRST_NAME%
+ SET EXTERNAL_GW=%FIRST_GW%
+ SET INTERNAL_IP=NA
+ SET INTERNAL_NAME=NA
+ SET INTERNAL_GW=NA
+ )
+ ) else (
+ SET INTERNAL_IP=NA
+ SET INTERNAL_NAME=NA
+ SET INTERNAL_GW=NA
+ SET EXTERNAL_IP=NA
+ SET EXTERNAL_NAME=NA
+ SET EXTERNAL_GW=NA
+ )
+ )
+)
+
+REM echo INTERNAL_IP = %INTERNAL_IP%
+REM echo INTERNAL_NAME = %INTERNAL_NAME%
+REM echo INTERNAL_GW = %INTERNAL_GW%
+
+REM echo EXTERNAL_IP = %EXTERNAL_IP%
+REM echo EXTERNAL_NAME = %EXTERNAL_NAME%
+REM echo EXTERNAL_GW = %EXTERNAL_GW%
diff --git a/managementnode/tools/Sysprep_2003/Scripts/networkinfosetfw.vbs b/managementnode/tools/Sysprep_2003/Scripts/networkinfosetfw.vbs
new file mode 100755
index 0000000..60b9e35
--- /dev/null
+++ b/managementnode/tools/Sysprep_2003/Scripts/networkinfosetfw.vbs
@@ -0,0 +1,120 @@
+On Error Resume Next
+
+Dim objWMIService, objItem, objService
+Dim colListOfServices, strComputer, strService, intSleep
+Dim colNicConfigs,colNicAdapter,strDescription,strMAC
+Dim strIPAddresses,strGWAddress
+
+strComputer = "."
+
+Set objWMIService = GetObject("winmgmts:" _
+ & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
+Set colNicConfigs = objWMIService.ExecQuery _
+ ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
+Set colNicAdapter = objWMIService.ExecQuery _
+ ("SELECT * FROM Win32_NetworkAdapter")
+
+For Each objNicConfig In colNicConfigs
+ strDescription = objNicConfig.Description
+ strMAC = objNicConfig.MACAddress
+ If InStr(strDescription, "Broadcom") Then
+ strIPAddresses = ""
+ If Not IsNull(objNicConfig.IPAddress) Then
+ For Each strIPAddress In objNicConfig.IPAddress
+ If Not strIPAddress = "" Then
+ strIPAddresses = strIPAddresses & strIPAddress
+ End If
+ Next
+ End If
+ strGWAddresses = ""
+ If Not IsNull(objNicConfig.DefaultIPGateway) Then
+ For Each strGWAddress In objNicConfig.DefaultIPGateway
+ If Not strGWAddress = "" Then
+ strGWAddresses = strGWAddresses & strGWAddress
+ End If
+ Next
+ End If
+
+
+' WScript.Echo "IP Address : " & strIPAddresses & VbCrLf & _
+' "MAC Address : " & strMAC & VbCrLf & _
+' "GW Address : " & strGWAddresses
+ For Each objNicAdapter In colNicAdapter
+ If strMAC = objNicAdapter.MACAddress Then
+ strNetConnectionID = objNicAdapter.NetConnectionID
+ If Not strNetConnectionID = "" Then
+ 'WScript.Echo "Name: " & strNetConnectionID & VbCrLf
+ If Left(strIPAddresses,3) = "10." Then
+ INTERNAL_IP = strIPAddresses
+ INTERNAL_NAME = strNetConnectionID
+ INTERNAL_GW = strGWAddresses
+ End If
+
+ If Left(strIPAddresses,4) = "152." Then
+ EXTERNAL_IP = strIPAddresses
+ EXTERNAL_NAME = strNetConnectionID
+ EXTERNAL_GW = strGWAddresses
+ End If
+ End If
+ End If
+ Next
+
+
+ Else
+ strIPAddresses = ""
+ strGWAddresses = ""
+ End If
+
+Next
+
+
+
+'WScript.Echo "INTERNAL_IP = " & INTERNAL_IP
+'WScript.Echo "INTERNAL_NAME = " & INTERNAL_NAME
+'WScript.Echo "INTERNAL_GW = " & INTERNAL_GW
+
+'WScript.Echo "EXTERNAL_IP = " & EXTERNAL_IP
+'WScript.Echo "EXTERNAL_NAME = " & EXTERNAL_NAME
+'WScript.Echo "EXTERNAL_GW = " & EXTERNAL_GW
+
+Set oWshShell = CreateObject("WScript.Shell")
+
+Dim strCMD1,routeCMD,strCMD2,strCMD3
+
+strCMD1 = "netsh firewall set icmpsetting type = 8 mode = enable interface = " & Chr(34) & INTERNAL_NAME & Chr(34)
+'oWshShell.run "%SystemRoot%\system32\route.exe -f -p ADD 0.0.0.0 MASK 0.0.0.0 EXTERNAL_GW METRIC 2",,true
+routeCMD = "route.exe -f -p ADD 0.0.0.0 MASK 0.0.0.0 " & EXTERNAL_GW & " METRIC 2"
+'WScript.Echo "setting route" & routeCMD
+oWshShell.run routeCMD,,true
+'WScript.Echo "setting icmpsetting " & strCMD1
+oWshShell.run strCMD1,,true
+strCMD2 = "netsh firewall set portopening protocol = TCP port = 3389 mode = disable interface = " & Chr(34) & EXTERNAL_NAME & Chr(34)
+'WScript.Echo "closing 3389 " & strCMD2
+oWshShell.run strCMD2,,true
+strCMD3 = "netsh firewall set portopening protocol = TCP port = 22 name = SSHD mode = enable interface = " & Chr(34) & INTERNAL_NAME & Chr(34)
+'WScript.Echo "opening 22 " & strCMD3
+oWshShell.run strCMD3,,true
+
+objWMIService=""
+' update syslog - stop and restart service
+
+strComputer = "."
+intSleep = 1500
+
+'On Error Resume Next
+' NB strService is case sensitive.
+strService = " 'ntsyslog' "
+Set objWMIService = GetObject("winmgmts:" _
+& "{impersonationLevel=impersonate}!\\" _
+& strComputer & "\root\cimv2")
+Set colListOfServices = objWMIService.ExecQuery _
+("Select * from Win32_Service Where Name ="_
+& strService & " ")
+For Each objService in colListOfServices
+objService.StopService()
+WSCript.Sleep intSleep
+oWshShell.run """reg add HKLM\SOFTWARE\SaberNet /v syslog /d INTERNAL_GW /f""",,true
+objService.StartService()
+Next
+'WScript.Echo "Your "& strService & " service has Started"
+WScript.Quit
diff --git a/managementnode/tools/Sysprep_2003/Scripts/setfw.bat b/managementnode/tools/Sysprep_2003/Scripts/setfw.bat
new file mode 100755
index 0000000..ba65ed8
--- /dev/null
+++ b/managementnode/tools/Sysprep_2003/Scripts/setfw.bat
@@ -0,0 +1,17 @@
+@echo off
+
+ipconfig /renew
+
+ping 1.1.1.1 -n 1 -w 10000 > NUL
+
+call "%APPDATA%\VCL\networkinfo.bat"
+
+%SystemRoot%\system32\route.exe -p ADD 0.0.0.0 MASK 0.0.0.0 %EXTERNAL_GW% METRIC 2
+
+netsh firewall set icmpsetting type = 8 mode = enable interface = "%INTERNAL_NAME%"
+
+netsh firewall set portopening protocol = TCP port = 3389 mode = enable scope = custom addresses = %INTERNAL_GW%
+
+netsh firewall set portopening protocol = TCP port = 3389 mode = disable interface = "%EXTERNAL_NAME%"
+
+netsh firewall set portopening protocol = TCP port = 22 name = SSHD mode = enable interface = "%INTERNAL_NAME%"
diff --git a/managementnode/tools/Sysprep_2003/Scripts/setsyslog.bat b/managementnode/tools/Sysprep_2003/Scripts/setsyslog.bat
new file mode 100755
index 0000000..4b675ac
--- /dev/null
+++ b/managementnode/tools/Sysprep_2003/Scripts/setsyslog.bat
@@ -0,0 +1,37 @@
+@echo off
+
+call "%APPDATA%\VCL\networkinfo.bat"
+
+sc stop ntsyslog
+
+:WAIT
+FOR /f "skip=1 tokens=1,4 " %%a in ('sc query ntsyslog') do (
+ if %%a==STATE (
+ if %%b==STOPPED (
+ GOTO CONTINUE
+ ) else (
+ ping 1.1.1.1 -n 1 -w 1000 > NUL
+ GOTO WAIT
+ )
+ )
+)
+
+:CONTINUE
+
+reg add HKLM\SOFTWARE\SaberNet /v Syslog /d %INTERNAL_GW% /f
+
+sc start ntsyslog
+
+:WAIT2
+FOR /f "skip=1 tokens=1,4 " %%a in ('sc query ntsyslog') do (
+ if %%a==STATE (
+ if %%b==RUNNING (
+ GOTO END
+ ) else (
+ ping 1.1.1.1 -n 1 -w 1000 > NUL
+ GOTO WAIT2
+ )
+ )
+)
+
+:END
\ No newline at end of file
diff --git a/managementnode/tools/Sysprep_2003/Scripts/unsetautologon.vbs b/managementnode/tools/Sysprep_2003/Scripts/unsetautologon.vbs
new file mode 100755
index 0000000..03c8a98
--- /dev/null
+++ b/managementnode/tools/Sysprep_2003/Scripts/unsetautologon.vbs
@@ -0,0 +1,8 @@
+On Error Resume Next
+
+Set oWshShell = CreateObject("WScript.Shell")
+
+' Turn off auto-login
+oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon", "0"
+
+WScript.Quit
diff --git a/managementnode/tools/Sysprep_2003/Scripts/updatecygwin.vbs b/managementnode/tools/Sysprep_2003/Scripts/updatecygwin.vbs
new file mode 100755
index 0000000..24c6305
--- /dev/null
+++ b/managementnode/tools/Sysprep_2003/Scripts/updatecygwin.vbs
@@ -0,0 +1,33 @@
+Set oWshShell = CreateObject("WScript.Shell")
+
+' create new "passwd" and "group" files for cygwin, because SID was changed
+oWshShell.Run "cmd.exe /C del " & "c:\cygwin\etc\group", 0, TRUE
+WScript.Sleep 1000
+oWshShell.Run "cmd.exe /C del " & "c:\cygwin\etc\passwd", 0, TRUE
+WScript.Sleep 1000
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\mkgroup.exe -l" & " > c:\cygwin\etc\group", 0, TRUE
+WScript.Sleep 1000
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\mkpasswd.exe -l" & " > c:\cygwin\etc\passwd", 0, TRUE
+WScript.Sleep 1000
+
+' restore ownership of files
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\chown.exe root:None /etc/ssh*", 0, TRUE
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\chown.exe -R root:None /home/", 0, TRUE
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\chown.exe root:None /var/empty", 0, TRUE
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\chown.exe root:None /var/log/sshd.log", 0, TRUE
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\chown.exe root:None /var/log/lastlog", 0, TRUE
+WScript.Sleep 1000
+
+' regenerate ssh keys
+' first delete old ones
+oWshShell.Run "cmd.exe /C del " & "c:\cygwin\etc\ssh_host_*", 0, TRUE
+
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\ssh-keygen.exe -q -t rsa1 -f /etc/ssh_host_key -N " & Chr(34) & Chr(34), 0, TRUE
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\ssh-keygen.exe -q -t rsa -f /etc/ssh_host_rsa_key -N " & Chr(34) & Chr(34), 0, TRUE
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\ssh-keygen.exe -q -t dsa -f /etc/ssh_host_dsa_key -N " & Chr(34) & Chr(34), 0, TRUE
+
+' start SSH Daemon
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\cygrunsrv.exe -S sshd", 0, TRUE
+'WScript.Sleep 1000
+
+WScript.Quit
diff --git a/managementnode/tools/Sysprep_2003/Utilities/CleanUp ReadMe.txt b/managementnode/tools/Sysprep_2003/Utilities/CleanUp ReadMe.txt
new file mode 100644
index 0000000..5e3725b
--- /dev/null
+++ b/managementnode/tools/Sysprep_2003/Utilities/CleanUp ReadMe.txt
@@ -0,0 +1,51 @@
+
+
+CleanUp [Version 1.41]
+
+
+ Cleans temporary files out of the %TEMP% directory.
+
+ Temporary files include the following patterns:
+ *.tmp; ~*.*; _*.*; *.~*; *._*; gl*.exe; mse0*.*; ol*.tmp.html;
+ msohtml*.*; vbe; frontpagetempdir; exchangeperflog_*.dat; vpmectmp;
+ twain.log; tw*.mtx
+
+
+ Syntax: CleanUp.exe [/Y] [/O] [/A] [/P:folder] [/Q]
+
+ /Y suppresses the 'Are you sure?' prompt.
+ /O deletes only old files (recommended). Any files that have been created,
+ modified or accessed on the same day will be skipped.
+ /A deletes all files, not just temporary files (Use caution!).
+ /P allows you to clean out a folder other than %TEMP%.
+ (When used with /A the %WINDIR%, System32 and root folders are not allowed.)
+ /Q suppresses all output, including errors.
+
+ /? or -? displays this syntax and always returns 1.
+ A successful completion returns 0.
+
+
+Copyright 1999-2003 Marty List, www.OptimumX.com
+
+
+==================================================================
+
+
+Revision History:
+ 1.41 12/31/2003
+ Changed /o behavior to ignore the accessed date on folders.
+
+ 1.40 12/21/2003
+ Added additional temporary file patterns.
+
+ 1.30 10/09/2002
+ Added additional temporary file patterns.
+
+ 1.20 03/12/2001
+ Modified /O switch to check the created, modified and accessed dates.
+
+ 1.10 07/05/2000
+ Added support for the /O switch to delete only old files.
+
+ 1.00 12/12/2000
+ Initial release.
diff --git a/managementnode/tools/Sysprep_2003/Utilities/CleanUp.exe b/managementnode/tools/Sysprep_2003/Utilities/CleanUp.exe
new file mode 100755
index 0000000..5d5da64
--- /dev/null
+++ b/managementnode/tools/Sysprep_2003/Utilities/CleanUp.exe
Binary files differ
diff --git a/managementnode/tools/Sysprep_2003/Utilities/EmptyRecycleBin ReadMe.txt b/managementnode/tools/Sysprep_2003/Utilities/EmptyRecycleBin ReadMe.txt
new file mode 100644
index 0000000..1965707
--- /dev/null
+++ b/managementnode/tools/Sysprep_2003/Utilities/EmptyRecycleBin ReadMe.txt
@@ -0,0 +1,28 @@
+
+Empty Recycle Bin [version 1.00]
+
+
+ Empties the Windows Recycle Bin.
+
+
+ Syntax: EmptyRecycleBin.exe [/Q]
+
+ /Q suppresses the 'Are you sure?' prompt and the progress bar.
+
+ /? or -? displays this syntax and always returns 1.
+ A successful completion returns 0.
+
+
+Copyright 2002 Marty List, Marty@OptimumX.com
+
+
+=======================================================================
+
+System Requirements: Windows XP; Windows 2000; Windows ME; Windows 98
+ Windows NT4 and Windows 95 require Active Desktop.
+
+
+Revision History:
+
+1.00 08/28/2002
+Initial release.
diff --git a/managementnode/tools/Sysprep_2003/Utilities/EmptyRecycleBin.exe b/managementnode/tools/Sysprep_2003/Utilities/EmptyRecycleBin.exe
new file mode 100755
index 0000000..2713d80
--- /dev/null
+++ b/managementnode/tools/Sysprep_2003/Utilities/EmptyRecycleBin.exe
Binary files differ
diff --git a/managementnode/tools/Sysprep_2003/Utilities/spdrvscn.exe b/managementnode/tools/Sysprep_2003/Utilities/spdrvscn.exe
new file mode 100755
index 0000000..fd2d823
--- /dev/null
+++ b/managementnode/tools/Sysprep_2003/Utilities/spdrvscn.exe
Binary files differ
diff --git a/managementnode/tools/Sysprep_2003/i386/$oem$/cmdlines.txt b/managementnode/tools/Sysprep_2003/i386/$oem$/cmdlines.txt
new file mode 100644
index 0000000..abf8170
--- /dev/null
+++ b/managementnode/tools/Sysprep_2003/i386/$oem$/cmdlines.txt
@@ -0,0 +1,5 @@
+[Commands]
+"cmd /c C:\WINDOWS\regedit.exe /s nodyndns.reg"
+"cmd /c wsname.exe /N:%DNS /MCN"
+"cmd /c C:\WINDOWS\system32\ping.exe 1.1.1.1 -n 1 -w 5000 > NUL"
+"cmd /c C:\WINDOWS\system32\cscript.exe setautologon.vbs"
diff --git a/managementnode/tools/Sysprep_2003/i386/$oem$/nodyndns.reg b/managementnode/tools/Sysprep_2003/i386/$oem$/nodyndns.reg
new file mode 100644
index 0000000..0c45314
--- /dev/null
+++ b/managementnode/tools/Sysprep_2003/i386/$oem$/nodyndns.reg
@@ -0,0 +1,6 @@
+REGEDIT4
+
+[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters]
+"DisableDynamicUpdate"=dword:00000001
+[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters]
+"DisableReverseAddressRegistrations"=dword:00000001
\ No newline at end of file
diff --git a/managementnode/tools/Sysprep_2003/i386/$oem$/setautologon.vbs b/managementnode/tools/Sysprep_2003/i386/$oem$/setautologon.vbs
new file mode 100755
index 0000000..b76890b
--- /dev/null
+++ b/managementnode/tools/Sysprep_2003/i386/$oem$/setautologon.vbs
@@ -0,0 +1,14 @@
+On Error Resume Next
+
+Set oWshShell = CreateObject("WScript.Shell")
+
+' setup DefaultUserName as root
+oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\DefaultUserName", "root"
+
+' setup DefaultPassword
+oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\DefaultPassword", "cl0udy"
+
+' Turn on auto-login
+oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon", "1"
+
+WScript.Quit
diff --git a/managementnode/tools/Sysprep_2003/i386/$oem$/wsname.exe b/managementnode/tools/Sysprep_2003/i386/$oem$/wsname.exe
new file mode 100755
index 0000000..a33f2b3
--- /dev/null
+++ b/managementnode/tools/Sysprep_2003/i386/$oem$/wsname.exe
Binary files differ
diff --git a/managementnode/tools/Sysprep_2003/sysprep.cmd b/managementnode/tools/Sysprep_2003/sysprep.cmd
new file mode 100755
index 0000000..2e975b9
--- /dev/null
+++ b/managementnode/tools/Sysprep_2003/sysprep.cmd
@@ -0,0 +1,156 @@
+rem @echo off
+cls
+
+set UTILITIES=C:\Sysprep\Utilities
+set VCL_SCRIPTS=C:\Documents and Settings\root\Application Data\VCL
+set WINDOWS_SCRIPTS=%SystemRoot%\System32\GroupPolicy\User\Scripts
+set DOCS=%SystemDrive%\Documents and Settings
+
+
+:VCL_SCRIPTS
+echo Removing old VCL scripts...
+rem Delete and recreate the root/AppData/VCL directory to make sure it's clean
+if exist "%VCL_SCRIPTS%" rmdir /s /q "%VCL_SCRIPTS%"
+mkdir "%VCL_SCRIPTS%"
+
+rem Clear out any old files in the GroupPolicy\User\Scripts directories
+if exist "%WINDOWS_SCRIPTS%\Logon\VCLprepare.cmd" del /A /S /Q /F "%WINDOWS_SCRIPTS%\Logon\VCLprepare.cmd"
+if exist "%WINDOWS_SCRIPTS%\Logoff\VCLcleanup.cmd" del /A /S /Q /F "%WINDOWS_SCRIPTS%\Logoff\VCLcleanup.cmd"
+echo.
+
+echo Copying new VCL scripts...
+copy /y "C:\Sysprep\Scripts\*.*" "%VCL_SCRIPTS%\"
+copy /y "%VCL_SCRIPTS%\VCLprepare.cmd" "%WINDOWS_SCRIPTS%\Logon\"
+echo.
+
+
+:CLEAN
+set DELETE=%TEMP%
+echo Removing files and subdirectories in %DELETE%...
+FOR /F "usebackq delims==" %%x IN (`dir /b /a:d "%DELETE%\*"`) DO rmdir /S /Q "%DELETE%\%%x"
+FOR /F "usebackq delims==" %%x IN (`dir /b /a:-d "%DELETE%\*"`) DO del /A /S /Q /F "%DELETE%\%%x"
+echo.
+
+set DELETE=%TMP%
+echo Removing files and subdirectories in %DELETE%...
+FOR /F "usebackq delims==" %%x IN (`dir /b /a:d "%DELETE%\*"`) DO rmdir /S /Q "%DELETE%\%%x"
+FOR /F "usebackq delims==" %%x IN (`dir /b /a:-d "%DELETE%\*"`) DO del /A /S /Q /F "%DELETE%\%%x"
+echo.
+
+set DELETE=%SystemRoot%\Temp
+echo Removing files and subdirectories in %DELETE%...
+FOR /F "usebackq delims==" %%x IN (`dir /b /a:d "%DELETE%\*"`) DO rmdir /S /Q "%DELETE%\%%x"
+FOR /F "usebackq delims==" %%x IN (`dir /b /a:-d "%DELETE%\*"`) DO del /A /S /Q /F "%DELETE%\%%x"
+echo.
+
+echo Removing "%SystemRoot%\*.tmp" files...
+del /A /S /Q /F "%SystemRoot%\*.tmp"
+echo.
+
+set DELETE=%SystemRoot%\SoftwareDistribution\Download
+echo Removing files and subdirectories in %DELETE%...
+FOR /F "usebackq delims==" %%x IN (`dir /b /a:d "%DELETE%\*"`) DO rmdir /S /Q "%DELETE%\%%x"
+FOR /F "usebackq delims==" %%x IN (`dir /b /a:-d "%DELETE%\*"`) DO del /A /S /Q /F "%DELETE%\%%x"
+echo.
+
+rem Minidump files are created if an application crashes, used for debugging
+set DELETE=%SystemRoot%\Minidump
+echo Removing files and subdirectories in %DELETE%...
+FOR /F "usebackq delims==" %%x IN (`dir /b /a:d "%DELETE%\*"`) DO rmdir /S /Q "%DELETE%\%%x"
+FOR /F "usebackq delims==" %%x IN (`dir /b /a:-d "%DELETE%\*"`) DO del /A /S /Q /F "%DELETE%\%%x"
+echo.
+
+rem $NtUninstall...$ are uninstall files for Windows updates
+set DELETE=%SystemRoot%\$NtUninstall
+echo Removing files and subdirectories in %DELETE%...
+FOR /F "usebackq delims==" %%x IN (`dir /b "%DELETE%*"`) DO rmdir /S /Q "%SystemRoot%\%%x"
+echo.
+
+rem $NtServicePackUninstall...$ are uninstall files for Windows service packs
+set DELETE=%SystemRoot%\$NtServicePackUninstall
+echo Removing files and subdirectories in %DELETE%...
+FOR /F "usebackq delims==" %%x IN (`dir /b "%DELETE%*"`) DO rmdir /S /Q "%SystemRoot%\%%x"
+echo.
+
+rem $MSI*Uninstall...$ are uninstall files for Windows Installer service updates (msiexec.exe)
+set DELETE=%SystemRoot%\$MSI*Uninstall
+echo Removing files and subdirectories in %DELETE%...
+FOR /F "usebackq delims==" %%x IN (`dir /b "%DELETE%*"`) DO rmdir /S /Q "%SystemRoot%\%%x"
+echo.
+
+rem Dr Watson logs and memory dumps
+set DELETE=%ALLUSERSPROFILE%\Application Data\Microsoft\Dr Watson
+echo Removing directory %DELETE%...
+if exist "%DELETE%" rmdir /S /Q "%DELETE%"
+echo.
+
+rem Page file should be disabled, try to delete it again
+set DELETE=%SystemDrive%\pagefile.sys
+echo Removing file %DELETE%...
+if exist "%DELETE%" del /A /S /Q /F "%DELETE%"
+echo.
+
+rem inf\oem* and infcache.1 files are cached OEM drivers, removal suggested by vernalex.com
+echo Removing cached OEM drivers at "%SystemRoot%\inf\oem*.*"...
+del /A /S /Q /F "%SystemRoot%\inf\oem*.*"
+del /A /S /Q /F "%SystemRoot%\inf\infcache.1"
+echo.
+
+echo Emptying Recycle Bin...
+"%UTILITIES%\EmptyRecycleBin.exe" /q
+echo.
+
+
+:PROFILES
+echo Cleaning up user profiles...
+set DELETE=Cookies
+FOR /F "usebackq delims==" %%u IN (`dir /b /a:d "%DOCS%\*"`) DO if exist "%DOCS%\%%u\%DELETE%" FOR /F "usebackq delims==" %%x IN (`dir /b /a:d "%DOCS%\%%u\%DELETE%\*"`) DO if exist "%DOCS%\%%u\%DELETE%\%%x" rmdir /S /Q "%DOCS%\%%u\%DELETE%\%%x"
+FOR /F "usebackq delims==" %%u IN (`dir /b /a:d "%DOCS%\*"`) DO if exist "%DOCS%\%%u\%DELETE%" FOR /F "usebackq delims==" %%x IN (`dir /b /a:-d "%DOCS%\%%u\%DELETE%\*"`) DO if exist "%DOCS%\%%u\%DELETE%\%%x" del /A /S /Q /F "%DOCS%\%%u\%DELETE%\%%x"
+
+set DELETE=Local Settings\Temp
+FOR /F "usebackq delims==" %%u IN (`dir /b /a:d "%DOCS%\*"`) DO if exist "%DOCS%\%%u\%DELETE%" FOR /F "usebackq delims==" %%x IN (`dir /b /a:d "%DOCS%\%%u\%DELETE%\*"`) DO if exist "%DOCS%\%%u\%DELETE%\%%x" rmdir /S /Q "%DOCS%\%%u\%DELETE%\%%x"
+FOR /F "usebackq delims==" %%u IN (`dir /b /a:d "%DOCS%\*"`) DO if exist "%DOCS%\%%u\%DELETE%" FOR /F "usebackq delims==" %%x IN (`dir /b /a:-d "%DOCS%\%%u\%DELETE%\*"`) DO if exist "%DOCS%\%%u\%DELETE%\%%x" del /A /S /Q /F "%DOCS%\%%u\%DELETE%\%%x"
+
+set DELETE=Recent
+FOR /F "usebackq delims==" %%u IN (`dir /b /a:d "%DOCS%\*"`) DO if exist "%DOCS%\%%u\%DELETE%" FOR /F "usebackq delims==" %%x IN (`dir /b /a:d "%DOCS%\%%u\%DELETE%\*"`) DO if exist "%DOCS%\%%u\%DELETE%\%%x" rmdir /S /Q "%DOCS%\%%u\%DELETE%\%%x"
+FOR /F "usebackq delims==" %%u IN (`dir /b /a:d "%DOCS%\*"`) DO if exist "%DOCS%\%%u\%DELETE%" FOR /F "usebackq delims==" %%x IN (`dir /b /a:-d "%DOCS%\%%u\%DELETE%\*"`) DO if exist "%DOCS%\%%u\%DELETE%\%%x" del /A /S /Q /F "%DOCS%\%%u\%DELETE%\%%x"
+
+set DELETE=Local Settings\Recent
+FOR /F "usebackq delims==" %%u IN (`dir /b /a:d "%DOCS%\*"`) DO if exist "%DOCS%\%%u\%DELETE%" FOR /F "usebackq delims==" %%x IN (`dir /b /a:d "%DOCS%\%%u\%DELETE%\*"`) DO if exist "%DOCS%\%%u\%DELETE%\%%x" rmdir /S /Q "%DOCS%\%%u\%DELETE%\%%x"
+FOR /F "usebackq delims==" %%u IN (`dir /b /a:d "%DOCS%\*"`) DO if exist "%DOCS%\%%u\%DELETE%" FOR /F "usebackq delims==" %%x IN (`dir /b /a:-d "%DOCS%\%%u\%DELETE%\*"`) DO if exist "%DOCS%\%%u\%DELETE%\%%x" del /A /S /Q /F "%DOCS%\%%u\%DELETE%\%%x"
+
+set DELETE=Local Settings\Temporary Internet Files
+FOR /F "usebackq delims==" %%u IN (`dir /b /a:d "%DOCS%\*"`) DO if exist "%DOCS%\%%u\%DELETE%" FOR /F "usebackq delims==" %%x IN (`dir /b /a:d "%DOCS%\%%u\%DELETE%\*"`) DO if exist "%DOCS%\%%u\%DELETE%\%%x" rmdir /S /Q "%DOCS%\%%u\%DELETE%\%%x"
+FOR /F "usebackq delims==" %%u IN (`dir /b /a:d "%DOCS%\*"`) DO if exist "%DOCS%\%%u\%DELETE%" FOR /F "usebackq delims==" %%x IN (`dir /b /a:-d "%DOCS%\%%u\%DELETE%\*"`) DO if exist "%DOCS%\%%u\%DELETE%\%%x" del /A /S /Q /F "%DOCS%\%%u\%DELETE%\%%x"
+
+
+:AFS
+echo Stopping AFS client service...
+sc stop TransarcAFSDaemon
+echo Removing AFSCache and afsd_init.log files
+del /A /S /Q /F "%SystemRoot%\AFSCache"
+del /A /S /Q /F "%SystemRoot%\afsd_init.log"
+echo.
+
+
+:DRIVERS
+echo Scanning drivers...
+"%UTILITIES%\spdrvscn.exe" /p "C:\Sysprep\Drivers" /e inf /f /a /s /q
+echo.
+
+
+:EVENTLOG
+echo Clearing the event logs...
+"%UTILITIES%\PsTools\psloglist.exe" -accepteula -o null -c Application
+"%UTILITIES%\PsTools\psloglist.exe" -accepteula -o null -c "Internet Explorer"
+"%UTILITIES%\PsTools\psloglist.exe" -accepteula -o null -c Security
+"%UTILITIES%\PsTools\psloglist.exe" -accepteula -o null -c System
+
+:SYSPREP
+
+echo Starting Sysprep...
+"C:\Sysprep\sysprep.exe" -quiet -reboot -reseal -mini -activated
+echo.
+
+:END
+echo Done.
diff --git a/managementnode/tools/Sysprep_2003/sysprep.inf b/managementnode/tools/Sysprep_2003/sysprep.inf
new file mode 100644
index 0000000..4755825
--- /dev/null
+++ b/managementnode/tools/Sysprep_2003/sysprep.inf
@@ -0,0 +1,69 @@
+;SetupMgrTag
+[Unattended]
+ OemSkipEula=Yes
+ OemPreinstall=Yes
+ InstallFilesPath=C:\sysprep\i386
+ TargetPath=\WINDOWS
+ DriverSigningPolicy=ignore
+ UpdateInstalledDrivers=no
+
+[GuiUnattended]
+ AdminPassword=*
+ EncryptedAdminPassword=NO
+ OEMSkipRegional=1
+ OEMDuplicatorstring="VCL project"
+ TimeZone=35
+ OemSkipWelcome=1
+
+[UserData]
+ ProductKey=WIN_2003_ENT_KEY
+ FullName="VCL"
+ OrgName="NCSU"
+ ComputerName=*
+
+[LicenseFilePrintData]
+ AutoMode=PerSeat
+
+[Display]
+ BitsPerPel=32
+ Xresolution=1024
+ YResolution=768
+ Vrefresh=75
+
+[Identification]
+ JoinWorkgroup=WORKGROUP
+
+[Networking]
+ InstallDefaultComponents=Yes
+
+[Branding]
+ BrandIEUsingUnattended=Yes
+
+[Proxy]
+ Proxy_Enable=0
+ Use_Same_Proxy=0
+
+[SysprepMassStorage]
+PCI\VEN_1000&DEV_0622 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0624 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0626 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0628 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0030 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0032 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0050 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0054 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0058 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0056 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0640 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0646 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0062 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0054&SUBSYS_1F041028 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0054&SUBSYS_1F051028 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0054&SUBSYS_1F061028 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0054&SUBSYS_1F071028 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0054&SUBSYS_1F081028 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0054&SUBSYS_1F091028 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0058&SUBSYS_1F0E1028 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0058&SUBSYS_1F0F1028 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+PCI\VEN_1000&DEV_0058&SUBSYS_1F101028 = "C:\Sysprep\Drivers\Storage\LSI-SAS\symmpi.inf"
+
diff --git a/managementnode/tools/Sysprep_vmware/i386/$oem$/cmdlines.txt b/managementnode/tools/Sysprep_vmware/i386/$oem$/cmdlines.txt
new file mode 100644
index 0000000..abf8170
--- /dev/null
+++ b/managementnode/tools/Sysprep_vmware/i386/$oem$/cmdlines.txt
@@ -0,0 +1,5 @@
+[Commands]
+"cmd /c C:\WINDOWS\regedit.exe /s nodyndns.reg"
+"cmd /c wsname.exe /N:%DNS /MCN"
+"cmd /c C:\WINDOWS\system32\ping.exe 1.1.1.1 -n 1 -w 5000 > NUL"
+"cmd /c C:\WINDOWS\system32\cscript.exe setautologon.vbs"
diff --git a/managementnode/tools/Sysprep_vmware/i386/$oem$/nodyndns.reg b/managementnode/tools/Sysprep_vmware/i386/$oem$/nodyndns.reg
new file mode 100644
index 0000000..0c45314
--- /dev/null
+++ b/managementnode/tools/Sysprep_vmware/i386/$oem$/nodyndns.reg
@@ -0,0 +1,6 @@
+REGEDIT4
+
+[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters]
+"DisableDynamicUpdate"=dword:00000001
+[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters]
+"DisableReverseAddressRegistrations"=dword:00000001
\ No newline at end of file
diff --git a/managementnode/tools/Sysprep_vmware/i386/$oem$/setautologon.vbs b/managementnode/tools/Sysprep_vmware/i386/$oem$/setautologon.vbs
new file mode 100755
index 0000000..b76890b
--- /dev/null
+++ b/managementnode/tools/Sysprep_vmware/i386/$oem$/setautologon.vbs
@@ -0,0 +1,14 @@
+On Error Resume Next
+
+Set oWshShell = CreateObject("WScript.Shell")
+
+' setup DefaultUserName as root
+oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\DefaultUserName", "root"
+
+' setup DefaultPassword
+oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\DefaultPassword", "cl0udy"
+
+' Turn on auto-login
+oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon", "1"
+
+WScript.Quit
diff --git a/managementnode/tools/Sysprep_vmware/i386/$oem$/wsname.exe b/managementnode/tools/Sysprep_vmware/i386/$oem$/wsname.exe
new file mode 100755
index 0000000..f075d63
--- /dev/null
+++ b/managementnode/tools/Sysprep_vmware/i386/$oem$/wsname.exe
Binary files differ
diff --git a/managementnode/tools/Sysprep_vmware/sysprep.cmd b/managementnode/tools/Sysprep_vmware/sysprep.cmd
new file mode 100755
index 0000000..f1a339e
--- /dev/null
+++ b/managementnode/tools/Sysprep_vmware/sysprep.cmd
@@ -0,0 +1,3 @@
+copy "C:\Documents and Settings/root/Application Data\VCL\VCLprepare.cmd" C:\WINDOWS\system32\GroupPolicy\User\Scripts\Logon\
+del "C:\WINDOWS\system32\GroupPolicy\User\Scripts\Logoff\VCLcleanup.cmd"
+C:\Sysprep\sysprep -quiet -reseal -mini -activated -shutdown
diff --git a/managementnode/tools/Sysprep_vmware/sysprep.inf b/managementnode/tools/Sysprep_vmware/sysprep.inf
new file mode 100644
index 0000000..2fe6419
--- /dev/null
+++ b/managementnode/tools/Sysprep_vmware/sysprep.inf
@@ -0,0 +1,39 @@
+;SetupMgrTag
+[Unattended]
+ OemSkipEula=Yes
+ OemPreinstall=Yes
+ InstallFilesPath=C:\sysprep\i386
+ TargetPath=\WINDOWS
+
+[GuiUnattended]
+ AdminPassword=*
+ EncryptedAdminPassword=NO
+ OEMSkipRegional=1
+ OEMDuplicatorstring="VCL project"
+ TimeZone=35
+ OemSkipWelcome=1
+
+[UserData]
+ ProductKey=WIN_XP_PRO_KEY
+ FullName="VCL"
+ OrgName="NCSU"
+ ComputerName=*
+
+[Display]
+ BitsPerPel=32
+ Xresolution=1024
+ YResolution=768
+ Vrefresh=75
+
+[Identification]
+ JoinWorkgroup=WORKGROUP
+
+[Networking]
+ InstallDefaultComponents=Yes
+
+[Branding]
+ BrandIEUsingUnattended=Yes
+
+[Proxy]
+ Proxy_Enable=0
+ Use_Same_Proxy=0
diff --git a/managementnode/tools/Sysprep_vmware/sysprep.vbs b/managementnode/tools/Sysprep_vmware/sysprep.vbs
new file mode 100755
index 0000000..bc6166f
--- /dev/null
+++ b/managementnode/tools/Sysprep_vmware/sysprep.vbs
@@ -0,0 +1,25 @@
+On Error Resume Next
+
+Set oWshShell = CreateObject("WScript.Shell")
+Set oWshEnvironment = oWshShell.Environment("Process")
+Set oFileSystem = CreateObject("Scripting.FileSystemObject")
+sTempDir = oWshEnvironment("TEMP")
+Dim oExec
+Dim GuiAnswer
+strComputer = "."
+
+oFileSystem.CopyFile "C:\Documents and Settings/root/Application Data\VCL\VCLprepare.cmd", "C:\WINDOWS\system32\GroupPolicy\User\Scripts\Logon\",true
+
+WScript.Echo "copied VCLrcboot"
+
+'delete
+Set aFile = oFileSystem.GetFile("C:\WINDOWS\system32\GroupPolicy\User\Scripts\Logoff\VCLcleanup.cmd")
+aFile.Delete
+WScript.Echo "Deleted VCLcleanup.cmd"
+
+'start sysprep
+oWshShell.run "C:\Sysprep\sysprep.exe -quiet -forceshutdown -reseal -mini -activated", 1, false
+WScript.Echo "Executed sysprep.exe"
+
+Set oWshShell = Nothing
+WScript.Quit
diff --git a/managementnode/tools/VCLprep1.vbs b/managementnode/tools/VCLprep1.vbs
new file mode 100755
index 0000000..d5b11b8
--- /dev/null
+++ b/managementnode/tools/VCLprep1.vbs
@@ -0,0 +1,55 @@
+On Error Resume Next
+
+Set oWshShell = CreateObject("WScript.Shell")
+Set oWshEnvironment = oWshShell.Environment("Process")
+Set oFileSystem = CreateObject("Scripting.FileSystemObject")
+Set WshNetwork = WScript.CreateObject("WScript.Network")
+sTempDir = oWshEnvironment("TEMP")
+Dim oExec
+strComputer = "."
+
+'copy VCLrcboot.cmd to Logon
+oFileSystem.CopyFile "C:\Documents and Settings\root\Application Data\VCL\VCLprepare.cmd", "C:\WINDOWS\system32\GroupPolicy\User\Scripts\Logon\",true
+WScript.Echo "copied VCLprepare"
+
+'delete any VCL logoff scripts
+oWshShell.Run "cmd.exe /C del " & "C:\WINDOWS\system32\GroupPolicy\User\Scripts\Logoff\VCL*\", 0, TRUE
+
+'re-enable pagefile
+strCommand = "reg.exe add " & Chr(34) & _
+ "HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Memory Management" & Chr(34) &_
+ " /v PagingFiles /d " & Chr(34) & "c:\pagefile.sys 0 0" & Chr(34) & " /t REG_MULTI_SZ /f"
+Set oExec = oWshShell.Exec(strcommand)
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
+
+WScript.Echo "enabling pagefile"
+
+'set autologin
+' setup DefaultUserName as root
+oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\DefaultUserName", "root"
+
+' setup DefaultPassword
+oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\DefaultPassword", "cl0udy"
+
+' Turn on auto-login
+oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon", "1"
+
+WScript.Echo "set autologin for root account"
+
+'shutdown
+Set objWMIService = GetObject("winmgmts:" _
+ & "{impersonationLevel=impersonate,(Shutdown)}!\\" & strComputer & "\root\cimv2")
+Set colOperatingSystems = objWMIService.ExecQuery _
+ ("Select * from Win32_OperatingSystem")
+For Each objOperatingSystem in colOperatingSystems
+ intreturn = ObjOperatingSystem.Win32Shutdown(6)
+ if intreturn = 0 Then
+ WScript.echo "rebooting"
+ Else
+ Wscript.echo "reboot failed error code " & intreturn
+ End If
+Next
+
+WScript.Quit
diff --git a/managementnode/tools/VCLrcboot.cmd b/managementnode/tools/VCLrcboot.cmd
new file mode 100755
index 0000000..a511ef8
--- /dev/null
+++ b/managementnode/tools/VCLrcboot.cmd
@@ -0,0 +1,19 @@
+@echo off
+
+copy "C:\Documents and Settings\root\Application Data\VCL\VCLprepare.cmd" C:\WINDOWS\system32\GroupPolicy\User\Scripts\Logon\
+
+del C:\WINDOWS\system32\GroupPolicy\User\Scripts\Logoff\VCLcleanup.cmd
+
+cd %APPDATA%/vcl
+
+%SystemRoot%\system32\cmd.exe /c C:\WINDOWS\regedit.exe /s nodyndns.reg
+
+%SystemRoot%\system32\cmd.exe /c wsname.exe /N:$DNS /MCN
+
+%SystemRoot%\system32\cscript.exe enablepagefile.vbs
+
+%SystemRoot%\system32\cmd.exe /c C:\WINDOWS\system32\ping.exe 1.1.1.1 %-n 1 -w 2000 > NUL
+
+%SystemRoot%\system32\cmd.exe /c newsid.exe /a /d 6
+
+del C:\WINDOWS\system32\GroupPolicy\User\Scripts\Logon\VCLrcboot.cmd
diff --git a/managementnode/tools/auto_create_image.vbs b/managementnode/tools/auto_create_image.vbs
new file mode 100755
index 0000000..d88cfd9
--- /dev/null
+++ b/managementnode/tools/auto_create_image.vbs
@@ -0,0 +1,95 @@
+On Error Resume Next
+
+Set oWshShell = CreateObject("WScript.Shell")
+Set oWshEnvironment = oWshShell.Environment("Process")
+Set oFileSystem = CreateObject("Scripting.FileSystemObject")
+Set WshNetwork = WScript.CreateObject("WScript.Network")
+sTempDir = oWshEnvironment("TEMP")
+Dim oExec
+Dim GuiAnswer
+strComputer = "."
+MyName = lcase(WshNetwork.ComputerName)
+
+Const ForAppending = 8
+
+
+' clean up %TEMP% directory from .log files
+oWshShell.Run "cmd.exe /C del /Q " & sTempDir & "\*.log", 0, TRUE
+
+' open log file to record all actions taken
+set objFSO = CreateObject("Scripting.FileSystemObject")
+Set objTextFile = objFSO.OpenTextFile _
+ (sTempDir & "\VCLprepare.log", ForAppending, True)
+objTextFile.WriteLine("========================================================================")
+objTextFile.WriteLine(Now & " : auto_create_image.vbs : script started")
+
+objTextFile.WriteLine(Now & " : auto_create_image.vbs : cleaned up " & sTempDir & " directory from .log files")
+
+
+' check that WAN network interface is enabled, if not - enable it
+WScript.Echo "Enabling WAN interface..."
+objTextFile.WriteLine(Now & " : auto_create_image.vbs : Enable WAN interface")
+oWshShell.Run "cscript.exe " & sTempDir & "\vcl\enWAN.vbs", 0, TRUE
+WScript.Echo "Done!"
+objTextFile.WriteLine(Now & " : auto_create_image.vbs : WAN interface enabled")
+
+
+' setup to run prepare_for_image.vbs script after reboot
+'objTextFile.WriteLine(Now & " : auto_create_image.vbs : setup RunOnce 'auto_prepare_for_image.vbs' after reboot")
+'oWshShell.RegWrite "HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce\step0", "cmd.exe /c cscript.exe " & sTempDir & "\vcl\auto_prepare_for_image.vbs"
+
+'check = oWshShell.RegRead("HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce\step0")
+'objTextFile.WriteLine(Now & " : CHECK (RunOnce registry entry): " & check)
+
+' enable AutoLogon after reboot
+'objTextFile.WriteLine(Now & " : auto_create_image.vbs : enable Auto-Logon after reboot")
+'oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon", "1"
+'oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\DefaultUserName", "root"
+
+'check = oWshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon")
+'objTextFile.WriteLine(Now & " : CHECK (AutoAdminLogon registry entry): " & check & " (should be 1)")
+
+
+' disable pagefile
+objTextFile.WriteLine(Now & " : auto_create_image.vbs : disable page file")
+strCommand = "reg.exe add " & Chr(34) & _
+ "HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Memory Management" & Chr(34) &_
+ " /v PagingFiles /d " & Chr(34) & "" & Chr(34) & " /t REG_MULTI_SZ /f"
+Set oExec = oWshShell.Exec(strcommand)
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
+strCommand = sTempDir & "\vcl\movefile.exe " & Chr(34) & "c:\pagefile.sys" & Chr(34) & " " & Chr(34) & Chr(34)
+Set oExec = oWshShell.Exec(strcommand)
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
+
+
+'check = oWshShell.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Memory Management\PagingFiles")
+'objTextFile.WriteLine(Now & " : CHECK (PagingFiles registry entry): '" & check(0) & "' (should be empty)")
+
+
+objTextFile.WriteLine(Now & " : auto_create_image.vbs : script finished, rebooting computer")
+objTextFile.WriteLine("========================================================================")
+'close log file handler
+objTextFile.Close
+
+
+'reboot computer to make changes effective
+
+Set objWMIService = GetObject("winmgmts:" _
+ & "{impersonationLevel=impersonate,(Shutdown)}!\\" & MyName & "\root\cimv2")
+Set colOperatingSystems = objWMIService.ExecQuery _
+ ("Select * from Win32_OperatingSystem")
+For Each objOperatingSystem in colOperatingSystems
+ intreturn = ObjOperatingSystem.Win32Shutdown(6)
+ if intreturn = 0 Then
+ WScript.echo "createimage reboot"
+ Else
+ Wscript.echo "reboot failed error code " & intreturn
+ End If
+Next
+
+WScript.Quit
+
diff --git a/managementnode/tools/check_ssh b/managementnode/tools/check_ssh
new file mode 100755
index 0000000..ae4ef31
--- /dev/null
+++ b/managementnode/tools/check_ssh
Binary files differ
diff --git a/managementnode/tools/default.tmpl b/managementnode/tools/default.tmpl
new file mode 100644
index 0000000..7c0e9bc
--- /dev/null
+++ b/managementnode/tools/default.tmpl
@@ -0,0 +1,13 @@
+#Edit and enter a space delimited list of disks, it must be in double quotes.
+
+export DISKS="#TABLE:hdtype.tab:$NODERES:1#"
+
+#Leave as is:
+
+export NFS_SERVER=#XCATVAR:INSTALL_NFS#
+export NFS_DIR=#XCATVAR:INSTALL_SRC_DIR#
+export MASTER_IP=#XCATVAR:MASTER_IP#
+export MASTER_IPS="#XCATVAR:MASTER_IPS#"
+export IMAGE=#XCATVAR:NODETYPE#
+export XCATDPORT=#TABLE:site.tab:xcatdport:1#
+
diff --git a/managementnode/tools/disablenetbios.vbs b/managementnode/tools/disablenetbios.vbs
new file mode 100755
index 0000000..177549e
--- /dev/null
+++ b/managementnode/tools/disablenetbios.vbs
@@ -0,0 +1,13 @@
+On Error Resume Next
+
+strComputer = "."
+Set objWMIService = GetObject("winmgmts:\\"& strComputer & "\root\cimv2")
+Set colAdapters = objWMIService.ExecQuery _
+ ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
+
+For Each objAdapter in colAdapters
+ ' Use 0 to use the NetBIOS setting from the DHCP server
+ ' Use 1 to enable NetBIOS over TCP/IP
+ ' Use 2 to disable NetBIOS over TCP/IP
+ objAdapter.SetTCPIPNetBIOS(2)
+Next
diff --git a/managementnode/tools/perltidy/.perltidyrc b/managementnode/tools/perltidy/.perltidyrc
new file mode 100644
index 0000000..d643162
--- /dev/null
+++ b/managementnode/tools/perltidy/.perltidyrc
@@ -0,0 +1,107 @@
+# This is a .perltidyrc configuration file
+# It is used by the perltidy module for formatting source code
+# http://perltidy.sourceforge.net/perltidy.html
+
+# GENERAL CONFIGURATION
+-log # save the .log file
+-se # errors to standard error output
+-w # show all warnings
+-syn # perform Perl syntax check
+-pscf=-c # don't run Perl syntax taint checking
+-b # modify files in place
+
+# INDENTATION
+-et=3 # replace each 3 leading space charaters with 1 tab character
+-i=3 # use 3 columns per indentation level
+-nola # do not outdent labels
+#-naws # don't add whitespace
+
+
+# COMMENTS
+-nbbc # don't add blank lines before a full-line comments
+-nbbs # don't add blank lines before a sub definitions
+-ibc # indent block comments
+-isbc # indent spaced block comments
+
+
+# BLANK LINES AND LINE LENGTH
+-l=0 # don't set a maximum line length, leave long lines alone
+-mbl=3 # set the maximum number of consecutive blank lines
+-ole=win # output line endings for a specific system (Windows)
+
+# TIGHTNESS
+-lp # line up parentheses
+
+-vt=2
+-vtc=2
+# -vt=0 always break a line after opening token (default)
+# -vt=1 do not break unless this would produce more than one step in indentation in a line
+# -vt=2 never break a line after opening token
+# -vtc=0 always break a line before a closing token (default)
+# -vtc=1 do not break before a closing token which is followed by a semicolon or another closing token, and is not in a list environment
+# -vtc=2 never break before a closing token
+
+#-pvt=2 # paren vert tight
+#-pvtc=2 # paren closing vert tight
+
+#-sbvt=2 # square vert tight
+#-sbvtc=2 # square closing vert tight
+
+#-bvt=2 # non-code block braces
+#-bvtc=2 # non-code block closing braces
+
+#-bbvt=2 # just like the -vt=n flag but applies to opening code block braces
+
+#-sot # stack opening tokens when possible to avoid lines with isolated opening tokens
+ # -sot is a synonym for -sop -sohb -sosb
+#-sop # stack opening paren
+#-sohb # stack opening hash brace
+#-sosb # stack opening square bracket
+
+#-sct # stack closing tokens
+ # -sct is a synonym for -scp -schb -scsb
+#-scp # stack closing paren
+#-schb # stack closing hash brace
+#-scsb # stack closing square bracket
+
+-pt=2 # parenthesis tightness, no spaces after ( and before )
+# if ( ( my $len_tab = length( $tabstr ) ) > 0 ) { # -pt=0
+# if ( ( my $len_tab = length($tabstr) ) > 0 ) { # -pt=1 (default)
+# if ((my $len_tab = length($tabstr)) > 0) { # -pt=2
+
+-sbt=2 # square bracket tightness, no spaces after [ and before ]
+# $width = $col[ $j + $k ] - $col[ $j ]; # -sbt=0
+# $width = $col[ $j + $k ] - $col[$j]; # -sbt=1 (default)
+# $width = $col[$j + $k] - $col[$j]; # -sbt=2
+
+-bt=2 # curly brace tightness, no spaces after { and before }
+# $obj->{ $parsed_sql->{ 'table' }[0] }; # -bt=0
+# $obj->{ $parsed_sql->{'table'}[0] }; # -bt=1 (default)
+# $obj->{$parsed_sql->{'table'}[0]}; # -bt=2
+
+-bbt=2 # curly brace tightness which contain blocks of code
+# %bf = map { $_ => -M $_ } grep { /\.deb$/ } dirents '.'; # -bbt=0 (default)
+# %bf = map { $_ => -M $_ } grep {/\.deb$/} dirents '.'; # -bbt=1
+# %bf = map {$_ => -M $_} grep {/\.deb$/} dirents '.'; # -bbt=2
+
+-nsts # no space before semicolons
+# $i = 1 ; # -sts
+# $i = 1; # -nsts (default)
+
+-nsfs # no spaces between special semicolons in for loops
+# for ( @a = @$ap, $u = shift @a ; @a ; $u = $v ) { # -sfs (default)
+# for ( @a = @$ap, $u = shift @a; @a; $u = $v ) { # -nsfs
+
+
+# CLOSING SIDE SCOMMENTS
+-csc # add closing side comments, adds or updates closing side comments
+# sub message {
+# } ## end sub message <-- -csc adds this
+
+#-cscw # enable closing side-comment warnings
+
+-csci=10 # minimum number of lines that a block must have in order for a closing side comment to be added
+
+-csct=40 # closing side comment maximum text
+
+-csce=2 # each elsif is also given the text of the opening if statement
diff --git a/managementnode/tools/perltidy/perltidy b/managementnode/tools/perltidy/perltidy
new file mode 100755
index 0000000..0845d69
--- /dev/null
+++ b/managementnode/tools/perltidy/perltidy
@@ -0,0 +1,27955 @@
+#!/usr/bin/perl
+############################################################
+#
+# perltidy - a perl script indenter and formatter
+#
+# Copyright (c) 2000-2007 by Steve Hancock
+# Distributed under the GPL license agreement; see file COPYING
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# For brief instructions instructions, try 'perltidy -h'.
+# For more complete documentation, try 'man perltidy'
+# or visit http://perltidy.sourceforge.net
+#
+# This script is an example of the default style. It was formatted with:
+#
+# perltidy Tidy.pm
+#
+# Code Contributions:
+# Michael Cartmell supplied code for adaptation to VMS and helped with
+# v-strings.
+# Hugh S. Myers supplied sub streamhandle and the supporting code to
+# create a Perl::Tidy module which can operate on strings, arrays, etc.
+# Yves Orton supplied coding to help detect Windows versions.
+# Axel Rose supplied a patch for MacPerl.
+# Sebastien Aperghis-Tramoni supplied a patch for the defined or operator.
+# Dan Tyrell contributed a patch for binary I/O.
+# Ueli Hugenschmidt contributed a patch for -fpsc
+# Many others have supplied key ideas, suggestions, and bug reports;
+# see the CHANGES file.
+#
+############################################################
+
+package Perl::Tidy;
+use 5.004; # need IO::File from 5.004 or later
+BEGIN { $^W = 1; } # turn on warnings
+
+use strict;
+use Exporter;
+use Carp;
+$|++;
+
+use vars qw{
+ $VERSION
+ @ISA
+ @EXPORT
+ $missing_file_spec
+};
+
+@ISA = qw( Exporter );
+@EXPORT = qw( &perltidy );
+
+use IO::File;
+use File::Basename;
+
+BEGIN {
+ ( $VERSION = q($Id: perltidy 1959 2008-12-12 15:40:09Z arkurth $) ) =~ s/^.*\s+(\d+)\/(\d+)\/(\d+).*$/$1$2$3/; # all one line for MakeMaker
+}
+
+sub streamhandle {
+
+ # given filename and mode (r or w), create an object which:
+ # has a 'getline' method if mode='r', and
+ # has a 'print' method if mode='w'.
+ # The objects also need a 'close' method.
+ #
+ # How the object is made:
+ #
+ # if $filename is: Make object using:
+ # ---------------- -----------------
+ # '-' (STDIN if mode = 'r', STDOUT if mode='w')
+ # string IO::File
+ # ARRAY ref Perl::Tidy::IOScalarArray (formerly IO::ScalarArray)
+ # STRING ref Perl::Tidy::IOScalar (formerly IO::Scalar)
+ # object object
+ # (check for 'print' method for 'w' mode)
+ # (check for 'getline' method for 'r' mode)
+ my $ref = ref( my $filename = shift );
+ my $mode = shift;
+ my $New;
+ my $fh;
+
+ # handle a reference
+ if ($ref) {
+ if ( $ref eq 'ARRAY' ) {
+ $New = sub { Perl::Tidy::IOScalarArray->new(@_) };
+ }
+ elsif ( $ref eq 'SCALAR' ) {
+ $New = sub { Perl::Tidy::IOScalar->new(@_) };
+ }
+ else {
+
+ # Accept an object with a getline method for reading. Note:
+ # IO::File is built-in and does not respond to the defined
+ # operator. If this causes trouble, the check can be
+ # skipped and we can just let it crash if there is no
+ # getline.
+ if ( $mode =~ /[rR]/ ) {
+ if ( $ref eq 'IO::File' || defined &{ $ref . "::getline" } ) {
+ $New = sub { $filename };
+ }
+ else {
+ $New = sub { undef };
+ confess <<EOM;
+------------------------------------------------------------------------
+No 'getline' method is defined for object of class $ref
+Please check your call to Perl::Tidy::perltidy. Trace follows.
+------------------------------------------------------------------------
+EOM
+ }
+ }
+
+ # Accept an object with a print method for writing.
+ # See note above about IO::File
+ if ( $mode =~ /[wW]/ ) {
+ if ( $ref eq 'IO::File' || defined &{ $ref . "::print" } ) {
+ $New = sub { $filename };
+ }
+ else {
+ $New = sub { undef };
+ confess <<EOM;
+------------------------------------------------------------------------
+No 'print' method is defined for object of class $ref
+Please check your call to Perl::Tidy::perltidy. Trace follows.
+------------------------------------------------------------------------
+EOM
+ }
+ }
+ }
+ }
+
+ # handle a string
+ else {
+ if ( $filename eq '-' ) {
+ $New = sub { $mode eq 'w' ? *STDOUT : *STDIN }
+ }
+ else {
+ $New = sub { IO::File->new(@_) };
+ }
+ }
+ $fh = $New->( $filename, $mode )
+ or warn "Couldn't open file:$filename in mode:$mode : $!\n";
+ return $fh, ( $ref or $filename );
+}
+
+sub find_input_line_ending {
+
+ # Peek at a file and return first line ending character.
+ # Quietly return undef in case of any trouble.
+ my ($input_file) = @_;
+ my $ending;
+
+ # silently ignore input from object or stdin
+ if ( ref($input_file) || $input_file eq '-' ) {
+ return $ending;
+ }
+ open( INFILE, $input_file ) || return $ending;
+
+ binmode INFILE;
+ my $buf;
+ read( INFILE, $buf, 1024 );
+ close INFILE;
+ if ( $buf && $buf =~ /([\012\015]+)/ ) {
+ my $test = $1;
+
+ # dos
+ if ( $test =~ /^(\015\012)+$/ ) { $ending = "\015\012" }
+
+ # mac
+ elsif ( $test =~ /^\015+$/ ) { $ending = "\015" }
+
+ # unix
+ elsif ( $test =~ /^\012+$/ ) { $ending = "\012" }
+
+ # unknown
+ else { }
+ }
+
+ # no ending seen
+ else { }
+
+ return $ending;
+}
+
+sub catfile {
+
+ # concatenate a path and file basename
+ # returns undef in case of error
+
+ BEGIN { eval "require File::Spec"; $missing_file_spec = $@; }
+
+ # use File::Spec if we can
+ unless ($missing_file_spec) {
+ return File::Spec->catfile(@_);
+ }
+
+ # Perl 5.004 systems may not have File::Spec so we'll make
+ # a simple try. We assume File::Basename is available.
+ # return undef if not successful.
+ my $name = pop @_;
+ my $path = join '/', @_;
+ my $test_file = $path . $name;
+ my ( $test_name, $test_path ) = fileparse($test_file);
+ return $test_file if ( $test_name eq $name );
+ return undef if ( $^O eq 'VMS' );
+
+ # this should work at least for Windows and Unix:
+ $test_file = $path . '/' . $name;
+ ( $test_name, $test_path ) = fileparse($test_file);
+ return $test_file if ( $test_name eq $name );
+ return undef;
+}
+
+sub make_temporary_filename {
+
+ # Make a temporary filename.
+ #
+ # The POSIX tmpnam() function tends to be unreliable for non-unix
+ # systems (at least for the win32 systems that I've tested), so use
+ # a pre-defined name. A slight disadvantage of this is that two
+ # perltidy runs in the same working directory may conflict.
+ # However, the chance of that is small and managable by the user.
+ # An alternative would be to check for the file's existance and use,
+ # say .TMP0, .TMP1, etc, but that scheme has its own problems. So,
+ # keep it simple.
+ my $name = "perltidy.TMP";
+ if ( $^O =~ /win32|dos/i || $^O eq 'VMS' || $^O eq 'MacOs' ) {
+ return $name;
+ }
+ eval "use POSIX qw(tmpnam)";
+ if ($@) { return $name }
+ use IO::File;
+
+ # just make a couple of tries before giving up and using the default
+ for ( 0 .. 1 ) {
+ my $tmpname = tmpnam();
+ my $fh = IO::File->new( $tmpname, O_RDWR | O_CREAT | O_EXCL );
+ if ($fh) {
+ $fh->close();
+ return ($tmpname);
+ last;
+ }
+ }
+ return ($name);
+}
+
+# Here is a map of the flow of data from the input source to the output
+# line sink:
+#
+# LineSource-->Tokenizer-->Formatter-->VerticalAligner-->FileWriter-->
+# input groups output
+# lines tokens lines of lines lines
+# lines
+#
+# The names correspond to the package names responsible for the unit processes.
+#
+# The overall process is controlled by the "main" package.
+#
+# LineSource is the stream of input lines
+#
+# Tokenizer analyzes a line and breaks it into tokens, peeking ahead
+# if necessary. A token is any section of the input line which should be
+# manipulated as a single entity during formatting. For example, a single
+# ',' character is a token, and so is an entire side comment. It handles
+# the complexities of Perl syntax, such as distinguishing between '<<' as
+# a shift operator and as a here-document, or distinguishing between '/'
+# as a divide symbol and as a pattern delimiter.
+#
+# Formatter inserts and deletes whitespace between tokens, and breaks
+# sequences of tokens at appropriate points as output lines. It bases its
+# decisions on the default rules as modified by any command-line options.
+#
+# VerticalAligner collects groups of lines together and tries to line up
+# certain tokens, such as '=>', '#', and '=' by adding whitespace.
+#
+# FileWriter simply writes lines to the output stream.
+#
+# The Logger package, not shown, records significant events and warning
+# messages. It writes a .LOG file, which may be saved with a
+# '-log' or a '-g' flag.
+
+{
+
+ # variables needed by interrupt handler:
+ my $tokenizer;
+ my $input_file;
+
+ # this routine may be called to give a status report if interrupted. If a
+ # parameter is given, it will call exit with that parameter. This is no
+ # longer used because it works under Unix but not under Windows.
+ sub interrupt_handler {
+
+ my $exit_flag = shift;
+ print STDERR "perltidy interrupted";
+ if ($tokenizer) {
+ my $input_line_number =
+ Perl::Tidy::Tokenizer::get_input_line_number();
+ print STDERR " at line $input_line_number";
+ }
+ if ($input_file) {
+
+ if ( ref $input_file ) { print STDERR " of reference to:" }
+ else { print STDERR " of file:" }
+ print STDERR " $input_file";
+ }
+ print STDERR "\n";
+ exit $exit_flag if defined($exit_flag);
+ }
+
+ sub perltidy {
+
+ my %defaults = (
+ argv => undef,
+ destination => undef,
+ formatter => undef,
+ logfile => undef,
+ errorfile => undef,
+ perltidyrc => undef,
+ source => undef,
+ stderr => undef,
+ dump_options => undef,
+ dump_options_type => undef,
+ dump_getopt_flags => undef,
+ dump_options_category => undef,
+ dump_options_range => undef,
+ dump_abbreviations => undef,
+ );
+
+ # don't overwrite callers ARGV
+ local @ARGV = @ARGV;
+
+ my %input_hash = @_;
+
+ if ( my @bad_keys = grep { !exists $defaults{$_} } keys %input_hash ) {
+ local $" = ')(';
+ my @good_keys = sort keys %defaults;
+ @bad_keys = sort @bad_keys;
+ confess <<EOM;
+------------------------------------------------------------------------
+Unknown perltidy parameter : (@bad_keys)
+perltidy only understands : (@good_keys)
+------------------------------------------------------------------------
+
+EOM
+ }
+
+ my $get_hash_ref = sub {
+ my ($key) = @_;
+ my $hash_ref = $input_hash{$key};
+ if ( defined($hash_ref) ) {
+ unless ( ref($hash_ref) eq 'HASH' ) {
+ my $what = ref($hash_ref);
+ my $but_is =
+ $what ? "but is ref to $what" : "but is not a reference";
+ croak <<EOM;
+------------------------------------------------------------------------
+error in call to perltidy:
+-$key must be reference to HASH $but_is
+------------------------------------------------------------------------
+EOM
+ }
+ }
+ return $hash_ref;
+ };
+
+ %input_hash = ( %defaults, %input_hash );
+ my $argv = $input_hash{'argv'};
+ my $destination_stream = $input_hash{'destination'};
+ my $errorfile_stream = $input_hash{'errorfile'};
+ my $logfile_stream = $input_hash{'logfile'};
+ my $perltidyrc_stream = $input_hash{'perltidyrc'};
+ my $source_stream = $input_hash{'source'};
+ my $stderr_stream = $input_hash{'stderr'};
+ my $user_formatter = $input_hash{'formatter'};
+
+ # various dump parameters
+ my $dump_options_type = $input_hash{'dump_options_type'};
+ my $dump_options = $get_hash_ref->('dump_options');
+ my $dump_getopt_flags = $get_hash_ref->('dump_getopt_flags');
+ my $dump_options_category = $get_hash_ref->('dump_options_category');
+ my $dump_abbreviations = $get_hash_ref->('dump_abbreviations');
+ my $dump_options_range = $get_hash_ref->('dump_options_range');
+
+ # validate dump_options_type
+ if ( defined($dump_options) ) {
+ unless ( defined($dump_options_type) ) {
+ $dump_options_type = 'perltidyrc';
+ }
+ unless ( $dump_options_type =~ /^(perltidyrc|full)$/ ) {
+ croak <<EOM;
+------------------------------------------------------------------------
+Please check value of -dump_options_type in call to perltidy;
+saw: '$dump_options_type'
+expecting: 'perltidyrc' or 'full'
+------------------------------------------------------------------------
+EOM
+
+ }
+ }
+ else {
+ $dump_options_type = "";
+ }
+
+ if ($user_formatter) {
+
+ # if the user defines a formatter, there is no output stream,
+ # but we need a null stream to keep coding simple
+ $destination_stream = Perl::Tidy::DevNull->new();
+ }
+
+ # see if ARGV is overridden
+ if ( defined($argv) ) {
+
+ my $rargv = ref $argv;
+ if ( $rargv eq 'SCALAR' ) { $argv = $$argv; $rargv = undef }
+
+ # ref to ARRAY
+ if ($rargv) {
+ if ( $rargv eq 'ARRAY' ) {
+ @ARGV = @$argv;
+ }
+ else {
+ croak <<EOM;
+------------------------------------------------------------------------
+Please check value of -argv in call to perltidy;
+it must be a string or ref to ARRAY but is: $rargv
+------------------------------------------------------------------------
+EOM
+ }
+ }
+
+ # string
+ else {
+ my ( $rargv, $msg ) = parse_args($argv);
+ if ($msg) {
+ die <<EOM;
+Error parsing this string passed to to perltidy with 'argv':
+$msg
+EOM
+ }
+ @ARGV = @{$rargv};
+ }
+ }
+
+ # redirect STDERR if requested
+ if ($stderr_stream) {
+ my ( $fh_stderr, $stderr_file ) =
+ Perl::Tidy::streamhandle( $stderr_stream, 'w' );
+ if ($fh_stderr) { *STDERR = $fh_stderr }
+ else {
+ croak <<EOM;
+------------------------------------------------------------------------
+Unable to redirect STDERR to $stderr_stream
+Please check value of -stderr in call to perltidy
+------------------------------------------------------------------------
+EOM
+ }
+ }
+
+ my $rpending_complaint;
+ $$rpending_complaint = "";
+ my $rpending_logfile_message;
+ $$rpending_logfile_message = "";
+
+ my ( $is_Windows, $Windows_type ) =
+ look_for_Windows($rpending_complaint);
+
+ # VMS file names are restricted to a 40.40 format, so we append _tdy
+ # instead of .tdy, etc. (but see also sub check_vms_filename)
+ my $dot;
+ my $dot_pattern;
+ if ( $^O eq 'VMS' ) {
+ $dot = '_';
+ $dot_pattern = '_';
+ }
+ else {
+ $dot = '.';
+ $dot_pattern = '\.'; # must escape for use in regex
+ }
+
+ # handle command line options
+ my ( $rOpts, $config_file, $rraw_options, $saw_extrude, $roption_string,
+ $rexpansion, $roption_category, $roption_range )
+ = process_command_line(
+ $perltidyrc_stream, $is_Windows, $Windows_type,
+ $rpending_complaint, $dump_options_type,
+ );
+
+ # return or exit immediately after all dumps
+ my $quit_now = 0;
+
+ # Getopt parameters and their flags
+ if ( defined($dump_getopt_flags) ) {
+ $quit_now = 1;
+ foreach my $op ( @{$roption_string} ) {
+ my $opt = $op;
+ my $flag = "";
+
+ # Examples:
+ # some-option=s
+ # some-option=i
+ # some-option:i
+ # some-option!
+ if ( $opt =~ /(.*)(!|=.*|:.*)$/ ) {
+ $opt = $1;
+ $flag = $2;
+ }
+ $dump_getopt_flags->{$opt} = $flag;
+ }
+ }
+
+ if ( defined($dump_options_category) ) {
+ $quit_now = 1;
+ %{$dump_options_category} = %{$roption_category};
+ }
+
+ if ( defined($dump_options_range) ) {
+ $quit_now = 1;
+ %{$dump_options_range} = %{$roption_range};
+ }
+
+ if ( defined($dump_abbreviations) ) {
+ $quit_now = 1;
+ %{$dump_abbreviations} = %{$rexpansion};
+ }
+
+ if ( defined($dump_options) ) {
+ $quit_now = 1;
+ %{$dump_options} = %{$rOpts};
+ }
+
+ return if ($quit_now);
+
+ # make printable string of options for this run as possible diagnostic
+ my $readable_options = readable_options( $rOpts, $roption_string );
+
+ # dump from command line
+ if ( $rOpts->{'dump-options'} ) {
+ print STDOUT $readable_options;
+ exit 1;
+ }
+
+ check_options( $rOpts, $is_Windows, $Windows_type,
+ $rpending_complaint );
+
+ if ($user_formatter) {
+ $rOpts->{'format'} = 'user';
+ }
+
+ # there must be one entry here for every possible format
+ my %default_file_extension = (
+ tidy => 'tdy',
+ html => 'html',
+ user => '',
+ );
+
+ # be sure we have a valid output format
+ unless ( exists $default_file_extension{ $rOpts->{'format'} } ) {
+ my $formats = join ' ',
+ sort map { "'" . $_ . "'" } keys %default_file_extension;
+ my $fmt = $rOpts->{'format'};
+ die "-format='$fmt' but must be one of: $formats\n";
+ }
+
+ my $output_extension =
+ make_extension( $rOpts->{'output-file-extension'},
+ $default_file_extension{ $rOpts->{'format'} }, $dot );
+
+ my $backup_extension =
+ make_extension( $rOpts->{'backup-file-extension'}, 'bak', $dot );
+
+ my $html_toc_extension =
+ make_extension( $rOpts->{'html-toc-extension'}, 'toc', $dot );
+
+ my $html_src_extension =
+ make_extension( $rOpts->{'html-src-extension'}, 'src', $dot );
+
+ # check for -b option;
+ my $in_place_modify = $rOpts->{'backup-and-modify-in-place'}
+ && $rOpts->{'format'} eq 'tidy' # silently ignore unless beautify mode
+ && @ARGV > 0; # silently ignore if standard input;
+ # this allows -b to be in a .perltidyrc file
+ # without error messages when running from an editor
+
+ # turn off -b with warnings in case of conflicts with other options
+ if ($in_place_modify) {
+ if ( $rOpts->{'standard-output'} ) {
+ warn "Ignoring -b; you may not use -b and -st together\n";
+ $in_place_modify = 0;
+ }
+ if ($destination_stream) {
+ warn
+"Ignoring -b; you may not specify a destination array and -b together\n";
+ $in_place_modify = 0;
+ }
+ if ($source_stream) {
+ warn
+"Ignoring -b; you may not specify a source array and -b together\n";
+ $in_place_modify = 0;
+ }
+ if ( $rOpts->{'outfile'} ) {
+ warn "Ignoring -b; you may not use -b and -o together\n";
+ $in_place_modify = 0;
+ }
+ if ( defined( $rOpts->{'output-path'} ) ) {
+ warn "Ignoring -b; you may not use -b and -opath together\n";
+ $in_place_modify = 0;
+ }
+ }
+
+ Perl::Tidy::Formatter::check_options($rOpts);
+ if ( $rOpts->{'format'} eq 'html' ) {
+ Perl::Tidy::HtmlWriter->check_options($rOpts);
+ }
+
+ # make the pattern of file extensions that we shouldn't touch
+ my $forbidden_file_extensions = "(($dot_pattern)(LOG|DEBUG|ERR|TEE)";
+ if ($output_extension) {
+ my $ext = quotemeta($output_extension);
+ $forbidden_file_extensions .= "|$ext";
+ }
+ if ( $in_place_modify && $backup_extension ) {
+ my $ext = quotemeta($backup_extension);
+ $forbidden_file_extensions .= "|$ext";
+ }
+ $forbidden_file_extensions .= ')$';
+
+ # Create a diagnostics object if requested;
+ # This is only useful for code development
+ my $diagnostics_object = undef;
+ if ( $rOpts->{'DIAGNOSTICS'} ) {
+ $diagnostics_object = Perl::Tidy::Diagnostics->new();
+ }
+
+ # no filenames should be given if input is from an array
+ if ($source_stream) {
+ if ( @ARGV > 0 ) {
+ die
+"You may not specify any filenames when a source array is given\n";
+ }
+
+ # we'll stuff the source array into ARGV
+ unshift( @ARGV, $source_stream );
+
+ # No special treatment for source stream which is a filename.
+ # This will enable checks for binary files and other bad stuff.
+ $source_stream = undef unless ref($source_stream);
+ }
+
+ # use stdin by default if no source array and no args
+ else {
+ unshift( @ARGV, '-' ) unless @ARGV;
+ }
+
+ # loop to process all files in argument list
+ my $number_of_files = @ARGV;
+ my $formatter = undef;
+ $tokenizer = undef;
+ while ( $input_file = shift @ARGV ) {
+ my $fileroot;
+ my $input_file_permissions;
+
+ #---------------------------------------------------------------
+ # determine the input file name
+ #---------------------------------------------------------------
+ if ($source_stream) {
+ $fileroot = "perltidy";
+ }
+ elsif ( $input_file eq '-' ) { # '-' indicates input from STDIN
+ $fileroot = "perltidy"; # root name to use for .ERR, .LOG, etc
+ $in_place_modify = 0;
+ }
+ else {
+ $fileroot = $input_file;
+ unless ( -e $input_file ) {
+
+ # file doesn't exist - check for a file glob
+ if ( $input_file =~ /([\?\*\[\{])/ ) {
+
+ # Windows shell may not remove quotes, so do it
+ my $input_file = $input_file;
+ if ( $input_file =~ /^\'(.+)\'$/ ) { $input_file = $1 }
+ if ( $input_file =~ /^\"(.+)\"$/ ) { $input_file = $1 }
+ my $pattern = fileglob_to_re($input_file);
+ eval "/$pattern/";
+ if ( !$@ && opendir( DIR, './' ) ) {
+ my @files =
+ grep { /$pattern/ && !-d $_ } readdir(DIR);
+ closedir(DIR);
+ if (@files) {
+ unshift @ARGV, @files;
+ next;
+ }
+ }
+ }
+ print "skipping file: '$input_file': no matches found\n";
+ next;
+ }
+
+ unless ( -f $input_file ) {
+ print "skipping file: $input_file: not a regular file\n";
+ next;
+ }
+
+ unless ( ( -T $input_file ) || $rOpts->{'force-read-binary'} ) {
+ print
+"skipping file: $input_file: Non-text (override with -f)\n";
+ next;
+ }
+
+ # we should have a valid filename now
+ $fileroot = $input_file;
+ $input_file_permissions = ( stat $input_file )[2] & 07777;
+
+ if ( $^O eq 'VMS' ) {
+ ( $fileroot, $dot ) = check_vms_filename($fileroot);
+ }
+
+ # add option to change path here
+ if ( defined( $rOpts->{'output-path'} ) ) {
+
+ my ( $base, $old_path ) = fileparse($fileroot);
+ my $new_path = $rOpts->{'output-path'};
+ unless ( -d $new_path ) {
+ unless ( mkdir $new_path, 0777 ) {
+ die "unable to create directory $new_path: $!\n";
+ }
+ }
+ my $path = $new_path;
+ $fileroot = catfile( $path, $base );
+ unless ($fileroot) {
+ die <<EOM;
+------------------------------------------------------------------------
+Problem combining $new_path and $base to make a filename; check -opath
+------------------------------------------------------------------------
+EOM
+ }
+ }
+ }
+
+ # Skip files with same extension as the output files because
+ # this can lead to a messy situation with files like
+ # script.tdy.tdy.tdy ... or worse problems ... when you
+ # rerun perltidy over and over with wildcard input.
+ if (
+ !$source_stream
+ && ( $input_file =~ /$forbidden_file_extensions/o
+ || $input_file eq 'DIAGNOSTICS' )
+ )
+ {
+ print "skipping file: $input_file: wrong extension\n";
+ next;
+ }
+
+ # the 'source_object' supplies a method to read the input file
+ my $source_object =
+ Perl::Tidy::LineSource->new( $input_file, $rOpts,
+ $rpending_logfile_message );
+ next unless ($source_object);
+
+ # register this file name with the Diagnostics package
+ $diagnostics_object->set_input_file($input_file)
+ if $diagnostics_object;
+
+ #---------------------------------------------------------------
+ # determine the output file name
+ #---------------------------------------------------------------
+ my $output_file = undef;
+ my $actual_output_extension;
+
+ if ( $rOpts->{'outfile'} ) {
+
+ if ( $number_of_files <= 1 ) {
+
+ if ( $rOpts->{'standard-output'} ) {
+ die "You may not use -o and -st together\n";
+ }
+ elsif ($destination_stream) {
+ die
+"You may not specify a destination array and -o together\n";
+ }
+ elsif ( defined( $rOpts->{'output-path'} ) ) {
+ die "You may not specify -o and -opath together\n";
+ }
+ elsif ( defined( $rOpts->{'output-file-extension'} ) ) {
+ die "You may not specify -o and -oext together\n";
+ }
+ $output_file = $rOpts->{outfile};
+
+ # make sure user gives a file name after -o
+ if ( $output_file =~ /^-/ ) {
+ die "You must specify a valid filename after -o\n";
+ }
+
+ # do not overwrite input file with -o
+ if ( defined($input_file_permissions)
+ && ( $output_file eq $input_file ) )
+ {
+ die
+ "Use 'perltidy -b $input_file' to modify in-place\n";
+ }
+ }
+ else {
+ die "You may not use -o with more than one input file\n";
+ }
+ }
+ elsif ( $rOpts->{'standard-output'} ) {
+ if ($destination_stream) {
+ die
+"You may not specify a destination array and -st together\n";
+ }
+ $output_file = '-';
+
+ if ( $number_of_files <= 1 ) {
+ }
+ else {
+ die "You may not use -st with more than one input file\n";
+ }
+ }
+ elsif ($destination_stream) {
+ $output_file = $destination_stream;
+ }
+ elsif ($source_stream) { # source but no destination goes to stdout
+ $output_file = '-';
+ }
+ elsif ( $input_file eq '-' ) {
+ $output_file = '-';
+ }
+ else {
+ if ($in_place_modify) {
+ $output_file = IO::File->new_tmpfile()
+ or die "cannot open temp file for -b option: $!\n";
+ }
+ else {
+ $actual_output_extension = $output_extension;
+ $output_file = $fileroot . $output_extension;
+ }
+ }
+
+ # the 'sink_object' knows how to write the output file
+ my $tee_file = $fileroot . $dot . "TEE";
+
+ my $line_separator = $rOpts->{'output-line-ending'};
+ if ( $rOpts->{'preserve-line-endings'} ) {
+ $line_separator = find_input_line_ending($input_file);
+ }
+
+ # Eventually all I/O may be done with binmode, but for now it is
+ # only done when a user requests a particular line separator
+ # through the -ple or -ole flags
+ my $binmode = 0;
+ if ( defined($line_separator) ) { $binmode = 1 }
+ else { $line_separator = "\n" }
+
+ my $sink_object =
+ Perl::Tidy::LineSink->new( $output_file, $tee_file,
+ $line_separator, $rOpts, $rpending_logfile_message, $binmode );
+
+ #---------------------------------------------------------------
+ # initialize the error logger
+ #---------------------------------------------------------------
+ my $warning_file = $fileroot . $dot . "ERR";
+ if ($errorfile_stream) { $warning_file = $errorfile_stream }
+ my $log_file = $fileroot . $dot . "LOG";
+ if ($logfile_stream) { $log_file = $logfile_stream }
+
+ my $logger_object =
+ Perl::Tidy::Logger->new( $rOpts, $log_file, $warning_file,
+ $saw_extrude );
+ write_logfile_header(
+ $rOpts, $logger_object, $config_file,
+ $rraw_options, $Windows_type, $readable_options,
+ );
+ if ($$rpending_logfile_message) {
+ $logger_object->write_logfile_entry($$rpending_logfile_message);
+ }
+ if ($$rpending_complaint) {
+ $logger_object->complain($$rpending_complaint);
+ }
+
+ #---------------------------------------------------------------
+ # initialize the debug object, if any
+ #---------------------------------------------------------------
+ my $debugger_object = undef;
+ if ( $rOpts->{DEBUG} ) {
+ $debugger_object =
+ Perl::Tidy::Debugger->new( $fileroot . $dot . "DEBUG" );
+ }
+
+ #---------------------------------------------------------------
+ # create a formatter for this file : html writer or pretty printer
+ #---------------------------------------------------------------
+
+ # we have to delete any old formatter because, for safety,
+ # the formatter will check to see that there is only one.
+ $formatter = undef;
+
+ if ($user_formatter) {
+ $formatter = $user_formatter;
+ }
+ elsif ( $rOpts->{'format'} eq 'html' ) {
+ $formatter =
+ Perl::Tidy::HtmlWriter->new( $fileroot, $output_file,
+ $actual_output_extension, $html_toc_extension,
+ $html_src_extension );
+ }
+ elsif ( $rOpts->{'format'} eq 'tidy' ) {
+ $formatter = Perl::Tidy::Formatter->new(
+ logger_object => $logger_object,
+ diagnostics_object => $diagnostics_object,
+ sink_object => $sink_object,
+ );
+ }
+ else {
+ die "I don't know how to do -format=$rOpts->{'format'}\n";
+ }
+
+ unless ($formatter) {
+ die "Unable to continue with $rOpts->{'format'} formatting\n";
+ }
+
+ #---------------------------------------------------------------
+ # create the tokenizer for this file
+ #---------------------------------------------------------------
+ $tokenizer = undef; # must destroy old tokenizer
+ $tokenizer = Perl::Tidy::Tokenizer->new(
+ source_object => $source_object,
+ logger_object => $logger_object,
+ debugger_object => $debugger_object,
+ diagnostics_object => $diagnostics_object,
+ starting_level => $rOpts->{'starting-indentation-level'},
+ tabs => $rOpts->{'tabs'},
+ indent_columns => $rOpts->{'indent-columns'},
+ look_for_hash_bang => $rOpts->{'look-for-hash-bang'},
+ look_for_autoloader => $rOpts->{'look-for-autoloader'},
+ look_for_selfloader => $rOpts->{'look-for-selfloader'},
+ trim_qw => $rOpts->{'trim-qw'},
+ );
+
+ #---------------------------------------------------------------
+ # now we can do it
+ #---------------------------------------------------------------
+ process_this_file( $tokenizer, $formatter );
+
+ #---------------------------------------------------------------
+ # close the input source and report errors
+ #---------------------------------------------------------------
+ $source_object->close_input_file();
+
+ # get file names to use for syntax check
+ my $ifname = $source_object->get_input_file_copy_name();
+ my $ofname = $sink_object->get_output_file_copy();
+
+ #---------------------------------------------------------------
+ # handle the -b option (backup and modify in-place)
+ #---------------------------------------------------------------
+ if ($in_place_modify) {
+ unless ( -f $input_file ) {
+
+ # oh, oh, no real file to backup ..
+ # shouldn't happen because of numerous preliminary checks
+ die print
+"problem with -b backing up input file '$input_file': not a file\n";
+ }
+ my $backup_name = $input_file . $backup_extension;
+ if ( -f $backup_name ) {
+ unlink($backup_name)
+ or die
+"unable to remove previous '$backup_name' for -b option; check permissions: $!\n";
+ }
+ rename( $input_file, $backup_name )
+ or die
+"problem renaming $input_file to $backup_name for -b option: $!\n";
+ $ifname = $backup_name;
+
+ seek( $output_file, 0, 0 )
+ or die "unable to rewind tmp file for -b option: $!\n";
+
+ my $fout = IO::File->new("> $input_file")
+ or die
+"problem opening $input_file for write for -b option; check directory permissions: $!\n";
+ binmode $fout;
+ my $line;
+ while ( $line = $output_file->getline() ) {
+ $fout->print($line);
+ }
+ $fout->close();
+ $output_file = $input_file;
+ $ofname = $input_file;
+ }
+
+ #---------------------------------------------------------------
+ # clean up and report errors
+ #---------------------------------------------------------------
+ $sink_object->close_output_file() if $sink_object;
+ $debugger_object->close_debug_file() if $debugger_object;
+
+ my $infile_syntax_ok = 0; # -1 no 0=don't know 1 yes
+ if ($output_file) {
+
+ if ($input_file_permissions) {
+
+ # give output script same permissions as input script, but
+ # make it user-writable or else we can't run perltidy again.
+ # Thus we retain whatever executable flags were set.
+ if ( $rOpts->{'format'} eq 'tidy' ) {
+ chmod( $input_file_permissions | 0600, $output_file );
+ }
+
+ # else use default permissions for html and any other format
+
+ }
+ if ( $logger_object && $rOpts->{'check-syntax'} ) {
+ $infile_syntax_ok =
+ check_syntax( $ifname, $ofname, $logger_object, $rOpts );
+ }
+ }
+
+ $logger_object->finish( $infile_syntax_ok, $formatter )
+ if $logger_object;
+ } # end of loop to process all files
+ } # end of main program
+}
+
+sub fileglob_to_re {
+
+ # modified (corrected) from version in find2perl
+ my $x = shift;
+ $x =~ s#([./^\$()])#\\$1#g; # escape special characters
+ $x =~ s#\*#.*#g; # '*' -> '.*'
+ $x =~ s#\?#.#g; # '?' -> '.'
+ "^$x\\z"; # match whole word
+}
+
+sub make_extension {
+
+ # Make a file extension, including any leading '.' if necessary
+ # The '.' may actually be an '_' under VMS
+ my ( $extension, $default, $dot ) = @_;
+
+ # Use the default if none specified
+ $extension = $default unless ($extension);
+
+ # Only extensions with these leading characters get a '.'
+ # This rule gives the user some freedom
+ if ( $extension =~ /^[a-zA-Z0-9]/ ) {
+ $extension = $dot . $extension;
+ }
+ return $extension;
+}
+
+sub write_logfile_header {
+ my (
+ $rOpts, $logger_object, $config_file,
+ $rraw_options, $Windows_type, $readable_options
+ ) = @_;
+ $logger_object->write_logfile_entry(
+"perltidy version $VERSION log file on a $^O system, OLD_PERL_VERSION=$]\n"
+ );
+ if ($Windows_type) {
+ $logger_object->write_logfile_entry("Windows type is $Windows_type\n");
+ }
+ my $options_string = join( ' ', @$rraw_options );
+
+ if ($config_file) {
+ $logger_object->write_logfile_entry(
+ "Found Configuration File >>> $config_file \n");
+ }
+ $logger_object->write_logfile_entry(
+ "Configuration and command line parameters for this run:\n");
+ $logger_object->write_logfile_entry("$options_string\n");
+
+ if ( $rOpts->{'DEBUG'} || $rOpts->{'show-options'} ) {
+ $rOpts->{'logfile'} = 1; # force logfile to be saved
+ $logger_object->write_logfile_entry(
+ "Final parameter set for this run\n");
+ $logger_object->write_logfile_entry(
+ "------------------------------------\n");
+
+ $logger_object->write_logfile_entry($readable_options);
+
+ $logger_object->write_logfile_entry(
+ "------------------------------------\n");
+ }
+ $logger_object->write_logfile_entry(
+ "To find error messages search for 'WARNING' with your editor\n");
+}
+
+sub generate_options {
+
+ ######################################################################
+ # Generate and return references to:
+ # @option_string - the list of options to be passed to Getopt::Long
+ # @defaults - the list of default options
+ # %expansion - a hash showing how all abbreviations are expanded
+ # %category - a hash giving the general category of each option
+ # %option_range - a hash giving the valid ranges of certain options
+
+ # Note: a few options are not documented in the man page and usage
+ # message. This is because these are experimental or debug options and
+ # may or may not be retained in future versions.
+ #
+ # Here are the undocumented flags as far as I know. Any of them
+ # may disappear at any time. They are mainly for fine-tuning
+ # and debugging.
+ #
+ # fll --> fuzzy-line-length # a trivial parameter which gets
+ # turned off for the extrude option
+ # which is mainly for debugging
+ # chk --> check-multiline-quotes # check for old bug; to be deleted
+ # scl --> short-concatenation-item-length # helps break at '.'
+ # recombine # for debugging line breaks
+ # valign # for debugging vertical alignment
+ # I --> DIAGNOSTICS # for debugging
+ ######################################################################
+
+ # here is a summary of the Getopt codes:
+ # <none> does not take an argument
+ # =s takes a mandatory string
+ # :s takes an optional string (DO NOT USE - filenames will get eaten up)
+ # =i takes a mandatory integer
+ # :i takes an optional integer (NOT RECOMMENDED - can cause trouble)
+ # ! does not take an argument and may be negated
+ # i.e., -foo and -nofoo are allowed
+ # a double dash signals the end of the options list
+ #
+ #---------------------------------------------------------------
+ # Define the option string passed to GetOptions.
+ #---------------------------------------------------------------
+
+ my @option_string = ();
+ my %expansion = ();
+ my %option_category = ();
+ my %option_range = ();
+ my $rexpansion = \%expansion;
+
+ # names of categories in manual
+ # leading integers will allow sorting
+ my @category_name = (
+ '0. I/O control',
+ '1. Basic formatting options',
+ '2. Code indentation control',
+ '3. Whitespace control',
+ '4. Comment controls',
+ '5. Linebreak controls',
+ '6. Controlling list formatting',
+ '7. Retaining or ignoring existing line breaks',
+ '8. Blank line control',
+ '9. Other controls',
+ '10. HTML options',
+ '11. pod2html options',
+ '12. Controlling HTML properties',
+ '13. Debugging',
+ );
+
+ # These options are parsed directly by perltidy:
+ # help h
+ # version v
+ # However, they are included in the option set so that they will
+ # be seen in the options dump.
+
+ # These long option names have no abbreviations or are treated specially
+ @option_string = qw(
+ html!
+ noprofile
+ no-profile
+ npro
+ recombine!
+ valign!
+ );
+
+ my $category = 13; # Debugging
+ foreach (@option_string) {
+ my $opt = $_; # must avoid changing the actual flag
+ $opt =~ s/!$//;
+ $option_category{$opt} = $category_name[$category];
+ }
+
+ $category = 11; # HTML
+ $option_category{html} = $category_name[$category];
+
+ # routine to install and check options
+ my $add_option = sub {
+ my ( $long_name, $short_name, $flag ) = @_;
+ push @option_string, $long_name . $flag;
+ $option_category{$long_name} = $category_name[$category];
+ if ($short_name) {
+ if ( $expansion{$short_name} ) {
+ my $existing_name = $expansion{$short_name}[0];
+ die
+"redefining abbreviation $short_name for $long_name; already used for $existing_name\n";
+ }
+ $expansion{$short_name} = [$long_name];
+ if ( $flag eq '!' ) {
+ my $nshort_name = 'n' . $short_name;
+ my $nolong_name = 'no' . $long_name;
+ if ( $expansion{$nshort_name} ) {
+ my $existing_name = $expansion{$nshort_name}[0];
+ die
+"attempting to redefine abbreviation $nshort_name for $nolong_name; already used for $existing_name\n";
+ }
+ $expansion{$nshort_name} = [$nolong_name];
+ }
+ }
+ };
+
+ # Install long option names which have a simple abbreviation.
+ # Options with code '!' get standard negation ('no' for long names,
+ # 'n' for abbreviations). Categories follow the manual.
+
+ ###########################
+ $category = 0; # I/O_Control
+ ###########################
+ $add_option->( 'backup-and-modify-in-place', 'b', '!' );
+ $add_option->( 'backup-file-extension', 'bext', '=s' );
+ $add_option->( 'force-read-binary', 'f', '!' );
+ $add_option->( 'format', 'fmt', '=s' );
+ $add_option->( 'logfile', 'log', '!' );
+ $add_option->( 'logfile-gap', 'g', ':i' );
+ $add_option->( 'outfile', 'o', '=s' );
+ $add_option->( 'output-file-extension', 'oext', '=s' );
+ $add_option->( 'output-path', 'opath', '=s' );
+ $add_option->( 'profile', 'pro', '=s' );
+ $add_option->( 'quiet', 'q', '!' );
+ $add_option->( 'standard-error-output', 'se', '!' );
+ $add_option->( 'standard-output', 'st', '!' );
+ $add_option->( 'warning-output', 'w', '!' );
+
+ # options which are both toggle switches and values moved here
+ # to hide from tidyview (which does not show category 0 flags):
+ # -ole moved here from category 1
+ # -sil moved here from category 2
+ $add_option->( 'output-line-ending', 'ole', '=s' );
+ $add_option->( 'starting-indentation-level', 'sil', '=i' );
+
+ ########################################
+ $category = 1; # Basic formatting options
+ ########################################
+ $add_option->( 'check-syntax', 'syn', '!' );
+ $add_option->( 'entab-leading-whitespace', 'et', '=i' );
+ $add_option->( 'indent-columns', 'i', '=i' );
+ $add_option->( 'maximum-line-length', 'l', '=i' );
+ $add_option->( 'perl-syntax-check-flags', 'pscf', '=s' );
+ $add_option->( 'preserve-line-endings', 'ple', '!' );
+ $add_option->( 'tabs', 't', '!' );
+
+ ########################################
+ $category = 2; # Code indentation control
+ ########################################
+ $add_option->( 'continuation-indentation', 'ci', '=i' );
+ $add_option->( 'line-up-parentheses', 'lp', '!' );
+ $add_option->( 'outdent-keyword-list', 'okwl', '=s' );
+ $add_option->( 'outdent-keywords', 'okw', '!' );
+ $add_option->( 'outdent-labels', 'ola', '!' );
+ $add_option->( 'outdent-long-quotes', 'olq', '!' );
+ $add_option->( 'indent-closing-brace', 'icb', '!' );
+ $add_option->( 'closing-token-indentation', 'cti', '=i' );
+ $add_option->( 'closing-paren-indentation', 'cpi', '=i' );
+ $add_option->( 'closing-brace-indentation', 'cbi', '=i' );
+ $add_option->( 'closing-square-bracket-indentation', 'csbi', '=i' );
+ $add_option->( 'brace-left-and-indent', 'bli', '!' );
+ $add_option->( 'brace-left-and-indent-list', 'blil', '=s' );
+
+ ########################################
+ $category = 3; # Whitespace control
+ ########################################
+ $add_option->( 'add-semicolons', 'asc', '!' );
+ $add_option->( 'add-whitespace', 'aws', '!' );
+ $add_option->( 'block-brace-tightness', 'bbt', '=i' );
+ $add_option->( 'brace-tightness', 'bt', '=i' );
+ $add_option->( 'delete-old-whitespace', 'dws', '!' );
+ $add_option->( 'delete-semicolons', 'dsm', '!' );
+ $add_option->( 'nospace-after-keyword', 'nsak', '=s' );
+ $add_option->( 'nowant-left-space', 'nwls', '=s' );
+ $add_option->( 'nowant-right-space', 'nwrs', '=s' );
+ $add_option->( 'paren-tightness', 'pt', '=i' );
+ $add_option->( 'space-after-keyword', 'sak', '=s' );
+ $add_option->( 'space-for-semicolon', 'sfs', '!' );
+ $add_option->( 'space-function-paren', 'sfp', '!' );
+ $add_option->( 'space-keyword-paren', 'skp', '!' );
+ $add_option->( 'space-terminal-semicolon', 'sts', '!' );
+ $add_option->( 'square-bracket-tightness', 'sbt', '=i' );
+ $add_option->( 'square-bracket-vertical-tightness', 'sbvt', '=i' );
+ $add_option->( 'square-bracket-vertical-tightness-closing', 'sbvtc', '=i' );
+ $add_option->( 'trim-qw', 'tqw', '!' );
+ $add_option->( 'want-left-space', 'wls', '=s' );
+ $add_option->( 'want-right-space', 'wrs', '=s' );
+
+ ########################################
+ $category = 4; # Comment controls
+ ########################################
+ $add_option->( 'closing-side-comment-else-flag', 'csce', '=i' );
+ $add_option->( 'closing-side-comment-interval', 'csci', '=i' );
+ $add_option->( 'closing-side-comment-list', 'cscl', '=s' );
+ $add_option->( 'closing-side-comment-maximum-text', 'csct', '=i' );
+ $add_option->( 'closing-side-comment-prefix', 'cscp', '=s' );
+ $add_option->( 'closing-side-comment-warnings', 'cscw', '!' );
+ $add_option->( 'closing-side-comments', 'csc', '!' );
+ $add_option->( 'format-skipping', 'fs', '!' );
+ $add_option->( 'format-skipping-begin', 'fsb', '=s' );
+ $add_option->( 'format-skipping-end', 'fse', '=s' );
+ $add_option->( 'hanging-side-comments', 'hsc', '!' );
+ $add_option->( 'indent-block-comments', 'ibc', '!' );
+ $add_option->( 'indent-spaced-block-comments', 'isbc', '!' );
+ $add_option->( 'fixed-position-side-comment', 'fpsc', '=i' );
+ $add_option->( 'minimum-space-to-comment', 'msc', '=i' );
+ $add_option->( 'outdent-long-comments', 'olc', '!' );
+ $add_option->( 'outdent-static-block-comments', 'osbc', '!' );
+ $add_option->( 'static-block-comment-prefix', 'sbcp', '=s' );
+ $add_option->( 'static-block-comments', 'sbc', '!' );
+ $add_option->( 'static-side-comment-prefix', 'sscp', '=s' );
+ $add_option->( 'static-side-comments', 'ssc', '!' );
+
+ ########################################
+ $category = 5; # Linebreak controls
+ ########################################
+ $add_option->( 'add-newlines', 'anl', '!' );
+ $add_option->( 'block-brace-vertical-tightness', 'bbvt', '=i' );
+ $add_option->( 'block-brace-vertical-tightness-list', 'bbvtl', '=s' );
+ $add_option->( 'brace-vertical-tightness', 'bvt', '=i' );
+ $add_option->( 'brace-vertical-tightness-closing', 'bvtc', '=i' );
+ $add_option->( 'cuddled-else', 'ce', '!' );
+ $add_option->( 'delete-old-newlines', 'dnl', '!' );
+ $add_option->( 'opening-brace-always-on-right', 'bar', '!' );
+ $add_option->( 'opening-brace-on-new-line', 'bl', '!' );
+ $add_option->( 'opening-hash-brace-right', 'ohbr', '!' );
+ $add_option->( 'opening-paren-right', 'opr', '!' );
+ $add_option->( 'opening-square-bracket-right', 'osbr', '!' );
+ $add_option->( 'opening-sub-brace-on-new-line', 'sbl', '!' );
+ $add_option->( 'paren-vertical-tightness', 'pvt', '=i' );
+ $add_option->( 'paren-vertical-tightness-closing', 'pvtc', '=i' );
+ $add_option->( 'stack-closing-hash-brace', 'schb', '!' );
+ $add_option->( 'stack-closing-paren', 'scp', '!' );
+ $add_option->( 'stack-closing-square-bracket', 'scsb', '!' );
+ $add_option->( 'stack-opening-hash-brace', 'sohb', '!' );
+ $add_option->( 'stack-opening-paren', 'sop', '!' );
+ $add_option->( 'stack-opening-square-bracket', 'sosb', '!' );
+ $add_option->( 'vertical-tightness', 'vt', '=i' );
+ $add_option->( 'vertical-tightness-closing', 'vtc', '=i' );
+ $add_option->( 'want-break-after', 'wba', '=s' );
+ $add_option->( 'want-break-before', 'wbb', '=s' );
+ $add_option->( 'break-after-all-operators', 'baao', '!' );
+ $add_option->( 'break-before-all-operators', 'bbao', '!' );
+ $add_option->( 'keep-interior-semicolons', 'kis', '!' );
+
+ ########################################
+ $category = 6; # Controlling list formatting
+ ########################################
+ $add_option->( 'break-at-old-comma-breakpoints', 'boc', '!' );
+ $add_option->( 'comma-arrow-breakpoints', 'cab', '=i' );
+ $add_option->( 'maximum-fields-per-table', 'mft', '=i' );
+
+ ########################################
+ $category = 7; # Retaining or ignoring existing line breaks
+ ########################################
+ $add_option->( 'break-at-old-keyword-breakpoints', 'bok', '!' );
+ $add_option->( 'break-at-old-logical-breakpoints', 'bol', '!' );
+ $add_option->( 'break-at-old-ternary-breakpoints', 'bot', '!' );
+ $add_option->( 'ignore-old-breakpoints', 'iob', '!' );
+
+ ########################################
+ $category = 8; # Blank line control
+ ########################################
+ $add_option->( 'blanks-before-blocks', 'bbb', '!' );
+ $add_option->( 'blanks-before-comments', 'bbc', '!' );
+ $add_option->( 'blanks-before-subs', 'bbs', '!' );
+ $add_option->( 'long-block-line-count', 'lbl', '=i' );
+ $add_option->( 'maximum-consecutive-blank-lines', 'mbl', '=i' );
+ $add_option->( 'swallow-optional-blank-lines', 'sob', '!' );
+
+ ########################################
+ $category = 9; # Other controls
+ ########################################
+ $add_option->( 'delete-block-comments', 'dbc', '!' );
+ $add_option->( 'delete-closing-side-comments', 'dcsc', '!' );
+ $add_option->( 'delete-pod', 'dp', '!' );
+ $add_option->( 'delete-side-comments', 'dsc', '!' );
+ $add_option->( 'tee-block-comments', 'tbc', '!' );
+ $add_option->( 'tee-pod', 'tp', '!' );
+ $add_option->( 'tee-side-comments', 'tsc', '!' );
+ $add_option->( 'look-for-autoloader', 'lal', '!' );
+ $add_option->( 'look-for-hash-bang', 'x', '!' );
+ $add_option->( 'look-for-selfloader', 'lsl', '!' );
+ $add_option->( 'pass-version-line', 'pvl', '!' );
+
+ ########################################
+ $category = 13; # Debugging
+ ########################################
+ $add_option->( 'DEBUG', 'D', '!' );
+ $add_option->( 'DIAGNOSTICS', 'I', '!' );
+ $add_option->( 'check-multiline-quotes', 'chk', '!' );
+ $add_option->( 'dump-defaults', 'ddf', '!' );
+ $add_option->( 'dump-long-names', 'dln', '!' );
+ $add_option->( 'dump-options', 'dop', '!' );
+ $add_option->( 'dump-profile', 'dpro', '!' );
+ $add_option->( 'dump-short-names', 'dsn', '!' );
+ $add_option->( 'dump-token-types', 'dtt', '!' );
+ $add_option->( 'dump-want-left-space', 'dwls', '!' );
+ $add_option->( 'dump-want-right-space', 'dwrs', '!' );
+ $add_option->( 'fuzzy-line-length', 'fll', '!' );
+ $add_option->( 'help', 'h', '' );
+ $add_option->( 'short-concatenation-item-length', 'scl', '=i' );
+ $add_option->( 'show-options', 'opt', '!' );
+ $add_option->( 'version', 'v', '' );
+
+ #---------------------------------------------------------------------
+
+ # The Perl::Tidy::HtmlWriter will add its own options to the string
+ Perl::Tidy::HtmlWriter->make_getopt_long_names( \@option_string );
+
+ ########################################
+ # Set categories 10, 11, 12
+ ########################################
+ # Based on their known order
+ $category = 12; # HTML properties
+ foreach my $opt (@option_string) {
+ my $long_name = $opt;
+ $long_name =~ s/(!|=.*|:.*)$//;
+ unless ( defined( $option_category{$long_name} ) ) {
+ if ( $long_name =~ /^html-linked/ ) {
+ $category = 10; # HTML options
+ }
+ elsif ( $long_name =~ /^pod2html/ ) {
+ $category = 11; # Pod2html
+ }
+ $option_category{$long_name} = $category_name[$category];
+ }
+ }
+
+ #---------------------------------------------------------------
+ # Assign valid ranges to certain options
+ #---------------------------------------------------------------
+ # In the future, these may be used to make preliminary checks
+ # hash keys are long names
+ # If key or value is undefined:
+ # strings may have any value
+ # integer ranges are >=0
+ # If value is defined:
+ # value is [qw(any valid words)] for strings
+ # value is [min, max] for integers
+ # if min is undefined, there is no lower limit
+ # if max is undefined, there is no upper limit
+ # Parameters not listed here have defaults
+ %option_range = (
+ 'format' => [ 'tidy', 'html', 'user' ],
+ 'output-line-ending' => [ 'dos', 'win', 'mac', 'unix' ],
+
+ 'block-brace-tightness' => [ 0, 2 ],
+ 'brace-tightness' => [ 0, 2 ],
+ 'paren-tightness' => [ 0, 2 ],
+ 'square-bracket-tightness' => [ 0, 2 ],
+
+ 'block-brace-vertical-tightness' => [ 0, 2 ],
+ 'brace-vertical-tightness' => [ 0, 2 ],
+ 'brace-vertical-tightness-closing' => [ 0, 2 ],
+ 'paren-vertical-tightness' => [ 0, 2 ],
+ 'paren-vertical-tightness-closing' => [ 0, 2 ],
+ 'square-bracket-vertical-tightness' => [ 0, 2 ],
+ 'square-bracket-vertical-tightness-closing' => [ 0, 2 ],
+ 'vertical-tightness' => [ 0, 2 ],
+ 'vertical-tightness-closing' => [ 0, 2 ],
+
+ 'closing-brace-indentation' => [ 0, 3 ],
+ 'closing-paren-indentation' => [ 0, 3 ],
+ 'closing-square-bracket-indentation' => [ 0, 3 ],
+ 'closing-token-indentation' => [ 0, 3 ],
+
+ 'closing-side-comment-else-flag' => [ 0, 2 ],
+ 'comma-arrow-breakpoints' => [ 0, 3 ],
+ );
+
+ # Note: we could actually allow negative ci if someone really wants it:
+ # $option_range{'continuation-indentation'} = [ undef, undef ];
+
+ #---------------------------------------------------------------
+ # Assign default values to the above options here, except
+ # for 'outfile' and 'help'.
+ # These settings should approximate the perlstyle(1) suggestions.
+ #---------------------------------------------------------------
+ my @defaults = qw(
+ add-newlines
+ add-semicolons
+ add-whitespace
+ blanks-before-blocks
+ blanks-before-comments
+ blanks-before-subs
+ block-brace-tightness=0
+ block-brace-vertical-tightness=0
+ brace-tightness=1
+ brace-vertical-tightness-closing=0
+ brace-vertical-tightness=0
+ break-at-old-logical-breakpoints
+ break-at-old-ternary-breakpoints
+ break-at-old-keyword-breakpoints
+ comma-arrow-breakpoints=1
+ nocheck-syntax
+ closing-side-comment-interval=6
+ closing-side-comment-maximum-text=20
+ closing-side-comment-else-flag=0
+ closing-paren-indentation=0
+ closing-brace-indentation=0
+ closing-square-bracket-indentation=0
+ continuation-indentation=2
+ delete-old-newlines
+ delete-semicolons
+ fuzzy-line-length
+ hanging-side-comments
+ indent-block-comments
+ indent-columns=4
+ long-block-line-count=8
+ look-for-autoloader
+ look-for-selfloader
+ maximum-consecutive-blank-lines=1
+ maximum-fields-per-table=0
+ maximum-line-length=80
+ minimum-space-to-comment=4
+ nobrace-left-and-indent
+ nocuddled-else
+ nodelete-old-whitespace
+ nohtml
+ nologfile
+ noquiet
+ noshow-options
+ nostatic-side-comments
+ noswallow-optional-blank-lines
+ notabs
+ nowarning-output
+ outdent-labels
+ outdent-long-quotes
+ outdent-long-comments
+ paren-tightness=1
+ paren-vertical-tightness-closing=0
+ paren-vertical-tightness=0
+ pass-version-line
+ recombine
+ valign
+ short-concatenation-item-length=8
+ space-for-semicolon
+ square-bracket-tightness=1
+ square-bracket-vertical-tightness-closing=0
+ square-bracket-vertical-tightness=0
+ static-block-comments
+ trim-qw
+ format=tidy
+ backup-file-extension=bak
+ format-skipping
+
+ pod2html
+ html-table-of-contents
+ html-entities
+ );
+
+ push @defaults, "perl-syntax-check-flags=-c -T";
+
+ #---------------------------------------------------------------
+ # Define abbreviations which will be expanded into the above primitives.
+ # These may be defined recursively.
+ #---------------------------------------------------------------
+ %expansion = (
+ %expansion,
+ 'freeze-newlines' => [qw(noadd-newlines nodelete-old-newlines)],
+ 'fnl' => [qw(freeze-newlines)],
+ 'freeze-whitespace' => [qw(noadd-whitespace nodelete-old-whitespace)],
+ 'fws' => [qw(freeze-whitespace)],
+ 'indent-only' => [qw(freeze-newlines freeze-whitespace)],
+ 'outdent-long-lines' => [qw(outdent-long-quotes outdent-long-comments)],
+ 'nooutdent-long-lines' =>
+ [qw(nooutdent-long-quotes nooutdent-long-comments)],
+ 'noll' => [qw(nooutdent-long-lines)],
+ 'io' => [qw(indent-only)],
+ 'delete-all-comments' =>
+ [qw(delete-block-comments delete-side-comments delete-pod)],
+ 'nodelete-all-comments' =>
+ [qw(nodelete-block-comments nodelete-side-comments nodelete-pod)],
+ 'dac' => [qw(delete-all-comments)],
+ 'ndac' => [qw(nodelete-all-comments)],
+ 'gnu' => [qw(gnu-style)],
+ 'pbp' => [qw(perl-best-practices)],
+ 'tee-all-comments' =>
+ [qw(tee-block-comments tee-side-comments tee-pod)],
+ 'notee-all-comments' =>
+ [qw(notee-block-comments notee-side-comments notee-pod)],
+ 'tac' => [qw(tee-all-comments)],
+ 'ntac' => [qw(notee-all-comments)],
+ 'html' => [qw(format=html)],
+ 'nhtml' => [qw(format=tidy)],
+ 'tidy' => [qw(format=tidy)],
+
+ 'break-after-comma-arrows' => [qw(cab=0)],
+ 'nobreak-after-comma-arrows' => [qw(cab=1)],
+ 'baa' => [qw(cab=0)],
+ 'nbaa' => [qw(cab=1)],
+
+ 'break-at-old-trinary-breakpoints' => [qw(bot)],
+
+ 'cti=0' => [qw(cpi=0 cbi=0 csbi=0)],
+ 'cti=1' => [qw(cpi=1 cbi=1 csbi=1)],
+ 'cti=2' => [qw(cpi=2 cbi=2 csbi=2)],
+ 'icp' => [qw(cpi=2 cbi=2 csbi=2)],
+ 'nicp' => [qw(cpi=0 cbi=0 csbi=0)],
+
+ 'closing-token-indentation=0' => [qw(cpi=0 cbi=0 csbi=0)],
+ 'closing-token-indentation=1' => [qw(cpi=1 cbi=1 csbi=1)],
+ 'closing-token-indentation=2' => [qw(cpi=2 cbi=2 csbi=2)],
+ 'indent-closing-paren' => [qw(cpi=2 cbi=2 csbi=2)],
+ 'noindent-closing-paren' => [qw(cpi=0 cbi=0 csbi=0)],
+
+ 'vt=0' => [qw(pvt=0 bvt=0 sbvt=0)],
+ 'vt=1' => [qw(pvt=1 bvt=1 sbvt=1)],
+ 'vt=2' => [qw(pvt=2 bvt=2 sbvt=2)],
+
+ 'vertical-tightness=0' => [qw(pvt=0 bvt=0 sbvt=0)],
+ 'vertical-tightness=1' => [qw(pvt=1 bvt=1 sbvt=1)],
+ 'vertical-tightness=2' => [qw(pvt=2 bvt=2 sbvt=2)],
+
+ 'vtc=0' => [qw(pvtc=0 bvtc=0 sbvtc=0)],
+ 'vtc=1' => [qw(pvtc=1 bvtc=1 sbvtc=1)],
+ 'vtc=2' => [qw(pvtc=2 bvtc=2 sbvtc=2)],
+
+ 'vertical-tightness-closing=0' => [qw(pvtc=0 bvtc=0 sbvtc=0)],
+ 'vertical-tightness-closing=1' => [qw(pvtc=1 bvtc=1 sbvtc=1)],
+ 'vertical-tightness-closing=2' => [qw(pvtc=2 bvtc=2 sbvtc=2)],
+
+ 'otr' => [qw(opr ohbr osbr)],
+ 'opening-token-right' => [qw(opr ohbr osbr)],
+ 'notr' => [qw(nopr nohbr nosbr)],
+ 'noopening-token-right' => [qw(nopr nohbr nosbr)],
+
+ 'sot' => [qw(sop sohb sosb)],
+ 'nsot' => [qw(nsop nsohb nsosb)],
+ 'stack-opening-tokens' => [qw(sop sohb sosb)],
+ 'nostack-opening-tokens' => [qw(nsop nsohb nsosb)],
+
+ 'sct' => [qw(scp schb scsb)],
+ 'stack-closing-tokens' => => [qw(scp schb scsb)],
+ 'nsct' => [qw(nscp nschb nscsb)],
+ 'nostack-opening-tokens' => [qw(nscp nschb nscsb)],
+
+ # 'mangle' originally deleted pod and comments, but to keep it
+ # reversible, it no longer does. But if you really want to
+ # delete them, just use:
+ # -mangle -dac
+
+ # An interesting use for 'mangle' is to do this:
+ # perltidy -mangle myfile.pl -st | perltidy -o myfile.pl.new
+ # which will form as many one-line blocks as possible
+
+ 'mangle' => [
+ qw(
+ check-syntax
+ delete-old-newlines
+ delete-old-whitespace
+ delete-semicolons
+ indent-columns=0
+ maximum-consecutive-blank-lines=0
+ maximum-line-length=100000
+ noadd-newlines
+ noadd-semicolons
+ noadd-whitespace
+ noblanks-before-blocks
+ noblanks-before-subs
+ notabs
+ )
+ ],
+
+ # 'extrude' originally deleted pod and comments, but to keep it
+ # reversible, it no longer does. But if you really want to
+ # delete them, just use
+ # extrude -dac
+ #
+ # An interesting use for 'extrude' is to do this:
+ # perltidy -extrude myfile.pl -st | perltidy -o myfile.pl.new
+ # which will break up all one-line blocks.
+
+ 'extrude' => [
+ qw(
+ check-syntax
+ ci=0
+ delete-old-newlines
+ delete-old-whitespace
+ delete-semicolons
+ indent-columns=0
+ maximum-consecutive-blank-lines=0
+ maximum-line-length=1
+ noadd-semicolons
+ noadd-whitespace
+ noblanks-before-blocks
+ noblanks-before-subs
+ nofuzzy-line-length
+ notabs
+ norecombine
+ )
+ ],
+
+ # this style tries to follow the GNU Coding Standards (which do
+ # not really apply to perl but which are followed by some perl
+ # programmers).
+ 'gnu-style' => [
+ qw(
+ lp bl noll pt=2 bt=2 sbt=2 cpi=1 csbi=1 cbi=1
+ )
+ ],
+
+ # Style suggested in Damian Conway's Perl Best Practices
+ 'perl-best-practices' => [
+ qw(l=78 i=4 ci=4 st se vt=2 cti=0 pt=1 bt=1 sbt=1 bbt=1 nsfs nolq),
+q(wbb=% + - * / x != == >= <= =~ !~ < > | & = **= += *= &= <<= &&= -= /= |= >>= ||= //= .= %= ^= x=)
+ ],
+
+ # Additional styles can be added here
+ );
+
+ Perl::Tidy::HtmlWriter->make_abbreviated_names( \%expansion );
+
+ # Uncomment next line to dump all expansions for debugging:
+ # dump_short_names(\%expansion);
+ return (
+ \@option_string, \@defaults, \%expansion,
+ \%option_category, \%option_range
+ );
+
+} # end of generate_options
+
+sub process_command_line {
+
+ my (
+ $perltidyrc_stream, $is_Windows, $Windows_type,
+ $rpending_complaint, $dump_options_type
+ ) = @_;
+
+ use Getopt::Long;
+
+ my (
+ $roption_string, $rdefaults, $rexpansion,
+ $roption_category, $roption_range
+ ) = generate_options();
+
+ #---------------------------------------------------------------
+ # set the defaults by passing the above list through GetOptions
+ #---------------------------------------------------------------
+ my %Opts = ();
+ {
+ local @ARGV;
+ my $i;
+
+ # do not load the defaults if we are just dumping perltidyrc
+ unless ( $dump_options_type eq 'perltidyrc' ) {
+ for $i (@$rdefaults) { push @ARGV, "--" . $i }
+ }
+
+ # Patch to save users Getopt::Long configuration
+ # and set to Getopt::Long defaults. Use eval to avoid
+ # breaking old versions of Perl without these routines.
+ my $glc;
+ eval { $glc = Getopt::Long::Configure() };
+ unless ($@) {
+ eval { Getopt::Long::ConfigDefaults() };
+ }
+ else { $glc = undef }
+
+ if ( !GetOptions( \%Opts, @$roption_string ) ) {
+ die "Programming Bug: error in setting default options";
+ }
+
+ # Patch to put the previous Getopt::Long configuration back
+ eval { Getopt::Long::Configure($glc) } if defined $glc;
+ }
+
+ my $word;
+ my @raw_options = ();
+ my $config_file = "";
+ my $saw_ignore_profile = 0;
+ my $saw_extrude = 0;
+ my $saw_dump_profile = 0;
+ my $i;
+
+ #---------------------------------------------------------------
+ # Take a first look at the command-line parameters. Do as many
+ # immediate dumps as possible, which can avoid confusion if the
+ # perltidyrc file has an error.
+ #---------------------------------------------------------------
+ foreach $i (@ARGV) {
+
+ $i =~ s/^--/-/;
+ if ( $i =~ /^-(npro|noprofile|no-profile)$/ ) {
+ $saw_ignore_profile = 1;
+ }
+
+ # note: this must come before -pro and -profile, below:
+ elsif ( $i =~ /^-(dump-profile|dpro)$/ ) {
+ $saw_dump_profile = 1;
+ }
+ elsif ( $i =~ /^-(pro|profile)=(.+)/ ) {
+ if ($config_file) {
+ warn
+"Only one -pro=filename allowed, using '$2' instead of '$config_file'\n";
+ }
+ $config_file = $2;
+ unless ( -e $config_file ) {
+ warn "cannot find file given with -pro=$config_file: $!\n";
+ $config_file = "";
+ }
+ }
+ elsif ( $i =~ /^-(pro|profile)=?$/ ) {
+ die "usage: -pro=filename or --profile=filename, no spaces\n";
+ }
+ elsif ( $i =~ /^-extrude$/ ) {
+ $saw_extrude = 1;
+ }
+ elsif ( $i =~ /^-(help|h|HELP|H)$/ ) {
+ usage();
+ exit 1;
+ }
+ elsif ( $i =~ /^-(version|v)$/ ) {
+ show_version();
+ exit 1;
+ }
+ elsif ( $i =~ /^-(dump-defaults|ddf)$/ ) {
+ dump_defaults(@$rdefaults);
+ exit 1;
+ }
+ elsif ( $i =~ /^-(dump-long-names|dln)$/ ) {
+ dump_long_names(@$roption_string);
+ exit 1;
+ }
+ elsif ( $i =~ /^-(dump-short-names|dsn)$/ ) {
+ dump_short_names($rexpansion);
+ exit 1;
+ }
+ elsif ( $i =~ /^-(dump-token-types|dtt)$/ ) {
+ Perl::Tidy::Tokenizer->dump_token_types(*STDOUT);
+ exit 1;
+ }
+ }
+
+ if ( $saw_dump_profile && $saw_ignore_profile ) {
+ warn "No profile to dump because of -npro\n";
+ exit 1;
+ }
+
+ #---------------------------------------------------------------
+ # read any .perltidyrc configuration file
+ #---------------------------------------------------------------
+ unless ($saw_ignore_profile) {
+
+ # resolve possible conflict between $perltidyrc_stream passed
+ # as call parameter to perltidy and -pro=filename on command
+ # line.
+ if ($perltidyrc_stream) {
+ if ($config_file) {
+ warn <<EOM;
+ Conflict: a perltidyrc configuration file was specified both as this
+ perltidy call parameter: $perltidyrc_stream
+ and with this -profile=$config_file.
+ Using -profile=$config_file.
+EOM
+ }
+ else {
+ $config_file = $perltidyrc_stream;
+ }
+ }
+
+ # look for a config file if we don't have one yet
+ my $rconfig_file_chatter;
+ $$rconfig_file_chatter = "";
+ $config_file =
+ find_config_file( $is_Windows, $Windows_type, $rconfig_file_chatter,
+ $rpending_complaint )
+ unless $config_file;
+
+ # open any config file
+ my $fh_config;
+ if ($config_file) {
+ ( $fh_config, $config_file ) =
+ Perl::Tidy::streamhandle( $config_file, 'r' );
+ unless ($fh_config) {
+ $$rconfig_file_chatter .=
+ "# $config_file exists but cannot be opened\n";
+ }
+ }
+
+ if ($saw_dump_profile) {
+ if ($saw_dump_profile) {
+ dump_config_file( $fh_config, $config_file,
+ $rconfig_file_chatter );
+ exit 1;
+ }
+ }
+
+ if ($fh_config) {
+
+ my ( $rconfig_list, $death_message ) =
+ read_config_file( $fh_config, $config_file, $rexpansion );
+ die $death_message if ($death_message);
+
+ # process any .perltidyrc parameters right now so we can
+ # localize errors
+ if (@$rconfig_list) {
+ local @ARGV = @$rconfig_list;
+
+ expand_command_abbreviations( $rexpansion, \@raw_options,
+ $config_file );
+
+ if ( !GetOptions( \%Opts, @$roption_string ) ) {
+ die
+"Error in this config file: $config_file \nUse -npro to ignore this file, -h for help'\n";
+ }
+
+ # Anything left in this local @ARGV is an error and must be
+ # invalid bare words from the configuration file. We cannot
+ # check this earlier because bare words may have been valid
+ # values for parameters. We had to wait for GetOptions to have
+ # a look at @ARGV.
+ if (@ARGV) {
+ my $count = @ARGV;
+ my $str = "\'" . pop(@ARGV) . "\'";
+ while ( my $param = pop(@ARGV) ) {
+ if ( length($str) < 70 ) {
+ $str .= ", '$param'";
+ }
+ else {
+ $str .= ", ...";
+ last;
+ }
+ }
+ die <<EOM;
+There are $count unrecognized values in the configuration file '$config_file':
+$str
+Use leading dashes for parameters. Use -npro to ignore this file.
+EOM
+ }
+
+ # Undo any options which cause premature exit. They are not
+ # appropriate for a config file, and it could be hard to
+ # diagnose the cause of the premature exit.
+ foreach (
+ qw{
+ dump-defaults
+ dump-long-names
+ dump-options
+ dump-profile
+ dump-short-names
+ dump-token-types
+ dump-want-left-space
+ dump-want-right-space
+ help
+ stylesheet
+ version
+ }
+ )
+ {
+
+ if ( defined( $Opts{$_} ) ) {
+ delete $Opts{$_};
+ warn "ignoring --$_ in config file: $config_file\n";
+ }
+ }
+ }
+ }
+ }
+
+ #---------------------------------------------------------------
+ # now process the command line parameters
+ #---------------------------------------------------------------
+ expand_command_abbreviations( $rexpansion, \@raw_options, $config_file );
+
+ if ( !GetOptions( \%Opts, @$roption_string ) ) {
+ die "Error on command line; for help try 'perltidy -h'\n";
+ }
+
+ return ( \%Opts, $config_file, \@raw_options, $saw_extrude, $roption_string,
+ $rexpansion, $roption_category, $roption_range );
+} # end of process_command_line
+
+sub check_options {
+
+ my ( $rOpts, $is_Windows, $Windows_type, $rpending_complaint ) = @_;
+
+ #---------------------------------------------------------------
+ # check and handle any interactions among the basic options..
+ #---------------------------------------------------------------
+
+ # Since -vt, -vtc, and -cti are abbreviations, but under
+ # msdos, an unquoted input parameter like vtc=1 will be
+ # seen as 2 parameters, vtc and 1, so the abbreviations
+ # won't be seen. Therefore, we will catch them here if
+ # they get through.
+
+ if ( defined $rOpts->{'vertical-tightness'} ) {
+ my $vt = $rOpts->{'vertical-tightness'};
+ $rOpts->{'paren-vertical-tightness'} = $vt;
+ $rOpts->{'square-bracket-vertical-tightness'} = $vt;
+ $rOpts->{'brace-vertical-tightness'} = $vt;
+ }
+
+ if ( defined $rOpts->{'vertical-tightness-closing'} ) {
+ my $vtc = $rOpts->{'vertical-tightness-closing'};
+ $rOpts->{'paren-vertical-tightness-closing'} = $vtc;
+ $rOpts->{'square-bracket-vertical-tightness-closing'} = $vtc;
+ $rOpts->{'brace-vertical-tightness-closing'} = $vtc;
+ }
+
+ if ( defined $rOpts->{'closing-token-indentation'} ) {
+ my $cti = $rOpts->{'closing-token-indentation'};
+ $rOpts->{'closing-square-bracket-indentation'} = $cti;
+ $rOpts->{'closing-brace-indentation'} = $cti;
+ $rOpts->{'closing-paren-indentation'} = $cti;
+ }
+
+ # In quiet mode, there is no log file and hence no way to report
+ # results of syntax check, so don't do it.
+ if ( $rOpts->{'quiet'} ) {
+ $rOpts->{'check-syntax'} = 0;
+ }
+
+ # can't check syntax if no output
+ if ( $rOpts->{'format'} ne 'tidy' ) {
+ $rOpts->{'check-syntax'} = 0;
+ }
+
+ # Never let Windows 9x/Me systems run syntax check -- this will prevent a
+ # wide variety of nasty problems on these systems, because they cannot
+ # reliably run backticks. Don't even think about changing this!
+ if ( $rOpts->{'check-syntax'}
+ && $is_Windows
+ && ( !$Windows_type || $Windows_type =~ /^(9|Me)/ ) )
+ {
+ $rOpts->{'check-syntax'} = 0;
+ }
+
+ # It's really a bad idea to check syntax as root unless you wrote
+ # the script yourself. FIXME: not sure if this works with VMS
+ unless ($is_Windows) {
+
+ if ( $< == 0 && $rOpts->{'check-syntax'} ) {
+ $rOpts->{'check-syntax'} = 0;
+ $$rpending_complaint .=
+"Syntax check deactivated for safety; you shouldn't run this as root\n";
+ }
+ }
+
+ # see if user set a non-negative logfile-gap
+ if ( defined( $rOpts->{'logfile-gap'} ) && $rOpts->{'logfile-gap'} >= 0 ) {
+
+ # a zero gap will be taken as a 1
+ if ( $rOpts->{'logfile-gap'} == 0 ) {
+ $rOpts->{'logfile-gap'} = 1;
+ }
+
+ # setting a non-negative logfile gap causes logfile to be saved
+ $rOpts->{'logfile'} = 1;
+ }
+
+ # not setting logfile gap, or setting it negative, causes default of 50
+ else {
+ $rOpts->{'logfile-gap'} = 50;
+ }
+
+ # set short-cut flag when only indentation is to be done.
+ # Note that the user may or may not have already set the
+ # indent-only flag.
+ if ( !$rOpts->{'add-whitespace'}
+ && !$rOpts->{'delete-old-whitespace'}
+ && !$rOpts->{'add-newlines'}
+ && !$rOpts->{'delete-old-newlines'} )
+ {
+ $rOpts->{'indent-only'} = 1;
+ }
+
+ # -isbc implies -ibc
+ if ( $rOpts->{'indent-spaced-block-comments'} ) {
+ $rOpts->{'indent-block-comments'} = 1;
+ }
+
+ # -bli flag implies -bl
+ if ( $rOpts->{'brace-left-and-indent'} ) {
+ $rOpts->{'opening-brace-on-new-line'} = 1;
+ }
+
+ if ( $rOpts->{'opening-brace-always-on-right'}
+ && $rOpts->{'opening-brace-on-new-line'} )
+ {
+ warn <<EOM;
+ Conflict: you specified both 'opening-brace-always-on-right' (-bar) and
+ 'opening-brace-on-new-line' (-bl). Ignoring -bl.
+EOM
+ $rOpts->{'opening-brace-on-new-line'} = 0;
+ }
+
+ # it simplifies things if -bl is 0 rather than undefined
+ if ( !defined( $rOpts->{'opening-brace-on-new-line'} ) ) {
+ $rOpts->{'opening-brace-on-new-line'} = 0;
+ }
+
+ # -sbl defaults to -bl if not defined
+ if ( !defined( $rOpts->{'opening-sub-brace-on-new-line'} ) ) {
+ $rOpts->{'opening-sub-brace-on-new-line'} =
+ $rOpts->{'opening-brace-on-new-line'};
+ }
+
+ # set shortcut flag if no blanks to be written
+ unless ( $rOpts->{'maximum-consecutive-blank-lines'} ) {
+ $rOpts->{'swallow-optional-blank-lines'} = 1;
+ }
+
+ if ( $rOpts->{'entab-leading-whitespace'} ) {
+ if ( $rOpts->{'entab-leading-whitespace'} < 0 ) {
+ warn "-et=n must use a positive integer; ignoring -et\n";
+ $rOpts->{'entab-leading-whitespace'} = undef;
+ }
+
+ # entab leading whitespace has priority over the older 'tabs' option
+ if ( $rOpts->{'tabs'} ) { $rOpts->{'tabs'} = 0; }
+ }
+}
+
+sub expand_command_abbreviations {
+
+ # go through @ARGV and expand any abbreviations
+
+ my ( $rexpansion, $rraw_options, $config_file ) = @_;
+ my ($word);
+
+ # set a pass limit to prevent an infinite loop;
+ # 10 should be plenty, but it may be increased to allow deeply
+ # nested expansions.
+ my $max_passes = 10;
+ my @new_argv = ();
+
+ # keep looping until all expansions have been converted into actual
+ # dash parameters..
+ for ( my $pass_count = 0 ; $pass_count <= $max_passes ; $pass_count++ ) {
+ my @new_argv = ();
+ my $abbrev_count = 0;
+
+ # loop over each item in @ARGV..
+ foreach $word (@ARGV) {
+
+ # convert any leading 'no-' to just 'no'
+ if ( $word =~ /^(-[-]?no)-(.*)/ ) { $word = $1 . $2 }
+
+ # if it is a dash flag (instead of a file name)..
+ if ( $word =~ /^-[-]?([\w\-]+)(.*)/ ) {
+
+ my $abr = $1;
+ my $flags = $2;
+
+ # save the raw input for debug output in case of circular refs
+ if ( $pass_count == 0 ) {
+ push( @$rraw_options, $word );
+ }
+
+ # recombine abbreviation and flag, if necessary,
+ # to allow abbreviations with arguments such as '-vt=1'
+ if ( $rexpansion->{ $abr . $flags } ) {
+ $abr = $abr . $flags;
+ $flags = "";
+ }
+
+ # if we see this dash item in the expansion hash..
+ if ( $rexpansion->{$abr} ) {
+ $abbrev_count++;
+
+ # stuff all of the words that it expands to into the
+ # new arg list for the next pass
+ foreach my $abbrev ( @{ $rexpansion->{$abr} } ) {
+ next unless $abbrev; # for safety; shouldn't happen
+ push( @new_argv, '--' . $abbrev . $flags );
+ }
+ }
+
+ # not in expansion hash, must be actual long name
+ else {
+ push( @new_argv, $word );
+ }
+ }
+
+ # not a dash item, so just save it for the next pass
+ else {
+ push( @new_argv, $word );
+ }
+ } # end of this pass
+
+ # update parameter list @ARGV to the new one
+ @ARGV = @new_argv;
+ last unless ( $abbrev_count > 0 );
+
+ # make sure we are not in an infinite loop
+ if ( $pass_count == $max_passes ) {
+ print STDERR
+"I'm tired. We seem to be in an infinite loop trying to expand aliases.\n";
+ print STDERR "Here are the raw options\n";
+ local $" = ')(';
+ print STDERR "(@$rraw_options)\n";
+ my $num = @new_argv;
+
+ if ( $num < 50 ) {
+ print STDERR "After $max_passes passes here is ARGV\n";
+ print STDERR "(@new_argv)\n";
+ }
+ else {
+ print STDERR "After $max_passes passes ARGV has $num entries\n";
+ }
+
+ if ($config_file) {
+ die <<"DIE";
+Please check your configuration file $config_file for circular-references.
+To deactivate it, use -npro.
+DIE
+ }
+ else {
+ die <<'DIE';
+Program bug - circular-references in the %expansion hash, probably due to
+a recent program change.
+DIE
+ }
+ } # end of check for circular references
+ } # end of loop over all passes
+}
+
+# Debug routine -- this will dump the expansion hash
+sub dump_short_names {
+ my $rexpansion = shift;
+ print STDOUT <<EOM;
+List of short names. This list shows how all abbreviations are
+translated into other abbreviations and, eventually, into long names.
+New abbreviations may be defined in a .perltidyrc file.
+For a list of all long names, use perltidy --dump-long-names (-dln).
+--------------------------------------------------------------------------
+EOM
+ foreach my $abbrev ( sort keys %$rexpansion ) {
+ my @list = @{ $$rexpansion{$abbrev} };
+ print STDOUT "$abbrev --> @list\n";
+ }
+}
+
+sub check_vms_filename {
+
+ # given a valid filename (the perltidy input file)
+ # create a modified filename and separator character
+ # suitable for VMS.
+ #
+ # Contributed by Michael Cartmell
+ #
+ my ( $base, $path ) = fileparse( $_[0] );
+
+ # remove explicit ; version
+ $base =~ s/;-?\d*$//
+
+ # remove explicit . version ie two dots in filename NB ^ escapes a dot
+ or $base =~ s/( # begin capture $1
+ (?:^|[^^])\. # match a dot not preceded by a caret
+ (?: # followed by nothing
+ | # or
+ .*[^^] # anything ending in a non caret
+ )
+ ) # end capture $1
+ \.-?\d*$ # match . version number
+ /$1/x;
+
+ # normalise filename, if there are no unescaped dots then append one
+ $base .= '.' unless $base =~ /(?:^|[^^])\./;
+
+ # if we don't already have an extension then we just append the extention
+ my $separator = ( $base =~ /\.$/ ) ? "" : "_";
+ return ( $path . $base, $separator );
+}
+
+sub Win_OS_Type {
+
+ # TODO: are these more standard names?
+ # Win32s Win95 Win98 WinMe WinNT3.51 WinNT4 Win2000 WinXP/.Net Win2003
+
+ # Returns a string that determines what MS OS we are on.
+ # Returns win32s,95,98,Me,NT3.51,NT4,2000,XP/.Net,Win2003
+ # Returns blank string if not an MS system.
+ # Original code contributed by: Yves Orton
+ # We need to know this to decide where to look for config files
+
+ my $rpending_complaint = shift;
+ my $os = "";
+ return $os unless $^O =~ /win32|dos/i; # is it a MS box?
+
+ # Systems built from Perl source may not have Win32.pm
+ # But probably have Win32::GetOSVersion() anyway so the
+ # following line is not 'required':
+ # return $os unless eval('require Win32');
+
+ # Use the standard API call to determine the version
+ my ( $undef, $major, $minor, $build, $id );
+ eval { ( $undef, $major, $minor, $build, $id ) = Win32::GetOSVersion() };
+
+ #
+ # NAME ID MAJOR MINOR
+ # Windows NT 4 2 4 0
+ # Windows 2000 2 5 0
+ # Windows XP 2 5 1
+ # Windows Server 2003 2 5 2
+
+ return "win32s" unless $id; # If id==0 then its a win32s box.
+ $os = { # Magic numbers from MSDN
+ # documentation of GetOSVersion
+ 1 => {
+ 0 => "95",
+ 10 => "98",
+ 90 => "Me"
+ },
+ 2 => {
+ 0 => "2000", # or NT 4, see below
+ 1 => "XP/.Net",
+ 2 => "Win2003",
+ 51 => "NT3.51"
+ }
+ }->{$id}->{$minor};
+
+ # If $os is undefined, the above code is out of date. Suggested updates
+ # are welcome.
+ unless ( defined $os ) {
+ $os = "";
+ $$rpending_complaint .= <<EOS;
+Error trying to discover Win_OS_Type: $id:$major:$minor Has no name of record!
+We won't be able to look for a system-wide config file.
+EOS
+ }
+
+ # Unfortunately the logic used for the various versions isnt so clever..
+ # so we have to handle an outside case.
+ return ( $os eq "2000" && $major != 5 ) ? "NT4" : $os;
+}
+
+sub is_unix {
+ return
+ ( $^O !~ /win32|dos/i )
+ && ( $^O ne 'VMS' )
+ && ( $^O ne 'OS2' )
+ && ( $^O ne 'MacOS' );
+}
+
+sub look_for_Windows {
+
+ # determine Windows sub-type and location of
+ # system-wide configuration files
+ my $rpending_complaint = shift;
+ my $is_Windows = ( $^O =~ /win32|dos/i );
+ my $Windows_type = Win_OS_Type($rpending_complaint) if $is_Windows;
+ return ( $is_Windows, $Windows_type );
+}
+
+sub find_config_file {
+
+ # look for a .perltidyrc configuration file
+ my ( $is_Windows, $Windows_type, $rconfig_file_chatter,
+ $rpending_complaint ) = @_;
+
+ $$rconfig_file_chatter .= "# Config file search...system reported as:";
+ if ($is_Windows) {
+ $$rconfig_file_chatter .= "Windows $Windows_type\n";
+ }
+ else {
+ $$rconfig_file_chatter .= " $^O\n";
+ }
+
+ # sub to check file existance and record all tests
+ my $exists_config_file = sub {
+ my $config_file = shift;
+ return 0 unless $config_file;
+ $$rconfig_file_chatter .= "# Testing: $config_file\n";
+ return -f $config_file;
+ };
+
+ my $config_file;
+
+ # look in current directory first
+ $config_file = ".perltidyrc";
+ return $config_file if $exists_config_file->($config_file);
+
+ # Default environment vars.
+ my @envs = qw(PERLTIDY HOME);
+
+ # Check the NT/2k/XP locations, first a local machine def, then a
+ # network def
+ push @envs, qw(USERPROFILE HOMESHARE) if $^O =~ /win32/i;
+
+ # Now go through the enviornment ...
+ foreach my $var (@envs) {
+ $$rconfig_file_chatter .= "# Examining: \$ENV{$var}";
+ if ( defined( $ENV{$var} ) ) {
+ $$rconfig_file_chatter .= " = $ENV{$var}\n";
+
+ # test ENV{ PERLTIDY } as file:
+ if ( $var eq 'PERLTIDY' ) {
+ $config_file = "$ENV{$var}";
+ return $config_file if $exists_config_file->($config_file);
+ }
+
+ # test ENV as directory:
+ $config_file = catfile( $ENV{$var}, ".perltidyrc" );
+ return $config_file if $exists_config_file->($config_file);
+ }
+ else {
+ $$rconfig_file_chatter .= "\n";
+ }
+ }
+
+ # then look for a system-wide definition
+ # where to look varies with OS
+ if ($is_Windows) {
+
+ if ($Windows_type) {
+ my ( $os, $system, $allusers ) =
+ Win_Config_Locs( $rpending_complaint, $Windows_type );
+
+ # Check All Users directory, if there is one.
+ if ($allusers) {
+ $config_file = catfile( $allusers, ".perltidyrc" );
+ return $config_file if $exists_config_file->($config_file);
+ }
+
+ # Check system directory.
+ $config_file = catfile( $system, ".perltidyrc" );
+ return $config_file if $exists_config_file->($config_file);
+ }
+ }
+
+ # Place to add customization code for other systems
+ elsif ( $^O eq 'OS2' ) {
+ }
+ elsif ( $^O eq 'MacOS' ) {
+ }
+ elsif ( $^O eq 'VMS' ) {
+ }
+
+ # Assume some kind of Unix
+ else {
+
+ $config_file = "/usr/local/etc/perltidyrc";
+ return $config_file if $exists_config_file->($config_file);
+
+ $config_file = "/etc/perltidyrc";
+ return $config_file if $exists_config_file->($config_file);
+ }
+
+ # Couldn't find a config file
+ return;
+}
+
+sub Win_Config_Locs {
+
+ # In scalar context returns the OS name (95 98 ME NT3.51 NT4 2000 XP),
+ # or undef if its not a win32 OS. In list context returns OS, System
+ # Directory, and All Users Directory. All Users will be empty on a
+ # 9x/Me box. Contributed by: Yves Orton.
+
+ my $rpending_complaint = shift;
+ my $os = (@_) ? shift : Win_OS_Type();
+ return unless $os;
+
+ my $system = "";
+ my $allusers = "";
+
+ if ( $os =~ /9[58]|Me/ ) {
+ $system = "C:/Windows";
+ }
+ elsif ( $os =~ /NT|XP|200?/ ) {
+ $system = ( $os =~ /XP/ ) ? "C:/Windows/" : "C:/WinNT/";
+ $allusers =
+ ( $os =~ /NT/ )
+ ? "C:/WinNT/profiles/All Users/"
+ : "C:/Documents and Settings/All Users/";
+ }
+ else {
+
+ # This currently would only happen on a win32s computer. I dont have
+ # one to test, so I am unsure how to proceed. Suggestions welcome!
+ $$rpending_complaint .=
+"I dont know a sensible place to look for config files on an $os system.\n";
+ return;
+ }
+ return wantarray ? ( $os, $system, $allusers ) : $os;
+}
+
+sub dump_config_file {
+ my $fh = shift;
+ my $config_file = shift;
+ my $rconfig_file_chatter = shift;
+ print STDOUT "$$rconfig_file_chatter";
+ if ($fh) {
+ print STDOUT "# Dump of file: '$config_file'\n";
+ while ( my $line = $fh->getline() ) { print STDOUT $line }
+ eval { $fh->close() };
+ }
+ else {
+ print STDOUT "# ...no config file found\n";
+ }
+}
+
+sub read_config_file {
+
+ my ( $fh, $config_file, $rexpansion ) = @_;
+ my @config_list = ();
+
+ # file is bad if non-empty $death_message is returned
+ my $death_message = "";
+
+ my $name = undef;
+ my $line_no;
+ while ( my $line = $fh->getline() ) {
+ $line_no++;
+ chomp $line;
+ next if $line =~ /^\s*#/; # skip full-line comment
+ ( $line, $death_message ) =
+ strip_comment( $line, $config_file, $line_no );
+ last if ($death_message);
+ $line =~ s/^\s*(.*?)\s*$/$1/; # trim both ends
+ next unless $line;
+
+ # look for something of the general form
+ # newname { body }
+ # or just
+ # body
+
+ if ( $line =~ /^((\w+)\s*\{)?([^}]*)(\})?$/ ) {
+ my ( $newname, $body, $curly ) = ( $2, $3, $4 );
+
+ # handle a new alias definition
+ if ($newname) {
+ if ($name) {
+ $death_message =
+"No '}' seen after $name and before $newname in config file $config_file line $.\n";
+ last;
+ }
+ $name = $newname;
+
+ if ( ${$rexpansion}{$name} ) {
+ local $" = ')(';
+ my @names = sort keys %$rexpansion;
+ $death_message =
+ "Here is a list of all installed aliases\n(@names)\n"
+ . "Attempting to redefine alias ($name) in config file $config_file line $.\n";
+ last;
+ }
+ ${$rexpansion}{$name} = [];
+ }
+
+ # now do the body
+ if ($body) {
+
+ my ( $rbody_parts, $msg ) = parse_args($body);
+ if ($msg) {
+ $death_message = <<EOM;
+Error reading file '$config_file' at line number $line_no.
+$msg
+Please fix this line or use -npro to avoid reading this file
+EOM
+ last;
+ }
+
+ if ($name) {
+
+ # remove leading dashes if this is an alias
+ foreach (@$rbody_parts) { s/^\-+//; }
+ push @{ ${$rexpansion}{$name} }, @$rbody_parts;
+ }
+ else {
+ push( @config_list, @$rbody_parts );
+ }
+ }
+
+ if ($curly) {
+ unless ($name) {
+ $death_message =
+"Unexpected '}' seen in config file $config_file line $.\n";
+ last;
+ }
+ $name = undef;
+ }
+ }
+ }
+ eval { $fh->close() };
+ return ( \@config_list, $death_message );
+}
+
+sub strip_comment {
+
+ my ( $instr, $config_file, $line_no ) = @_;
+ my $msg = "";
+
+ # nothing to do if no comments
+ if ( $instr !~ /#/ ) {
+ return ( $instr, $msg );
+ }
+
+ # use simple method of no quotes
+ elsif ( $instr !~ /['"]/ ) {
+ $instr =~ s/\s*\#.*$//; # simple trim
+ return ( $instr, $msg );
+ }
+
+ # handle comments and quotes
+ my $outstr = "";
+ my $quote_char = "";
+ while (1) {
+
+ # looking for ending quote character
+ if ($quote_char) {
+ if ( $instr =~ /\G($quote_char)/gc ) {
+ $quote_char = "";
+ $outstr .= $1;
+ }
+ elsif ( $instr =~ /\G(.)/gc ) {
+ $outstr .= $1;
+ }
+
+ # error..we reached the end without seeing the ending quote char
+ else {
+ $msg = <<EOM;
+Error reading file $config_file at line number $line_no.
+Did not see ending quote character <$quote_char> in this text:
+$instr
+Please fix this line or use -npro to avoid reading this file
+EOM
+ last;
+ }
+ }
+
+ # accumulating characters and looking for start of a quoted string
+ else {
+ if ( $instr =~ /\G([\"\'])/gc ) {
+ $outstr .= $1;
+ $quote_char = $1;
+ }
+ elsif ( $instr =~ /\G#/gc ) {
+ last;
+ }
+ elsif ( $instr =~ /\G(.)/gc ) {
+ $outstr .= $1;
+ }
+ else {
+ last;
+ }
+ }
+ }
+ return ( $outstr, $msg );
+}
+
+sub parse_args {
+
+ # Parse a command string containing multiple string with possible
+ # quotes, into individual commands. It might look like this, for example:
+ #
+ # -wba=" + - " -some-thing -wbb='. && ||'
+ #
+ # There is no need, at present, to handle escaped quote characters.
+ # (They are not perltidy tokens, so needn't be in strings).
+
+ my ($body) = @_;
+ my @body_parts = ();
+ my $quote_char = "";
+ my $part = "";
+ my $msg = "";
+ while (1) {
+
+ # looking for ending quote character
+ if ($quote_char) {
+ if ( $body =~ /\G($quote_char)/gc ) {
+ $quote_char = "";
+ }
+ elsif ( $body =~ /\G(.)/gc ) {
+ $part .= $1;
+ }
+
+ # error..we reached the end without seeing the ending quote char
+ else {
+ if ( length($part) ) { push @body_parts, $part; }
+ $msg = <<EOM;
+Did not see ending quote character <$quote_char> in this text:
+$body
+EOM
+ last;
+ }
+ }
+
+ # accumulating characters and looking for start of a quoted string
+ else {
+ if ( $body =~ /\G([\"\'])/gc ) {
+ $quote_char = $1;
+ }
+ elsif ( $body =~ /\G(\s+)/gc ) {
+ if ( length($part) ) { push @body_parts, $part; }
+ $part = "";
+ }
+ elsif ( $body =~ /\G(.)/gc ) {
+ $part .= $1;
+ }
+ else {
+ if ( length($part) ) { push @body_parts, $part; }
+ last;
+ }
+ }
+ }
+ return ( \@body_parts, $msg );
+}
+
+sub dump_long_names {
+
+ my @names = sort @_;
+ print STDOUT <<EOM;
+# Command line long names (passed to GetOptions)
+#---------------------------------------------------------------
+# here is a summary of the Getopt codes:
+# <none> does not take an argument
+# =s takes a mandatory string
+# :s takes an optional string
+# =i takes a mandatory integer
+# :i takes an optional integer
+# ! does not take an argument and may be negated
+# i.e., -foo and -nofoo are allowed
+# a double dash signals the end of the options list
+#
+#---------------------------------------------------------------
+EOM
+
+ foreach (@names) { print STDOUT "$_\n" }
+}
+
+sub dump_defaults {
+ my @defaults = sort @_;
+ print STDOUT "Default command line options:\n";
+ foreach (@_) { print STDOUT "$_\n" }
+}
+
+sub readable_options {
+
+ # return options for this run as a string which could be
+ # put in a perltidyrc file
+ my ( $rOpts, $roption_string ) = @_;
+ my %Getopt_flags;
+ my $rGetopt_flags = \%Getopt_flags;
+ my $readable_options = "# Final parameter set for this run.\n";
+ $readable_options .=
+ "# See utility 'perltidyrc_dump.pl' for nicer formatting.\n";
+ foreach my $opt ( @{$roption_string} ) {
+ my $flag = "";
+ if ( $opt =~ /(.*)(!|=.*)$/ ) {
+ $opt = $1;
+ $flag = $2;
+ }
+ if ( defined( $rOpts->{$opt} ) ) {
+ $rGetopt_flags->{$opt} = $flag;
+ }
+ }
+ foreach my $key ( sort keys %{$rOpts} ) {
+ my $flag = $rGetopt_flags->{$key};
+ my $value = $rOpts->{$key};
+ my $prefix = '--';
+ my $suffix = "";
+ if ($flag) {
+ if ( $flag =~ /^=/ ) {
+ if ( $value !~ /^\d+$/ ) { $value = '"' . $value . '"' }
+ $suffix = "=" . $value;
+ }
+ elsif ( $flag =~ /^!/ ) {
+ $prefix .= "no" unless ($value);
+ }
+ else {
+
+ # shouldn't happen
+ $readable_options .=
+ "# ERROR in dump_options: unrecognized flag $flag for $key\n";
+ }
+ }
+ $readable_options .= $prefix . $key . $suffix . "\n";
+ }
+ return $readable_options;
+}
+
+sub show_version {
+ print <<"EOM";
+This is perltidy, v$VERSION
+
+Copyright 2000-2007, Steve Hancock
+
+Perltidy is free software and may be copied under the terms of the GNU
+General Public License, which is included in the distribution files.
+
+Complete documentation for perltidy can be found using 'man perltidy'
+or on the internet at http://perltidy.sourceforge.net.
+EOM
+}
+
+sub usage {
+
+ print STDOUT <<EOF;
+This is perltidy version $VERSION, a perl script indenter. Usage:
+
+ perltidy [ options ] file1 file2 file3 ...
+ (output goes to file1.tdy, file2.tdy, file3.tdy, ...)
+ perltidy [ options ] file1 -o outfile
+ perltidy [ options ] file1 -st >outfile
+ perltidy [ options ] <infile >outfile
+
+Options have short and long forms. Short forms are shown; see
+man pages for long forms. Note: '=s' indicates a required string,
+and '=n' indicates a required integer.
+
+I/O control
+ -h show this help
+ -o=file name of the output file (only if single input file)
+ -oext=s change output extension from 'tdy' to s
+ -opath=path change path to be 'path' for output files
+ -b backup original to .bak and modify file in-place
+ -bext=s change default backup extension from 'bak' to s
+ -q deactivate error messages (for running under editor)
+ -w include non-critical warning messages in the .ERR error output
+ -syn run perl -c to check syntax (default under unix systems)
+ -log save .LOG file, which has useful diagnostics
+ -f force perltidy to read a binary file
+ -g like -log but writes more detailed .LOG file, for debugging scripts
+ -opt write the set of options actually used to a .LOG file
+ -npro ignore .perltidyrc configuration command file
+ -pro=file read configuration commands from file instead of .perltidyrc
+ -st send output to standard output, STDOUT
+ -se send error output to standard error output, STDERR
+ -v display version number to standard output and quit
+
+Basic Options:
+ -i=n use n columns per indentation level (default n=4)
+ -t tabs: use one tab character per indentation level, not recommeded
+ -nt no tabs: use n spaces per indentation level (default)
+ -et=n entab leading whitespace n spaces per tab; not recommended
+ -io "indent only": just do indentation, no other formatting.
+ -sil=n set starting indentation level to n; use if auto detection fails
+ -ole=s specify output line ending (s=dos or win, mac, unix)
+ -ple keep output line endings same as input (input must be filename)
+
+Whitespace Control
+ -fws freeze whitespace; this disables all whitespace changes
+ and disables the following switches:
+ -bt=n sets brace tightness, n= (0 = loose, 1=default, 2 = tight)
+ -bbt same as -bt but for code block braces; same as -bt if not given
+ -bbvt block braces vertically tight; use with -bl or -bli
+ -bbvtl=s make -bbvt to apply to selected list of block types
+ -pt=n paren tightness (n=0, 1 or 2)
+ -sbt=n square bracket tightness (n=0, 1, or 2)
+ -bvt=n brace vertical tightness,
+ n=(0=open, 1=close unless multiple steps on a line, 2=always close)
+ -pvt=n paren vertical tightness (see -bvt for n)
+ -sbvt=n square bracket vertical tightness (see -bvt for n)
+ -bvtc=n closing brace vertical tightness:
+ n=(0=open, 1=sometimes close, 2=always close)
+ -pvtc=n closing paren vertical tightness, see -bvtc for n.
+ -sbvtc=n closing square bracket vertical tightness, see -bvtc for n.
+ -ci=n sets continuation indentation=n, default is n=2 spaces
+ -lp line up parentheses, brackets, and non-BLOCK braces
+ -sfs add space before semicolon in for( ; ; )
+ -aws allow perltidy to add whitespace (default)
+ -dws delete all old non-essential whitespace
+ -icb indent closing brace of a code block
+ -cti=n closing indentation of paren, square bracket, or non-block brace:
+ n=0 none, =1 align with opening, =2 one full indentation level
+ -icp equivalent to -cti=2
+ -wls=s want space left of tokens in string; i.e. -nwls='+ - * /'
+ -wrs=s want space right of tokens in string;
+ -sts put space before terminal semicolon of a statement
+ -sak=s put space between keywords given in s and '(';
+ -nsak=s no space between keywords in s and '('; i.e. -nsak='my our local'
+
+Line Break Control
+ -fnl freeze newlines; this disables all line break changes
+ and disables the following switches:
+ -anl add newlines; ok to introduce new line breaks
+ -bbs add blank line before subs and packages
+ -bbc add blank line before block comments
+ -bbb add blank line between major blocks
+ -sob swallow optional blank lines
+ -ce cuddled else; use this style: '} else {'
+ -dnl delete old newlines (default)
+ -mbl=n maximum consecutive blank lines (default=1)
+ -l=n maximum line length; default n=80
+ -bl opening brace on new line
+ -sbl opening sub brace on new line. value of -bl is used if not given.
+ -bli opening brace on new line and indented
+ -bar opening brace always on right, even for long clauses
+ -vt=n vertical tightness (requires -lp); n controls break after opening
+ token: 0=never 1=no break if next line balanced 2=no break
+ -vtc=n vertical tightness of closing container; n controls if closing
+ token starts new line: 0=always 1=not unless list 1=never
+ -wba=s want break after tokens in string; i.e. wba=': .'
+ -wbb=s want break before tokens in string
+
+Following Old Breakpoints
+ -kis keep interior semicolons. Allows multiple statements per line.
+ -boc break at old comma breaks: turns off all automatic list formatting
+ -bol break at old logical breakpoints: or, and, ||, && (default)
+ -bok break at old list keyword breakpoints such as map, sort (default)
+ -bot break at old conditional (ternary ?:) operator breakpoints (default)
+ -cab=n break at commas after a comma-arrow (=>):
+ n=0 break at all commas after =>
+ n=1 stable: break unless this breaks an existing one-line container
+ n=2 break only if a one-line container cannot be formed
+ n=3 do not treat commas after => specially at all
+
+Comment controls
+ -ibc indent block comments (default)
+ -isbc indent spaced block comments; may indent unless no leading space
+ -msc=n minimum desired spaces to side comment, default 4
+ -fpsc=n fix position for side comments; default 0;
+ -csc add or update closing side comments after closing BLOCK brace
+ -dcsc delete closing side comments created by a -csc command
+ -cscp=s change closing side comment prefix to be other than '## end'
+ -cscl=s change closing side comment to apply to selected list of blocks
+ -csci=n minimum number of lines needed to apply a -csc tag, default n=6
+ -csct=n maximum number of columns of appended text, default n=20
+ -cscw causes warning if old side comment is overwritten with -csc
+
+ -sbc use 'static block comments' identified by leading '##' (default)
+ -sbcp=s change static block comment identifier to be other than '##'
+ -osbc outdent static block comments
+
+ -ssc use 'static side comments' identified by leading '##' (default)
+ -sscp=s change static side comment identifier to be other than '##'
+
+Delete selected text
+ -dac delete all comments AND pod
+ -dbc delete block comments
+ -dsc delete side comments
+ -dp delete pod
+
+Send selected text to a '.TEE' file
+ -tac tee all comments AND pod
+ -tbc tee block comments
+ -tsc tee side comments
+ -tp tee pod
+
+Outdenting
+ -olq outdent long quoted strings (default)
+ -olc outdent a long block comment line
+ -ola outdent statement labels
+ -okw outdent control keywords (redo, next, last, goto, return)
+ -okwl=s specify alternative keywords for -okw command
+
+Other controls
+ -mft=n maximum fields per table; default n=40
+ -x do not format lines before hash-bang line (i.e., for VMS)
+ -asc allows perltidy to add a ';' when missing (default)
+ -dsm allows perltidy to delete an unnecessary ';' (default)
+
+Combinations of other parameters
+ -gnu attempt to follow GNU Coding Standards as applied to perl
+ -mangle remove as many newlines as possible (but keep comments and pods)
+ -extrude insert as many newlines as possible
+
+Dump and die, debugging
+ -dop dump options used in this run to standard output and quit
+ -ddf dump default options to standard output and quit
+ -dsn dump all option short names to standard output and quit
+ -dln dump option long names to standard output and quit
+ -dpro dump whatever configuration file is in effect to standard output
+ -dtt dump all token types to standard output and quit
+
+HTML
+ -html write an html file (see 'man perl2web' for many options)
+ Note: when -html is used, no indentation or formatting are done.
+ Hint: try perltidy -html -css=mystyle.css filename.pl
+ and edit mystyle.css to change the appearance of filename.html.
+ -nnn gives line numbers
+ -pre only writes out <pre>..</pre> code section
+ -toc places a table of contents to subs at the top (default)
+ -pod passes pod text through pod2html (default)
+ -frm write html as a frame (3 files)
+ -text=s extra extension for table of contents if -frm, default='toc'
+ -sext=s extra extension for file content if -frm, default='src'
+
+A prefix of "n" negates short form toggle switches, and a prefix of "no"
+negates the long forms. For example, -nasc means don't add missing
+semicolons.
+
+If you are unable to see this entire text, try "perltidy -h | more"
+For more detailed information, and additional options, try "man perltidy",
+or go to the perltidy home page at http://perltidy.sourceforge.net
+EOF
+
+}
+
+sub process_this_file {
+
+ my ( $truth, $beauty ) = @_;
+
+ # loop to process each line of this file
+ while ( my $line_of_tokens = $truth->get_line() ) {
+ $beauty->write_line($line_of_tokens);
+ }
+
+ # finish up
+ eval { $beauty->finish_formatting() };
+ $truth->report_tokenization_errors();
+}
+
+sub check_syntax {
+
+ # Use 'perl -c' to make sure that we did not create bad syntax
+ # This is a very good independent check for programming errors
+ #
+ # Given names of the input and output files, ($ifname, $ofname),
+ # we do the following:
+ # - check syntax of the input file
+ # - if bad, all done (could be an incomplete code snippet)
+ # - if infile syntax ok, then check syntax of the output file;
+ # - if outfile syntax bad, issue warning; this implies a code bug!
+ # - set and return flag "infile_syntax_ok" : =-1 bad 0 unknown 1 good
+
+ my ( $ifname, $ofname, $logger_object, $rOpts ) = @_;
+ my $infile_syntax_ok = 0;
+ my $line_of_dashes = '-' x 42 . "\n";
+
+ my $flags = $rOpts->{'perl-syntax-check-flags'};
+
+ # be sure we invoke perl with -c
+ # note: perl will accept repeated flags like '-c -c'. It is safest
+ # to append another -c than try to find an interior bundled c, as
+ # in -Tc, because such a 'c' might be in a quoted string, for example.
+ if ( $flags !~ /(^-c|\s+-c)/ ) { $flags .= " -c" }
+
+ # be sure we invoke perl with -x if requested
+ # same comments about repeated parameters applies
+ if ( $rOpts->{'look-for-hash-bang'} ) {
+ if ( $flags !~ /(^-x|\s+-x)/ ) { $flags .= " -x" }
+ }
+
+ # this shouldn't happen unless a termporary file couldn't be made
+ if ( $ifname eq '-' ) {
+ $logger_object->write_logfile_entry(
+ "Cannot run perl -c on STDIN and STDOUT\n");
+ return $infile_syntax_ok;
+ }
+
+ $logger_object->write_logfile_entry(
+ "checking input file syntax with perl $flags\n");
+ $logger_object->write_logfile_entry($line_of_dashes);
+
+ # Not all operating systems/shells support redirection of the standard
+ # error output.
+ my $error_redirection = ( $^O eq 'VMS' ) ? "" : '2>&1';
+
+ my $perl_output = do_syntax_check( $ifname, $flags, $error_redirection );
+ $logger_object->write_logfile_entry("$perl_output\n");
+
+ if ( $perl_output =~ /syntax\s*OK/ ) {
+ $infile_syntax_ok = 1;
+ $logger_object->write_logfile_entry($line_of_dashes);
+ $logger_object->write_logfile_entry(
+ "checking output file syntax with perl $flags ...\n");
+ $logger_object->write_logfile_entry($line_of_dashes);
+
+ my $perl_output =
+ do_syntax_check( $ofname, $flags, $error_redirection );
+ $logger_object->write_logfile_entry("$perl_output\n");
+
+ unless ( $perl_output =~ /syntax\s*OK/ ) {
+ $logger_object->write_logfile_entry($line_of_dashes);
+ $logger_object->warning(
+"The output file has a syntax error when tested with perl $flags $ofname !\n"
+ );
+ $logger_object->warning(
+ "This implies an error in perltidy; the file $ofname is bad\n");
+ $logger_object->report_definite_bug();
+
+ # the perl version number will be helpful for diagnosing the problem
+ $logger_object->write_logfile_entry(
+ qx/perl -v $error_redirection/ . "\n" );
+ }
+ }
+ else {
+
+ # Only warn of perl -c syntax errors. Other messages,
+ # such as missing modules, are too common. They can be
+ # seen by running with perltidy -w
+ $logger_object->complain("A syntax check using perl $flags gives: \n");
+ $logger_object->complain($line_of_dashes);
+ $logger_object->complain("$perl_output\n");
+ $logger_object->complain($line_of_dashes);
+ $infile_syntax_ok = -1;
+ $logger_object->write_logfile_entry($line_of_dashes);
+ $logger_object->write_logfile_entry(
+"The output file will not be checked because of input file problems\n"
+ );
+ }
+ return $infile_syntax_ok;
+}
+
+sub do_syntax_check {
+ my ( $fname, $flags, $error_redirection ) = @_;
+
+ # We have to quote the filename in case it has unusual characters
+ # or spaces. Example: this filename #CM11.pm# gives trouble.
+ $fname = '"' . $fname . '"';
+
+ # Under VMS something like -T will become -t (and an error) so we
+ # will put quotes around the flags. Double quotes seem to work on
+ # Unix/Windows/VMS, but this may not work on all systems. (Single
+ # quotes do not work under Windows). It could become necessary to
+ # put double quotes around each flag, such as: -"c" -"T"
+ # We may eventually need some system-dependent coding here.
+ $flags = '"' . $flags . '"';
+
+ # now wish for luck...
+ return qx/perl $flags $fname $error_redirection/;
+}
+
+#####################################################################
+#
+# This is a stripped down version of IO::Scalar
+# Given a reference to a scalar, it supplies either:
+# a getline method which reads lines (mode='r'), or
+# a print method which reads lines (mode='w')
+#
+#####################################################################
+package Perl::Tidy::IOScalar;
+use Carp;
+
+sub new {
+ my ( $package, $rscalar, $mode ) = @_;
+ my $ref = ref $rscalar;
+ if ( $ref ne 'SCALAR' ) {
+ confess <<EOM;
+------------------------------------------------------------------------
+expecting ref to SCALAR but got ref to ($ref); trace follows:
+------------------------------------------------------------------------
+EOM
+
+ }
+ if ( $mode eq 'w' ) {
+ $$rscalar = "";
+ return bless [ $rscalar, $mode ], $package;
+ }
+ elsif ( $mode eq 'r' ) {
+
+ # Convert a scalar to an array.
+ # This avoids looking for "\n" on each call to getline
+ my @array = map { $_ .= "\n" } split /\n/, ${$rscalar};
+ my $i_next = 0;
+ return bless [ \@array, $mode, $i_next ], $package;
+ }
+ else {
+ confess <<EOM;
+------------------------------------------------------------------------
+expecting mode = 'r' or 'w' but got mode ($mode); trace follows:
+------------------------------------------------------------------------
+EOM
+ }
+}
+
+sub getline {
+ my $self = shift;
+ my $mode = $self->[1];
+ if ( $mode ne 'r' ) {
+ confess <<EOM;
+------------------------------------------------------------------------
+getline call requires mode = 'r' but mode = ($mode); trace follows:
+------------------------------------------------------------------------
+EOM
+ }
+ my $i = $self->[2]++;
+ ##my $line = $self->[0]->[$i];
+ return $self->[0]->[$i];
+}
+
+sub print {
+ my $self = shift;
+ my $mode = $self->[1];
+ if ( $mode ne 'w' ) {
+ confess <<EOM;
+------------------------------------------------------------------------
+print call requires mode = 'w' but mode = ($mode); trace follows:
+------------------------------------------------------------------------
+EOM
+ }
+ ${ $self->[0] } .= $_[0];
+}
+sub close { return }
+
+#####################################################################
+#
+# This is a stripped down version of IO::ScalarArray
+# Given a reference to an array, it supplies either:
+# a getline method which reads lines (mode='r'), or
+# a print method which reads lines (mode='w')
+#
+# NOTE: this routine assumes that that there aren't any embedded
+# newlines within any of the array elements. There are no checks
+# for that.
+#
+#####################################################################
+package Perl::Tidy::IOScalarArray;
+use Carp;
+
+sub new {
+ my ( $package, $rarray, $mode ) = @_;
+ my $ref = ref $rarray;
+ if ( $ref ne 'ARRAY' ) {
+ confess <<EOM;
+------------------------------------------------------------------------
+expecting ref to ARRAY but got ref to ($ref); trace follows:
+------------------------------------------------------------------------
+EOM
+
+ }
+ if ( $mode eq 'w' ) {
+ @$rarray = ();
+ return bless [ $rarray, $mode ], $package;
+ }
+ elsif ( $mode eq 'r' ) {
+ my $i_next = 0;
+ return bless [ $rarray, $mode, $i_next ], $package;
+ }
+ else {
+ confess <<EOM;
+------------------------------------------------------------------------
+expecting mode = 'r' or 'w' but got mode ($mode); trace follows:
+------------------------------------------------------------------------
+EOM
+ }
+}
+
+sub getline {
+ my $self = shift;
+ my $mode = $self->[1];
+ if ( $mode ne 'r' ) {
+ confess <<EOM;
+------------------------------------------------------------------------
+getline requires mode = 'r' but mode = ($mode); trace follows:
+------------------------------------------------------------------------
+EOM
+ }
+ my $i = $self->[2]++;
+ return $self->[0]->[$i];
+}
+
+sub print {
+ my $self = shift;
+ my $mode = $self->[1];
+ if ( $mode ne 'w' ) {
+ confess <<EOM;
+------------------------------------------------------------------------
+print requires mode = 'w' but mode = ($mode); trace follows:
+------------------------------------------------------------------------
+EOM
+ }
+ push @{ $self->[0] }, $_[0];
+}
+sub close { return }
+
+#####################################################################
+#
+# the Perl::Tidy::LineSource class supplies an object with a 'get_line()' method
+# which returns the next line to be parsed
+#
+#####################################################################
+
+package Perl::Tidy::LineSource;
+
+sub new {
+
+ my ( $class, $input_file, $rOpts, $rpending_logfile_message ) = @_;
+ my $input_file_copy = undef;
+ my $fh_copy;
+
+ my $input_line_ending;
+ if ( $rOpts->{'preserve-line-endings'} ) {
+ $input_line_ending = Perl::Tidy::find_input_line_ending($input_file);
+ }
+
+ ( my $fh, $input_file ) = Perl::Tidy::streamhandle( $input_file, 'r' );
+ return undef unless $fh;
+
+ # in order to check output syntax when standard output is used,
+ # or when it is an object, we have to make a copy of the file
+ if ( ( $input_file eq '-' || ref $input_file ) && $rOpts->{'check-syntax'} )
+ {
+
+ # Turning off syntax check when input output is used.
+ # The reason is that temporary files cause problems on
+ # on many systems.
+ $rOpts->{'check-syntax'} = 0;
+ $input_file_copy = '-';
+
+ $$rpending_logfile_message .= <<EOM;
+Note: --syntax check will be skipped because standard input is used
+EOM
+
+ }
+
+ return bless {
+ _fh => $fh,
+ _fh_copy => $fh_copy,
+ _filename => $input_file,
+ _input_file_copy => $input_file_copy,
+ _input_line_ending => $input_line_ending,
+ _rinput_buffer => [],
+ _started => 0,
+ }, $class;
+}
+
+sub get_input_file_copy_name {
+ my $self = shift;
+ my $ifname = $self->{_input_file_copy};
+ unless ($ifname) {
+ $ifname = $self->{_filename};
+ }
+ return $ifname;
+}
+
+sub close_input_file {
+ my $self = shift;
+ eval { $self->{_fh}->close() };
+ eval { $self->{_fh_copy}->close() } if $self->{_fh_copy};
+}
+
+sub get_line {
+ my $self = shift;
+ my $line = undef;
+ my $fh = $self->{_fh};
+ my $fh_copy = $self->{_fh_copy};
+ my $rinput_buffer = $self->{_rinput_buffer};
+
+ if ( scalar(@$rinput_buffer) ) {
+ $line = shift @$rinput_buffer;
+ }
+ else {
+ $line = $fh->getline();
+
+ # patch to read raw mac files under unix, dos
+ # see if the first line has embedded \r's
+ if ( $line && !$self->{_started} ) {
+ if ( $line =~ /[\015][^\015\012]/ ) {
+
+ # found one -- break the line up and store in a buffer
+ @$rinput_buffer = map { $_ . "\n" } split /\015/, $line;
+ my $count = @$rinput_buffer;
+ $line = shift @$rinput_buffer;
+ }
+ $self->{_started}++;
+ }
+ }
+ if ( $line && $fh_copy ) { $fh_copy->print($line); }
+ return $line;
+}
+
+#####################################################################
+#
+# the Perl::Tidy::LineSink class supplies a write_line method for
+# actual file writing
+#
+#####################################################################
+
+package Perl::Tidy::LineSink;
+
+sub new {
+
+ my ( $class, $output_file, $tee_file, $line_separator, $rOpts,
+ $rpending_logfile_message, $binmode )
+ = @_;
+ my $fh = undef;
+ my $fh_copy = undef;
+ my $fh_tee = undef;
+ my $output_file_copy = "";
+ my $output_file_open = 0;
+
+ if ( $rOpts->{'format'} eq 'tidy' ) {
+ ( $fh, $output_file ) = Perl::Tidy::streamhandle( $output_file, 'w' );
+ unless ($fh) { die "Cannot write to output stream\n"; }
+ $output_file_open = 1;
+ if ($binmode) {
+ if ( ref($fh) eq 'IO::File' ) {
+ binmode $fh;
+ }
+ if ( $output_file eq '-' ) { binmode STDOUT }
+ }
+ }
+
+ # in order to check output syntax when standard output is used,
+ # or when it is an object, we have to make a copy of the file
+ if ( $output_file eq '-' || ref $output_file ) {
+ if ( $rOpts->{'check-syntax'} ) {
+
+ # Turning off syntax check when standard output is used.
+ # The reason is that temporary files cause problems on
+ # on many systems.
+ $rOpts->{'check-syntax'} = 0;
+ $output_file_copy = '-';
+ $$rpending_logfile_message .= <<EOM;
+Note: --syntax check will be skipped because standard output is used
+EOM
+
+ }
+ }
+
+ bless {
+ _fh => $fh,
+ _fh_copy => $fh_copy,
+ _fh_tee => $fh_tee,
+ _output_file => $output_file,
+ _output_file_open => $output_file_open,
+ _output_file_copy => $output_file_copy,
+ _tee_flag => 0,
+ _tee_file => $tee_file,
+ _tee_file_opened => 0,
+ _line_separator => $line_separator,
+ _binmode => $binmode,
+ }, $class;
+}
+
+sub write_line {
+
+ my $self = shift;
+ my $fh = $self->{_fh};
+ my $fh_copy = $self->{_fh_copy};
+
+ my $output_file_open = $self->{_output_file_open};
+ chomp $_[0];
+ $_[0] .= $self->{_line_separator};
+
+ $fh->print( $_[0] ) if ( $self->{_output_file_open} );
+ print $fh_copy $_[0] if ( $fh_copy && $self->{_output_file_copy} );
+
+ if ( $self->{_tee_flag} ) {
+ unless ( $self->{_tee_file_opened} ) { $self->really_open_tee_file() }
+ my $fh_tee = $self->{_fh_tee};
+ print $fh_tee $_[0];
+ }
+}
+
+sub get_output_file_copy {
+ my $self = shift;
+ my $ofname = $self->{_output_file_copy};
+ unless ($ofname) {
+ $ofname = $self->{_output_file};
+ }
+ return $ofname;
+}
+
+sub tee_on {
+ my $self = shift;
+ $self->{_tee_flag} = 1;
+}
+
+sub tee_off {
+ my $self = shift;
+ $self->{_tee_flag} = 0;
+}
+
+sub really_open_tee_file {
+ my $self = shift;
+ my $tee_file = $self->{_tee_file};
+ my $fh_tee;
+ $fh_tee = IO::File->new(">$tee_file")
+ or die("couldn't open TEE file $tee_file: $!\n");
+ binmode $fh_tee if $self->{_binmode};
+ $self->{_tee_file_opened} = 1;
+ $self->{_fh_tee} = $fh_tee;
+}
+
+sub close_output_file {
+ my $self = shift;
+ eval { $self->{_fh}->close() } if $self->{_output_file_open};
+ eval { $self->{_fh_copy}->close() } if ( $self->{_output_file_copy} );
+ $self->close_tee_file();
+}
+
+sub close_tee_file {
+ my $self = shift;
+
+ if ( $self->{_tee_file_opened} ) {
+ eval { $self->{_fh_tee}->close() };
+ $self->{_tee_file_opened} = 0;
+ }
+}
+
+#####################################################################
+#
+# The Perl::Tidy::Diagnostics class writes the DIAGNOSTICS file, which is
+# useful for program development.
+#
+# Only one such file is created regardless of the number of input
+# files processed. This allows the results of processing many files
+# to be summarized in a single file.
+#
+#####################################################################
+
+package Perl::Tidy::Diagnostics;
+
+sub new {
+
+ my $class = shift;
+ bless {
+ _write_diagnostics_count => 0,
+ _last_diagnostic_file => "",
+ _input_file => "",
+ _fh => undef,
+ }, $class;
+}
+
+sub set_input_file {
+ my $self = shift;
+ $self->{_input_file} = $_[0];
+}
+
+# This is a diagnostic routine which is useful for program development.
+# Output from debug messages go to a file named DIAGNOSTICS, where
+# they are labeled by file and line. This allows many files to be
+# scanned at once for some particular condition of interest.
+sub write_diagnostics {
+ my $self = shift;
+
+ unless ( $self->{_write_diagnostics_count} ) {
+ open DIAGNOSTICS, ">DIAGNOSTICS"
+ or death("couldn't open DIAGNOSTICS: $!\n");
+ }
+
+ my $last_diagnostic_file = $self->{_last_diagnostic_file};
+ my $input_file = $self->{_input_file};
+ if ( $last_diagnostic_file ne $input_file ) {
+ print DIAGNOSTICS "\nFILE:$input_file\n";
+ }
+ $self->{_last_diagnostic_file} = $input_file;
+ my $input_line_number = Perl::Tidy::Tokenizer::get_input_line_number();
+ print DIAGNOSTICS "$input_line_number:\t@_";
+ $self->{_write_diagnostics_count}++;
+}
+
+#####################################################################
+#
+# The Perl::Tidy::Logger class writes the .LOG and .ERR files
+#
+#####################################################################
+
+package Perl::Tidy::Logger;
+
+sub new {
+ my $class = shift;
+ my $fh;
+ my ( $rOpts, $log_file, $warning_file, $saw_extrude ) = @_;
+
+ # remove any old error output file
+ unless ( ref($warning_file) ) {
+ if ( -e $warning_file ) { unlink($warning_file) }
+ }
+
+ bless {
+ _log_file => $log_file,
+ _fh_warnings => undef,
+ _rOpts => $rOpts,
+ _fh_warnings => undef,
+ _last_input_line_written => 0,
+ _at_end_of_file => 0,
+ _use_prefix => 1,
+ _block_log_output => 0,
+ _line_of_tokens => undef,
+ _output_line_number => undef,
+ _wrote_line_information_string => 0,
+ _wrote_column_headings => 0,
+ _warning_file => $warning_file,
+ _warning_count => 0,
+ _complaint_count => 0,
+ _saw_code_bug => -1, # -1=no 0=maybe 1=for sure
+ _saw_brace_error => 0,
+ _saw_extrude => $saw_extrude,
+ _output_array => [],
+ }, $class;
+}
+
+sub close_log_file {
+
+ my $self = shift;
+ if ( $self->{_fh_warnings} ) {
+ eval { $self->{_fh_warnings}->close() };
+ $self->{_fh_warnings} = undef;
+ }
+}
+
+sub get_warning_count {
+ my $self = shift;
+ return $self->{_warning_count};
+}
+
+sub get_use_prefix {
+ my $self = shift;
+ return $self->{_use_prefix};
+}
+
+sub block_log_output {
+ my $self = shift;
+ $self->{_block_log_output} = 1;
+}
+
+sub unblock_log_output {
+ my $self = shift;
+ $self->{_block_log_output} = 0;
+}
+
+sub interrupt_logfile {
+ my $self = shift;
+ $self->{_use_prefix} = 0;
+ $self->warning("\n");
+ $self->write_logfile_entry( '#' x 24 . " WARNING " . '#' x 25 . "\n" );
+}
+
+sub resume_logfile {
+ my $self = shift;
+ $self->write_logfile_entry( '#' x 60 . "\n" );
+ $self->{_use_prefix} = 1;
+}
+
+sub we_are_at_the_last_line {
+ my $self = shift;
+ unless ( $self->{_wrote_line_information_string} ) {
+ $self->write_logfile_entry("Last line\n\n");
+ }
+ $self->{_at_end_of_file} = 1;
+}
+
+# record some stuff in case we go down in flames
+sub black_box {
+ my $self = shift;
+ my ( $line_of_tokens, $output_line_number ) = @_;
+ my $input_line = $line_of_tokens->{_line_text};
+ my $input_line_number = $line_of_tokens->{_line_number};
+
+ # save line information in case we have to write a logfile message
+ $self->{_line_of_tokens} = $line_of_tokens;
+ $self->{_output_line_number} = $output_line_number;
+ $self->{_wrote_line_information_string} = 0;
+
+ my $last_input_line_written = $self->{_last_input_line_written};
+ my $rOpts = $self->{_rOpts};
+ if (
+ (
+ ( $input_line_number - $last_input_line_written ) >=
+ $rOpts->{'logfile-gap'}
+ )
+ || ( $input_line =~ /^\s*(sub|package)\s+(\w+)/ )
+ )
+ {
+ my $rlevels = $line_of_tokens->{_rlevels};
+ my $structural_indentation_level = $$rlevels[0];
+ $self->{_last_input_line_written} = $input_line_number;
+ ( my $out_str = $input_line ) =~ s/^\s*//;
+ chomp $out_str;
+
+ $out_str = ( '.' x $structural_indentation_level ) . $out_str;
+
+ if ( length($out_str) > 35 ) {
+ $out_str = substr( $out_str, 0, 35 ) . " ....";
+ }
+ $self->logfile_output( "", "$out_str\n" );
+ }
+}
+
+sub write_logfile_entry {
+ my $self = shift;
+
+ # add leading >>> to avoid confusing error mesages and code
+ $self->logfile_output( ">>>", "@_" );
+}
+
+sub write_column_headings {
+ my $self = shift;
+
+ $self->{_wrote_column_headings} = 1;
+ my $routput_array = $self->{_output_array};
+ push @{$routput_array}, <<EOM;
+The nesting depths in the table below are at the start of the lines.
+The indicated output line numbers are not always exact.
+ci = levels of continuation indentation; bk = 1 if in BLOCK, 0 if not.
+
+in:out indent c b nesting code + messages; (messages begin with >>>)
+lines levels i k (code begins with one '.' per indent level)
+------ ----- - - -------- -------------------------------------------
+EOM
+}
+
+sub make_line_information_string {
+
+ # make columns of information when a logfile message needs to go out
+ my $self = shift;
+ my $line_of_tokens = $self->{_line_of_tokens};
+ my $input_line_number = $line_of_tokens->{_line_number};
+ my $line_information_string = "";
+ if ($input_line_number) {
+
+ my $output_line_number = $self->{_output_line_number};
+ my $brace_depth = $line_of_tokens->{_curly_brace_depth};
+ my $paren_depth = $line_of_tokens->{_paren_depth};
+ my $square_bracket_depth = $line_of_tokens->{_square_bracket_depth};
+ my $python_indentation_level =
+ $line_of_tokens->{_python_indentation_level};
+ my $rlevels = $line_of_tokens->{_rlevels};
+ my $rnesting_tokens = $line_of_tokens->{_rnesting_tokens};
+ my $rci_levels = $line_of_tokens->{_rci_levels};
+ my $rnesting_blocks = $line_of_tokens->{_rnesting_blocks};
+
+ my $structural_indentation_level = $$rlevels[0];
+
+ $self->write_column_headings() unless $self->{_wrote_column_headings};
+
+ # keep logfile columns aligned for scripts up to 999 lines;
+ # for longer scripts it doesn't really matter
+ my $extra_space = "";
+ $extra_space .=
+ ( $input_line_number < 10 ) ? " "
+ : ( $input_line_number < 100 ) ? " "
+ : "";
+ $extra_space .=
+ ( $output_line_number < 10 ) ? " "
+ : ( $output_line_number < 100 ) ? " "
+ : "";
+
+ # there are 2 possible nesting strings:
+ # the original which looks like this: (0 [1 {2
+ # the new one, which looks like this: {{[
+ # the new one is easier to read, and shows the order, but
+ # could be arbitrarily long, so we use it unless it is too long
+ my $nesting_string =
+ "($paren_depth [$square_bracket_depth {$brace_depth";
+ my $nesting_string_new = $$rnesting_tokens[0];
+
+ my $ci_level = $$rci_levels[0];
+ if ( $ci_level > 9 ) { $ci_level = '*' }
+ my $bk = ( $$rnesting_blocks[0] =~ /1$/ ) ? '1' : '0';
+
+ if ( length($nesting_string_new) <= 8 ) {
+ $nesting_string =
+ $nesting_string_new . " " x ( 8 - length($nesting_string_new) );
+ }
+ if ( $python_indentation_level < 0 ) { $python_indentation_level = 0 }
+ $line_information_string =
+"L$input_line_number:$output_line_number$extra_space i$python_indentation_level:$structural_indentation_level $ci_level $bk $nesting_string";
+ }
+ return $line_information_string;
+}
+
+sub logfile_output {
+ my $self = shift;
+ my ( $prompt, $msg ) = @_;
+ return if ( $self->{_block_log_output} );
+
+ my $routput_array = $self->{_output_array};
+ if ( $self->{_at_end_of_file} || !$self->{_use_prefix} ) {
+ push @{$routput_array}, "$msg";
+ }
+ else {
+ my $line_information_string = $self->make_line_information_string();
+ $self->{_wrote_line_information_string} = 1;
+
+ if ($line_information_string) {
+ push @{$routput_array}, "$line_information_string $prompt$msg";
+ }
+ else {
+ push @{$routput_array}, "$msg";
+ }
+ }
+}
+
+sub get_saw_brace_error {
+ my $self = shift;
+ return $self->{_saw_brace_error};
+}
+
+sub increment_brace_error {
+ my $self = shift;
+ $self->{_saw_brace_error}++;
+}
+
+sub brace_warning {
+ my $self = shift;
+ use constant BRACE_WARNING_LIMIT => 10;
+ my $saw_brace_error = $self->{_saw_brace_error};
+
+ if ( $saw_brace_error < BRACE_WARNING_LIMIT ) {
+ $self->warning(@_);
+ }
+ $saw_brace_error++;
+ $self->{_saw_brace_error} = $saw_brace_error;
+
+ if ( $saw_brace_error == BRACE_WARNING_LIMIT ) {
+ $self->warning("No further warnings of this type will be given\n");
+ }
+}
+
+sub complain {
+
+ # handle non-critical warning messages based on input flag
+ my $self = shift;
+ my $rOpts = $self->{_rOpts};
+
+ # these appear in .ERR output only if -w flag is used
+ if ( $rOpts->{'warning-output'} ) {
+ $self->warning(@_);
+ }
+
+ # otherwise, they go to the .LOG file
+ else {
+ $self->{_complaint_count}++;
+ $self->write_logfile_entry(@_);
+ }
+}
+
+sub warning {
+
+ # report errors to .ERR file (or stdout)
+ my $self = shift;
+ use constant WARNING_LIMIT => 50;
+
+ my $rOpts = $self->{_rOpts};
+ unless ( $rOpts->{'quiet'} ) {
+
+ my $warning_count = $self->{_warning_count};
+ unless ($warning_count) {
+ my $warning_file = $self->{_warning_file};
+ my $fh_warnings;
+ if ( $rOpts->{'standard-error-output'} ) {
+ $fh_warnings = *STDERR;
+ }
+ else {
+ ( $fh_warnings, my $filename ) =
+ Perl::Tidy::streamhandle( $warning_file, 'w' );
+ $fh_warnings or die("couldn't open $filename $!\n");
+ warn "## Please see file $filename\n";
+ }
+ $self->{_fh_warnings} = $fh_warnings;
+ }
+
+ my $fh_warnings = $self->{_fh_warnings};
+ if ( $warning_count < WARNING_LIMIT ) {
+ if ( $self->get_use_prefix() > 0 ) {
+ my $input_line_number =
+ Perl::Tidy::Tokenizer::get_input_line_number();
+ $fh_warnings->print("$input_line_number:\t@_");
+ $self->write_logfile_entry("WARNING: @_");
+ }
+ else {
+ $fh_warnings->print(@_);
+ $self->write_logfile_entry(@_);
+ }
+ }
+ $warning_count++;
+ $self->{_warning_count} = $warning_count;
+
+ if ( $warning_count == WARNING_LIMIT ) {
+ $fh_warnings->print("No further warnings will be given\n");
+ }
+ }
+}
+
+# programming bug codes:
+# -1 = no bug
+# 0 = maybe, not sure.
+# 1 = definitely
+sub report_possible_bug {
+ my $self = shift;
+ my $saw_code_bug = $self->{_saw_code_bug};
+ $self->{_saw_code_bug} = ( $saw_code_bug < 0 ) ? 0 : $saw_code_bug;
+}
+
+sub report_definite_bug {
+ my $self = shift;
+ $self->{_saw_code_bug} = 1;
+}
+
+sub ask_user_for_bug_report {
+ my $self = shift;
+
+ my ( $infile_syntax_ok, $formatter ) = @_;
+ my $saw_code_bug = $self->{_saw_code_bug};
+ if ( ( $saw_code_bug == 0 ) && ( $infile_syntax_ok == 1 ) ) {
+ $self->warning(<<EOM);
+
+You may have encountered a code bug in perltidy. If you think so, and
+the problem is not listed in the BUGS file at
+http://perltidy.sourceforge.net, please report it so that it can be
+corrected. Include the smallest possible script which has the problem,
+along with the .LOG file. See the manual pages for contact information.
+Thank you!
+EOM
+
+ }
+ elsif ( $saw_code_bug == 1 ) {
+ if ( $self->{_saw_extrude} ) {
+ $self->warning(<<EOM);
+
+You may have encountered a bug in perltidy. However, since you are using the
+-extrude option, the problem may be with perl or one of its modules, which have
+occasional problems with this type of file. If you believe that the
+problem is with perltidy, and the problem is not listed in the BUGS file at
+http://perltidy.sourceforge.net, please report it so that it can be corrected.
+Include the smallest possible script which has the problem, along with the .LOG
+file. See the manual pages for contact information.
+Thank you!
+EOM
+ }
+ else {
+ $self->warning(<<EOM);
+
+Oops, you seem to have encountered a bug in perltidy. Please check the
+BUGS file at http://perltidy.sourceforge.net. If the problem is not
+listed there, please report it so that it can be corrected. Include the
+smallest possible script which produces this message, along with the
+.LOG file if appropriate. See the manual pages for contact information.
+Your efforts are appreciated.
+Thank you!
+EOM
+ my $added_semicolon_count = 0;
+ eval {
+ $added_semicolon_count =
+ $formatter->get_added_semicolon_count();
+ };
+ if ( $added_semicolon_count > 0 ) {
+ $self->warning(<<EOM);
+
+The log file shows that perltidy added $added_semicolon_count semicolons.
+Please rerun with -nasc to see if that is the cause of the syntax error. Even
+if that is the problem, please report it so that it can be fixed.
+EOM
+
+ }
+ }
+ }
+}
+
+sub finish {
+
+ # called after all formatting to summarize errors
+ my $self = shift;
+ my ( $infile_syntax_ok, $formatter ) = @_;
+
+ my $rOpts = $self->{_rOpts};
+ my $warning_count = $self->{_warning_count};
+ my $saw_code_bug = $self->{_saw_code_bug};
+
+ my $save_logfile =
+ ( $saw_code_bug == 0 && $infile_syntax_ok == 1 )
+ || $saw_code_bug == 1
+ || $rOpts->{'logfile'};
+ my $log_file = $self->{_log_file};
+ if ($warning_count) {
+ if ($save_logfile) {
+ $self->block_log_output(); # avoid echoing this to the logfile
+ $self->warning(
+ "The logfile $log_file may contain useful information\n");
+ $self->unblock_log_output();
+ }
+
+ if ( $self->{_complaint_count} > 0 ) {
+ $self->warning(
+"To see $self->{_complaint_count} non-critical warnings rerun with -w\n"
+ );
+ }
+
+ if ( $self->{_saw_brace_error}
+ && ( $rOpts->{'logfile-gap'} > 1 || !$save_logfile ) )
+ {
+ $self->warning("To save a full .LOG file rerun with -g\n");
+ }
+ }
+ $self->ask_user_for_bug_report( $infile_syntax_ok, $formatter );
+
+ if ($save_logfile) {
+ my $log_file = $self->{_log_file};
+ my ( $fh, $filename ) = Perl::Tidy::streamhandle( $log_file, 'w' );
+ if ($fh) {
+ my $routput_array = $self->{_output_array};
+ foreach ( @{$routput_array} ) { $fh->print($_) }
+ eval { $fh->close() };
+ }
+ }
+}
+
+#####################################################################
+#
+# The Perl::Tidy::DevNull class supplies a dummy print method
+#
+#####################################################################
+
+package Perl::Tidy::DevNull;
+sub new { return bless {}, $_[0] }
+sub print { return }
+sub close { return }
+
+#####################################################################
+#
+# The Perl::Tidy::HtmlWriter class writes a copy of the input stream in html
+#
+#####################################################################
+
+package Perl::Tidy::HtmlWriter;
+
+use File::Basename;
+
+# class variables
+use vars qw{
+ %html_color
+ %html_bold
+ %html_italic
+ %token_short_names
+ %short_to_long_names
+ $rOpts
+ $css_filename
+ $css_linkname
+ $missing_html_entities
+};
+
+# replace unsafe characters with HTML entity representation if HTML::Entities
+# is available
+{ eval "use HTML::Entities"; $missing_html_entities = $@; }
+
+sub new {
+
+ my ( $class, $input_file, $html_file, $extension, $html_toc_extension,
+ $html_src_extension )
+ = @_;
+
+ my $html_file_opened = 0;
+ my $html_fh;
+ ( $html_fh, my $html_filename ) =
+ Perl::Tidy::streamhandle( $html_file, 'w' );
+ unless ($html_fh) {
+ warn("can't open $html_file: $!\n");
+ return undef;
+ }
+ $html_file_opened = 1;
+
+ if ( !$input_file || $input_file eq '-' || ref($input_file) ) {
+ $input_file = "NONAME";
+ }
+
+ # write the table of contents to a string
+ my $toc_string;
+ my $html_toc_fh = Perl::Tidy::IOScalar->new( \$toc_string, 'w' );
+
+ my $html_pre_fh;
+ my @pre_string_stack;
+ if ( $rOpts->{'html-pre-only'} ) {
+
+ # pre section goes directly to the output stream
+ $html_pre_fh = $html_fh;
+ $html_pre_fh->print( <<"PRE_END");
+<pre>
+PRE_END
+ }
+ else {
+
+ # pre section go out to a temporary string
+ my $pre_string;
+ $html_pre_fh = Perl::Tidy::IOScalar->new( \$pre_string, 'w' );
+ push @pre_string_stack, \$pre_string;
+ }
+
+ # pod text gets diverted if the 'pod2html' is used
+ my $html_pod_fh;
+ my $pod_string;
+ if ( $rOpts->{'pod2html'} ) {
+ if ( $rOpts->{'html-pre-only'} ) {
+ undef $rOpts->{'pod2html'};
+ }
+ else {
+ eval "use Pod::Html";
+ if ($@) {
+ warn
+"unable to find Pod::Html; cannot use pod2html\n-npod disables this message\n";
+ undef $rOpts->{'pod2html'};
+ }
+ else {
+ $html_pod_fh = Perl::Tidy::IOScalar->new( \$pod_string, 'w' );
+ }
+ }
+ }
+
+ my $toc_filename;
+ my $src_filename;
+ if ( $rOpts->{'frames'} ) {
+ unless ($extension) {
+ warn
+"cannot use frames without a specified output extension; ignoring -frm\n";
+ undef $rOpts->{'frames'};
+ }
+ else {
+ $toc_filename = $input_file . $html_toc_extension . $extension;
+ $src_filename = $input_file . $html_src_extension . $extension;
+ }
+ }
+
+ # ----------------------------------------------------------
+ # Output is now directed as follows:
+ # html_toc_fh <-- table of contents items
+ # html_pre_fh <-- the <pre> section of formatted code, except:
+ # html_pod_fh <-- pod goes here with the pod2html option
+ # ----------------------------------------------------------
+
+ my $title = $rOpts->{'title'};
+ unless ($title) {
+ ( $title, my $path ) = fileparse($input_file);
+ }
+ my $toc_item_count = 0;
+ my $in_toc_package = "";
+ my $last_level = 0;
+ bless {
+ _input_file => $input_file, # name of input file
+ _title => $title, # title, unescaped
+ _html_file => $html_file, # name of .html output file
+ _toc_filename => $toc_filename, # for frames option
+ _src_filename => $src_filename, # for frames option
+ _html_file_opened => $html_file_opened, # a flag
+ _html_fh => $html_fh, # the output stream
+ _html_pre_fh => $html_pre_fh, # pre section goes here
+ _rpre_string_stack => \@pre_string_stack, # stack of pre sections
+ _html_pod_fh => $html_pod_fh, # pod goes here if pod2html
+ _rpod_string => \$pod_string, # string holding pod
+ _pod_cut_count => 0, # how many =cut's?
+ _html_toc_fh => $html_toc_fh, # fh for table of contents
+ _rtoc_string => \$toc_string, # string holding toc
+ _rtoc_item_count => \$toc_item_count, # how many toc items
+ _rin_toc_package => \$in_toc_package, # package name
+ _rtoc_name_count => {}, # hash to track unique names
+ _rpackage_stack => [], # stack to check for package
+ # name changes
+ _rlast_level => \$last_level, # brace indentation level
+ }, $class;
+}
+
+sub add_toc_item {
+
+ # Add an item to the html table of contents.
+ # This is called even if no table of contents is written,
+ # because we still want to put the anchors in the <pre> text.
+ # We are given an anchor name and its type; types are:
+ # 'package', 'sub', '__END__', '__DATA__', 'EOF'
+ # There must be an 'EOF' call at the end to wrap things up.
+ my $self = shift;
+ my ( $name, $type ) = @_;
+ my $html_toc_fh = $self->{_html_toc_fh};
+ my $html_pre_fh = $self->{_html_pre_fh};
+ my $rtoc_name_count = $self->{_rtoc_name_count};
+ my $rtoc_item_count = $self->{_rtoc_item_count};
+ my $rlast_level = $self->{_rlast_level};
+ my $rin_toc_package = $self->{_rin_toc_package};
+ my $rpackage_stack = $self->{_rpackage_stack};
+
+ # packages contain sublists of subs, so to avoid errors all package
+ # items are written and finished with the following routines
+ my $end_package_list = sub {
+ if ($$rin_toc_package) {
+ $html_toc_fh->print("</ul>\n</li>\n");
+ $$rin_toc_package = "";
+ }
+ };
+
+ my $start_package_list = sub {
+ my ( $unique_name, $package ) = @_;
+ if ($$rin_toc_package) { $end_package_list->() }
+ $html_toc_fh->print(<<EOM);
+<li><a href=\"#$unique_name\">package $package</a>
+<ul>
+EOM
+ $$rin_toc_package = $package;
+ };
+
+ # start the table of contents on the first item
+ unless ($$rtoc_item_count) {
+
+ # but just quit if we hit EOF without any other entries
+ # in this case, there will be no toc
+ return if ( $type eq 'EOF' );
+ $html_toc_fh->print( <<"TOC_END");
+<!-- BEGIN CODE INDEX --><a name="code-index"></a>
+<ul>
+TOC_END
+ }
+ $$rtoc_item_count++;
+
+ # make a unique anchor name for this location:
+ # - packages get a 'package-' prefix
+ # - subs use their names
+ my $unique_name = $name;
+ if ( $type eq 'package' ) { $unique_name = "package-$name" }
+
+ # append '-1', '-2', etc if necessary to make unique; this will
+ # be unique because subs and packages cannot have a '-'
+ if ( my $count = $rtoc_name_count->{ lc $unique_name }++ ) {
+ $unique_name .= "-$count";
+ }
+
+ # - all names get terminal '-' if pod2html is used, to avoid
+ # conflicts with anchor names created by pod2html
+ if ( $rOpts->{'pod2html'} ) { $unique_name .= '-' }
+
+ # start/stop lists of subs
+ if ( $type eq 'sub' ) {
+ my $package = $rpackage_stack->[$$rlast_level];
+ unless ($package) { $package = 'main' }
+
+ # if we're already in a package/sub list, be sure its the right
+ # package or else close it
+ if ( $$rin_toc_package && $$rin_toc_package ne $package ) {
+ $end_package_list->();
+ }
+
+ # start a package/sub list if necessary
+ unless ($$rin_toc_package) {
+ $start_package_list->( $unique_name, $package );
+ }
+ }
+
+ # now write an entry in the toc for this item
+ if ( $type eq 'package' ) {
+ $start_package_list->( $unique_name, $name );
+ }
+ elsif ( $type eq 'sub' ) {
+ $html_toc_fh->print("<li><a href=\"#$unique_name\">$name</a></li>\n");
+ }
+ else {
+ $end_package_list->();
+ $html_toc_fh->print("<li><a href=\"#$unique_name\">$name</a></li>\n");
+ }
+
+ # write the anchor in the <pre> section
+ $html_pre_fh->print("<a name=\"$unique_name\"></a>");
+
+ # end the table of contents, if any, on the end of file
+ if ( $type eq 'EOF' ) {
+ $html_toc_fh->print( <<"TOC_END");
+</ul>
+<!-- END CODE INDEX -->
+TOC_END
+ }
+}
+
+BEGIN {
+
+ # This is the official list of tokens which may be identified by the
+ # user. Long names are used as getopt keys. Short names are
+ # convenient short abbreviations for specifying input. Short names
+ # somewhat resemble token type characters, but are often different
+ # because they may only be alphanumeric, to allow command line
+ # input. Also, note that because of case insensitivity of html,
+ # this table must be in a single case only (I've chosen to use all
+ # lower case).
+ # When adding NEW_TOKENS: update this hash table
+ # short names => long names
+ %short_to_long_names = (
+ 'n' => 'numeric',
+ 'p' => 'paren',
+ 'q' => 'quote',
+ 's' => 'structure',
+ 'c' => 'comment',
+ 'v' => 'v-string',
+ 'cm' => 'comma',
+ 'w' => 'bareword',
+ 'co' => 'colon',
+ 'pu' => 'punctuation',
+ 'i' => 'identifier',
+ 'j' => 'label',
+ 'h' => 'here-doc-target',
+ 'hh' => 'here-doc-text',
+ 'k' => 'keyword',
+ 'sc' => 'semicolon',
+ 'm' => 'subroutine',
+ 'pd' => 'pod-text',
+ );
+
+ # Now we have to map actual token types into one of the above short
+ # names; any token types not mapped will get 'punctuation'
+ # properties.
+
+ # The values of this hash table correspond to the keys of the
+ # previous hash table.
+ # The keys of this hash table are token types and can be seen
+ # by running with --dump-token-types (-dtt).
+
+ # When adding NEW_TOKENS: update this hash table
+ # $type => $short_name
+ %token_short_names = (
+ '#' => 'c',
+ 'n' => 'n',
+ 'v' => 'v',
+ 'k' => 'k',
+ 'F' => 'k',
+ 'Q' => 'q',
+ 'q' => 'q',
+ 'J' => 'j',
+ 'j' => 'j',
+ 'h' => 'h',
+ 'H' => 'hh',
+ 'w' => 'w',
+ ',' => 'cm',
+ '=>' => 'cm',
+ ';' => 'sc',
+ ':' => 'co',
+ 'f' => 'sc',
+ '(' => 'p',
+ ')' => 'p',
+ 'M' => 'm',
+ 'P' => 'pd',
+ 'A' => 'co',
+ );
+
+ # These token types will all be called identifiers for now
+ # FIXME: need to separate user defined modules as separate type
+ my @identifier = qw" i t U C Y Z G :: ";
+ @token_short_names{@identifier} = ('i') x scalar(@identifier);
+
+ # These token types will be called 'structure'
+ my @structure = qw" { } ";
+ @token_short_names{@structure} = ('s') x scalar(@structure);
+
+ # OLD NOTES: save for reference
+ # Any of these could be added later if it would be useful.
+ # For now, they will by default become punctuation
+ # my @list = qw" L R [ ] ";
+ # @token_long_names{@list} = ('non-structure') x scalar(@list);
+ #
+ # my @list = qw"
+ # / /= * *= ** **= + += - -= % %= = ++ -- << <<= >> >>= pp p m mm
+ # ";
+ # @token_long_names{@list} = ('math') x scalar(@list);
+ #
+ # my @list = qw" & &= ~ ~= ^ ^= | |= ";
+ # @token_long_names{@list} = ('bit') x scalar(@list);
+ #
+ # my @list = qw" == != < > <= <=> ";
+ # @token_long_names{@list} = ('numerical-comparison') x scalar(@list);
+ #
+ # my @list = qw" && || ! &&= ||= //= ";
+ # @token_long_names{@list} = ('logical') x scalar(@list);
+ #
+ # my @list = qw" . .= =~ !~ x x= ";
+ # @token_long_names{@list} = ('string-operators') x scalar(@list);
+ #
+ # # Incomplete..
+ # my @list = qw" .. -> <> ... \ ? ";
+ # @token_long_names{@list} = ('misc-operators') x scalar(@list);
+
+}
+
+sub make_getopt_long_names {
+ my $class = shift;
+ my ($rgetopt_names) = @_;
+ while ( my ( $short_name, $name ) = each %short_to_long_names ) {
+ push @$rgetopt_names, "html-color-$name=s";
+ push @$rgetopt_names, "html-italic-$name!";
+ push @$rgetopt_names, "html-bold-$name!";
+ }
+ push @$rgetopt_names, "html-color-background=s";
+ push @$rgetopt_names, "html-linked-style-sheet=s";
+ push @$rgetopt_names, "nohtml-style-sheets";
+ push @$rgetopt_names, "html-pre-only";
+ push @$rgetopt_names, "html-line-numbers";
+ push @$rgetopt_names, "html-entities!";
+ push @$rgetopt_names, "stylesheet";
+ push @$rgetopt_names, "html-table-of-contents!";
+ push @$rgetopt_names, "pod2html!";
+ push @$rgetopt_names, "frames!";
+ push @$rgetopt_names, "html-toc-extension=s";
+ push @$rgetopt_names, "html-src-extension=s";
+
+ # Pod::Html parameters:
+ push @$rgetopt_names, "backlink=s";
+ push @$rgetopt_names, "cachedir=s";
+ push @$rgetopt_names, "htmlroot=s";
+ push @$rgetopt_names, "libpods=s";
+ push @$rgetopt_names, "podpath=s";
+ push @$rgetopt_names, "podroot=s";
+ push @$rgetopt_names, "title=s";
+
+ # Pod::Html parameters with leading 'pod' which will be removed
+ # before the call to Pod::Html
+ push @$rgetopt_names, "podquiet!";
+ push @$rgetopt_names, "podverbose!";
+ push @$rgetopt_names, "podrecurse!";
+ push @$rgetopt_names, "podflush";
+ push @$rgetopt_names, "podheader!";
+ push @$rgetopt_names, "podindex!";
+}
+
+sub make_abbreviated_names {
+
+ # We're appending things like this to the expansion list:
+ # 'hcc' => [qw(html-color-comment)],
+ # 'hck' => [qw(html-color-keyword)],
+ # etc
+ my $class = shift;
+ my ($rexpansion) = @_;
+
+ # abbreviations for color/bold/italic properties
+ while ( my ( $short_name, $long_name ) = each %short_to_long_names ) {
+ ${$rexpansion}{"hc$short_name"} = ["html-color-$long_name"];
+ ${$rexpansion}{"hb$short_name"} = ["html-bold-$long_name"];
+ ${$rexpansion}{"hi$short_name"} = ["html-italic-$long_name"];
+ ${$rexpansion}{"nhb$short_name"} = ["nohtml-bold-$long_name"];
+ ${$rexpansion}{"nhi$short_name"} = ["nohtml-italic-$long_name"];
+ }
+
+ # abbreviations for all other html options
+ ${$rexpansion}{"hcbg"} = ["html-color-background"];
+ ${$rexpansion}{"pre"} = ["html-pre-only"];
+ ${$rexpansion}{"toc"} = ["html-table-of-contents"];
+ ${$rexpansion}{"ntoc"} = ["nohtml-table-of-contents"];
+ ${$rexpansion}{"nnn"} = ["html-line-numbers"];
+ ${$rexpansion}{"hent"} = ["html-entities"];
+ ${$rexpansion}{"nhent"} = ["nohtml-entities"];
+ ${$rexpansion}{"css"} = ["html-linked-style-sheet"];
+ ${$rexpansion}{"nss"} = ["nohtml-style-sheets"];
+ ${$rexpansion}{"ss"} = ["stylesheet"];
+ ${$rexpansion}{"pod"} = ["pod2html"];
+ ${$rexpansion}{"npod"} = ["nopod2html"];
+ ${$rexpansion}{"frm"} = ["frames"];
+ ${$rexpansion}{"nfrm"} = ["noframes"];
+ ${$rexpansion}{"text"} = ["html-toc-extension"];
+ ${$rexpansion}{"sext"} = ["html-src-extension"];
+}
+
+sub check_options {
+
+ # This will be called once after options have been parsed
+ my $class = shift;
+ $rOpts = shift;
+
+ # X11 color names for default settings that seemed to look ok
+ # (these color names are only used for programming clarity; the hex
+ # numbers are actually written)
+ use constant ForestGreen => "#228B22";
+ use constant SaddleBrown => "#8B4513";
+ use constant magenta4 => "#8B008B";
+ use constant IndianRed3 => "#CD5555";
+ use constant DeepSkyBlue4 => "#00688B";
+ use constant MediumOrchid3 => "#B452CD";
+ use constant black => "#000000";
+ use constant white => "#FFFFFF";
+ use constant red => "#FF0000";
+
+ # set default color, bold, italic properties
+ # anything not listed here will be given the default (punctuation) color --
+ # these types currently not listed and get default: ws pu s sc cm co p
+ # When adding NEW_TOKENS: add an entry here if you don't want defaults
+
+ # set_default_properties( $short_name, default_color, bold?, italic? );
+ set_default_properties( 'c', ForestGreen, 0, 0 );
+ set_default_properties( 'pd', ForestGreen, 0, 1 );
+ set_default_properties( 'k', magenta4, 1, 0 ); # was SaddleBrown
+ set_default_properties( 'q', IndianRed3, 0, 0 );
+ set_default_properties( 'hh', IndianRed3, 0, 1 );
+ set_default_properties( 'h', IndianRed3, 1, 0 );
+ set_default_properties( 'i', DeepSkyBlue4, 0, 0 );
+ set_default_properties( 'w', black, 0, 0 );
+ set_default_properties( 'n', MediumOrchid3, 0, 0 );
+ set_default_properties( 'v', MediumOrchid3, 0, 0 );
+ set_default_properties( 'j', IndianRed3, 1, 0 );
+ set_default_properties( 'm', red, 1, 0 );
+
+ set_default_color( 'html-color-background', white );
+ set_default_color( 'html-color-punctuation', black );
+
+ # setup property lookup tables for tokens based on their short names
+ # every token type has a short name, and will use these tables
+ # to do the html markup
+ while ( my ( $short_name, $long_name ) = each %short_to_long_names ) {
+ $html_color{$short_name} = $rOpts->{"html-color-$long_name"};
+ $html_bold{$short_name} = $rOpts->{"html-bold-$long_name"};
+ $html_italic{$short_name} = $rOpts->{"html-italic-$long_name"};
+ }
+
+ # write style sheet to STDOUT and die if requested
+ if ( defined( $rOpts->{'stylesheet'} ) ) {
+ write_style_sheet_file('-');
+ exit 1;
+ }
+
+ # make sure user gives a file name after -css
+ if ( defined( $rOpts->{'html-linked-style-sheet'} ) ) {
+ $css_linkname = $rOpts->{'html-linked-style-sheet'};
+ if ( $css_linkname =~ /^-/ ) {
+ die "You must specify a valid filename after -css\n";
+ }
+ }
+
+ # check for conflict
+ if ( $css_linkname && $rOpts->{'nohtml-style-sheets'} ) {
+ $rOpts->{'nohtml-style-sheets'} = 0;
+ warning("You can't specify both -css and -nss; -nss ignored\n");
+ }
+
+ # write a style sheet file if necessary
+ if ($css_linkname) {
+
+ # if the selected filename exists, don't write, because user may
+ # have done some work by hand to create it; use backup name instead
+ # Also, this will avoid a potential disaster in which the user
+ # forgets to specify the style sheet, like this:
+ # perltidy -html -css myfile1.pl myfile2.pl
+ # This would cause myfile1.pl to parsed as the style sheet by GetOpts
+ my $css_filename = $css_linkname;
+ unless ( -e $css_filename ) {
+ write_style_sheet_file($css_filename);
+ }
+ }
+ $missing_html_entities = 1 unless $rOpts->{'html-entities'};
+}
+
+sub write_style_sheet_file {
+
+ my $css_filename = shift;
+ my $fh;
+ unless ( $fh = IO::File->new("> $css_filename") ) {
+ die "can't open $css_filename: $!\n";
+ }
+ write_style_sheet_data($fh);
+ eval { $fh->close };
+}
+
+sub write_style_sheet_data {
+
+ # write the style sheet data to an open file handle
+ my $fh = shift;
+
+ my $bg_color = $rOpts->{'html-color-background'};
+ my $text_color = $rOpts->{'html-color-punctuation'};
+
+ # pre-bgcolor is new, and may not be defined
+ my $pre_bg_color = $rOpts->{'html-pre-color-background'};
+ $pre_bg_color = $bg_color unless $pre_bg_color;
+
+ $fh->print(<<"EOM");
+/* default style sheet generated by perltidy */
+body {background: $bg_color; color: $text_color}
+pre { color: $text_color;
+ background: $pre_bg_color;
+ font-family: courier;
+ }
+
+EOM
+
+ foreach my $short_name ( sort keys %short_to_long_names ) {
+ my $long_name = $short_to_long_names{$short_name};
+
+ my $abbrev = '.' . $short_name;
+ if ( length($short_name) == 1 ) { $abbrev .= ' ' } # for alignment
+ my $color = $html_color{$short_name};
+ if ( !defined($color) ) { $color = $text_color }
+ $fh->print("$abbrev \{ color: $color;");
+
+ if ( $html_bold{$short_name} ) {
+ $fh->print(" font-weight:bold;");
+ }
+
+ if ( $html_italic{$short_name} ) {
+ $fh->print(" font-style:italic;");
+ }
+ $fh->print("} /* $long_name */\n");
+ }
+}
+
+sub set_default_color {
+
+ # make sure that options hash $rOpts->{$key} contains a valid color
+ my ( $key, $color ) = @_;
+ if ( $rOpts->{$key} ) { $color = $rOpts->{$key} }
+ $rOpts->{$key} = check_RGB($color);
+}
+
+sub check_RGB {
+
+ # if color is a 6 digit hex RGB value, prepend a #, otherwise
+ # assume that it is a valid ascii color name
+ my ($color) = @_;
+ if ( $color =~ /^[0-9a-fA-F]{6,6}$/ ) { $color = "#$color" }
+ return $color;
+}
+
+sub set_default_properties {
+ my ( $short_name, $color, $bold, $italic ) = @_;
+
+ set_default_color( "html-color-$short_to_long_names{$short_name}", $color );
+ my $key;
+ $key = "html-bold-$short_to_long_names{$short_name}";
+ $rOpts->{$key} = ( defined $rOpts->{$key} ) ? $rOpts->{$key} : $bold;
+ $key = "html-italic-$short_to_long_names{$short_name}";
+ $rOpts->{$key} = ( defined $rOpts->{$key} ) ? $rOpts->{$key} : $italic;
+}
+
+sub pod_to_html {
+
+ # Use Pod::Html to process the pod and make the page
+ # then merge the perltidy code sections into it.
+ # return 1 if success, 0 otherwise
+ my $self = shift;
+ my ( $pod_string, $css_string, $toc_string, $rpre_string_stack ) = @_;
+ my $input_file = $self->{_input_file};
+ my $title = $self->{_title};
+ my $success_flag = 0;
+
+ # don't try to use pod2html if no pod
+ unless ($pod_string) {
+ return $success_flag;
+ }
+
+ # Pod::Html requires a real temporary filename
+ # If we are making a frame, we have a name available
+ # Otherwise, we have to fine one
+ my $tmpfile;
+ if ( $rOpts->{'frames'} ) {
+ $tmpfile = $self->{_toc_filename};
+ }
+ else {
+ $tmpfile = Perl::Tidy::make_temporary_filename();
+ }
+ my $fh_tmp = IO::File->new( $tmpfile, 'w' );
+ unless ($fh_tmp) {
+ warn "unable to open temporary file $tmpfile; cannot use pod2html\n";
+ return $success_flag;
+ }
+
+ #------------------------------------------------------------------
+ # Warning: a temporary file is open; we have to clean up if
+ # things go bad. From here on all returns should be by going to
+ # RETURN so that the temporary file gets unlinked.
+ #------------------------------------------------------------------
+
+ # write the pod text to the temporary file
+ $fh_tmp->print($pod_string);
+ $fh_tmp->close();
+
+ # Hand off the pod to pod2html.
+ # Note that we can use the same temporary filename for input and output
+ # because of the way pod2html works.
+ {
+
+ my @args;
+ push @args, "--infile=$tmpfile", "--outfile=$tmpfile", "--title=$title";
+ my $kw;
+
+ # Flags with string args:
+ # "backlink=s", "cachedir=s", "htmlroot=s", "libpods=s",
+ # "podpath=s", "podroot=s"
+ # Note: -css=s is handled by perltidy itself
+ foreach $kw (qw(backlink cachedir htmlroot libpods podpath podroot)) {
+ if ( $rOpts->{$kw} ) { push @args, "--$kw=$rOpts->{$kw}" }
+ }
+
+ # Toggle switches; these have extra leading 'pod'
+ # "header!", "index!", "recurse!", "quiet!", "verbose!"
+ foreach $kw (qw(podheader podindex podrecurse podquiet podverbose)) {
+ my $kwd = $kw; # allows us to strip 'pod'
+ if ( $rOpts->{$kw} ) { $kwd =~ s/^pod//; push @args, "--$kwd" }
+ elsif ( defined( $rOpts->{$kw} ) ) {
+ $kwd =~ s/^pod//;
+ push @args, "--no$kwd";
+ }
+ }
+
+ # "flush",
+ $kw = 'podflush';
+ if ( $rOpts->{$kw} ) { $kw =~ s/^pod//; push @args, "--$kw" }
+
+ # Must clean up if pod2html dies (it can);
+ # Be careful not to overwrite callers __DIE__ routine
+ local $SIG{__DIE__} = sub {
+ print $_[0];
+ unlink $tmpfile if -e $tmpfile;
+ exit 1;
+ };
+
+ pod2html(@args);
+ }
+ $fh_tmp = IO::File->new( $tmpfile, 'r' );
+ unless ($fh_tmp) {
+
+ # this error shouldn't happen ... we just used this filename
+ warn "unable to open temporary file $tmpfile; cannot use pod2html\n";
+ goto RETURN;
+ }
+
+ my $html_fh = $self->{_html_fh};
+ my @toc;
+ my $in_toc;
+ my $no_print;
+
+ # This routine will write the html selectively and store the toc
+ my $html_print = sub {
+ foreach (@_) {
+ $html_fh->print($_) unless ($no_print);
+ if ($in_toc) { push @toc, $_ }
+ }
+ };
+
+ # loop over lines of html output from pod2html and merge in
+ # the necessary perltidy html sections
+ my ( $saw_body, $saw_index, $saw_body_end );
+ while ( my $line = $fh_tmp->getline() ) {
+
+ if ( $line =~ /^\s*<html>\s*$/i ) {
+ my $date = localtime;
+ $html_print->("<!-- Generated by perltidy on $date -->\n");
+ $html_print->($line);
+ }
+
+ # Copy the perltidy css, if any, after <body> tag
+ elsif ( $line =~ /^\s*<body.*>\s*$/i ) {
+ $saw_body = 1;
+ $html_print->($css_string) if $css_string;
+ $html_print->($line);
+
+ # add a top anchor and heading
+ $html_print->("<a name=\"-top-\"></a>\n");
+ $title = escape_html($title);
+ $html_print->("<h1>$title</h1>\n");
+ }
+ elsif ( $line =~ /^\s*<!-- INDEX BEGIN -->\s*$/i ) {
+ $in_toc = 1;
+
+ # when frames are used, an extra table of contents in the
+ # contents panel is confusing, so don't print it
+ $no_print = $rOpts->{'frames'}
+ || !$rOpts->{'html-table-of-contents'};
+ $html_print->("<h2>Doc Index:</h2>\n") if $rOpts->{'frames'};
+ $html_print->($line);
+ }
+
+ # Copy the perltidy toc, if any, after the Pod::Html toc
+ elsif ( $line =~ /^\s*<!-- INDEX END -->\s*$/i ) {
+ $saw_index = 1;
+ $html_print->($line);
+ if ($toc_string) {
+ $html_print->("<hr />\n") if $rOpts->{'frames'};
+ $html_print->("<h2>Code Index:</h2>\n");
+ my @toc = map { $_ .= "\n" } split /\n/, $toc_string;
+ $html_print->(@toc);
+ }
+ $in_toc = 0;
+ $no_print = 0;
+ }
+
+ # Copy one perltidy section after each marker
+ elsif ( $line =~ /^(.*)<!-- pERLTIDY sECTION -->(.*)$/ ) {
+ $line = $2;
+ $html_print->($1) if $1;
+
+ # Intermingle code and pod sections if we saw multiple =cut's.
+ if ( $self->{_pod_cut_count} > 1 ) {
+ my $rpre_string = shift(@$rpre_string_stack);
+ if ($$rpre_string) {
+ $html_print->('<pre>');
+ $html_print->($$rpre_string);
+ $html_print->('</pre>');
+ }
+ else {
+
+ # shouldn't happen: we stored a string before writing
+ # each marker.
+ warn
+"Problem merging html stream with pod2html; order may be wrong\n";
+ }
+ $html_print->($line);
+ }
+
+ # If didn't see multiple =cut lines, we'll put the pod out first
+ # and then the code, because it's less confusing.
+ else {
+
+ # since we are not intermixing code and pod, we don't need
+ # or want any <hr> lines which separated pod and code
+ $html_print->($line) unless ( $line =~ /^\s*<hr>\s*$/i );
+ }
+ }
+
+ # Copy any remaining code section before the </body> tag
+ elsif ( $line =~ /^\s*<\/body>\s*$/i ) {
+ $saw_body_end = 1;
+ if (@$rpre_string_stack) {
+ unless ( $self->{_pod_cut_count} > 1 ) {
+ $html_print->('<hr />');
+ }
+ while ( my $rpre_string = shift(@$rpre_string_stack) ) {
+ $html_print->('<pre>');
+ $html_print->($$rpre_string);
+ $html_print->('</pre>');
+ }
+ }
+ $html_print->($line);
+ }
+ else {
+ $html_print->($line);
+ }
+ }
+
+ $success_flag = 1;
+ unless ($saw_body) {
+ warn "Did not see <body> in pod2html output\n";
+ $success_flag = 0;
+ }
+ unless ($saw_body_end) {
+ warn "Did not see </body> in pod2html output\n";
+ $success_flag = 0;
+ }
+ unless ($saw_index) {
+ warn "Did not find INDEX END in pod2html output\n";
+ $success_flag = 0;
+ }
+
+ RETURN:
+ eval { $html_fh->close() };
+
+ # note that we have to unlink tmpfile before making frames
+ # because the tmpfile may be one of the names used for frames
+ unlink $tmpfile if -e $tmpfile;
+ if ( $success_flag && $rOpts->{'frames'} ) {
+ $self->make_frame( \@toc );
+ }
+ return $success_flag;
+}
+
+sub make_frame {
+
+ # Make a frame with table of contents in the left panel
+ # and the text in the right panel.
+ # On entry:
+ # $html_filename contains the no-frames html output
+ # $rtoc is a reference to an array with the table of contents
+ my $self = shift;
+ my ($rtoc) = @_;
+ my $input_file = $self->{_input_file};
+ my $html_filename = $self->{_html_file};
+ my $toc_filename = $self->{_toc_filename};
+ my $src_filename = $self->{_src_filename};
+ my $title = $self->{_title};
+ $title = escape_html($title);
+
+ # FUTURE input parameter:
+ my $top_basename = "";
+
+ # We need to produce 3 html files:
+ # 1. - the table of contents
+ # 2. - the contents (source code) itself
+ # 3. - the frame which contains them
+
+ # get basenames for relative links
+ my ( $toc_basename, $toc_path ) = fileparse($toc_filename);
+ my ( $src_basename, $src_path ) = fileparse($src_filename);
+
+ # 1. Make the table of contents panel, with appropriate changes
+ # to the anchor names
+ my $src_frame_name = 'SRC';
+ my $first_anchor =
+ write_toc_html( $title, $toc_filename, $src_basename, $rtoc,
+ $src_frame_name );
+
+ # 2. The current .html filename is renamed to be the contents panel
+ rename( $html_filename, $src_filename )
+ or die "Cannot rename $html_filename to $src_filename:$!\n";
+
+ # 3. Then use the original html filename for the frame
+ write_frame_html(
+ $title, $html_filename, $top_basename,
+ $toc_basename, $src_basename, $src_frame_name
+ );
+}
+
+sub write_toc_html {
+
+ # write a separate html table of contents file for frames
+ my ( $title, $toc_filename, $src_basename, $rtoc, $src_frame_name ) = @_;
+ my $fh = IO::File->new( $toc_filename, 'w' )
+ or die "Cannot open $toc_filename:$!\n";
+ $fh->print(<<EOM);
+<html>
+<head>
+<title>$title</title>
+</head>
+<body>
+<h1><a href=\"$src_basename#-top-" target="$src_frame_name">$title</a></h1>
+EOM
+
+ my $first_anchor =
+ change_anchor_names( $rtoc, $src_basename, "$src_frame_name" );
+ $fh->print( join "", @$rtoc );
+
+ $fh->print(<<EOM);
+</body>
+</html>
+EOM
+
+}
+
+sub write_frame_html {
+
+ # write an html file to be the table of contents frame
+ my (
+ $title, $frame_filename, $top_basename,
+ $toc_basename, $src_basename, $src_frame_name
+ ) = @_;
+
+ my $fh = IO::File->new( $frame_filename, 'w' )
+ or die "Cannot open $toc_basename:$!\n";
+
+ $fh->print(<<EOM);
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Frameset//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd">
+<?xml version="1.0" encoding="iso-8859-1" ?>
+<html xmlns="http://www.w3.org/1999/xhtml">
+<head>
+<title>$title</title>
+</head>
+EOM
+
+ # two left panels, one right, if master index file
+ if ($top_basename) {
+ $fh->print(<<EOM);
+<frameset cols="20%,80%">
+<frameset rows="30%,70%">
+<frame src = "$top_basename" />
+<frame src = "$toc_basename" />
+</frameset>
+EOM
+ }
+
+ # one left panels, one right, if no master index file
+ else {
+ $fh->print(<<EOM);
+<frameset cols="20%,*">
+<frame src = "$toc_basename" />
+EOM
+ }
+ $fh->print(<<EOM);
+<frame src = "$src_basename" name = "$src_frame_name" />
+<noframes>
+<body>
+<p>If you see this message, you are using a non-frame-capable web client.</p>
+<p>This document contains:</p>
+<ul>
+<li><a href="$toc_basename">A table of contents</a></li>
+<li><a href="$src_basename">The source code</a></li>
+</ul>
+</body>
+</noframes>
+</frameset>
+</html>
+EOM
+}
+
+sub change_anchor_names {
+
+ # add a filename and target to anchors
+ # also return the first anchor
+ my ( $rlines, $filename, $target ) = @_;
+ my $first_anchor;
+ foreach my $line (@$rlines) {
+
+ # We're looking for lines like this:
+ # <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ # ---- - -------- -----------------
+ # $1 $4 $5
+ if ( $line =~ /^(.*)<a(.*)href\s*=\s*"([^#]*)#([^"]+)"[^>]*>(.*)$/i ) {
+ my $pre = $1;
+ my $name = $4;
+ my $post = $5;
+ my $href = "$filename#$name";
+ $line = "$pre<a href=\"$href\" target=\"$target\">$post\n";
+ unless ($first_anchor) { $first_anchor = $href }
+ }
+ }
+ return $first_anchor;
+}
+
+sub close_html_file {
+ my $self = shift;
+ return unless $self->{_html_file_opened};
+
+ my $html_fh = $self->{_html_fh};
+ my $rtoc_string = $self->{_rtoc_string};
+
+ # There are 3 basic paths to html output...
+
+ # ---------------------------------
+ # Path 1: finish up if in -pre mode
+ # ---------------------------------
+ if ( $rOpts->{'html-pre-only'} ) {
+ $html_fh->print( <<"PRE_END");
+</pre>
+PRE_END
+ eval { $html_fh->close() };
+ return;
+ }
+
+ # Finish the index
+ $self->add_toc_item( 'EOF', 'EOF' );
+
+ my $rpre_string_stack = $self->{_rpre_string_stack};
+
+ # Patch to darken the <pre> background color in case of pod2html and
+ # interleaved code/documentation. Otherwise, the distinction
+ # between code and documentation is blurred.
+ if ( $rOpts->{pod2html}
+ && $self->{_pod_cut_count} >= 1
+ && $rOpts->{'html-color-background'} eq '#FFFFFF' )
+ {
+ $rOpts->{'html-pre-color-background'} = '#F0F0F0';
+ }
+
+ # put the css or its link into a string, if used
+ my $css_string;
+ my $fh_css = Perl::Tidy::IOScalar->new( \$css_string, 'w' );
+
+ # use css linked to another file
+ if ( $rOpts->{'html-linked-style-sheet'} ) {
+ $fh_css->print(
+ qq(<link rel="stylesheet" href="$css_linkname" type="text/css" />)
+ );
+ }
+
+ # use css embedded in this file
+ elsif ( !$rOpts->{'nohtml-style-sheets'} ) {
+ $fh_css->print( <<'ENDCSS');
+<style type="text/css">
+<!--
+ENDCSS
+ write_style_sheet_data($fh_css);
+ $fh_css->print( <<"ENDCSS");
+-->
+</style>
+ENDCSS
+ }
+
+ # -----------------------------------------------------------
+ # path 2: use pod2html if requested
+ # If we fail for some reason, continue on to path 3
+ # -----------------------------------------------------------
+ if ( $rOpts->{'pod2html'} ) {
+ my $rpod_string = $self->{_rpod_string};
+ $self->pod_to_html( $$rpod_string, $css_string, $$rtoc_string,
+ $rpre_string_stack )
+ && return;
+ }
+
+ # --------------------------------------------------
+ # path 3: write code in html, with pod only in italics
+ # --------------------------------------------------
+ my $input_file = $self->{_input_file};
+ my $title = escape_html($input_file);
+ my $date = localtime;
+ $html_fh->print( <<"HTML_START");
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<!-- Generated by perltidy on $date -->
+<html xmlns="http://www.w3.org/1999/xhtml">
+<head>
+<title>$title</title>
+HTML_START
+
+ # output the css, if used
+ if ($css_string) {
+ $html_fh->print($css_string);
+ $html_fh->print( <<"ENDCSS");
+</head>
+<body>
+ENDCSS
+ }
+ else {
+
+ $html_fh->print( <<"HTML_START");
+</head>
+<body bgcolor=\"$rOpts->{'html-color-background'}\" text=\"$rOpts->{'html-color-punctuation'}\">
+HTML_START
+ }
+
+ $html_fh->print("<a name=\"-top-\"></a>\n");
+ $html_fh->print( <<"EOM");
+<h1>$title</h1>
+EOM
+
+ # copy the table of contents
+ if ( $$rtoc_string
+ && !$rOpts->{'frames'}
+ && $rOpts->{'html-table-of-contents'} )
+ {
+ $html_fh->print($$rtoc_string);
+ }
+
+ # copy the pre section(s)
+ my $fname_comment = $input_file;
+ $fname_comment =~ s/--+/-/g; # protect HTML comment tags
+ $html_fh->print( <<"END_PRE");
+<hr />
+<!-- contents of filename: $fname_comment -->
+<pre>
+END_PRE
+
+ foreach my $rpre_string (@$rpre_string_stack) {
+ $html_fh->print($$rpre_string);
+ }
+
+ # and finish the html page
+ $html_fh->print( <<"HTML_END");
+</pre>
+</body>
+</html>
+HTML_END
+ eval { $html_fh->close() }; # could be object without close method
+
+ if ( $rOpts->{'frames'} ) {
+ my @toc = map { $_ .= "\n" } split /\n/, $$rtoc_string;
+ $self->make_frame( \@toc );
+ }
+}
+
+sub markup_tokens {
+ my $self = shift;
+ my ( $rtokens, $rtoken_type, $rlevels ) = @_;
+ my ( @colored_tokens, $j, $string, $type, $token, $level );
+ my $rlast_level = $self->{_rlast_level};
+ my $rpackage_stack = $self->{_rpackage_stack};
+
+ for ( $j = 0 ; $j < @$rtoken_type ; $j++ ) {
+ $type = $$rtoken_type[$j];
+ $token = $$rtokens[$j];
+ $level = $$rlevels[$j];
+ $level = 0 if ( $level < 0 );
+
+ #-------------------------------------------------------
+ # Update the package stack. The package stack is needed to keep
+ # the toc correct because some packages may be declared within
+ # blocks and go out of scope when we leave the block.
+ #-------------------------------------------------------
+ if ( $level > $$rlast_level ) {
+ unless ( $rpackage_stack->[ $level - 1 ] ) {
+ $rpackage_stack->[ $level - 1 ] = 'main';
+ }
+ $rpackage_stack->[$level] = $rpackage_stack->[ $level - 1 ];
+ }
+ elsif ( $level < $$rlast_level ) {
+ my $package = $rpackage_stack->[$level];
+ unless ($package) { $package = 'main' }
+
+ # if we change packages due to a nesting change, we
+ # have to make an entry in the toc
+ if ( $package ne $rpackage_stack->[ $level + 1 ] ) {
+ $self->add_toc_item( $package, 'package' );
+ }
+ }
+ $$rlast_level = $level;
+
+ #-------------------------------------------------------
+ # Intercept a sub name here; split it
+ # into keyword 'sub' and sub name; and add an
+ # entry in the toc
+ #-------------------------------------------------------
+ if ( $type eq 'i' && $token =~ /^(sub\s+)(\w.*)$/ ) {
+ $token = $self->markup_html_element( $1, 'k' );
+ push @colored_tokens, $token;
+ $token = $2;
+ $type = 'M';
+
+ # but don't include sub declarations in the toc;
+ # these wlll have leading token types 'i;'
+ my $signature = join "", @$rtoken_type;
+ unless ( $signature =~ /^i;/ ) {
+ my $subname = $token;
+ $subname =~ s/[\s\(].*$//; # remove any attributes and prototype
+ $self->add_toc_item( $subname, 'sub' );
+ }
+ }
+
+ #-------------------------------------------------------
+ # Intercept a package name here; split it
+ # into keyword 'package' and name; add to the toc,
+ # and update the package stack
+ #-------------------------------------------------------
+ if ( $type eq 'i' && $token =~ /^(package\s+)(\w.*)$/ ) {
+ $token = $self->markup_html_element( $1, 'k' );
+ push @colored_tokens, $token;
+ $token = $2;
+ $type = 'i';
+ $self->add_toc_item( "$token", 'package' );
+ $rpackage_stack->[$level] = $token;
+ }
+
+ $token = $self->markup_html_element( $token, $type );
+ push @colored_tokens, $token;
+ }
+ return ( \@colored_tokens );
+}
+
+sub markup_html_element {
+ my $self = shift;
+ my ( $token, $type ) = @_;
+
+ return $token if ( $type eq 'b' ); # skip a blank token
+ return $token if ( $token =~ /^\s*$/ ); # skip a blank line
+ $token = escape_html($token);
+
+ # get the short abbreviation for this token type
+ my $short_name = $token_short_names{$type};
+ if ( !defined($short_name) ) {
+ $short_name = "pu"; # punctuation is default
+ }
+
+ # handle style sheets..
+ if ( !$rOpts->{'nohtml-style-sheets'} ) {
+ if ( $short_name ne 'pu' ) {
+ $token = qq(<span class="$short_name">) . $token . "</span>";
+ }
+ }
+
+ # handle no style sheets..
+ else {
+ my $color = $html_color{$short_name};
+
+ if ( $color && ( $color ne $rOpts->{'html-color-punctuation'} ) ) {
+ $token = qq(<font color="$color">) . $token . "</font>";
+ }
+ if ( $html_italic{$short_name} ) { $token = "<i>$token</i>" }
+ if ( $html_bold{$short_name} ) { $token = "<b>$token</b>" }
+ }
+ return $token;
+}
+
+sub escape_html {
+
+ my $token = shift;
+ if ($missing_html_entities) {
+ $token =~ s/\&/&/g;
+ $token =~ s/\</</g;
+ $token =~ s/\>/>/g;
+ $token =~ s/\"/"/g;
+ }
+ else {
+ HTML::Entities::encode_entities($token);
+ }
+ return $token;
+}
+
+sub finish_formatting {
+
+ # called after last line
+ my $self = shift;
+ $self->close_html_file();
+ return;
+}
+
+sub write_line {
+
+ my $self = shift;
+ return unless $self->{_html_file_opened};
+ my $html_pre_fh = $self->{_html_pre_fh};
+ my ($line_of_tokens) = @_;
+ my $line_type = $line_of_tokens->{_line_type};
+ my $input_line = $line_of_tokens->{_line_text};
+ my $line_number = $line_of_tokens->{_line_number};
+ chomp $input_line;
+
+ # markup line of code..
+ my $html_line;
+ if ( $line_type eq 'CODE' ) {
+ my $rtoken_type = $line_of_tokens->{_rtoken_type};
+ my $rtokens = $line_of_tokens->{_rtokens};
+ my $rlevels = $line_of_tokens->{_rlevels};
+
+ if ( $input_line =~ /(^\s*)/ ) {
+ $html_line = $1;
+ }
+ else {
+ $html_line = "";
+ }
+ my ($rcolored_tokens) =
+ $self->markup_tokens( $rtokens, $rtoken_type, $rlevels );
+ $html_line .= join '', @$rcolored_tokens;
+ }
+
+ # markup line of non-code..
+ else {
+ my $line_character;
+ if ( $line_type eq 'HERE' ) { $line_character = 'H' }
+ elsif ( $line_type eq 'HERE_END' ) { $line_character = 'h' }
+ elsif ( $line_type eq 'FORMAT' ) { $line_character = 'H' }
+ elsif ( $line_type eq 'FORMAT_END' ) { $line_character = 'h' }
+ elsif ( $line_type eq 'SYSTEM' ) { $line_character = 'c' }
+ elsif ( $line_type eq 'END_START' ) {
+ $line_character = 'k';
+ $self->add_toc_item( '__END__', '__END__' );
+ }
+ elsif ( $line_type eq 'DATA_START' ) {
+ $line_character = 'k';
+ $self->add_toc_item( '__DATA__', '__DATA__' );
+ }
+ elsif ( $line_type =~ /^POD/ ) {
+ $line_character = 'P';
+ if ( $rOpts->{'pod2html'} ) {
+ my $html_pod_fh = $self->{_html_pod_fh};
+ if ( $line_type eq 'POD_START' ) {
+
+ my $rpre_string_stack = $self->{_rpre_string_stack};
+ my $rpre_string = $rpre_string_stack->[-1];
+
+ # if we have written any non-blank lines to the
+ # current pre section, start writing to a new output
+ # string
+ if ( $$rpre_string =~ /\S/ ) {
+ my $pre_string;
+ $html_pre_fh =
+ Perl::Tidy::IOScalar->new( \$pre_string, 'w' );
+ $self->{_html_pre_fh} = $html_pre_fh;
+ push @$rpre_string_stack, \$pre_string;
+
+ # leave a marker in the pod stream so we know
+ # where to put the pre section we just
+ # finished.
+ my $for_html = '=for html'; # don't confuse pod utils
+ $html_pod_fh->print(<<EOM);
+
+$for_html
+<!-- pERLTIDY sECTION -->
+
+EOM
+ }
+
+ # otherwise, just clear the current string and start
+ # over
+ else {
+ $$rpre_string = "";
+ $html_pod_fh->print("\n");
+ }
+ }
+ $html_pod_fh->print( $input_line . "\n" );
+ if ( $line_type eq 'POD_END' ) {
+ $self->{_pod_cut_count}++;
+ $html_pod_fh->print("\n");
+ }
+ return;
+ }
+ }
+ else { $line_character = 'Q' }
+ $html_line = $self->markup_html_element( $input_line, $line_character );
+ }
+
+ # add the line number if requested
+ if ( $rOpts->{'html-line-numbers'} ) {
+ my $extra_space .=
+ ( $line_number < 10 ) ? " "
+ : ( $line_number < 100 ) ? " "
+ : ( $line_number < 1000 ) ? " "
+ : "";
+ $html_line = $extra_space . $line_number . " " . $html_line;
+ }
+
+ # write the line
+ $html_pre_fh->print("$html_line\n");
+}
+
+#####################################################################
+#
+# The Perl::Tidy::Formatter package adds indentation, whitespace, and
+# line breaks to the token stream
+#
+# WARNING: This is not a real class for speed reasons. Only one
+# Formatter may be used.
+#
+#####################################################################
+
+package Perl::Tidy::Formatter;
+
+BEGIN {
+
+ # Caution: these debug flags produce a lot of output
+ # They should all be 0 except when debugging small scripts
+ use constant FORMATTER_DEBUG_FLAG_BOND => 0;
+ use constant FORMATTER_DEBUG_FLAG_BREAK => 0;
+ use constant FORMATTER_DEBUG_FLAG_CI => 0;
+ use constant FORMATTER_DEBUG_FLAG_FLUSH => 0;
+ use constant FORMATTER_DEBUG_FLAG_FORCE => 0;
+ use constant FORMATTER_DEBUG_FLAG_LIST => 0;
+ use constant FORMATTER_DEBUG_FLAG_NOBREAK => 0;
+ use constant FORMATTER_DEBUG_FLAG_OUTPUT => 0;
+ use constant FORMATTER_DEBUG_FLAG_SPARSE => 0;
+ use constant FORMATTER_DEBUG_FLAG_STORE => 0;
+ use constant FORMATTER_DEBUG_FLAG_UNDOBP => 0;
+ use constant FORMATTER_DEBUG_FLAG_WHITE => 0;
+
+ my $debug_warning = sub {
+ print "FORMATTER_DEBUGGING with key $_[0]\n";
+ };
+
+ FORMATTER_DEBUG_FLAG_BOND && $debug_warning->('BOND');
+ FORMATTER_DEBUG_FLAG_BREAK && $debug_warning->('BREAK');
+ FORMATTER_DEBUG_FLAG_CI && $debug_warning->('CI');
+ FORMATTER_DEBUG_FLAG_FLUSH && $debug_warning->('FLUSH');
+ FORMATTER_DEBUG_FLAG_FORCE && $debug_warning->('FORCE');
+ FORMATTER_DEBUG_FLAG_LIST && $debug_warning->('LIST');
+ FORMATTER_DEBUG_FLAG_NOBREAK && $debug_warning->('NOBREAK');
+ FORMATTER_DEBUG_FLAG_OUTPUT && $debug_warning->('OUTPUT');
+ FORMATTER_DEBUG_FLAG_SPARSE && $debug_warning->('SPARSE');
+ FORMATTER_DEBUG_FLAG_STORE && $debug_warning->('STORE');
+ FORMATTER_DEBUG_FLAG_UNDOBP && $debug_warning->('UNDOBP');
+ FORMATTER_DEBUG_FLAG_WHITE && $debug_warning->('WHITE');
+}
+
+use Carp;
+use vars qw{
+
+ @gnu_stack
+ $max_gnu_stack_index
+ $gnu_position_predictor
+ $line_start_index_to_go
+ $last_indentation_written
+ $last_unadjusted_indentation
+ $last_leading_token
+
+ $saw_VERSION_in_this_file
+ $saw_END_or_DATA_
+
+ @gnu_item_list
+ $max_gnu_item_index
+ $gnu_sequence_number
+ $last_output_indentation
+ %last_gnu_equals
+ %gnu_comma_count
+ %gnu_arrow_count
+
+ @block_type_to_go
+ @type_sequence_to_go
+ @container_environment_to_go
+ @bond_strength_to_go
+ @forced_breakpoint_to_go
+ @lengths_to_go
+ @levels_to_go
+ @leading_spaces_to_go
+ @reduced_spaces_to_go
+ @matching_token_to_go
+ @mate_index_to_go
+ @nesting_blocks_to_go
+ @ci_levels_to_go
+ @nesting_depth_to_go
+ @nobreak_to_go
+ @old_breakpoint_to_go
+ @tokens_to_go
+ @types_to_go
+
+ %saved_opening_indentation
+
+ $max_index_to_go
+ $comma_count_in_batch
+ $old_line_count_in_batch
+ $last_nonblank_index_to_go
+ $last_nonblank_type_to_go
+ $last_nonblank_token_to_go
+ $last_last_nonblank_index_to_go
+ $last_last_nonblank_type_to_go
+ $last_last_nonblank_token_to_go
+ @nonblank_lines_at_depth
+ $starting_in_quote
+ $ending_in_quote
+
+ $in_format_skipping_section
+ $format_skipping_pattern_begin
+ $format_skipping_pattern_end
+
+ $forced_breakpoint_count
+ $forced_breakpoint_undo_count
+ @forced_breakpoint_undo_stack
+ %postponed_breakpoint
+
+ $tabbing
+ $embedded_tab_count
+ $first_embedded_tab_at
+ $last_embedded_tab_at
+ $deleted_semicolon_count
+ $first_deleted_semicolon_at
+ $last_deleted_semicolon_at
+ $added_semicolon_count
+ $first_added_semicolon_at
+ $last_added_semicolon_at
+ $first_tabbing_disagreement
+ $last_tabbing_disagreement
+ $in_tabbing_disagreement
+ $tabbing_disagreement_count
+ $input_line_tabbing
+
+ $last_line_type
+ $last_line_leading_type
+ $last_line_leading_level
+ $last_last_line_leading_level
+
+ %block_leading_text
+ %block_opening_line_number
+ $csc_new_statement_ok
+ $accumulating_text_for_block
+ $leading_block_text
+ $rleading_block_if_elsif_text
+ $leading_block_text_level
+ $leading_block_text_length_exceeded
+ $leading_block_text_line_length
+ $leading_block_text_line_number
+ $closing_side_comment_prefix_pattern
+ $closing_side_comment_list_pattern
+
+ $last_nonblank_token
+ $last_nonblank_type
+ $last_last_nonblank_token
+ $last_last_nonblank_type
+ $last_nonblank_block_type
+ $last_output_level
+ %is_do_follower
+ %is_if_brace_follower
+ %space_after_keyword
+ $rbrace_follower
+ $looking_for_else
+ %is_last_next_redo_return
+ %is_other_brace_follower
+ %is_else_brace_follower
+ %is_anon_sub_brace_follower
+ %is_anon_sub_1_brace_follower
+ %is_sort_map_grep
+ %is_sort_map_grep_eval
+ %is_sort_map_grep_eval_do
+ %is_block_without_semicolon
+ %is_if_unless
+ %is_and_or
+ %is_assignment
+ %is_chain_operator
+ %is_if_unless_and_or_last_next_redo_return
+ %is_until_while_for_if_elsif_else
+
+ @has_broken_sublist
+ @dont_align
+ @want_comma_break
+
+ $is_static_block_comment
+ $index_start_one_line_block
+ $semicolons_before_block_self_destruct
+ $index_max_forced_break
+ $input_line_number
+ $diagnostics_object
+ $vertical_aligner_object
+ $logger_object
+ $file_writer_object
+ $formatter_self
+ @ci_stack
+ $last_line_had_side_comment
+ %want_break_before
+ %outdent_keyword
+ $static_block_comment_pattern
+ $static_side_comment_pattern
+ %opening_vertical_tightness
+ %closing_vertical_tightness
+ %closing_token_indentation
+
+ %opening_token_right
+ %stack_opening_token
+ %stack_closing_token
+
+ $block_brace_vertical_tightness_pattern
+
+ $rOpts_add_newlines
+ $rOpts_add_whitespace
+ $rOpts_block_brace_tightness
+ $rOpts_block_brace_vertical_tightness
+ $rOpts_brace_left_and_indent
+ $rOpts_comma_arrow_breakpoints
+ $rOpts_break_at_old_keyword_breakpoints
+ $rOpts_break_at_old_comma_breakpoints
+ $rOpts_break_at_old_logical_breakpoints
+ $rOpts_break_at_old_ternary_breakpoints
+ $rOpts_closing_side_comment_else_flag
+ $rOpts_closing_side_comment_maximum_text
+ $rOpts_continuation_indentation
+ $rOpts_cuddled_else
+ $rOpts_delete_old_whitespace
+ $rOpts_fuzzy_line_length
+ $rOpts_indent_columns
+ $rOpts_line_up_parentheses
+ $rOpts_maximum_fields_per_table
+ $rOpts_maximum_line_length
+ $rOpts_short_concatenation_item_length
+ $rOpts_swallow_optional_blank_lines
+ $rOpts_ignore_old_breakpoints
+ $rOpts_format_skipping
+ $rOpts_space_function_paren
+ $rOpts_space_keyword_paren
+ $rOpts_keep_interior_semicolons
+
+ $half_maximum_line_length
+
+ %is_opening_type
+ %is_closing_type
+ %is_keyword_returning_list
+ %tightness
+ %matching_token
+ $rOpts
+ %right_bond_strength
+ %left_bond_strength
+ %binary_ws_rules
+ %want_left_space
+ %want_right_space
+ %is_digraph
+ %is_trigraph
+ $bli_pattern
+ $bli_list_string
+ %is_closing_type
+ %is_opening_type
+ %is_closing_token
+ %is_opening_token
+};
+
+BEGIN {
+
+ # default list of block types for which -bli would apply
+ $bli_list_string = 'if else elsif unless while for foreach do : sub';
+
+ @_ = qw(
+ .. :: << >> ** && .. || // -> => += -= .= %= &= |= ^= *= <>
+ <= >= == =~ !~ != ++ -- /= x=
+ );
+ @is_digraph{@_} = (1) x scalar(@_);
+
+ @_ = qw( ... **= <<= >>= &&= ||= //= <=> );
+ @is_trigraph{@_} = (1) x scalar(@_);
+
+ @_ = qw(
+ = **= += *= &= <<= &&=
+ -= /= |= >>= ||= //=
+ .= %= ^=
+ x=
+ );
+ @is_assignment{@_} = (1) x scalar(@_);
+
+ @_ = qw(
+ grep
+ keys
+ map
+ reverse
+ sort
+ split
+ );
+ @is_keyword_returning_list{@_} = (1) x scalar(@_);
+
+ @_ = qw(is if unless and or err last next redo return);
+ @is_if_unless_and_or_last_next_redo_return{@_} = (1) x scalar(@_);
+
+ # always break after a closing curly of these block types:
+ @_ = qw(until while for if elsif else);
+ @is_until_while_for_if_elsif_else{@_} = (1) x scalar(@_);
+
+ @_ = qw(last next redo return);
+ @is_last_next_redo_return{@_} = (1) x scalar(@_);
+
+ @_ = qw(sort map grep);
+ @is_sort_map_grep{@_} = (1) x scalar(@_);
+
+ @_ = qw(sort map grep eval);
+ @is_sort_map_grep_eval{@_} = (1) x scalar(@_);
+
+ @_ = qw(sort map grep eval do);
+ @is_sort_map_grep_eval_do{@_} = (1) x scalar(@_);
+
+ @_ = qw(if unless);
+ @is_if_unless{@_} = (1) x scalar(@_);
+
+ @_ = qw(and or err);
+ @is_and_or{@_} = (1) x scalar(@_);
+
+ # Identify certain operators which often occur in chains.
+ # Note: the minus (-) causes a side effect of padding of the first line in
+ # something like this (by sub set_logical_padding):
+ # Checkbutton => 'Transmission checked',
+ # -variable => \$TRANS
+ # This usually improves appearance so it seems ok.
+ @_ = qw(&& || and or : ? . + - * /);
+ @is_chain_operator{@_} = (1) x scalar(@_);
+
+ # We can remove semicolons after blocks preceded by these keywords
+ @_ =
+ qw(BEGIN END CHECK INIT AUTOLOAD DESTROY UNITCHECK continue if elsif else
+ unless while until for foreach);
+ @is_block_without_semicolon{@_} = (1) x scalar(@_);
+
+ # 'L' is token for opening { at hash key
+ @_ = qw" L { ( [ ";
+ @is_opening_type{@_} = (1) x scalar(@_);
+
+ # 'R' is token for closing } at hash key
+ @_ = qw" R } ) ] ";
+ @is_closing_type{@_} = (1) x scalar(@_);
+
+ @_ = qw" { ( [ ";
+ @is_opening_token{@_} = (1) x scalar(@_);
+
+ @_ = qw" } ) ] ";
+ @is_closing_token{@_} = (1) x scalar(@_);
+}
+
+# whitespace codes
+use constant WS_YES => 1;
+use constant WS_OPTIONAL => 0;
+use constant WS_NO => -1;
+
+# Token bond strengths.
+use constant NO_BREAK => 10000;
+use constant VERY_STRONG => 100;
+use constant STRONG => 2.1;
+use constant NOMINAL => 1.1;
+use constant WEAK => 0.8;
+use constant VERY_WEAK => 0.55;
+
+# values for testing indexes in output array
+use constant UNDEFINED_INDEX => -1;
+
+# Maximum number of little messages; probably need not be changed.
+use constant MAX_NAG_MESSAGES => 6;
+
+# increment between sequence numbers for each type
+# For example, ?: pairs might have numbers 7,11,15,...
+use constant TYPE_SEQUENCE_INCREMENT => 4;
+
+{
+
+ # methods to count instances
+ my $_count = 0;
+ sub get_count { $_count; }
+ sub _increment_count { ++$_count }
+ sub _decrement_count { --$_count }
+}
+
+sub trim {
+
+ # trim leading and trailing whitespace from a string
+ $_[0] =~ s/\s+$//;
+ $_[0] =~ s/^\s+//;
+ return $_[0];
+}
+
+sub split_words {
+
+ # given a string containing words separated by whitespace,
+ # return the list of words
+ my ($str) = @_;
+ return unless $str;
+ $str =~ s/\s+$//;
+ $str =~ s/^\s+//;
+ return split( /\s+/, $str );
+}
+
+# interface to Perl::Tidy::Logger routines
+sub warning {
+ if ($logger_object) {
+ $logger_object->warning(@_);
+ }
+}
+
+sub complain {
+ if ($logger_object) {
+ $logger_object->complain(@_);
+ }
+}
+
+sub write_logfile_entry {
+ if ($logger_object) {
+ $logger_object->write_logfile_entry(@_);
+ }
+}
+
+sub black_box {
+ if ($logger_object) {
+ $logger_object->black_box(@_);
+ }
+}
+
+sub report_definite_bug {
+ if ($logger_object) {
+ $logger_object->report_definite_bug();
+ }
+}
+
+sub get_saw_brace_error {
+ if ($logger_object) {
+ $logger_object->get_saw_brace_error();
+ }
+}
+
+sub we_are_at_the_last_line {
+ if ($logger_object) {
+ $logger_object->we_are_at_the_last_line();
+ }
+}
+
+# interface to Perl::Tidy::Diagnostics routine
+sub write_diagnostics {
+
+ if ($diagnostics_object) {
+ $diagnostics_object->write_diagnostics(@_);
+ }
+}
+
+sub get_added_semicolon_count {
+ my $self = shift;
+ return $added_semicolon_count;
+}
+
+sub DESTROY {
+ $_[0]->_decrement_count();
+}
+
+sub new {
+
+ my $class = shift;
+
+ # we are given an object with a write_line() method to take lines
+ my %defaults = (
+ sink_object => undef,
+ diagnostics_object => undef,
+ logger_object => undef,
+ );
+ my %args = ( %defaults, @_ );
+
+ $logger_object = $args{logger_object};
+ $diagnostics_object = $args{diagnostics_object};
+
+ # we create another object with a get_line() and peek_ahead() method
+ my $sink_object = $args{sink_object};
+ $file_writer_object =
+ Perl::Tidy::FileWriter->new( $sink_object, $rOpts, $logger_object );
+
+ # initialize the leading whitespace stack to negative levels
+ # so that we can never run off the end of the stack
+ $gnu_position_predictor = 0; # where the current token is predicted to be
+ $max_gnu_stack_index = 0;
+ $max_gnu_item_index = -1;
+ $gnu_stack[0] = new_lp_indentation_item( 0, -1, -1, 0, 0 );
+ @gnu_item_list = ();
+ $last_output_indentation = 0;
+ $last_indentation_written = 0;
+ $last_unadjusted_indentation = 0;
+ $last_leading_token = "";
+
+ $saw_VERSION_in_this_file = !$rOpts->{'pass-version-line'};
+ $saw_END_or_DATA_ = 0;
+
+ @block_type_to_go = ();
+ @type_sequence_to_go = ();
+ @container_environment_to_go = ();
+ @bond_strength_to_go = ();
+ @forced_breakpoint_to_go = ();
+ @lengths_to_go = (); # line length to start of ith token
+ @levels_to_go = ();
+ @matching_token_to_go = ();
+ @mate_index_to_go = ();
+ @nesting_blocks_to_go = ();
+ @ci_levels_to_go = ();
+ @nesting_depth_to_go = (0);
+ @nobreak_to_go = ();
+ @old_breakpoint_to_go = ();
+ @tokens_to_go = ();
+ @types_to_go = ();
+ @leading_spaces_to_go = ();
+ @reduced_spaces_to_go = ();
+
+ @dont_align = ();
+ @has_broken_sublist = ();
+ @want_comma_break = ();
+
+ @ci_stack = ("");
+ $first_tabbing_disagreement = 0;
+ $last_tabbing_disagreement = 0;
+ $tabbing_disagreement_count = 0;
+ $in_tabbing_disagreement = 0;
+ $input_line_tabbing = undef;
+
+ $last_line_type = "";
+ $last_last_line_leading_level = 0;
+ $last_line_leading_level = 0;
+ $last_line_leading_type = '#';
+
+ $last_nonblank_token = ';';
+ $last_nonblank_type = ';';
+ $last_last_nonblank_token = ';';
+ $last_last_nonblank_type = ';';
+ $last_nonblank_block_type = "";
+ $last_output_level = 0;
+ $looking_for_else = 0;
+ $embedded_tab_count = 0;
+ $first_embedded_tab_at = 0;
+ $last_embedded_tab_at = 0;
+ $deleted_semicolon_count = 0;
+ $first_deleted_semicolon_at = 0;
+ $last_deleted_semicolon_at = 0;
+ $added_semicolon_count = 0;
+ $first_added_semicolon_at = 0;
+ $last_added_semicolon_at = 0;
+ $last_line_had_side_comment = 0;
+ $is_static_block_comment = 0;
+ %postponed_breakpoint = ();
+
+ # variables for adding side comments
+ %block_leading_text = ();
+ %block_opening_line_number = ();
+ $csc_new_statement_ok = 1;
+
+ %saved_opening_indentation = ();
+ $in_format_skipping_section = 0;
+
+ reset_block_text_accumulator();
+
+ prepare_for_new_input_lines();
+
+ $vertical_aligner_object =
+ Perl::Tidy::VerticalAligner->initialize( $rOpts, $file_writer_object,
+ $logger_object, $diagnostics_object );
+
+ if ( $rOpts->{'entab-leading-whitespace'} ) {
+ write_logfile_entry(
+"Leading whitespace will be entabbed with $rOpts->{'entab-leading-whitespace'} spaces per tab\n"
+ );
+ }
+ elsif ( $rOpts->{'tabs'} ) {
+ write_logfile_entry("Indentation will be with a tab character\n");
+ }
+ else {
+ write_logfile_entry(
+ "Indentation will be with $rOpts->{'indent-columns'} spaces\n");
+ }
+
+ # This was the start of a formatter referent, but object-oriented
+ # coding has turned out to be too slow here.
+ $formatter_self = {};
+
+ bless $formatter_self, $class;
+
+ # Safety check..this is not a class yet
+ if ( _increment_count() > 1 ) {
+ confess
+"Attempt to create more than 1 object in $class, which is not a true class yet\n";
+ }
+ return $formatter_self;
+}
+
+sub prepare_for_new_input_lines {
+
+ $gnu_sequence_number++; # increment output batch counter
+ %last_gnu_equals = ();
+ %gnu_comma_count = ();
+ %gnu_arrow_count = ();
+ $line_start_index_to_go = 0;
+ $max_gnu_item_index = UNDEFINED_INDEX;
+ $index_max_forced_break = UNDEFINED_INDEX;
+ $max_index_to_go = UNDEFINED_INDEX;
+ $last_nonblank_index_to_go = UNDEFINED_INDEX;
+ $last_nonblank_type_to_go = '';
+ $last_nonblank_token_to_go = '';
+ $last_last_nonblank_index_to_go = UNDEFINED_INDEX;
+ $last_last_nonblank_type_to_go = '';
+ $last_last_nonblank_token_to_go = '';
+ $forced_breakpoint_count = 0;
+ $forced_breakpoint_undo_count = 0;
+ $rbrace_follower = undef;
+ $lengths_to_go[0] = 0;
+ $old_line_count_in_batch = 1;
+ $comma_count_in_batch = 0;
+ $starting_in_quote = 0;
+
+ destroy_one_line_block();
+}
+
+sub write_line {
+
+ my $self = shift;
+ my ($line_of_tokens) = @_;
+
+ my $line_type = $line_of_tokens->{_line_type};
+ my $input_line = $line_of_tokens->{_line_text};
+
+ # _line_type codes are:
+ # SYSTEM - system-specific code before hash-bang line
+ # CODE - line of perl code (including comments)
+ # POD_START - line starting pod, such as '=head'
+ # POD - pod documentation text
+ # POD_END - last line of pod section, '=cut'
+ # HERE - text of here-document
+ # HERE_END - last line of here-doc (target word)
+ # FORMAT - format section
+ # FORMAT_END - last line of format section, '.'
+ # DATA_START - __DATA__ line
+ # DATA - unidentified text following __DATA__
+ # END_START - __END__ line
+ # END - unidentified text following __END__
+ # ERROR - we are in big trouble, probably not a perl script
+
+ # put a blank line after an =cut which comes before __END__ and __DATA__
+ # (required by podchecker)
+ if ( $last_line_type eq 'POD_END' && !$saw_END_or_DATA_ ) {
+ $file_writer_object->reset_consecutive_blank_lines();
+ if ( $input_line !~ /^\s*$/ ) { want_blank_line() }
+ }
+
+ # handle line of code..
+ if ( $line_type eq 'CODE' ) {
+
+ # let logger see all non-blank lines of code
+ if ( $input_line !~ /^\s*$/ ) {
+ my $output_line_number =
+ $vertical_aligner_object->get_output_line_number();
+ black_box( $line_of_tokens, $output_line_number );
+ }
+ print_line_of_tokens($line_of_tokens);
+ }
+
+ # handle line of non-code..
+ else {
+
+ # set special flags
+ my $skip_line = 0;
+ my $tee_line = 0;
+ if ( $line_type =~ /^POD/ ) {
+
+ # Pod docs should have a preceding blank line. But be
+ # very careful in __END__ and __DATA__ sections, because:
+ # 1. the user may be using this section for any purpose whatsoever
+ # 2. the blank counters are not active there
+ # It should be safe to request a blank line between an
+ # __END__ or __DATA__ and an immediately following '=head'
+ # type line, (types END_START and DATA_START), but not for
+ # any other lines of type END or DATA.
+ if ( $rOpts->{'delete-pod'} ) { $skip_line = 1; }
+ if ( $rOpts->{'tee-pod'} ) { $tee_line = 1; }
+ if ( !$skip_line
+ && $line_type eq 'POD_START'
+ && $last_line_type !~ /^(END|DATA)$/ )
+ {
+ want_blank_line();
+ }
+ }
+
+ # leave the blank counters in a predictable state
+ # after __END__ or __DATA__
+ elsif ( $line_type =~ /^(END_START|DATA_START)$/ ) {
+ $file_writer_object->reset_consecutive_blank_lines();
+ $saw_END_or_DATA_ = 1;
+ }
+
+ # write unindented non-code line
+ if ( !$skip_line ) {
+ if ($tee_line) { $file_writer_object->tee_on() }
+ write_unindented_line($input_line);
+ if ($tee_line) { $file_writer_object->tee_off() }
+ }
+ }
+ $last_line_type = $line_type;
+}
+
+sub create_one_line_block {
+ $index_start_one_line_block = $_[0];
+ $semicolons_before_block_self_destruct = $_[1];
+}
+
+sub destroy_one_line_block {
+ $index_start_one_line_block = UNDEFINED_INDEX;
+ $semicolons_before_block_self_destruct = 0;
+}
+
+sub leading_spaces_to_go {
+
+ # return the number of indentation spaces for a token in the output stream;
+ # these were previously stored by 'set_leading_whitespace'.
+
+ return get_SPACES( $leading_spaces_to_go[ $_[0] ] );
+
+}
+
+sub get_SPACES {
+
+ # return the number of leading spaces associated with an indentation
+ # variable $indentation is either a constant number of spaces or an object
+ # with a get_SPACES method.
+ my $indentation = shift;
+ return ref($indentation) ? $indentation->get_SPACES() : $indentation;
+}
+
+sub get_RECOVERABLE_SPACES {
+
+ # return the number of spaces (+ means shift right, - means shift left)
+ # that we would like to shift a group of lines with the same indentation
+ # to get them to line up with their opening parens
+ my $indentation = shift;
+ return ref($indentation) ? $indentation->get_RECOVERABLE_SPACES() : 0;
+}
+
+sub get_AVAILABLE_SPACES_to_go {
+
+ my $item = $leading_spaces_to_go[ $_[0] ];
+
+ # return the number of available leading spaces associated with an
+ # indentation variable. $indentation is either a constant number of
+ # spaces or an object with a get_AVAILABLE_SPACES method.
+ return ref($item) ? $item->get_AVAILABLE_SPACES() : 0;
+}
+
+sub new_lp_indentation_item {
+
+ # this is an interface to the IndentationItem class
+ my ( $spaces, $level, $ci_level, $available_spaces, $align_paren ) = @_;
+
+ # A negative level implies not to store the item in the item_list
+ my $index = 0;
+ if ( $level >= 0 ) { $index = ++$max_gnu_item_index; }
+
+ my $item = Perl::Tidy::IndentationItem->new(
+ $spaces, $level,
+ $ci_level, $available_spaces,
+ $index, $gnu_sequence_number,
+ $align_paren, $max_gnu_stack_index,
+ $line_start_index_to_go,
+ );
+
+ if ( $level >= 0 ) {
+ $gnu_item_list[$max_gnu_item_index] = $item;
+ }
+
+ return $item;
+}
+
+sub set_leading_whitespace {
+
+ # This routine defines leading whitespace
+ # given: the level and continuation_level of a token,
+ # define: space count of leading string which would apply if it
+ # were the first token of a new line.
+
+ my ( $level, $ci_level, $in_continued_quote ) = @_;
+
+ # modify for -bli, which adds one continuation indentation for
+ # opening braces
+ if ( $rOpts_brace_left_and_indent
+ && $max_index_to_go == 0
+ && $block_type_to_go[$max_index_to_go] =~ /$bli_pattern/o )
+ {
+ $ci_level++;
+ }
+
+ # patch to avoid trouble when input file has negative indentation.
+ # other logic should catch this error.
+ if ( $level < 0 ) { $level = 0 }
+
+ #-------------------------------------------
+ # handle the standard indentation scheme
+ #-------------------------------------------
+ unless ($rOpts_line_up_parentheses) {
+ my $space_count =
+ $ci_level * $rOpts_continuation_indentation +
+ $level * $rOpts_indent_columns;
+ my $ci_spaces =
+ ( $ci_level == 0 ) ? 0 : $rOpts_continuation_indentation;
+
+ if ($in_continued_quote) {
+ $space_count = 0;
+ $ci_spaces = 0;
+ }
+ $leading_spaces_to_go[$max_index_to_go] = $space_count;
+ $reduced_spaces_to_go[$max_index_to_go] = $space_count - $ci_spaces;
+ return;
+ }
+
+ #-------------------------------------------------------------
+ # handle case of -lp indentation..
+ #-------------------------------------------------------------
+
+ # The continued_quote flag means that this is the first token of a
+ # line, and it is the continuation of some kind of multi-line quote
+ # or pattern. It requires special treatment because it must have no
+ # added leading whitespace. So we create a special indentation item
+ # which is not in the stack.
+ if ($in_continued_quote) {
+ my $space_count = 0;
+ my $available_space = 0;
+ $level = -1; # flag to prevent storing in item_list
+ $leading_spaces_to_go[$max_index_to_go] =
+ $reduced_spaces_to_go[$max_index_to_go] =
+ new_lp_indentation_item( $space_count, $level, $ci_level,
+ $available_space, 0 );
+ return;
+ }
+
+ # get the top state from the stack
+ my $space_count = $gnu_stack[$max_gnu_stack_index]->get_SPACES();
+ my $current_level = $gnu_stack[$max_gnu_stack_index]->get_LEVEL();
+ my $current_ci_level = $gnu_stack[$max_gnu_stack_index]->get_CI_LEVEL();
+
+ my $type = $types_to_go[$max_index_to_go];
+ my $token = $tokens_to_go[$max_index_to_go];
+ my $total_depth = $nesting_depth_to_go[$max_index_to_go];
+
+ if ( $type eq '{' || $type eq '(' ) {
+
+ $gnu_comma_count{ $total_depth + 1 } = 0;
+ $gnu_arrow_count{ $total_depth + 1 } = 0;
+
+ # If we come to an opening token after an '=' token of some type,
+ # see if it would be helpful to 'break' after the '=' to save space
+ my $last_equals = $last_gnu_equals{$total_depth};
+ if ( $last_equals && $last_equals > $line_start_index_to_go ) {
+
+ # find the position if we break at the '='
+ my $i_test = $last_equals;
+ if ( $types_to_go[ $i_test + 1 ] eq 'b' ) { $i_test++ }
+
+ # TESTING
+ ##my $too_close = ($i_test==$max_index_to_go-1);
+
+ my $test_position = total_line_length( $i_test, $max_index_to_go );
+
+ if (
+
+ # the equals is not just before an open paren (testing)
+ ##!$too_close &&
+
+ # if we are beyond the midpoint
+ $gnu_position_predictor > $half_maximum_line_length
+
+ # or we are beyont the 1/4 point and there was an old
+ # break at the equals
+ || (
+ $gnu_position_predictor > $half_maximum_line_length / 2
+ && (
+ $old_breakpoint_to_go[$last_equals]
+ || ( $last_equals > 0
+ && $old_breakpoint_to_go[ $last_equals - 1 ] )
+ || ( $last_equals > 1
+ && $types_to_go[ $last_equals - 1 ] eq 'b'
+ && $old_breakpoint_to_go[ $last_equals - 2 ] )
+ )
+ )
+ )
+ {
+
+ # then make the switch -- note that we do not set a real
+ # breakpoint here because we may not really need one; sub
+ # scan_list will do that if necessary
+ $line_start_index_to_go = $i_test + 1;
+ $gnu_position_predictor = $test_position;
+ }
+ }
+ }
+
+ # Check for decreasing depth ..
+ # Note that one token may have both decreasing and then increasing
+ # depth. For example, (level, ci) can go from (1,1) to (2,0). So,
+ # in this example we would first go back to (1,0) then up to (2,0)
+ # in a single call.
+ if ( $level < $current_level || $ci_level < $current_ci_level ) {
+
+ # loop to find the first entry at or completely below this level
+ my ( $lev, $ci_lev );
+ while (1) {
+ if ($max_gnu_stack_index) {
+
+ # save index of token which closes this level
+ $gnu_stack[$max_gnu_stack_index]->set_CLOSED($max_index_to_go);
+
+ # Undo any extra indentation if we saw no commas
+ my $available_spaces =
+ $gnu_stack[$max_gnu_stack_index]->get_AVAILABLE_SPACES();
+
+ my $comma_count = 0;
+ my $arrow_count = 0;
+ if ( $type eq '}' || $type eq ')' ) {
+ $comma_count = $gnu_comma_count{$total_depth};
+ $arrow_count = $gnu_arrow_count{$total_depth};
+ $comma_count = 0 unless $comma_count;
+ $arrow_count = 0 unless $arrow_count;
+ }
+ $gnu_stack[$max_gnu_stack_index]->set_COMMA_COUNT($comma_count);
+ $gnu_stack[$max_gnu_stack_index]->set_ARROW_COUNT($arrow_count);
+
+ if ( $available_spaces > 0 ) {
+
+ if ( $comma_count <= 0 || $arrow_count > 0 ) {
+
+ my $i = $gnu_stack[$max_gnu_stack_index]->get_INDEX();
+ my $seqno =
+ $gnu_stack[$max_gnu_stack_index]
+ ->get_SEQUENCE_NUMBER();
+
+ # Be sure this item was created in this batch. This
+ # should be true because we delete any available
+ # space from open items at the end of each batch.
+ if ( $gnu_sequence_number != $seqno
+ || $i > $max_gnu_item_index )
+ {
+ warning(
+"Program bug with -lp. seqno=$seqno should be $gnu_sequence_number and i=$i should be less than max=$max_gnu_item_index\n"
+ );
+ report_definite_bug();
+ }
+
+ else {
+ if ( $arrow_count == 0 ) {
+ $gnu_item_list[$i]
+ ->permanently_decrease_AVAILABLE_SPACES(
+ $available_spaces);
+ }
+ else {
+ $gnu_item_list[$i]
+ ->tentatively_decrease_AVAILABLE_SPACES(
+ $available_spaces);
+ }
+
+ my $j;
+ for (
+ $j = $i + 1 ;
+ $j <= $max_gnu_item_index ;
+ $j++
+ )
+ {
+ $gnu_item_list[$j]
+ ->decrease_SPACES($available_spaces);
+ }
+ }
+ }
+ }
+
+ # go down one level
+ --$max_gnu_stack_index;
+ $lev = $gnu_stack[$max_gnu_stack_index]->get_LEVEL();
+ $ci_lev = $gnu_stack[$max_gnu_stack_index]->get_CI_LEVEL();
+
+ # stop when we reach a level at or below the current level
+ if ( $lev <= $level && $ci_lev <= $ci_level ) {
+ $space_count =
+ $gnu_stack[$max_gnu_stack_index]->get_SPACES();
+ $current_level = $lev;
+ $current_ci_level = $ci_lev;
+ last;
+ }
+ }
+
+ # reached bottom of stack .. should never happen because
+ # only negative levels can get here, and $level was forced
+ # to be positive above.
+ else {
+ warning(
+"program bug with -lp: stack_error. level=$level; lev=$lev; ci_level=$ci_level; ci_lev=$ci_lev; rerun with -nlp\n"
+ );
+ report_definite_bug();
+ last;
+ }
+ }
+ }
+
+ # handle increasing depth
+ if ( $level > $current_level || $ci_level > $current_ci_level ) {
+
+ # Compute the standard incremental whitespace. This will be
+ # the minimum incremental whitespace that will be used. This
+ # choice results in a smooth transition between the gnu-style
+ # and the standard style.
+ my $standard_increment =
+ ( $level - $current_level ) * $rOpts_indent_columns +
+ ( $ci_level - $current_ci_level ) * $rOpts_continuation_indentation;
+
+ # Now we have to define how much extra incremental space
+ # ("$available_space") we want. This extra space will be
+ # reduced as necessary when long lines are encountered or when
+ # it becomes clear that we do not have a good list.
+ my $available_space = 0;
+ my $align_paren = 0;
+ my $excess = 0;
+
+ # initialization on empty stack..
+ if ( $max_gnu_stack_index == 0 ) {
+ $space_count = $level * $rOpts_indent_columns;
+ }
+
+ # if this is a BLOCK, add the standard increment
+ elsif ($last_nonblank_block_type) {
+ $space_count += $standard_increment;
+ }
+
+ # if last nonblank token was not structural indentation,
+ # just use standard increment
+ elsif ( $last_nonblank_type ne '{' ) {
+ $space_count += $standard_increment;
+ }
+
+ # otherwise use the space to the first non-blank level change token
+ else {
+
+ $space_count = $gnu_position_predictor;
+
+ my $min_gnu_indentation =
+ $gnu_stack[$max_gnu_stack_index]->get_SPACES();
+
+ $available_space = $space_count - $min_gnu_indentation;
+ if ( $available_space >= $standard_increment ) {
+ $min_gnu_indentation += $standard_increment;
+ }
+ elsif ( $available_space > 1 ) {
+ $min_gnu_indentation += $available_space + 1;
+ }
+ elsif ( $last_nonblank_token =~ /^[\{\[\(]$/ ) {
+ if ( ( $tightness{$last_nonblank_token} < 2 ) ) {
+ $min_gnu_indentation += 2;
+ }
+ else {
+ $min_gnu_indentation += 1;
+ }
+ }
+ else {
+ $min_gnu_indentation += $standard_increment;
+ }
+ $available_space = $space_count - $min_gnu_indentation;
+
+ if ( $available_space < 0 ) {
+ $space_count = $min_gnu_indentation;
+ $available_space = 0;
+ }
+ $align_paren = 1;
+ }
+
+ # update state, but not on a blank token
+ if ( $types_to_go[$max_index_to_go] ne 'b' ) {
+
+ $gnu_stack[$max_gnu_stack_index]->set_HAVE_CHILD(1);
+
+ ++$max_gnu_stack_index;
+ $gnu_stack[$max_gnu_stack_index] =
+ new_lp_indentation_item( $space_count, $level, $ci_level,
+ $available_space, $align_paren );
+
+ # If the opening paren is beyond the half-line length, then
+ # we will use the minimum (standard) indentation. This will
+ # help avoid problems associated with running out of space
+ # near the end of a line. As a result, in deeply nested
+ # lists, there will be some indentations which are limited
+ # to this minimum standard indentation. But the most deeply
+ # nested container will still probably be able to shift its
+ # parameters to the right for proper alignment, so in most
+ # cases this will not be noticable.
+ if ( $available_space > 0
+ && $space_count > $half_maximum_line_length )
+ {
+ $gnu_stack[$max_gnu_stack_index]
+ ->tentatively_decrease_AVAILABLE_SPACES($available_space);
+ }
+ }
+ }
+
+ # Count commas and look for non-list characters. Once we see a
+ # non-list character, we give up and don't look for any more commas.
+ if ( $type eq '=>' ) {
+ $gnu_arrow_count{$total_depth}++;
+
+ # tentatively treating '=>' like '=' for estimating breaks
+ # TODO: this could use some experimentation
+ $last_gnu_equals{$total_depth} = $max_index_to_go;
+ }
+
+ elsif ( $type eq ',' ) {
+ $gnu_comma_count{$total_depth}++;
+ }
+
+ elsif ( $is_assignment{$type} ) {
+ $last_gnu_equals{$total_depth} = $max_index_to_go;
+ }
+
+ # this token might start a new line
+ # if this is a non-blank..
+ if ( $type ne 'b' ) {
+
+ # and if ..
+ if (
+
+ # this is the first nonblank token of the line
+ $max_index_to_go == 1 && $types_to_go[0] eq 'b'
+
+ # or previous character was one of these:
+ || $last_nonblank_type_to_go =~ /^([\:\?\,f])$/
+
+ # or previous character was opening and this does not close it
+ || ( $last_nonblank_type_to_go eq '{' && $type ne '}' )
+ || ( $last_nonblank_type_to_go eq '(' and $type ne ')' )
+
+ # or this token is one of these:
+ || $type =~ /^([\.]|\|\||\&\&)$/
+
+ # or this is a closing structure
+ || ( $last_nonblank_type_to_go eq '}'
+ && $last_nonblank_token_to_go eq $last_nonblank_type_to_go )
+
+ # or previous token was keyword 'return'
+ || ( $last_nonblank_type_to_go eq 'k'
+ && ( $last_nonblank_token_to_go eq 'return' && $type ne '{' ) )
+
+ # or starting a new line at certain keywords is fine
+ || ( $type eq 'k'
+ && $is_if_unless_and_or_last_next_redo_return{$token} )
+
+ # or this is after an assignment after a closing structure
+ || (
+ $is_assignment{$last_nonblank_type_to_go}
+ && (
+ $last_last_nonblank_type_to_go =~ /^[\}\)\]]$/
+
+ # and it is significantly to the right
+ || $gnu_position_predictor > $half_maximum_line_length
+ )
+ )
+ )
+ {
+ check_for_long_gnu_style_lines();
+ $line_start_index_to_go = $max_index_to_go;
+
+ # back up 1 token if we want to break before that type
+ # otherwise, we may strand tokens like '?' or ':' on a line
+ if ( $line_start_index_to_go > 0 ) {
+ if ( $last_nonblank_type_to_go eq 'k' ) {
+
+ if ( $want_break_before{$last_nonblank_token_to_go} ) {
+ $line_start_index_to_go--;
+ }
+ }
+ elsif ( $want_break_before{$last_nonblank_type_to_go} ) {
+ $line_start_index_to_go--;
+ }
+ }
+ }
+ }
+
+ # remember the predicted position of this token on the output line
+ if ( $max_index_to_go > $line_start_index_to_go ) {
+ $gnu_position_predictor =
+ total_line_length( $line_start_index_to_go, $max_index_to_go );
+ }
+ else {
+ $gnu_position_predictor = $space_count +
+ token_sequence_length( $max_index_to_go, $max_index_to_go );
+ }
+
+ # store the indentation object for this token
+ # this allows us to manipulate the leading whitespace
+ # (in case we have to reduce indentation to fit a line) without
+ # having to change any token values
+ $leading_spaces_to_go[$max_index_to_go] = $gnu_stack[$max_gnu_stack_index];
+ $reduced_spaces_to_go[$max_index_to_go] =
+ ( $max_gnu_stack_index > 0 && $ci_level )
+ ? $gnu_stack[ $max_gnu_stack_index - 1 ]
+ : $gnu_stack[$max_gnu_stack_index];
+ return;
+}
+
+sub check_for_long_gnu_style_lines {
+
+ # look at the current estimated maximum line length, and
+ # remove some whitespace if it exceeds the desired maximum
+
+ # this is only for the '-lp' style
+ return unless ($rOpts_line_up_parentheses);
+
+ # nothing can be done if no stack items defined for this line
+ return if ( $max_gnu_item_index == UNDEFINED_INDEX );
+
+ # see if we have exceeded the maximum desired line length
+ # keep 2 extra free because they are needed in some cases
+ # (result of trial-and-error testing)
+ my $spaces_needed =
+ $gnu_position_predictor - $rOpts_maximum_line_length + 2;
+
+ return if ( $spaces_needed < 0 );
+
+ # We are over the limit, so try to remove a requested number of
+ # spaces from leading whitespace. We are only allowed to remove
+ # from whitespace items created on this batch, since others have
+ # already been used and cannot be undone.
+ my @candidates = ();
+ my $i;
+
+ # loop over all whitespace items created for the current batch
+ for ( $i = 0 ; $i <= $max_gnu_item_index ; $i++ ) {
+ my $item = $gnu_item_list[$i];
+
+ # item must still be open to be a candidate (otherwise it
+ # cannot influence the current token)
+ next if ( $item->get_CLOSED() >= 0 );
+
+ my $available_spaces = $item->get_AVAILABLE_SPACES();
+
+ if ( $available_spaces > 0 ) {
+ push( @candidates, [ $i, $available_spaces ] );
+ }
+ }
+
+ return unless (@candidates);
+
+ # sort by available whitespace so that we can remove whitespace
+ # from the maximum available first
+ @candidates = sort { $b->[1] <=> $a->[1] } @candidates;
+
+ # keep removing whitespace until we are done or have no more
+ my $candidate;
+ foreach $candidate (@candidates) {
+ my ( $i, $available_spaces ) = @{$candidate};
+ my $deleted_spaces =
+ ( $available_spaces > $spaces_needed )
+ ? $spaces_needed
+ : $available_spaces;
+
+ # remove the incremental space from this item
+ $gnu_item_list[$i]->decrease_AVAILABLE_SPACES($deleted_spaces);
+
+ my $i_debug = $i;
+
+ # update the leading whitespace of this item and all items
+ # that came after it
+ for ( ; $i <= $max_gnu_item_index ; $i++ ) {
+
+ my $old_spaces = $gnu_item_list[$i]->get_SPACES();
+ if ( $old_spaces > $deleted_spaces ) {
+ $gnu_item_list[$i]->decrease_SPACES($deleted_spaces);
+ }
+
+ # shouldn't happen except for code bug:
+ else {
+ my $level = $gnu_item_list[$i_debug]->get_LEVEL();
+ my $ci_level = $gnu_item_list[$i_debug]->get_CI_LEVEL();
+ my $old_level = $gnu_item_list[$i]->get_LEVEL();
+ my $old_ci_level = $gnu_item_list[$i]->get_CI_LEVEL();
+ warning(
+"program bug with -lp: want to delete $deleted_spaces from item $i, but old=$old_spaces deleted: lev=$level ci=$ci_level deleted: level=$old_level ci=$ci_level\n"
+ );
+ report_definite_bug();
+ }
+ }
+ $gnu_position_predictor -= $deleted_spaces;
+ $spaces_needed -= $deleted_spaces;
+ last unless ( $spaces_needed > 0 );
+ }
+}
+
+sub finish_lp_batch {
+
+ # This routine is called once after each each output stream batch is
+ # finished to undo indentation for all incomplete -lp
+ # indentation levels. It is too risky to leave a level open,
+ # because then we can't backtrack in case of a long line to follow.
+ # This means that comments and blank lines will disrupt this
+ # indentation style. But the vertical aligner may be able to
+ # get the space back if there are side comments.
+
+ # this is only for the 'lp' style
+ return unless ($rOpts_line_up_parentheses);
+
+ # nothing can be done if no stack items defined for this line
+ return if ( $max_gnu_item_index == UNDEFINED_INDEX );
+
+ # loop over all whitespace items created for the current batch
+ my $i;
+ for ( $i = 0 ; $i <= $max_gnu_item_index ; $i++ ) {
+ my $item = $gnu_item_list[$i];
+
+ # only look for open items
+ next if ( $item->get_CLOSED() >= 0 );
+
+ # Tentatively remove all of the available space
+ # (The vertical aligner will try to get it back later)
+ my $available_spaces = $item->get_AVAILABLE_SPACES();
+ if ( $available_spaces > 0 ) {
+
+ # delete incremental space for this item
+ $gnu_item_list[$i]
+ ->tentatively_decrease_AVAILABLE_SPACES($available_spaces);
+
+ # Reduce the total indentation space of any nodes that follow
+ # Note that any such nodes must necessarily be dependents
+ # of this node.
+ foreach ( $i + 1 .. $max_gnu_item_index ) {
+ $gnu_item_list[$_]->decrease_SPACES($available_spaces);
+ }
+ }
+ }
+ return;
+}
+
+sub reduce_lp_indentation {
+
+ # reduce the leading whitespace at token $i if possible by $spaces_needed
+ # (a large value of $spaces_needed will remove all excess space)
+ # NOTE: to be called from scan_list only for a sequence of tokens
+ # contained between opening and closing parens/braces/brackets
+
+ my ( $i, $spaces_wanted ) = @_;
+ my $deleted_spaces = 0;
+
+ my $item = $leading_spaces_to_go[$i];
+ my $available_spaces = $item->get_AVAILABLE_SPACES();
+
+ if (
+ $available_spaces > 0
+ && ( ( $spaces_wanted <= $available_spaces )
+ || !$item->get_HAVE_CHILD() )
+ )
+ {
+
+ # we'll remove these spaces, but mark them as recoverable
+ $deleted_spaces =
+ $item->tentatively_decrease_AVAILABLE_SPACES($spaces_wanted);
+ }
+
+ return $deleted_spaces;
+}
+
+sub token_sequence_length {
+
+ # return length of tokens ($ifirst .. $ilast) including first & last
+ # returns 0 if $ifirst > $ilast
+ my $ifirst = shift;
+ my $ilast = shift;
+ return 0 if ( $ilast < 0 || $ifirst > $ilast );
+ return $lengths_to_go[ $ilast + 1 ] if ( $ifirst < 0 );
+ return $lengths_to_go[ $ilast + 1 ] - $lengths_to_go[$ifirst];
+}
+
+sub total_line_length {
+
+ # return length of a line of tokens ($ifirst .. $ilast)
+ my $ifirst = shift;
+ my $ilast = shift;
+ if ( $ifirst < 0 ) { $ifirst = 0 }
+
+ return leading_spaces_to_go($ifirst) +
+ token_sequence_length( $ifirst, $ilast );
+}
+
+sub excess_line_length {
+
+ # return number of characters by which a line of tokens ($ifirst..$ilast)
+ # exceeds the allowable line length.
+ my $ifirst = shift;
+ my $ilast = shift;
+ if ( $ifirst < 0 ) { $ifirst = 0 }
+ return leading_spaces_to_go($ifirst) +
+ token_sequence_length( $ifirst, $ilast ) - $rOpts_maximum_line_length;
+}
+
+sub finish_formatting {
+
+ # flush buffer and write any informative messages
+ my $self = shift;
+
+ flush();
+ $file_writer_object->decrement_output_line_number()
+ ; # fix up line number since it was incremented
+ we_are_at_the_last_line();
+ if ( $added_semicolon_count > 0 ) {
+ my $first = ( $added_semicolon_count > 1 ) ? "First" : "";
+ my $what =
+ ( $added_semicolon_count > 1 ) ? "semicolons were" : "semicolon was";
+ write_logfile_entry("$added_semicolon_count $what added:\n");
+ write_logfile_entry(
+ " $first at input line $first_added_semicolon_at\n");
+
+ if ( $added_semicolon_count > 1 ) {
+ write_logfile_entry(
+ " Last at input line $last_added_semicolon_at\n");
+ }
+ write_logfile_entry(" (Use -nasc to prevent semicolon addition)\n");
+ write_logfile_entry("\n");
+ }
+
+ if ( $deleted_semicolon_count > 0 ) {
+ my $first = ( $deleted_semicolon_count > 1 ) ? "First" : "";
+ my $what =
+ ( $deleted_semicolon_count > 1 )
+ ? "semicolons were"
+ : "semicolon was";
+ write_logfile_entry(
+ "$deleted_semicolon_count unnecessary $what deleted:\n");
+ write_logfile_entry(
+ " $first at input line $first_deleted_semicolon_at\n");
+
+ if ( $deleted_semicolon_count > 1 ) {
+ write_logfile_entry(
+ " Last at input line $last_deleted_semicolon_at\n");
+ }
+ write_logfile_entry(" (Use -ndsc to prevent semicolon deletion)\n");
+ write_logfile_entry("\n");
+ }
+
+ if ( $embedded_tab_count > 0 ) {
+ my $first = ( $embedded_tab_count > 1 ) ? "First" : "";
+ my $what =
+ ( $embedded_tab_count > 1 )
+ ? "quotes or patterns"
+ : "quote or pattern";
+ write_logfile_entry("$embedded_tab_count $what had embedded tabs:\n");
+ write_logfile_entry(
+"This means the display of this script could vary with device or software\n"
+ );
+ write_logfile_entry(" $first at input line $first_embedded_tab_at\n");
+
+ if ( $embedded_tab_count > 1 ) {
+ write_logfile_entry(
+ " Last at input line $last_embedded_tab_at\n");
+ }
+ write_logfile_entry("\n");
+ }
+
+ if ($first_tabbing_disagreement) {
+ write_logfile_entry(
+"First indentation disagreement seen at input line $first_tabbing_disagreement\n"
+ );
+ }
+
+ if ($in_tabbing_disagreement) {
+ write_logfile_entry(
+"Ending with indentation disagreement which started at input line $in_tabbing_disagreement\n"
+ );
+ }
+ else {
+
+ if ($last_tabbing_disagreement) {
+
+ write_logfile_entry(
+"Last indentation disagreement seen at input line $last_tabbing_disagreement\n"
+ );
+ }
+ else {
+ write_logfile_entry("No indentation disagreement seen\n");
+ }
+ }
+ write_logfile_entry("\n");
+
+ $vertical_aligner_object->report_anything_unusual();
+
+ $file_writer_object->report_line_length_errors();
+}
+
+sub check_options {
+
+ # This routine is called to check the Opts hash after it is defined
+
+ ($rOpts) = @_;
+ my ( $tabbing_string, $tab_msg );
+
+ make_static_block_comment_pattern();
+ make_static_side_comment_pattern();
+ make_closing_side_comment_prefix();
+ make_closing_side_comment_list_pattern();
+ $format_skipping_pattern_begin =
+ make_format_skipping_pattern( 'format-skipping-begin', '#<<<' );
+ $format_skipping_pattern_end =
+ make_format_skipping_pattern( 'format-skipping-end', '#>>>' );
+
+ # If closing side comments ARE selected, then we can safely
+ # delete old closing side comments unless closing side comment
+ # warnings are requested. This is a good idea because it will
+ # eliminate any old csc's which fall below the line count threshold.
+ # We cannot do this if warnings are turned on, though, because we
+ # might delete some text which has been added. So that must
+ # be handled when comments are created.
+ if ( $rOpts->{'closing-side-comments'} ) {
+ if ( !$rOpts->{'closing-side-comment-warnings'} ) {
+ $rOpts->{'delete-closing-side-comments'} = 1;
+ }
+ }
+
+ # If closing side comments ARE NOT selected, but warnings ARE
+ # selected and we ARE DELETING csc's, then we will pretend to be
+ # adding with a huge interval. This will force the comments to be
+ # generated for comparison with the old comments, but not added.
+ elsif ( $rOpts->{'closing-side-comment-warnings'} ) {
+ if ( $rOpts->{'delete-closing-side-comments'} ) {
+ $rOpts->{'delete-closing-side-comments'} = 0;
+ $rOpts->{'closing-side-comments'} = 1;
+ $rOpts->{'closing-side-comment-interval'} = 100000000;
+ }
+ }
+
+ make_bli_pattern();
+ make_block_brace_vertical_tightness_pattern();
+
+ if ( $rOpts->{'line-up-parentheses'} ) {
+
+ if ( $rOpts->{'indent-only'}
+ || !$rOpts->{'add-newlines'}
+ || !$rOpts->{'delete-old-newlines'} )
+ {
+ warn <<EOM;
+-----------------------------------------------------------------------
+Conflict: -lp conflicts with -io, -fnl, -nanl, or -ndnl; ignoring -lp
+
+The -lp indentation logic requires that perltidy be able to coordinate
+arbitrarily large numbers of line breakpoints. This isn't possible
+with these flags. Sometimes an acceptable workaround is to use -wocb=3
+-----------------------------------------------------------------------
+EOM
+ $rOpts->{'line-up-parentheses'} = 0;
+ }
+ }
+
+ # At present, tabs are not compatable with the line-up-parentheses style
+ # (it would be possible to entab the total leading whitespace
+ # just prior to writing the line, if desired).
+ if ( $rOpts->{'line-up-parentheses'} && $rOpts->{'tabs'} ) {
+ warn <<EOM;
+Conflict: -t (tabs) cannot be used with the -lp option; ignoring -t; see -et.
+EOM
+ $rOpts->{'tabs'} = 0;
+ }
+
+ # Likewise, tabs are not compatable with outdenting..
+ if ( $rOpts->{'outdent-keywords'} && $rOpts->{'tabs'} ) {
+ warn <<EOM;
+Conflict: -t (tabs) cannot be used with the -okw options; ignoring -t; see -et.
+EOM
+ $rOpts->{'tabs'} = 0;
+ }
+
+ if ( $rOpts->{'outdent-labels'} && $rOpts->{'tabs'} ) {
+ warn <<EOM;
+Conflict: -t (tabs) cannot be used with the -ola option; ignoring -t; see -et.
+EOM
+ $rOpts->{'tabs'} = 0;
+ }
+
+ if ( !$rOpts->{'space-for-semicolon'} ) {
+ $want_left_space{'f'} = -1;
+ }
+
+ if ( $rOpts->{'space-terminal-semicolon'} ) {
+ $want_left_space{';'} = 1;
+ }
+
+ # implement outdenting preferences for keywords
+ %outdent_keyword = ();
+ unless ( @_ = split_words( $rOpts->{'outdent-keyword-okl'} ) ) {
+ @_ = qw(next last redo goto return); # defaults
+ }
+
+ # FUTURE: if not a keyword, assume that it is an identifier
+ foreach (@_) {
+ if ( $Perl::Tidy::Tokenizer::is_keyword{$_} ) {
+ $outdent_keyword{$_} = 1;
+ }
+ else {
+ warn "ignoring '$_' in -okwl list; not a perl keyword";
+ }
+ }
+
+ # implement user whitespace preferences
+ if ( @_ = split_words( $rOpts->{'want-left-space'} ) ) {
+ @want_left_space{@_} = (1) x scalar(@_);
+ }
+
+ if ( @_ = split_words( $rOpts->{'want-right-space'} ) ) {
+ @want_right_space{@_} = (1) x scalar(@_);
+ }
+
+ if ( @_ = split_words( $rOpts->{'nowant-left-space'} ) ) {
+ @want_left_space{@_} = (-1) x scalar(@_);
+ }
+
+ if ( @_ = split_words( $rOpts->{'nowant-right-space'} ) ) {
+ @want_right_space{@_} = (-1) x scalar(@_);
+ }
+ if ( $rOpts->{'dump-want-left-space'} ) {
+ dump_want_left_space(*STDOUT);
+ exit 1;
+ }
+
+ if ( $rOpts->{'dump-want-right-space'} ) {
+ dump_want_right_space(*STDOUT);
+ exit 1;
+ }
+
+ # default keywords for which space is introduced before an opening paren
+ # (at present, including them messes up vertical alignment)
+ @_ = qw(my local our and or err eq ne if else elsif until
+ unless while for foreach return switch case given when);
+ @space_after_keyword{@_} = (1) x scalar(@_);
+
+ # allow user to modify these defaults
+ if ( @_ = split_words( $rOpts->{'space-after-keyword'} ) ) {
+ @space_after_keyword{@_} = (1) x scalar(@_);
+ }
+
+ if ( @_ = split_words( $rOpts->{'nospace-after-keyword'} ) ) {
+ @space_after_keyword{@_} = (0) x scalar(@_);
+ }
+
+ # implement user break preferences
+ my @all_operators = qw(% + - * / x != == >= <= =~ !~ < > | &
+ = **= += *= &= <<= &&= -= /= |= >>= ||= //= .= %= ^= x=
+ . : ? && || and or err xor
+ );
+
+ my $break_after = sub {
+ foreach my $tok (@_) {
+ if ( $tok eq '?' ) { $tok = ':' } # patch to coordinate ?/:
+ my $lbs = $left_bond_strength{$tok};
+ my $rbs = $right_bond_strength{$tok};
+ if ( defined($lbs) && defined($rbs) && $lbs < $rbs ) {
+ ( $right_bond_strength{$tok}, $left_bond_strength{$tok} ) =
+ ( $lbs, $rbs );
+ }
+ }
+ };
+
+ my $break_before = sub {
+ foreach my $tok (@_) {
+ my $lbs = $left_bond_strength{$tok};
+ my $rbs = $right_bond_strength{$tok};
+ if ( defined($lbs) && defined($rbs) && $rbs < $lbs ) {
+ ( $right_bond_strength{$tok}, $left_bond_strength{$tok} ) =
+ ( $lbs, $rbs );
+ }
+ }
+ };
+
+ $break_after->(@all_operators) if ( $rOpts->{'break-after-all-operators'} );
+ $break_before->(@all_operators)
+ if ( $rOpts->{'break-before-all-operators'} );
+
+ $break_after->( split_words( $rOpts->{'want-break-after'} ) );
+ $break_before->( split_words( $rOpts->{'want-break-before'} ) );
+
+ # make note if breaks are before certain key types
+ %want_break_before = ();
+ foreach my $tok ( @all_operators, ',' ) {
+ $want_break_before{$tok} =
+ $left_bond_strength{$tok} < $right_bond_strength{$tok};
+ }
+
+ # Coordinate ?/: breaks, which must be similar
+ if ( !$want_break_before{':'} ) {
+ $want_break_before{'?'} = $want_break_before{':'};
+ $right_bond_strength{'?'} = $right_bond_strength{':'} + 0.01;
+ $left_bond_strength{'?'} = NO_BREAK;
+ }
+
+ # Define here tokens which may follow the closing brace of a do statement
+ # on the same line, as in:
+ # } while ( $something);
+ @_ = qw(until while unless if ; : );
+ push @_, ',';
+ @is_do_follower{@_} = (1) x scalar(@_);
+
+ # These tokens may follow the closing brace of an if or elsif block.
+ # In other words, for cuddled else we want code to look like:
+ # } elsif ( $something) {
+ # } else {
+ if ( $rOpts->{'cuddled-else'} ) {
+ @_ = qw(else elsif);
+ @is_if_brace_follower{@_} = (1) x scalar(@_);
+ }
+ else {
+ %is_if_brace_follower = ();
+ }
+
+ # nothing can follow the closing curly of an else { } block:
+ %is_else_brace_follower = ();
+
+ # what can follow a multi-line anonymous sub definition closing curly:
+ @_ = qw# ; : => or and && || ~~ !~~ ) #;
+ push @_, ',';
+ @is_anon_sub_brace_follower{@_} = (1) x scalar(@_);
+
+ # what can follow a one-line anonynomous sub closing curly:
+ # one-line anonumous subs also have ']' here...
+ # see tk3.t and PP.pm
+ @_ = qw# ; : => or and && || ) ] ~~ !~~ #;
+ push @_, ',';
+ @is_anon_sub_1_brace_follower{@_} = (1) x scalar(@_);
+
+ # What can follow a closing curly of a block
+ # which is not an if/elsif/else/do/sort/map/grep/eval/sub
+ # Testfiles: 'Toolbar.pm', 'Menubar.pm', bless.t, '3rules.pl'
+ @_ = qw# ; : => or and && || ) #;
+ push @_, ',';
+
+ # allow cuddled continue if cuddled else is specified
+ if ( $rOpts->{'cuddled-else'} ) { push @_, 'continue'; }
+
+ @is_other_brace_follower{@_} = (1) x scalar(@_);
+
+ $right_bond_strength{'{'} = WEAK;
+ $left_bond_strength{'{'} = VERY_STRONG;
+
+ # make -l=0 equal to -l=infinite
+ if ( !$rOpts->{'maximum-line-length'} ) {
+ $rOpts->{'maximum-line-length'} = 1000000;
+ }
+
+ # make -lbl=0 equal to -lbl=infinite
+ if ( !$rOpts->{'long-block-line-count'} ) {
+ $rOpts->{'long-block-line-count'} = 1000000;
+ }
+
+ my $ole = $rOpts->{'output-line-ending'};
+ if ($ole) {
+ my %endings = (
+ dos => "\015\012",
+ win => "\015\012",
+ mac => "\015",
+ unix => "\012",
+ );
+ $ole = lc $ole;
+ unless ( $rOpts->{'output-line-ending'} = $endings{$ole} ) {
+ my $str = join " ", keys %endings;
+ die <<EOM;
+Unrecognized line ending '$ole'; expecting one of: $str
+EOM
+ }
+ if ( $rOpts->{'preserve-line-endings'} ) {
+ warn "Ignoring -ple; conflicts with -ole\n";
+ $rOpts->{'preserve-line-endings'} = undef;
+ }
+ }
+
+ # hashes used to simplify setting whitespace
+ %tightness = (
+ '{' => $rOpts->{'brace-tightness'},
+ '}' => $rOpts->{'brace-tightness'},
+ '(' => $rOpts->{'paren-tightness'},
+ ')' => $rOpts->{'paren-tightness'},
+ '[' => $rOpts->{'square-bracket-tightness'},
+ ']' => $rOpts->{'square-bracket-tightness'},
+ );
+ %matching_token = (
+ '{' => '}',
+ '(' => ')',
+ '[' => ']',
+ '?' => ':',
+ );
+
+ # frequently used parameters
+ $rOpts_add_newlines = $rOpts->{'add-newlines'};
+ $rOpts_add_whitespace = $rOpts->{'add-whitespace'};
+ $rOpts_block_brace_tightness = $rOpts->{'block-brace-tightness'};
+ $rOpts_block_brace_vertical_tightness =
+ $rOpts->{'block-brace-vertical-tightness'};
+ $rOpts_brace_left_and_indent = $rOpts->{'brace-left-and-indent'};
+ $rOpts_comma_arrow_breakpoints = $rOpts->{'comma-arrow-breakpoints'};
+ $rOpts_break_at_old_ternary_breakpoints =
+ $rOpts->{'break-at-old-ternary-breakpoints'};
+ $rOpts_break_at_old_comma_breakpoints =
+ $rOpts->{'break-at-old-comma-breakpoints'};
+ $rOpts_break_at_old_keyword_breakpoints =
+ $rOpts->{'break-at-old-keyword-breakpoints'};
+ $rOpts_break_at_old_logical_breakpoints =
+ $rOpts->{'break-at-old-logical-breakpoints'};
+ $rOpts_closing_side_comment_else_flag =
+ $rOpts->{'closing-side-comment-else-flag'};
+ $rOpts_closing_side_comment_maximum_text =
+ $rOpts->{'closing-side-comment-maximum-text'};
+ $rOpts_continuation_indentation = $rOpts->{'continuation-indentation'};
+ $rOpts_cuddled_else = $rOpts->{'cuddled-else'};
+ $rOpts_delete_old_whitespace = $rOpts->{'delete-old-whitespace'};
+ $rOpts_fuzzy_line_length = $rOpts->{'fuzzy-line-length'};
+ $rOpts_indent_columns = $rOpts->{'indent-columns'};
+ $rOpts_line_up_parentheses = $rOpts->{'line-up-parentheses'};
+ $rOpts_maximum_fields_per_table = $rOpts->{'maximum-fields-per-table'};
+ $rOpts_maximum_line_length = $rOpts->{'maximum-line-length'};
+ $rOpts_short_concatenation_item_length =
+ $rOpts->{'short-concatenation-item-length'};
+ $rOpts_swallow_optional_blank_lines =
+ $rOpts->{'swallow-optional-blank-lines'};
+ $rOpts_ignore_old_breakpoints = $rOpts->{'ignore-old-breakpoints'};
+ $rOpts_format_skipping = $rOpts->{'format-skipping'};
+ $rOpts_space_function_paren = $rOpts->{'space-function-paren'};
+ $rOpts_space_keyword_paren = $rOpts->{'space-keyword-paren'};
+ $rOpts_keep_interior_semicolons = $rOpts->{'keep-interior-semicolons'};
+ $half_maximum_line_length = $rOpts_maximum_line_length / 2;
+
+ # Note that both opening and closing tokens can access the opening
+ # and closing flags of their container types.
+ %opening_vertical_tightness = (
+ '(' => $rOpts->{'paren-vertical-tightness'},
+ '{' => $rOpts->{'brace-vertical-tightness'},
+ '[' => $rOpts->{'square-bracket-vertical-tightness'},
+ ')' => $rOpts->{'paren-vertical-tightness'},
+ '}' => $rOpts->{'brace-vertical-tightness'},
+ ']' => $rOpts->{'square-bracket-vertical-tightness'},
+ );
+
+ %closing_vertical_tightness = (
+ '(' => $rOpts->{'paren-vertical-tightness-closing'},
+ '{' => $rOpts->{'brace-vertical-tightness-closing'},
+ '[' => $rOpts->{'square-bracket-vertical-tightness-closing'},
+ ')' => $rOpts->{'paren-vertical-tightness-closing'},
+ '}' => $rOpts->{'brace-vertical-tightness-closing'},
+ ']' => $rOpts->{'square-bracket-vertical-tightness-closing'},
+ );
+
+ # assume flag for '>' same as ')' for closing qw quotes
+ %closing_token_indentation = (
+ ')' => $rOpts->{'closing-paren-indentation'},
+ '}' => $rOpts->{'closing-brace-indentation'},
+ ']' => $rOpts->{'closing-square-bracket-indentation'},
+ '>' => $rOpts->{'closing-paren-indentation'},
+ );
+
+ %opening_token_right = (
+ '(' => $rOpts->{'opening-paren-right'},
+ '{' => $rOpts->{'opening-hash-brace-right'},
+ '[' => $rOpts->{'opening-square-bracket-right'},
+ );
+
+ %stack_opening_token = (
+ '(' => $rOpts->{'stack-opening-paren'},
+ '{' => $rOpts->{'stack-opening-hash-brace'},
+ '[' => $rOpts->{'stack-opening-square-bracket'},
+ );
+
+ %stack_closing_token = (
+ ')' => $rOpts->{'stack-closing-paren'},
+ '}' => $rOpts->{'stack-closing-hash-brace'},
+ ']' => $rOpts->{'stack-closing-square-bracket'},
+ );
+}
+
+sub make_static_block_comment_pattern {
+
+ # create the pattern used to identify static block comments
+ $static_block_comment_pattern = '^\s*##';
+
+ # allow the user to change it
+ if ( $rOpts->{'static-block-comment-prefix'} ) {
+ my $prefix = $rOpts->{'static-block-comment-prefix'};
+ $prefix =~ s/^\s*//;
+ my $pattern = $prefix;
+
+ # user may give leading caret to force matching left comments only
+ if ( $prefix !~ /^\^#/ ) {
+ if ( $prefix !~ /^#/ ) {
+ die
+"ERROR: the -sbcp prefix is '$prefix' but must begin with '#' or '^#'\n";
+ }
+ $pattern = '^\s*' . $prefix;
+ }
+ eval "'##'=~/$pattern/";
+ if ($@) {
+ die
+"ERROR: the -sbc prefix '$prefix' causes the invalid regex '$pattern'\n";
+ }
+ $static_block_comment_pattern = $pattern;
+ }
+}
+
+sub make_format_skipping_pattern {
+ my ( $opt_name, $default ) = @_;
+ my $param = $rOpts->{$opt_name};
+ unless ($param) { $param = $default }
+ $param =~ s/^\s*//;
+ if ( $param !~ /^#/ ) {
+ die "ERROR: the $opt_name parameter '$param' must begin with '#'\n";
+ }
+ my $pattern = '^' . $param . '\s';
+ eval "'#'=~/$pattern/";
+ if ($@) {
+ die
+"ERROR: the $opt_name parameter '$param' causes the invalid regex '$pattern'\n";
+ }
+ return $pattern;
+}
+
+sub make_closing_side_comment_list_pattern {
+
+ # turn any input list into a regex for recognizing selected block types
+ $closing_side_comment_list_pattern = '^\w+';
+ if ( defined( $rOpts->{'closing-side-comment-list'} )
+ && $rOpts->{'closing-side-comment-list'} )
+ {
+ $closing_side_comment_list_pattern =
+ make_block_pattern( '-cscl', $rOpts->{'closing-side-comment-list'} );
+ }
+}
+
+sub make_bli_pattern {
+
+ if ( defined( $rOpts->{'brace-left-and-indent-list'} )
+ && $rOpts->{'brace-left-and-indent-list'} )
+ {
+ $bli_list_string = $rOpts->{'brace-left-and-indent-list'};
+ }
+
+ $bli_pattern = make_block_pattern( '-blil', $bli_list_string );
+}
+
+sub make_block_brace_vertical_tightness_pattern {
+
+ # turn any input list into a regex for recognizing selected block types
+ $block_brace_vertical_tightness_pattern =
+ '^((if|else|elsif|unless|while|for|foreach|do|\w+:)$|sub)';
+
+ if ( defined( $rOpts->{'block-brace-vertical-tightness-list'} )
+ && $rOpts->{'block-brace-vertical-tightness-list'} )
+ {
+ $block_brace_vertical_tightness_pattern =
+ make_block_pattern( '-bbvtl',
+ $rOpts->{'block-brace-vertical-tightness-list'} );
+ }
+}
+
+sub make_block_pattern {
+
+ # given a string of block-type keywords, return a regex to match them
+ # The only tricky part is that labels are indicated with a single ':'
+ # and the 'sub' token text may have additional text after it (name of
+ # sub).
+ #
+ # Example:
+ #
+ # input string: "if else elsif unless while for foreach do : sub";
+ # pattern: '^((if|else|elsif|unless|while|for|foreach|do|\w+:)$|sub)';
+
+ my ( $abbrev, $string ) = @_;
+ my @list = split_words($string);
+ my @words = ();
+ my %seen;
+ for my $i (@list) {
+ next if $seen{$i};
+ $seen{$i} = 1;
+ if ( $i eq 'sub' ) {
+ }
+ elsif ( $i eq ':' ) {
+ push @words, '\w+:';
+ }
+ elsif ( $i =~ /^\w/ ) {
+ push @words, $i;
+ }
+ else {
+ warn "unrecognized block type $i after $abbrev, ignoring\n";
+ }
+ }
+ my $pattern = '(' . join( '|', @words ) . ')$';
+ if ( $seen{'sub'} ) {
+ $pattern = '(' . $pattern . '|sub)';
+ }
+ $pattern = '^' . $pattern;
+ return $pattern;
+}
+
+sub make_static_side_comment_pattern {
+
+ # create the pattern used to identify static side comments
+ $static_side_comment_pattern = '^##';
+
+ # allow the user to change it
+ if ( $rOpts->{'static-side-comment-prefix'} ) {
+ my $prefix = $rOpts->{'static-side-comment-prefix'};
+ $prefix =~ s/^\s*//;
+ my $pattern = '^' . $prefix;
+ eval "'##'=~/$pattern/";
+ if ($@) {
+ die
+"ERROR: the -sscp prefix '$prefix' causes the invalid regex '$pattern'\n";
+ }
+ $static_side_comment_pattern = $pattern;
+ }
+}
+
+sub make_closing_side_comment_prefix {
+
+ # Be sure we have a valid closing side comment prefix
+ my $csc_prefix = $rOpts->{'closing-side-comment-prefix'};
+ my $csc_prefix_pattern;
+ if ( !defined($csc_prefix) ) {
+ $csc_prefix = '## end';
+ $csc_prefix_pattern = '^##\s+end';
+ }
+ else {
+ my $test_csc_prefix = $csc_prefix;
+ if ( $test_csc_prefix !~ /^#/ ) {
+ $test_csc_prefix = '#' . $test_csc_prefix;
+ }
+
+ # make a regex to recognize the prefix
+ my $test_csc_prefix_pattern = $test_csc_prefix;
+
+ # escape any special characters
+ $test_csc_prefix_pattern =~ s/([^#\s\w])/\\$1/g;
+
+ $test_csc_prefix_pattern = '^' . $test_csc_prefix_pattern;
+
+ # allow exact number of intermediate spaces to vary
+ $test_csc_prefix_pattern =~ s/\s+/\\s\+/g;
+
+ # make sure we have a good pattern
+ # if we fail this we probably have an error in escaping
+ # characters.
+ eval "'##'=~/$test_csc_prefix_pattern/";
+ if ($@) {
+
+ # shouldn't happen..must have screwed up escaping, above
+ report_definite_bug();
+ warn
+"Program Error: the -cscp prefix '$csc_prefix' caused the invalid regex '$csc_prefix_pattern'\n";
+
+ # just warn and keep going with defaults
+ warn "Please consider using a simpler -cscp prefix\n";
+ warn "Using default -cscp instead; please check output\n";
+ }
+ else {
+ $csc_prefix = $test_csc_prefix;
+ $csc_prefix_pattern = $test_csc_prefix_pattern;
+ }
+ }
+ $rOpts->{'closing-side-comment-prefix'} = $csc_prefix;
+ $closing_side_comment_prefix_pattern = $csc_prefix_pattern;
+}
+
+sub dump_want_left_space {
+ my $fh = shift;
+ local $" = "\n";
+ print $fh <<EOM;
+These values are the main control of whitespace to the left of a token type;
+They may be altered with the -wls parameter.
+For a list of token types, use perltidy --dump-token-types (-dtt)
+ 1 means the token wants a space to its left
+-1 means the token does not want a space to its left
+------------------------------------------------------------------------
+EOM
+ foreach ( sort keys %want_left_space ) {
+ print $fh "$_\t$want_left_space{$_}\n";
+ }
+}
+
+sub dump_want_right_space {
+ my $fh = shift;
+ local $" = "\n";
+ print $fh <<EOM;
+These values are the main control of whitespace to the right of a token type;
+They may be altered with the -wrs parameter.
+For a list of token types, use perltidy --dump-token-types (-dtt)
+ 1 means the token wants a space to its right
+-1 means the token does not want a space to its right
+------------------------------------------------------------------------
+EOM
+ foreach ( sort keys %want_right_space ) {
+ print $fh "$_\t$want_right_space{$_}\n";
+ }
+}
+
+{ # begin is_essential_whitespace
+
+ my %is_sort_grep_map;
+ my %is_for_foreach;
+
+ BEGIN {
+
+ @_ = qw(sort grep map);
+ @is_sort_grep_map{@_} = (1) x scalar(@_);
+
+ @_ = qw(for foreach);
+ @is_for_foreach{@_} = (1) x scalar(@_);
+
+ }
+
+ sub is_essential_whitespace {
+
+ # Essential whitespace means whitespace which cannot be safely deleted
+ # without risking the introduction of a syntax error.
+ # We are given three tokens and their types:
+ # ($tokenl, $typel) is the token to the left of the space in question
+ # ($tokenr, $typer) is the token to the right of the space in question
+ # ($tokenll, $typell) is previous nonblank token to the left of $tokenl
+ #
+ # This is a slow routine but is not needed too often except when -mangle
+ # is used.
+ #
+ # Note: This routine should almost never need to be changed. It is
+ # for avoiding syntax problems rather than for formatting.
+ my ( $tokenll, $typell, $tokenl, $typel, $tokenr, $typer ) = @_;
+
+ my $result =
+
+ # never combine two bare words or numbers
+ # examples: and ::ok(1)
+ # return ::spw(...)
+ # for bla::bla:: abc
+ # example is "%overload:: and" in files Dumpvalue.pm or colonbug.pl
+ # $input eq"quit" to make $inputeq"quit"
+ # my $size=-s::SINK if $file; <==OK but we won't do it
+ # don't join something like: for bla::bla:: abc
+ # example is "%overload:: and" in files Dumpvalue.pm or colonbug.pl
+ ( ( $tokenl =~ /([\'\w]|\:\:)$/ ) && ( $tokenr =~ /^([\'\w]|\:\:)/ ) )
+
+ # do not combine a number with a concatination dot
+ # example: pom.caputo:
+ # $vt100_compatible ? "\e[0;0H" : ('-' x 78 . "\n");
+ || ( ( $typel eq 'n' ) && ( $tokenr eq '.' ) )
+ || ( ( $typer eq 'n' ) && ( $tokenl eq '.' ) )
+
+ # do not join a minus with a bare word, because you might form
+ # a file test operator. Example from Complex.pm:
+ # if (CORE::abs($z - i) < $eps); "z-i" would be taken as a file test.
+ || ( ( $tokenl eq '-' ) && ( $tokenr =~ /^[_A-Za-z]$/ ) )
+
+ # and something like this could become ambiguous without space
+ # after the '-':
+ # use constant III=>1;
+ # $a = $b - III;
+ # and even this:
+ # $a = - III;
+ || ( ( $tokenl eq '-' )
+ && ( $typer =~ /^[wC]$/ && $tokenr =~ /^[_A-Za-z]/ ) )
+
+ # '= -' should not become =- or you will get a warning
+ # about reversed -=
+ # || ($tokenr eq '-')
+
+ # keep a space between a quote and a bareword to prevent the
+ # bareword from becomming a quote modifier.
+ || ( ( $typel eq 'Q' ) && ( $tokenr =~ /^[a-zA-Z_]/ ) )
+
+ # keep a space between a token ending in '$' and any word;
+ # this caused trouble: "die @$ if $@"
+ || ( ( $typel eq 'i' && $tokenl =~ /\$$/ )
+ && ( $tokenr =~ /^[a-zA-Z_]/ ) )
+
+ # perl is very fussy about spaces before <<
+ || ( $tokenr =~ /^\<\</ )
+
+ # avoid combining tokens to create new meanings. Example:
+ # $a+ +$b must not become $a++$b
+ || ( $is_digraph{ $tokenl . $tokenr } )
+ || ( $is_trigraph{ $tokenl . $tokenr } )
+
+ # another example: do not combine these two &'s:
+ # allow_options & &OPT_EXECCGI
+ || ( $is_digraph{ $tokenl . substr( $tokenr, 0, 1 ) } )
+
+ # don't combine $$ or $# with any alphanumeric
+ # (testfile mangle.t with --mangle)
+ || ( ( $tokenl =~ /^\$[\$\#]$/ ) && ( $tokenr =~ /^\w/ ) )
+
+ # retain any space after possible filehandle
+ # (testfiles prnterr1.t with --extrude and mangle.t with --mangle)
+ || ( $typel eq 'Z' )
+
+ # Perl is sensitive to whitespace after the + here:
+ # $b = xvals $a + 0.1 * yvals $a;
+ || ( $typell eq 'Z' && $typel =~ /^[\/\?\+\-\*]$/ )
+
+ # keep paren separate in 'use Foo::Bar ()'
+ || ( $tokenr eq '('
+ && $typel eq 'w'
+ && $typell eq 'k'
+ && $tokenll eq 'use' )
+
+ # keep any space between filehandle and paren:
+ # file mangle.t with --mangle:
+ || ( $typel eq 'Y' && $tokenr eq '(' )
+
+ # retain any space after here doc operator ( hereerr.t)
+ || ( $typel eq 'h' )
+
+ # be careful with a space around ++ and --, to avoid ambiguity as to
+ # which token it applies
+ || ( ( $typer =~ /^(pp|mm)$/ ) && ( $tokenl !~ /^[\;\{\(\[]/ ) )
+ || ( ( $typel =~ /^(\+\+|\-\-)$/ ) && ( $tokenr !~ /^[\;\}\)\]]/ ) )
+
+ # need space after foreach my; for example, this will fail in
+ # older versions of Perl:
+ # foreach my$ft(@filetypes)...
+ || (
+ $tokenl eq 'my'
+
+ # /^(for|foreach)$/
+ && $is_for_foreach{$tokenll}
+ && $tokenr =~ /^\$/
+ )
+
+ # must have space between grep and left paren; "grep(" will fail
+ || ( $tokenr eq '(' && $is_sort_grep_map{$tokenl} )
+
+ # don't stick numbers next to left parens, as in:
+ #use Mail::Internet 1.28 (); (see Entity.pm, Head.pm, Test.pm)
+ || ( ( $typel eq 'n' ) && ( $tokenr eq '(' ) )
+
+ # We must be sure that a space between a ? and a quoted string
+ # remains if the space before the ? remains. [Loca.pm, lockarea]
+ # ie,
+ # $b=join $comma ? ',' : ':', @_; # ok
+ # $b=join $comma?',' : ':', @_; # ok!
+ # $b=join $comma ?',' : ':', @_; # error!
+ # Not really required:
+ ## || ( ( $typel eq '?' ) && ( $typer eq 'Q' ) )
+
+ # do not remove space between an '&' and a bare word because
+ # it may turn into a function evaluation, like here
+ # between '&' and 'O_ACCMODE', producing a syntax error [File.pm]
+ # $opts{rdonly} = (($opts{mode} & O_ACCMODE) == O_RDONLY);
+ || ( ( $typel eq '&' ) && ( $tokenr =~ /^[a-zA-Z_]/ ) )
+
+ ; # the value of this long logic sequence is the result we want
+ return $result;
+ }
+}
+
+sub set_white_space_flag {
+
+ # This routine examines each pair of nonblank tokens and
+ # sets values for array @white_space_flag.
+ #
+ # $white_space_flag[$j] is a flag indicating whether a white space
+ # BEFORE token $j is needed, with the following values:
+ #
+ # -1 do not want a space before token $j
+ # 0 optional space or $j is a whitespace
+ # 1 want a space before token $j
+ #
+ #
+ # The values for the first token will be defined based
+ # upon the contents of the "to_go" output array.
+ #
+ # Note: retain debug print statements because they are usually
+ # required after adding new token types.
+
+ BEGIN {
+
+ # initialize these global hashes, which control the use of
+ # whitespace around tokens:
+ #
+ # %binary_ws_rules
+ # %want_left_space
+ # %want_right_space
+ # %space_after_keyword
+ #
+ # Many token types are identical to the tokens themselves.
+ # See the tokenizer for a complete list. Here are some special types:
+ # k = perl keyword
+ # f = semicolon in for statement
+ # m = unary minus
+ # p = unary plus
+ # Note that :: is excluded since it should be contained in an identifier
+ # Note that '->' is excluded because it never gets space
+ # parentheses and brackets are excluded since they are handled specially
+ # curly braces are included but may be overridden by logic, such as
+ # newline logic.
+
+ # NEW_TOKENS: create a whitespace rule here. This can be as
+ # simple as adding your new letter to @spaces_both_sides, for
+ # example.
+
+ @_ = qw" L { ( [ ";
+ @is_opening_type{@_} = (1) x scalar(@_);
+
+ @_ = qw" R } ) ] ";
+ @is_closing_type{@_} = (1) x scalar(@_);
+
+ my @spaces_both_sides = qw"
+ + - * / % ? = . : x < > | & ^ .. << >> ** && .. || // => += -=
+ .= %= x= &= |= ^= *= <> <= >= == =~ !~ /= != ... <<= >>= ~~ !~~
+ &&= ||= //= <=> A k f w F n C Y U G v
+ ";
+
+ my @spaces_left_side = qw"
+ t ! ~ m p { \ h pp mm Z j
+ ";
+ push( @spaces_left_side, '#' ); # avoids warning message
+
+ my @spaces_right_side = qw"
+ ; } ) ] R J ++ -- **=
+ ";
+ push( @spaces_right_side, ',' ); # avoids warning message
+ @want_left_space{@spaces_both_sides} = (1) x scalar(@spaces_both_sides);
+ @want_right_space{@spaces_both_sides} =
+ (1) x scalar(@spaces_both_sides);
+ @want_left_space{@spaces_left_side} = (1) x scalar(@spaces_left_side);
+ @want_right_space{@spaces_left_side} = (-1) x scalar(@spaces_left_side);
+ @want_left_space{@spaces_right_side} =
+ (-1) x scalar(@spaces_right_side);
+ @want_right_space{@spaces_right_side} =
+ (1) x scalar(@spaces_right_side);
+ $want_left_space{'L'} = WS_NO;
+ $want_left_space{'->'} = WS_NO;
+ $want_right_space{'->'} = WS_NO;
+ $want_left_space{'**'} = WS_NO;
+ $want_right_space{'**'} = WS_NO;
+
+ # hash type information must stay tightly bound
+ # as in : ${xxxx}
+ $binary_ws_rules{'i'}{'L'} = WS_NO;
+ $binary_ws_rules{'i'}{'{'} = WS_YES;
+ $binary_ws_rules{'k'}{'{'} = WS_YES;
+ $binary_ws_rules{'U'}{'{'} = WS_YES;
+ $binary_ws_rules{'i'}{'['} = WS_NO;
+ $binary_ws_rules{'R'}{'L'} = WS_NO;
+ $binary_ws_rules{'R'}{'{'} = WS_NO;
+ $binary_ws_rules{'t'}{'L'} = WS_NO;
+ $binary_ws_rules{'t'}{'{'} = WS_NO;
+ $binary_ws_rules{'}'}{'L'} = WS_NO;
+ $binary_ws_rules{'}'}{'{'} = WS_NO;
+ $binary_ws_rules{'$'}{'L'} = WS_NO;
+ $binary_ws_rules{'$'}{'{'} = WS_NO;
+ $binary_ws_rules{'@'}{'L'} = WS_NO;
+ $binary_ws_rules{'@'}{'{'} = WS_NO;
+ $binary_ws_rules{'='}{'L'} = WS_YES;
+
+ # the following includes ') {'
+ # as in : if ( xxx ) { yyy }
+ $binary_ws_rules{']'}{'L'} = WS_NO;
+ $binary_ws_rules{']'}{'{'} = WS_NO;
+ $binary_ws_rules{')'}{'{'} = WS_YES;
+ $binary_ws_rules{')'}{'['} = WS_NO;
+ $binary_ws_rules{']'}{'['} = WS_NO;
+ $binary_ws_rules{']'}{'{'} = WS_NO;
+ $binary_ws_rules{'}'}{'['} = WS_NO;
+ $binary_ws_rules{'R'}{'['} = WS_NO;
+
+ $binary_ws_rules{']'}{'++'} = WS_NO;
+ $binary_ws_rules{']'}{'--'} = WS_NO;
+ $binary_ws_rules{')'}{'++'} = WS_NO;
+ $binary_ws_rules{')'}{'--'} = WS_NO;
+
+ $binary_ws_rules{'R'}{'++'} = WS_NO;
+ $binary_ws_rules{'R'}{'--'} = WS_NO;
+
+ ########################################################
+ # should no longer be necessary (see niek.pl)
+ ##$binary_ws_rules{'k'}{':'} = WS_NO; # keep colon with label
+ ##$binary_ws_rules{'w'}{':'} = WS_NO;
+ ########################################################
+ $binary_ws_rules{'i'}{'Q'} = WS_YES;
+ $binary_ws_rules{'n'}{'('} = WS_YES; # occurs in 'use package n ()'
+
+ # FIXME: we need to split 'i' into variables and functions
+ # and have no space for functions but space for variables. For now,
+ # I have a special patch in the special rules below
+ $binary_ws_rules{'i'}{'('} = WS_NO;
+
+ $binary_ws_rules{'w'}{'('} = WS_NO;
+ $binary_ws_rules{'w'}{'{'} = WS_YES;
+ }
+ my ( $jmax, $rtokens, $rtoken_type, $rblock_type ) = @_;
+ my ( $last_token, $last_type, $last_block_type, $token, $type,
+ $block_type );
+ my (@white_space_flag);
+ my $j_tight_closing_paren = -1;
+
+ if ( $max_index_to_go >= 0 ) {
+ $token = $tokens_to_go[$max_index_to_go];
+ $type = $types_to_go[$max_index_to_go];
+ $block_type = $block_type_to_go[$max_index_to_go];
+ }
+ else {
+ $token = ' ';
+ $type = 'b';
+ $block_type = '';
+ }
+
+ # loop over all tokens
+ my ( $j, $ws );
+
+ for ( $j = 0 ; $j <= $jmax ; $j++ ) {
+
+ if ( $$rtoken_type[$j] eq 'b' ) {
+ $white_space_flag[$j] = WS_OPTIONAL;
+ next;
+ }
+
+ # set a default value, to be changed as needed
+ $ws = undef;
+ $last_token = $token;
+ $last_type = $type;
+ $last_block_type = $block_type;
+ $token = $$rtokens[$j];
+ $type = $$rtoken_type[$j];
+ $block_type = $$rblock_type[$j];
+
+ #---------------------------------------------------------------
+ # section 1:
+ # handle space on the inside of opening braces
+ #---------------------------------------------------------------
+
+ # /^[L\{\(\[]$/
+ if ( $is_opening_type{$last_type} ) {
+
+ $j_tight_closing_paren = -1;
+
+ # let's keep empty matched braces together: () {} []
+ # except for BLOCKS
+ if ( $token eq $matching_token{$last_token} ) {
+ if ($block_type) {
+ $ws = WS_YES;
+ }
+ else {
+ $ws = WS_NO;
+ }
+ }
+ else {
+
+ # we're considering the right of an opening brace
+ # tightness = 0 means always pad inside with space
+ # tightness = 1 means pad inside if "complex"
+ # tightness = 2 means never pad inside with space
+
+ my $tightness;
+ if ( $last_type eq '{'
+ && $last_token eq '{'
+ && $last_block_type )
+ {
+ $tightness = $rOpts_block_brace_tightness;
+ }
+ else { $tightness = $tightness{$last_token} }
+
+ if ( $tightness <= 0 ) {
+ $ws = WS_YES;
+ }
+ elsif ( $tightness > 1 ) {
+ $ws = WS_NO;
+ }
+ else {
+
+ # Patch to count '-foo' as single token so that
+ # each of $a{-foo} and $a{foo} and $a{'foo'} do
+ # not get spaces with default formatting.
+ my $j_here = $j;
+ ++$j_here
+ if ( $token eq '-'
+ && $last_token eq '{'
+ && $$rtoken_type[ $j + 1 ] eq 'w' );
+
+ # $j_next is where a closing token should be if
+ # the container has a single token
+ my $j_next =
+ ( $$rtoken_type[ $j_here + 1 ] eq 'b' )
+ ? $j_here + 2
+ : $j_here + 1;
+ my $tok_next = $$rtokens[$j_next];
+ my $type_next = $$rtoken_type[$j_next];
+
+ # for tightness = 1, if there is just one token
+ # within the matching pair, we will keep it tight
+ if (
+ $tok_next eq $matching_token{$last_token}
+
+ # but watch out for this: [ [ ] (misc.t)
+ && $last_token ne $token
+ )
+ {
+
+ # remember where to put the space for the closing paren
+ $j_tight_closing_paren = $j_next;
+ $ws = WS_NO;
+ }
+ else {
+ $ws = WS_YES;
+ }
+ }
+ }
+ } # done with opening braces and brackets
+ my $ws_1 = $ws
+ if FORMATTER_DEBUG_FLAG_WHITE;
+
+ #---------------------------------------------------------------
+ # section 2:
+ # handle space on inside of closing brace pairs
+ #---------------------------------------------------------------
+
+ # /[\}\)\]R]/
+ if ( $is_closing_type{$type} ) {
+
+ if ( $j == $j_tight_closing_paren ) {
+
+ $j_tight_closing_paren = -1;
+ $ws = WS_NO;
+ }
+ else {
+
+ if ( !defined($ws) ) {
+
+ my $tightness;
+ if ( $type eq '}' && $token eq '}' && $block_type ) {
+ $tightness = $rOpts_block_brace_tightness;
+ }
+ else { $tightness = $tightness{$token} }
+
+ $ws = ( $tightness > 1 ) ? WS_NO : WS_YES;
+ }
+ }
+ }
+
+ my $ws_2 = $ws
+ if FORMATTER_DEBUG_FLAG_WHITE;
+
+ #---------------------------------------------------------------
+ # section 3:
+ # use the binary table
+ #---------------------------------------------------------------
+ if ( !defined($ws) ) {
+ $ws = $binary_ws_rules{$last_type}{$type};
+ }
+ my $ws_3 = $ws
+ if FORMATTER_DEBUG_FLAG_WHITE;
+
+ #---------------------------------------------------------------
+ # section 4:
+ # some special cases
+ #---------------------------------------------------------------
+ if ( $token eq '(' ) {
+
+ # This will have to be tweaked as tokenization changes.
+ # We usually want a space at '} (', for example:
+ # map { 1 * $_; } ( $y, $M, $w, $d, $h, $m, $s );
+ #
+ # But not others:
+ # &{ $_->[1] }( delete $_[$#_]{ $_->[0] } );
+ # At present, the above & block is marked as type L/R so this case
+ # won't go through here.
+ if ( $last_type eq '}' ) { $ws = WS_YES }
+
+ # NOTE: some older versions of Perl had occasional problems if
+ # spaces are introduced between keywords or functions and opening
+ # parens. So the default is not to do this except is certain
+ # cases. The current Perl seems to tolerate spaces.
+
+ # Space between keyword and '('
+ elsif ( $last_type eq 'k' ) {
+ $ws = WS_NO
+ unless ( $rOpts_space_keyword_paren
+ || $space_after_keyword{$last_token} );
+ }
+
+ # Space between function and '('
+ # -----------------------------------------------------
+ # 'w' and 'i' checks for something like:
+ # myfun( &myfun( ->myfun(
+ # -----------------------------------------------------
+ elsif (( $last_type =~ /^[wU]$/ )
+ || ( $last_type =~ /^[wi]$/ && $last_token =~ /^(\&|->)/ ) )
+ {
+ $ws = WS_NO unless ($rOpts_space_function_paren);
+ }
+
+ # space between something like $i and ( in
+ # for $i ( 0 .. 20 ) {
+ # FIXME: eventually, type 'i' needs to be split into multiple
+ # token types so this can be a hardwired rule.
+ elsif ( $last_type eq 'i' && $last_token =~ /^[\$\%\@]/ ) {
+ $ws = WS_YES;
+ }
+
+ # allow constant function followed by '()' to retain no space
+ elsif ( $last_type eq 'C' && $$rtokens[ $j + 1 ] eq ')' ) {
+ $ws = WS_NO;
+ }
+ }
+
+ # patch for SWITCH/CASE: make space at ']{' optional
+ # since the '{' might begin a case or when block
+ elsif ( ( $token eq '{' && $type ne 'L' ) && $last_token eq ']' ) {
+ $ws = WS_OPTIONAL;
+ }
+
+ # keep space between 'sub' and '{' for anonymous sub definition
+ if ( $type eq '{' ) {
+ if ( $last_token eq 'sub' ) {
+ $ws = WS_YES;
+ }
+
+ # this is needed to avoid no space in '){'
+ if ( $last_token eq ')' && $token eq '{' ) { $ws = WS_YES }
+
+ # avoid any space before the brace or bracket in something like
+ # @opts{'a','b',...}
+ if ( $last_type eq 'i' && $last_token =~ /^\@/ ) {
+ $ws = WS_NO;
+ }
+ }
+
+ elsif ( $type eq 'i' ) {
+
+ # never a space before ->
+ if ( $token =~ /^\-\>/ ) {
+ $ws = WS_NO;
+ }
+ }
+
+ # retain any space between '-' and bare word
+ elsif ( $type eq 'w' || $type eq 'C' ) {
+ $ws = WS_OPTIONAL if $last_type eq '-';
+
+ # never a space before ->
+ if ( $token =~ /^\-\>/ ) {
+ $ws = WS_NO;
+ }
+ }
+
+ # retain any space between '-' and bare word
+ # example: avoid space between 'USER' and '-' here:
+ # $myhash{USER-NAME}='steve';
+ elsif ( $type eq 'm' || $type eq '-' ) {
+ $ws = WS_OPTIONAL if ( $last_type eq 'w' );
+ }
+
+ # always space before side comment
+ elsif ( $type eq '#' ) { $ws = WS_YES if $j > 0 }
+
+ # always preserver whatever space was used after a possible
+ # filehandle (except _) or here doc operator
+ if (
+ $type ne '#'
+ && ( ( $last_type eq 'Z' && $last_token ne '_' )
+ || $last_type eq 'h' )
+ )
+ {
+ $ws = WS_OPTIONAL;
+ }
+
+ my $ws_4 = $ws
+ if FORMATTER_DEBUG_FLAG_WHITE;
+
+ #---------------------------------------------------------------
+ # section 5:
+ # default rules not covered above
+ #---------------------------------------------------------------
+ # if we fall through to here,
+ # look at the pre-defined hash tables for the two tokens, and
+ # if (they are equal) use the common value
+ # if (either is zero or undef) use the other
+ # if (either is -1) use it
+ # That is,
+ # left vs right
+ # 1 vs 1 --> 1
+ # 0 vs 0 --> 0
+ # -1 vs -1 --> -1
+ #
+ # 0 vs -1 --> -1
+ # 0 vs 1 --> 1
+ # 1 vs 0 --> 1
+ # -1 vs 0 --> -1
+ #
+ # -1 vs 1 --> -1
+ # 1 vs -1 --> -1
+ if ( !defined($ws) ) {
+ my $wl = $want_left_space{$type};
+ my $wr = $want_right_space{$last_type};
+ if ( !defined($wl) ) { $wl = 0 }
+ if ( !defined($wr) ) { $wr = 0 }
+ $ws = ( ( $wl == $wr ) || ( $wl == -1 ) || !$wr ) ? $wl : $wr;
+ }
+
+ if ( !defined($ws) ) {
+ $ws = 0;
+ write_diagnostics(
+ "WS flag is undefined for tokens $last_token $token\n");
+ }
+
+ # Treat newline as a whitespace. Otherwise, we might combine
+ # 'Send' and '-recipients' here according to the above rules:
+ # my $msg = new Fax::Send
+ # -recipients => $to,
+ # -data => $data;
+ if ( $ws == 0 && $j == 0 ) { $ws = 1 }
+
+ if ( ( $ws == 0 )
+ && $j > 0
+ && $j < $jmax
+ && ( $last_type !~ /^[Zh]$/ ) )
+ {
+
+ # If this happens, we have a non-fatal but undesirable
+ # hole in the above rules which should be patched.
+ write_diagnostics(
+ "WS flag is zero for tokens $last_token $token\n");
+ }
+ $white_space_flag[$j] = $ws;
+
+ FORMATTER_DEBUG_FLAG_WHITE && do {
+ my $str = substr( $last_token, 0, 15 );
+ $str .= ' ' x ( 16 - length($str) );
+ if ( !defined($ws_1) ) { $ws_1 = "*" }
+ if ( !defined($ws_2) ) { $ws_2 = "*" }
+ if ( !defined($ws_3) ) { $ws_3 = "*" }
+ if ( !defined($ws_4) ) { $ws_4 = "*" }
+ print
+"WHITE: i=$j $str $last_type $type $ws_1 : $ws_2 : $ws_3 : $ws_4 : $ws \n";
+ };
+ }
+ return \@white_space_flag;
+}
+
+{ # begin print_line_of_tokens
+
+ my $rtoken_type;
+ my $rtokens;
+ my $rlevels;
+ my $rslevels;
+ my $rblock_type;
+ my $rcontainer_type;
+ my $rcontainer_environment;
+ my $rtype_sequence;
+ my $input_line;
+ my $rnesting_tokens;
+ my $rci_levels;
+ my $rnesting_blocks;
+
+ my $in_quote;
+ my $python_indentation_level;
+
+ # These local token variables are stored by store_token_to_go:
+ my $block_type;
+ my $ci_level;
+ my $container_environment;
+ my $container_type;
+ my $in_continued_quote;
+ my $level;
+ my $nesting_blocks;
+ my $no_internal_newlines;
+ my $slevel;
+ my $token;
+ my $type;
+ my $type_sequence;
+
+ # routine to pull the jth token from the line of tokens
+ sub extract_token {
+ my $j = shift;
+ $token = $$rtokens[$j];
+ $type = $$rtoken_type[$j];
+ $block_type = $$rblock_type[$j];
+ $container_type = $$rcontainer_type[$j];
+ $container_environment = $$rcontainer_environment[$j];
+ $type_sequence = $$rtype_sequence[$j];
+ $level = $$rlevels[$j];
+ $slevel = $$rslevels[$j];
+ $nesting_blocks = $$rnesting_blocks[$j];
+ $ci_level = $$rci_levels[$j];
+ }
+
+ {
+ my @saved_token;
+
+ sub save_current_token {
+
+ @saved_token = (
+ $block_type, $ci_level,
+ $container_environment, $container_type,
+ $in_continued_quote, $level,
+ $nesting_blocks, $no_internal_newlines,
+ $slevel, $token,
+ $type, $type_sequence,
+ );
+ }
+
+ sub restore_current_token {
+ (
+ $block_type, $ci_level,
+ $container_environment, $container_type,
+ $in_continued_quote, $level,
+ $nesting_blocks, $no_internal_newlines,
+ $slevel, $token,
+ $type, $type_sequence,
+ ) = @saved_token;
+ }
+ }
+
+ # Routine to place the current token into the output stream.
+ # Called once per output token.
+ sub store_token_to_go {
+
+ my $flag = $no_internal_newlines;
+ if ( $_[0] ) { $flag = 1 }
+
+ $tokens_to_go[ ++$max_index_to_go ] = $token;
+ $types_to_go[$max_index_to_go] = $type;
+ $nobreak_to_go[$max_index_to_go] = $flag;
+ $old_breakpoint_to_go[$max_index_to_go] = 0;
+ $forced_breakpoint_to_go[$max_index_to_go] = 0;
+ $block_type_to_go[$max_index_to_go] = $block_type;
+ $type_sequence_to_go[$max_index_to_go] = $type_sequence;
+ $container_environment_to_go[$max_index_to_go] = $container_environment;
+ $nesting_blocks_to_go[$max_index_to_go] = $nesting_blocks;
+ $ci_levels_to_go[$max_index_to_go] = $ci_level;
+ $mate_index_to_go[$max_index_to_go] = -1;
+ $matching_token_to_go[$max_index_to_go] = '';
+ $bond_strength_to_go[$max_index_to_go] = 0;
+
+ # Note: negative levels are currently retained as a diagnostic so that
+ # the 'final indentation level' is correctly reported for bad scripts.
+ # But this means that every use of $level as an index must be checked.
+ # If this becomes too much of a problem, we might give up and just clip
+ # them at zero.
+ ## $levels_to_go[$max_index_to_go] = ( $level > 0 ) ? $level : 0;
+ $levels_to_go[$max_index_to_go] = $level;
+ $nesting_depth_to_go[$max_index_to_go] = ( $slevel >= 0 ) ? $slevel : 0;
+ $lengths_to_go[ $max_index_to_go + 1 ] =
+ $lengths_to_go[$max_index_to_go] + length($token);
+
+ # Define the indentation that this token would have if it started
+ # a new line. We have to do this now because we need to know this
+ # when considering one-line blocks.
+ set_leading_whitespace( $level, $ci_level, $in_continued_quote );
+
+ if ( $type ne 'b' ) {
+ $last_last_nonblank_index_to_go = $last_nonblank_index_to_go;
+ $last_last_nonblank_type_to_go = $last_nonblank_type_to_go;
+ $last_last_nonblank_token_to_go = $last_nonblank_token_to_go;
+ $last_nonblank_index_to_go = $max_index_to_go;
+ $last_nonblank_type_to_go = $type;
+ $last_nonblank_token_to_go = $token;
+ if ( $type eq ',' ) {
+ $comma_count_in_batch++;
+ }
+ }
+
+ FORMATTER_DEBUG_FLAG_STORE && do {
+ my ( $a, $b, $c ) = caller();
+ print
+"STORE: from $a $c: storing token $token type $type lev=$level slev=$slevel at $max_index_to_go\n";
+ };
+ }
+
+ sub insert_new_token_to_go {
+
+ # insert a new token into the output stream. use same level as
+ # previous token; assumes a character at max_index_to_go.
+ save_current_token();
+ ( $token, $type, $slevel, $no_internal_newlines ) = @_;
+
+ if ( $max_index_to_go == UNDEFINED_INDEX ) {
+ warning("code bug: bad call to insert_new_token_to_go\n");
+ }
+ $level = $levels_to_go[$max_index_to_go];
+
+ # FIXME: it seems to be necessary to use the next, rather than
+ # previous, value of this variable when creating a new blank (align.t)
+ #my $slevel = $nesting_depth_to_go[$max_index_to_go];
+ $nesting_blocks = $nesting_blocks_to_go[$max_index_to_go];
+ $ci_level = $ci_levels_to_go[$max_index_to_go];
+ $container_environment = $container_environment_to_go[$max_index_to_go];
+ $in_continued_quote = 0;
+ $block_type = "";
+ $type_sequence = "";
+ store_token_to_go();
+ restore_current_token();
+ return;
+ }
+
+ sub print_line_of_tokens {
+
+ my $line_of_tokens = shift;
+
+ # This routine is called once per input line to process all of
+ # the tokens on that line. This is the first stage of
+ # beautification.
+ #
+ # Full-line comments and blank lines may be processed immediately.
+ #
+ # For normal lines of code, the tokens are stored one-by-one,
+ # via calls to 'sub store_token_to_go', until a known line break
+ # point is reached. Then, the batch of collected tokens is
+ # passed along to 'sub output_line_to_go' for further
+ # processing. This routine decides if there should be
+ # whitespace between each pair of non-white tokens, so later
+ # routines only need to decide on any additional line breaks.
+ # Any whitespace is initally a single space character. Later,
+ # the vertical aligner may expand that to be multiple space
+ # characters if necessary for alignment.
+
+ # extract input line number for error messages
+ $input_line_number = $line_of_tokens->{_line_number};
+
+ $rtoken_type = $line_of_tokens->{_rtoken_type};
+ $rtokens = $line_of_tokens->{_rtokens};
+ $rlevels = $line_of_tokens->{_rlevels};
+ $rslevels = $line_of_tokens->{_rslevels};
+ $rblock_type = $line_of_tokens->{_rblock_type};
+ $rcontainer_type = $line_of_tokens->{_rcontainer_type};
+ $rcontainer_environment = $line_of_tokens->{_rcontainer_environment};
+ $rtype_sequence = $line_of_tokens->{_rtype_sequence};
+ $input_line = $line_of_tokens->{_line_text};
+ $rnesting_tokens = $line_of_tokens->{_rnesting_tokens};
+ $rci_levels = $line_of_tokens->{_rci_levels};
+ $rnesting_blocks = $line_of_tokens->{_rnesting_blocks};
+
+ $in_continued_quote = $starting_in_quote =
+ $line_of_tokens->{_starting_in_quote};
+ $in_quote = $line_of_tokens->{_ending_in_quote};
+ $ending_in_quote = $in_quote;
+ $python_indentation_level =
+ $line_of_tokens->{_python_indentation_level};
+
+ my $j;
+ my $j_next;
+ my $jmax;
+ my $next_nonblank_token;
+ my $next_nonblank_token_type;
+ my $rwhite_space_flag;
+
+ $jmax = @$rtokens - 1;
+ $block_type = "";
+ $container_type = "";
+ $container_environment = "";
+ $type_sequence = "";
+ $no_internal_newlines = 1 - $rOpts_add_newlines;
+ $is_static_block_comment = 0;
+
+ # Handle a continued quote..
+ if ($in_continued_quote) {
+
+ # A line which is entirely a quote or pattern must go out
+ # verbatim. Note: the \n is contained in $input_line.
+ if ( $jmax <= 0 ) {
+ if ( ( $input_line =~ "\t" ) ) {
+ note_embedded_tab();
+ }
+ write_unindented_line("$input_line");
+ $last_line_had_side_comment = 0;
+ return;
+ }
+
+ # prior to version 20010406, perltidy had a bug which placed
+ # continuation indentation before the last line of some multiline
+ # quotes and patterns -- exactly the lines passing this way.
+ # To help find affected lines in scripts run with these
+ # versions, run with '-chk', and it will warn of any quotes or
+ # patterns which might have been modified by these early
+ # versions.
+ if ( $rOpts->{'check-multiline-quotes'} && $input_line =~ /^ / ) {
+ warning(
+"-chk: please check this line for extra leading whitespace\n"
+ );
+ }
+ }
+
+ # Write line verbatim if we are in a formatting skip section
+ if ($in_format_skipping_section) {
+ write_unindented_line("$input_line");
+ $last_line_had_side_comment = 0;
+
+ # Note: extra space appended to comment simplifies pattern matching
+ if ( $jmax == 0
+ && $$rtoken_type[0] eq '#'
+ && ( $$rtokens[0] . " " ) =~ /$format_skipping_pattern_end/o )
+ {
+ $in_format_skipping_section = 0;
+ write_logfile_entry("Exiting formatting skip section\n");
+ }
+ return;
+ }
+
+ # See if we are entering a formatting skip section
+ if ( $rOpts_format_skipping
+ && $jmax == 0
+ && $$rtoken_type[0] eq '#'
+ && ( $$rtokens[0] . " " ) =~ /$format_skipping_pattern_begin/o )
+ {
+ flush();
+ $in_format_skipping_section = 1;
+ write_logfile_entry("Entering formatting skip section\n");
+ write_unindented_line("$input_line");
+ $last_line_had_side_comment = 0;
+ return;
+ }
+
+ # delete trailing blank tokens
+ if ( $jmax > 0 && $$rtoken_type[$jmax] eq 'b' ) { $jmax-- }
+
+ # Handle a blank line..
+ if ( $jmax < 0 ) {
+
+ # For the 'swallow-optional-blank-lines' option, we delete all
+ # old blank lines and let the blank line rules generate any
+ # needed blanks.
+ if ( !$rOpts_swallow_optional_blank_lines ) {
+ flush();
+ $file_writer_object->write_blank_code_line();
+ $last_line_leading_type = 'b';
+ }
+ $last_line_had_side_comment = 0;
+ return;
+ }
+
+ # see if this is a static block comment (starts with ## by default)
+ my $is_static_block_comment_without_leading_space = 0;
+ if ( $jmax == 0
+ && $$rtoken_type[0] eq '#'
+ && $rOpts->{'static-block-comments'}
+ && $input_line =~ /$static_block_comment_pattern/o )
+ {
+ $is_static_block_comment = 1;
+ $is_static_block_comment_without_leading_space =
+ substr( $input_line, 0, 1 ) eq '#';
+ }
+
+ # Check for comments which are line directives
+ # Treat exactly as static block comments without leading space
+ # reference: perlsyn, near end, section Plain Old Comments (Not!)
+ # example: '# line 42 "new_filename.plx"'
+ if (
+ $jmax == 0
+ && $$rtoken_type[0] eq '#'
+ && $input_line =~ /^\# \s*
+ line \s+ (\d+) \s*
+ (?:\s("?)([^"]+)\2)? \s*
+ $/x
+ )
+ {
+ $is_static_block_comment = 1;
+ $is_static_block_comment_without_leading_space = 1;
+ }
+
+ # create a hanging side comment if appropriate
+ if (
+ $jmax == 0
+ && $$rtoken_type[0] eq '#' # only token is a comment
+ && $last_line_had_side_comment # last line had side comment
+ && $input_line =~ /^\s/ # there is some leading space
+ && !$is_static_block_comment # do not make static comment hanging
+ && $rOpts->{'hanging-side-comments'} # user is allowing this
+ )
+ {
+
+ # We will insert an empty qw string at the start of the token list
+ # to force this comment to be a side comment. The vertical aligner
+ # should then line it up with the previous side comment.
+ unshift @$rtoken_type, 'q';
+ unshift @$rtokens, '';
+ unshift @$rlevels, $$rlevels[0];
+ unshift @$rslevels, $$rslevels[0];
+ unshift @$rblock_type, '';
+ unshift @$rcontainer_type, '';
+ unshift @$rcontainer_environment, '';
+ unshift @$rtype_sequence, '';
+ unshift @$rnesting_tokens, $$rnesting_tokens[0];
+ unshift @$rci_levels, $$rci_levels[0];
+ unshift @$rnesting_blocks, $$rnesting_blocks[0];
+ $jmax = 1;
+ }
+
+ # remember if this line has a side comment
+ $last_line_had_side_comment =
+ ( $jmax > 0 && $$rtoken_type[$jmax] eq '#' );
+
+ # Handle a block (full-line) comment..
+ if ( ( $jmax == 0 ) && ( $$rtoken_type[0] eq '#' ) ) {
+
+ if ( $rOpts->{'delete-block-comments'} ) { return }
+
+ if ( $rOpts->{'tee-block-comments'} ) {
+ $file_writer_object->tee_on();
+ }
+
+ destroy_one_line_block();
+ output_line_to_go();
+
+ # output a blank line before block comments
+ if (
+ $last_line_leading_type !~ /^[#b]$/
+ && $rOpts->{'blanks-before-comments'} # only if allowed
+ && !
+ $is_static_block_comment # never before static block comments
+ )
+ {
+ flush(); # switching to new output stream
+ $file_writer_object->write_blank_code_line();
+ $last_line_leading_type = 'b';
+ }
+
+ # TRIM COMMENTS -- This could be turned off as a option
+ $$rtokens[0] =~ s/\s*$//; # trim right end
+
+ if (
+ $rOpts->{'indent-block-comments'}
+ && ( !$rOpts->{'indent-spaced-block-comments'}
+ || $input_line =~ /^\s+/ )
+ && !$is_static_block_comment_without_leading_space
+ )
+ {
+ extract_token(0);
+ store_token_to_go();
+ output_line_to_go();
+ }
+ else {
+ flush(); # switching to new output stream
+ $file_writer_object->write_code_line( $$rtokens[0] . "\n" );
+ $last_line_leading_type = '#';
+ }
+ if ( $rOpts->{'tee-block-comments'} ) {
+ $file_writer_object->tee_off();
+ }
+ return;
+ }
+
+ # compare input/output indentation except for continuation lines
+ # (because they have an unknown amount of initial blank space)
+ # and lines which are quotes (because they may have been outdented)
+ # Note: this test is placed here because we know the continuation flag
+ # at this point, which allows us to avoid non-meaningful checks.
+ my $structural_indentation_level = $$rlevels[0];
+ compare_indentation_levels( $python_indentation_level,
+ $structural_indentation_level )
+ unless ( $python_indentation_level < 0
+ || ( $$rci_levels[0] > 0 )
+ || ( ( $python_indentation_level == 0 ) && $$rtoken_type[0] eq 'Q' )
+ );
+
+ # Patch needed for MakeMaker. Do not break a statement
+ # in which $VERSION may be calculated. See MakeMaker.pm;
+ # this is based on the coding in it.
+ # The first line of a file that matches this will be eval'd:
+ # /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/
+ # Examples:
+ # *VERSION = \'1.01';
+ # ( $VERSION ) = '$Revision: 1959 $ ' =~ /\$Revision:\s+([^\s]+)/;
+ # We will pass such a line straight through without breaking
+ # it unless -npvl is used
+
+ my $is_VERSION_statement = 0;
+
+ if (
+ !$saw_VERSION_in_this_file
+ && $input_line =~ /VERSION/ # quick check to reject most lines
+ && $input_line =~ /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/
+ )
+ {
+ $saw_VERSION_in_this_file = 1;
+ $is_VERSION_statement = 1;
+ write_logfile_entry("passing VERSION line; -npvl deactivates\n");
+ $no_internal_newlines = 1;
+ }
+
+ # take care of indentation-only
+ # NOTE: In previous versions we sent all qw lines out immediately here.
+ # No longer doing this: also write a line which is entirely a 'qw' list
+ # to allow stacking of opening and closing tokens. Note that interior
+ # qw lines will still go out at the end of this routine.
+ if ( $rOpts->{'indent-only'} ) {
+ flush();
+ trim($input_line);
+
+ extract_token(0);
+ $token = $input_line;
+ $type = 'q';
+ $block_type = "";
+ $container_type = "";
+ $container_environment = "";
+ $type_sequence = "";
+ store_token_to_go();
+ output_line_to_go();
+ return;
+ }
+
+ push( @$rtokens, ' ', ' ' ); # making $j+2 valid simplifies coding
+ push( @$rtoken_type, 'b', 'b' );
+ ($rwhite_space_flag) =
+ set_white_space_flag( $jmax, $rtokens, $rtoken_type, $rblock_type );
+
+ # find input tabbing to allow checks for tabbing disagreement
+ ## not used for now
+ ##$input_line_tabbing = "";
+ ##if ( $input_line =~ /^(\s*)/ ) { $input_line_tabbing = $1; }
+
+ # if the buffer hasn't been flushed, add a leading space if
+ # necessary to keep essential whitespace. This is really only
+ # necessary if we are squeezing out all ws.
+ if ( $max_index_to_go >= 0 ) {
+
+ $old_line_count_in_batch++;
+
+ if (
+ is_essential_whitespace(
+ $last_last_nonblank_token,
+ $last_last_nonblank_type,
+ $tokens_to_go[$max_index_to_go],
+ $types_to_go[$max_index_to_go],
+ $$rtokens[0],
+ $$rtoken_type[0]
+ )
+ )
+ {
+ my $slevel = $$rslevels[0];
+ insert_new_token_to_go( ' ', 'b', $slevel,
+ $no_internal_newlines );
+ }
+ }
+
+ # If we just saw the end of an elsif block, write nag message
+ # if we do not see another elseif or an else.
+ if ($looking_for_else) {
+
+ unless ( $$rtokens[0] =~ /^(elsif|else)$/ ) {
+ write_logfile_entry("(No else block)\n");
+ }
+ $looking_for_else = 0;
+ }
+
+ # This is a good place to kill incomplete one-line blocks
+ if ( ( $semicolons_before_block_self_destruct == 0 )
+ && ( $max_index_to_go >= 0 )
+ && ( $types_to_go[$max_index_to_go] eq ';' )
+ && ( $$rtokens[0] ne '}' ) )
+ {
+ destroy_one_line_block();
+ output_line_to_go();
+ }
+
+ # loop to process the tokens one-by-one
+ $type = 'b';
+ $token = "";
+
+ foreach $j ( 0 .. $jmax ) {
+
+ # pull out the local values for this token
+ extract_token($j);
+
+ if ( $type eq '#' ) {
+
+ # trim trailing whitespace
+ # (there is no option at present to prevent this)
+ $token =~ s/\s*$//;
+
+ if (
+ $rOpts->{'delete-side-comments'}
+
+ # delete closing side comments if necessary
+ || ( $rOpts->{'delete-closing-side-comments'}
+ && $token =~ /$closing_side_comment_prefix_pattern/o
+ && $last_nonblank_block_type =~
+ /$closing_side_comment_list_pattern/o )
+ )
+ {
+ if ( $types_to_go[$max_index_to_go] eq 'b' ) {
+ unstore_token_to_go();
+ }
+ last;
+ }
+ }
+
+ # If we are continuing after seeing a right curly brace, flush
+ # buffer unless we see what we are looking for, as in
+ # } else ...
+ if ( $rbrace_follower && $type ne 'b' ) {
+
+ unless ( $rbrace_follower->{$token} ) {
+ output_line_to_go();
+ }
+ $rbrace_follower = undef;
+ }
+
+ $j_next = ( $$rtoken_type[ $j + 1 ] eq 'b' ) ? $j + 2 : $j + 1;
+ $next_nonblank_token = $$rtokens[$j_next];
+ $next_nonblank_token_type = $$rtoken_type[$j_next];
+
+ #--------------------------------------------------------
+ # Start of section to patch token text
+ #--------------------------------------------------------
+
+ # Modify certain tokens here for whitespace
+ # The following is not yet done, but could be:
+ # sub (x x x)
+ if ( $type =~ /^[wit]$/ ) {
+
+ # Examples:
+ # change '$ var' to '$var' etc
+ # '-> new' to '->new'
+ if ( $token =~ /^([\$\&\%\*\@]|\-\>)\s/ ) {
+ $token =~ s/\s*//g;
+ }
+
+ if ( $token =~ /^sub/ ) { $token =~ s/\s+/ /g }
+ }
+
+ # change 'LABEL :' to 'LABEL:'
+ elsif ( $type eq 'J' ) { $token =~ s/\s+//g }
+
+ # patch to add space to something like "x10"
+ # This avoids having to split this token in the pre-tokenizer
+ elsif ( $type eq 'n' ) {
+ if ( $token =~ /^x\d+/ ) { $token =~ s/x/x / }
+ }
+
+ elsif ( $type eq 'Q' ) {
+ note_embedded_tab() if ( $token =~ "\t" );
+
+ # make note of something like '$var = s/xxx/yyy/;'
+ # in case it should have been '$var =~ s/xxx/yyy/;'
+ if (
+ $token =~ /^(s|tr|y|m|\/)/
+ && $last_nonblank_token =~ /^(=|==|!=)$/
+
+ # precededed by simple scalar
+ && $last_last_nonblank_type eq 'i'
+ && $last_last_nonblank_token =~ /^\$/
+
+ # followed by some kind of termination
+ # (but give complaint if we can's see far enough ahead)
+ && $next_nonblank_token =~ /^[; \)\}]$/
+
+ # scalar is not decleared
+ && !(
+ $types_to_go[0] eq 'k'
+ && $tokens_to_go[0] =~ /^(my|our|local)$/
+ )
+ )
+ {
+ my $guess = substr( $last_nonblank_token, 0, 1 ) . '~';
+ complain(
+"Note: be sure you want '$last_nonblank_token' instead of '$guess' here\n"
+ );
+ }
+ }
+
+ # trim blanks from right of qw quotes
+ # (To avoid trimming qw quotes use -ntqw; the tokenizer handles this)
+ elsif ( $type eq 'q' ) {
+ $token =~ s/\s*$//;
+ note_embedded_tab() if ( $token =~ "\t" );
+ }
+
+ #--------------------------------------------------------
+ # End of section to patch token text
+ #--------------------------------------------------------
+
+ # insert any needed whitespace
+ if ( ( $type ne 'b' )
+ && ( $max_index_to_go >= 0 )
+ && ( $types_to_go[$max_index_to_go] ne 'b' )
+ && $rOpts_add_whitespace )
+ {
+ my $ws = $$rwhite_space_flag[$j];
+
+ if ( $ws == 1 ) {
+ insert_new_token_to_go( ' ', 'b', $slevel,
+ $no_internal_newlines );
+ }
+ }
+
+ # Do not allow breaks which would promote a side comment to a
+ # block comment. In order to allow a break before an opening
+ # or closing BLOCK, followed by a side comment, those sections
+ # of code will handle this flag separately.
+ my $side_comment_follows = ( $next_nonblank_token_type eq '#' );
+ my $is_opening_BLOCK =
+ ( $type eq '{'
+ && $token eq '{'
+ && $block_type
+ && $block_type ne 't' );
+ my $is_closing_BLOCK =
+ ( $type eq '}'
+ && $token eq '}'
+ && $block_type
+ && $block_type ne 't' );
+
+ if ( $side_comment_follows
+ && !$is_opening_BLOCK
+ && !$is_closing_BLOCK )
+ {
+ $no_internal_newlines = 1;
+ }
+
+ # We're only going to handle breaking for code BLOCKS at this
+ # (top) level. Other indentation breaks will be handled by
+ # sub scan_list, which is better suited to dealing with them.
+ if ($is_opening_BLOCK) {
+
+ # Tentatively output this token. This is required before
+ # calling starting_one_line_block. We may have to unstore
+ # it, though, if we have to break before it.
+ store_token_to_go($side_comment_follows);
+
+ # Look ahead to see if we might form a one-line block
+ my $too_long =
+ starting_one_line_block( $j, $jmax, $level, $slevel,
+ $ci_level, $rtokens, $rtoken_type, $rblock_type );
+ clear_breakpoint_undo_stack();
+
+ # to simplify the logic below, set a flag to indicate if
+ # this opening brace is far from the keyword which introduces it
+ my $keyword_on_same_line = 1;
+ if ( ( $max_index_to_go >= 0 )
+ && ( $last_nonblank_type eq ')' ) )
+ {
+ if ( $block_type =~ /^(if|else|elsif)$/
+ && ( $tokens_to_go[0] eq '}' )
+ && $rOpts_cuddled_else )
+ {
+ $keyword_on_same_line = 1;
+ }
+ elsif ( ( $slevel < $nesting_depth_to_go[0] ) || $too_long )
+ {
+ $keyword_on_same_line = 0;
+ }
+ }
+
+ # decide if user requested break before '{'
+ my $want_break =
+
+ # use -bl flag if not a sub block of any type
+ $block_type !~ /^sub/
+ ? $rOpts->{'opening-brace-on-new-line'}
+
+ # use -sbl flag unless this is an anonymous sub block
+ : $block_type !~ /^sub\W*$/
+ ? $rOpts->{'opening-sub-brace-on-new-line'}
+
+ # do not break for anonymous subs
+ : 0;
+
+ # Break before an opening '{' ...
+ if (
+
+ # if requested
+ $want_break
+
+ # and we were unable to start looking for a block,
+ && $index_start_one_line_block == UNDEFINED_INDEX
+
+ # or if it will not be on same line as its keyword, so that
+ # it will be outdented (eval.t, overload.t), and the user
+ # has not insisted on keeping it on the right
+ || ( !$keyword_on_same_line
+ && !$rOpts->{'opening-brace-always-on-right'} )
+
+ )
+ {
+
+ # but only if allowed
+ unless ($no_internal_newlines) {
+
+ # since we already stored this token, we must unstore it
+ unstore_token_to_go();
+
+ # then output the line
+ output_line_to_go();
+
+ # and now store this token at the start of a new line
+ store_token_to_go($side_comment_follows);
+ }
+ }
+
+ # Now update for side comment
+ if ($side_comment_follows) { $no_internal_newlines = 1 }
+
+ # now output this line
+ unless ($no_internal_newlines) {
+ output_line_to_go();
+ }
+ }
+
+ elsif ($is_closing_BLOCK) {
+
+ # If there is a pending one-line block ..
+ if ( $index_start_one_line_block != UNDEFINED_INDEX ) {
+
+ # we have to terminate it if..
+ if (
+
+ # it is too long (final length may be different from
+ # initial estimate). note: must allow 1 space for this token
+ excess_line_length( $index_start_one_line_block,
+ $max_index_to_go ) >= 0
+
+ # or if it has too many semicolons
+ || ( $semicolons_before_block_self_destruct == 0
+ && $last_nonblank_type ne ';' )
+ )
+ {
+ destroy_one_line_block();
+ }
+ }
+
+ # put a break before this closing curly brace if appropriate
+ unless ( $no_internal_newlines
+ || $index_start_one_line_block != UNDEFINED_INDEX )
+ {
+
+ # add missing semicolon if ...
+ # there are some tokens
+ if (
+ ( $max_index_to_go > 0 )
+
+ # and we don't have one
+ && ( $last_nonblank_type ne ';' )
+
+ # patch until some block type issues are fixed:
+ # Do not add semi-colon for block types '{',
+ # '}', and ';' because we cannot be sure yet
+ # that this is a block and not an anonomyous
+ # hash (blktype.t, blktype1.t)
+ && ( $block_type !~ /^[\{\};]$/ )
+
+ # it seems best not to add semicolons in these
+ # special block types: sort|map|grep
+ && ( !$is_sort_map_grep{$block_type} )
+
+ # and we are allowed to do so.
+ && $rOpts->{'add-semicolons'}
+ )
+ {
+
+ save_current_token();
+ $token = ';';
+ $type = ';';
+ $level = $levels_to_go[$max_index_to_go];
+ $slevel = $nesting_depth_to_go[$max_index_to_go];
+ $nesting_blocks =
+ $nesting_blocks_to_go[$max_index_to_go];
+ $ci_level = $ci_levels_to_go[$max_index_to_go];
+ $block_type = "";
+ $container_type = "";
+ $container_environment = "";
+ $type_sequence = "";
+
+ # Note - we remove any blank AFTER extracting its
+ # parameters such as level, etc, above
+ if ( $types_to_go[$max_index_to_go] eq 'b' ) {
+ unstore_token_to_go();
+ }
+ store_token_to_go();
+
+ note_added_semicolon();
+ restore_current_token();
+ }
+
+ # then write out everything before this closing curly brace
+ output_line_to_go();
+
+ }
+
+ # Now update for side comment
+ if ($side_comment_follows) { $no_internal_newlines = 1 }
+
+ # store the closing curly brace
+ store_token_to_go();
+
+ # ok, we just stored a closing curly brace. Often, but
+ # not always, we want to end the line immediately.
+ # So now we have to check for special cases.
+
+ # if this '}' successfully ends a one-line block..
+ my $is_one_line_block = 0;
+ my $keep_going = 0;
+ if ( $index_start_one_line_block != UNDEFINED_INDEX ) {
+
+ # Remember the type of token just before the
+ # opening brace. It would be more general to use
+ # a stack, but this will work for one-line blocks.
+ $is_one_line_block =
+ $types_to_go[$index_start_one_line_block];
+
+ # we have to actually make it by removing tentative
+ # breaks that were set within it
+ undo_forced_breakpoint_stack(0);
+ set_nobreaks( $index_start_one_line_block,
+ $max_index_to_go - 1 );
+
+ # then re-initialize for the next one-line block
+ destroy_one_line_block();
+
+ # then decide if we want to break after the '}' ..
+ # We will keep going to allow certain brace followers as in:
+ # do { $ifclosed = 1; last } unless $losing;
+ #
+ # But make a line break if the curly ends a
+ # significant block:
+ if (
+ $is_block_without_semicolon{$block_type}
+
+ # if needless semicolon follows we handle it later
+ && $next_nonblank_token ne ';'
+ )
+ {
+ output_line_to_go() unless ($no_internal_newlines);
+ }
+ }
+
+ # set string indicating what we need to look for brace follower
+ # tokens
+ if ( $block_type eq 'do' ) {
+ $rbrace_follower = \%is_do_follower;
+ }
+ elsif ( $block_type =~ /^(if|elsif|unless)$/ ) {
+ $rbrace_follower = \%is_if_brace_follower;
+ }
+ elsif ( $block_type eq 'else' ) {
+ $rbrace_follower = \%is_else_brace_follower;
+ }
+
+ # added eval for borris.t
+ elsif ($is_sort_map_grep_eval{$block_type}
+ || $is_one_line_block eq 'G' )
+ {
+ $rbrace_follower = undef;
+ $keep_going = 1;
+ }
+
+ # anonymous sub
+ elsif ( $block_type =~ /^sub\W*$/ ) {
+
+ if ($is_one_line_block) {
+ $rbrace_follower = \%is_anon_sub_1_brace_follower;
+ }
+ else {
+ $rbrace_follower = \%is_anon_sub_brace_follower;
+ }
+ }
+
+ # None of the above: specify what can follow a closing
+ # brace of a block which is not an
+ # if/elsif/else/do/sort/map/grep/eval
+ # Testfiles:
+ # 'Toolbar.pm', 'Menubar.pm', bless.t, '3rules.pl', 'break1.t
+ else {
+ $rbrace_follower = \%is_other_brace_follower;
+ }
+
+ # See if an elsif block is followed by another elsif or else;
+ # complain if not.
+ if ( $block_type eq 'elsif' ) {
+
+ if ( $next_nonblank_token_type eq 'b' ) { # end of line?
+ $looking_for_else = 1; # ok, check on next line
+ }
+ else {
+
+ unless ( $next_nonblank_token =~ /^(elsif|else)$/ ) {
+ write_logfile_entry("No else block :(\n");
+ }
+ }
+ }
+
+ # keep going after certain block types (map,sort,grep,eval)
+ # added eval for borris.t
+ if ($keep_going) {
+
+ # keep going
+ }
+
+ # if no more tokens, postpone decision until re-entring
+ elsif ( ( $next_nonblank_token_type eq 'b' )
+ && $rOpts_add_newlines )
+ {
+ unless ($rbrace_follower) {
+ output_line_to_go() unless ($no_internal_newlines);
+ }
+ }
+
+ elsif ($rbrace_follower) {
+
+ unless ( $rbrace_follower->{$next_nonblank_token} ) {
+ output_line_to_go() unless ($no_internal_newlines);
+ }
+ $rbrace_follower = undef;
+ }
+
+ else {
+ output_line_to_go() unless ($no_internal_newlines);
+ }
+
+ } # end treatment of closing block token
+
+ # handle semicolon
+ elsif ( $type eq ';' ) {
+
+ # kill one-line blocks with too many semicolons
+ $semicolons_before_block_self_destruct--;
+ if (
+ ( $semicolons_before_block_self_destruct < 0 )
+ || ( $semicolons_before_block_self_destruct == 0
+ && $next_nonblank_token_type !~ /^[b\}]$/ )
+ )
+ {
+ destroy_one_line_block();
+ }
+
+ # Remove unnecessary semicolons, but not after bare
+ # blocks, where it could be unsafe if the brace is
+ # mistokenized.
+ if (
+ (
+ $last_nonblank_token eq '}'
+ && (
+ $is_block_without_semicolon{
+ $last_nonblank_block_type}
+ || $last_nonblank_block_type =~ /^sub\s+\w/
+ || $last_nonblank_block_type =~ /^\w+:$/ )
+ )
+ || $last_nonblank_type eq ';'
+ )
+ {
+
+ if (
+ $rOpts->{'delete-semicolons'}
+
+ # don't delete ; before a # because it would promote it
+ # to a block comment
+ && ( $next_nonblank_token_type ne '#' )
+ )
+ {
+ note_deleted_semicolon();
+ output_line_to_go()
+ unless ( $no_internal_newlines
+ || $index_start_one_line_block != UNDEFINED_INDEX );
+ next;
+ }
+ else {
+ write_logfile_entry("Extra ';'\n");
+ }
+ }
+ store_token_to_go();
+
+ output_line_to_go()
+ unless ( $no_internal_newlines
+ || ( $rOpts_keep_interior_semicolons && $j < $jmax )
+ || ( $next_nonblank_token eq '}' ) );
+
+ }
+
+ # handle here_doc target string
+ elsif ( $type eq 'h' ) {
+ $no_internal_newlines =
+ 1; # no newlines after seeing here-target
+ destroy_one_line_block();
+ store_token_to_go();
+ }
+
+ # handle all other token types
+ else {
+
+ # if this is a blank...
+ if ( $type eq 'b' ) {
+
+ # make it just one character
+ $token = ' ' if $rOpts_add_whitespace;
+
+ # delete it if unwanted by whitespace rules
+ # or we are deleting all whitespace
+ my $ws = $$rwhite_space_flag[ $j + 1 ];
+ if ( ( defined($ws) && $ws == -1 )
+ || $rOpts_delete_old_whitespace )
+ {
+
+ # unless it might make a syntax error
+ next
+ unless is_essential_whitespace(
+ $last_last_nonblank_token,
+ $last_last_nonblank_type,
+ $tokens_to_go[$max_index_to_go],
+ $types_to_go[$max_index_to_go],
+ $$rtokens[ $j + 1 ],
+ $$rtoken_type[ $j + 1 ]
+ );
+ }
+ }
+ store_token_to_go();
+ }
+
+ # remember two previous nonblank OUTPUT tokens
+ if ( $type ne '#' && $type ne 'b' ) {
+ $last_last_nonblank_token = $last_nonblank_token;
+ $last_last_nonblank_type = $last_nonblank_type;
+ $last_nonblank_token = $token;
+ $last_nonblank_type = $type;
+ $last_nonblank_block_type = $block_type;
+ }
+
+ # unset the continued-quote flag since it only applies to the
+ # first token, and we want to resume normal formatting if
+ # there are additional tokens on the line
+ $in_continued_quote = 0;
+
+ } # end of loop over all tokens in this 'line_of_tokens'
+
+ # we have to flush ..
+ if (
+
+ # if there is a side comment
+ ( ( $type eq '#' ) && !$rOpts->{'delete-side-comments'} )
+
+ # if this line ends in a quote
+ # NOTE: This is critically important for insuring that quoted lines
+ # do not get processed by things like -sot and -sct
+ || $in_quote
+
+ # if this is a VERSION statement
+ || $is_VERSION_statement
+
+ # to keep a label on one line if that is how it is now
+ || ( ( $type eq 'J' ) && ( $max_index_to_go == 0 ) )
+
+ # if we are instructed to keep all old line breaks
+ || !$rOpts->{'delete-old-newlines'}
+ )
+ {
+ destroy_one_line_block();
+ output_line_to_go();
+ }
+
+ # mark old line breakpoints in current output stream
+ if ( $max_index_to_go >= 0 && !$rOpts_ignore_old_breakpoints ) {
+ $old_breakpoint_to_go[$max_index_to_go] = 1;
+ }
+ } # end sub print_line_of_tokens
+} # end print_line_of_tokens
+
+# sub output_line_to_go sends one logical line of tokens on down the
+# pipeline to the VerticalAligner package, breaking the line into continuation
+# lines as necessary. The line of tokens is ready to go in the "to_go"
+# arrays.
+sub output_line_to_go {
+
+ # debug stuff; this routine can be called from many points
+ FORMATTER_DEBUG_FLAG_OUTPUT && do {
+ my ( $a, $b, $c ) = caller;
+ write_diagnostics(
+"OUTPUT: output_line_to_go called: $a $c $last_nonblank_type $last_nonblank_token, one_line=$index_start_one_line_block, tokens to write=$max_index_to_go\n"
+ );
+ my $output_str = join "", @tokens_to_go[ 0 .. $max_index_to_go ];
+ write_diagnostics("$output_str\n");
+ };
+
+ # just set a tentative breakpoint if we might be in a one-line block
+ if ( $index_start_one_line_block != UNDEFINED_INDEX ) {
+ set_forced_breakpoint($max_index_to_go);
+ return;
+ }
+
+ my $cscw_block_comment;
+ $cscw_block_comment = add_closing_side_comment()
+ if ( $rOpts->{'closing-side-comments'} && $max_index_to_go >= 0 );
+
+ match_opening_and_closing_tokens();
+
+ # tell the -lp option we are outputting a batch so it can close
+ # any unfinished items in its stack
+ finish_lp_batch();
+
+ # If this line ends in a code block brace, set breaks at any
+ # previous closing code block braces to breakup a chain of code
+ # blocks on one line. This is very rare but can happen for
+ # user-defined subs. For example we might be looking at this:
+ # BOOL { $server_data{uptime} > 0; } NUM { $server_data{load}; } STR {
+ my $saw_good_break = 0; # flag to force breaks even if short line
+ if (
+
+ # looking for opening or closing block brace
+ $block_type_to_go[$max_index_to_go]
+
+ # but not one of these which are never duplicated on a line:
+ # until|while|for|if|elsif|else
+ && !$is_block_without_semicolon{ $block_type_to_go[$max_index_to_go] }
+ )
+ {
+ my $lev = $nesting_depth_to_go[$max_index_to_go];
+
+ # Walk backwards from the end and
+ # set break at any closing block braces at the same level.
+ # But quit if we are not in a chain of blocks.
+ for ( my $i = $max_index_to_go - 1 ; $i >= 0 ; $i-- ) {
+ last if ( $levels_to_go[$i] < $lev ); # stop at a lower level
+ next if ( $levels_to_go[$i] > $lev ); # skip past higher level
+
+ if ( $block_type_to_go[$i] ) {
+ if ( $tokens_to_go[$i] eq '}' ) {
+ set_forced_breakpoint($i);
+ $saw_good_break = 1;
+ }
+ }
+
+ # quit if we see anything besides words, function, blanks
+ # at this level
+ elsif ( $types_to_go[$i] !~ /^[\(\)Gwib]$/ ) { last }
+ }
+ }
+
+ my $imin = 0;
+ my $imax = $max_index_to_go;
+
+ # trim any blank tokens
+ if ( $max_index_to_go >= 0 ) {
+ if ( $types_to_go[$imin] eq 'b' ) { $imin++ }
+ if ( $types_to_go[$imax] eq 'b' ) { $imax-- }
+ }
+
+ # anything left to write?
+ if ( $imin <= $imax ) {
+
+ # add a blank line before certain key types
+ if ( $last_line_leading_type !~ /^[#b]/ ) {
+ my $want_blank = 0;
+ my $leading_token = $tokens_to_go[$imin];
+ my $leading_type = $types_to_go[$imin];
+
+ # blank lines before subs except declarations and one-liners
+ # MCONVERSION LOCATION - for sub tokenization change
+ if ( $leading_token =~ /^(sub\s)/ && $leading_type eq 'i' ) {
+ $want_blank = ( $rOpts->{'blanks-before-subs'} )
+ && (
+ terminal_type( \@types_to_go, \@block_type_to_go, $imin,
+ $imax ) !~ /^[\;\}]$/
+ );
+ }
+
+ # break before all package declarations
+ # MCONVERSION LOCATION - for tokenizaton change
+ elsif ($leading_token =~ /^(package\s)/
+ && $leading_type eq 'i' )
+ {
+ $want_blank = ( $rOpts->{'blanks-before-subs'} );
+ }
+
+ # break before certain key blocks except one-liners
+ if ( $leading_token =~ /^(BEGIN|END)$/ && $leading_type eq 'k' ) {
+ $want_blank = ( $rOpts->{'blanks-before-subs'} )
+ && (
+ terminal_type( \@types_to_go, \@block_type_to_go, $imin,
+ $imax ) ne '}'
+ );
+ }
+
+ # Break before certain block types if we haven't had a
+ # break at this level for a while. This is the
+ # difficult decision..
+ elsif ($leading_token =~ /^(unless|if|while|until|for|foreach)$/
+ && $leading_type eq 'k' )
+ {
+ my $lc = $nonblank_lines_at_depth[$last_line_leading_level];
+ if ( !defined($lc) ) { $lc = 0 }
+
+ $want_blank =
+ $rOpts->{'blanks-before-blocks'}
+ && $lc >= $rOpts->{'long-block-line-count'}
+ && $file_writer_object->get_consecutive_nonblank_lines() >=
+ $rOpts->{'long-block-line-count'}
+ && (
+ terminal_type( \@types_to_go, \@block_type_to_go, $imin,
+ $imax ) ne '}'
+ );
+ }
+
+ if ($want_blank) {
+
+ # future: send blank line down normal path to VerticalAligner
+ Perl::Tidy::VerticalAligner::flush();
+ $file_writer_object->write_blank_code_line();
+ }
+ }
+
+ # update blank line variables and count number of consecutive
+ # non-blank, non-comment lines at this level
+ $last_last_line_leading_level = $last_line_leading_level;
+ $last_line_leading_level = $levels_to_go[$imin];
+ if ( $last_line_leading_level < 0 ) { $last_line_leading_level = 0 }
+ $last_line_leading_type = $types_to_go[$imin];
+ if ( $last_line_leading_level == $last_last_line_leading_level
+ && $last_line_leading_type ne 'b'
+ && $last_line_leading_type ne '#'
+ && defined( $nonblank_lines_at_depth[$last_line_leading_level] ) )
+ {
+ $nonblank_lines_at_depth[$last_line_leading_level]++;
+ }
+ else {
+ $nonblank_lines_at_depth[$last_line_leading_level] = 1;
+ }
+
+ FORMATTER_DEBUG_FLAG_FLUSH && do {
+ my ( $package, $file, $line ) = caller;
+ print
+"FLUSH: flushing from $package $file $line, types= $types_to_go[$imin] to $types_to_go[$imax]\n";
+ };
+
+ # add a couple of extra terminal blank tokens
+ pad_array_to_go();
+
+ # set all forced breakpoints for good list formatting
+ my $is_long_line = excess_line_length( $imin, $max_index_to_go ) > 0;
+
+ if (
+ $max_index_to_go > 0
+ && (
+ $is_long_line
+ || $old_line_count_in_batch > 1
+ || is_unbalanced_batch()
+ || (
+ $comma_count_in_batch
+ && ( $rOpts_maximum_fields_per_table > 0
+ || $rOpts_comma_arrow_breakpoints == 0 )
+ )
+ )
+ )
+ {
+ $saw_good_break ||= scan_list();
+ }
+
+ # let $ri_first and $ri_last be references to lists of
+ # first and last tokens of line fragments to output..
+ my ( $ri_first, $ri_last );
+
+ # write a single line if..
+ if (
+
+ # we aren't allowed to add any newlines
+ !$rOpts_add_newlines
+
+ # or, we don't already have an interior breakpoint
+ # and we didn't see a good breakpoint
+ || (
+ !$forced_breakpoint_count
+ && !$saw_good_break
+
+ # and this line is 'short'
+ && !$is_long_line
+ )
+ )
+ {
+ @$ri_first = ($imin);
+ @$ri_last = ($imax);
+ }
+
+ # otherwise use multiple lines
+ else {
+
+ ( $ri_first, $ri_last, my $colon_count ) =
+ set_continuation_breaks($saw_good_break);
+
+ break_all_chain_tokens( $ri_first, $ri_last );
+
+ break_equals( $ri_first, $ri_last );
+
+ # now we do a correction step to clean this up a bit
+ # (The only time we would not do this is for debugging)
+ if ( $rOpts->{'recombine'} ) {
+ ( $ri_first, $ri_last ) =
+ recombine_breakpoints( $ri_first, $ri_last );
+ }
+
+ insert_final_breaks( $ri_first, $ri_last ) if $colon_count;
+ }
+
+ # do corrector step if -lp option is used
+ my $do_not_pad = 0;
+ if ($rOpts_line_up_parentheses) {
+ $do_not_pad = correct_lp_indentation( $ri_first, $ri_last );
+ }
+ send_lines_to_vertical_aligner( $ri_first, $ri_last, $do_not_pad );
+ }
+ prepare_for_new_input_lines();
+
+ # output any new -cscw block comment
+ if ($cscw_block_comment) {
+ flush();
+ $file_writer_object->write_code_line( $cscw_block_comment . "\n" );
+ }
+}
+
+sub note_added_semicolon {
+ $last_added_semicolon_at = $input_line_number;
+ if ( $added_semicolon_count == 0 ) {
+ $first_added_semicolon_at = $last_added_semicolon_at;
+ }
+ $added_semicolon_count++;
+ write_logfile_entry("Added ';' here\n");
+}
+
+sub note_deleted_semicolon {
+ $last_deleted_semicolon_at = $input_line_number;
+ if ( $deleted_semicolon_count == 0 ) {
+ $first_deleted_semicolon_at = $last_deleted_semicolon_at;
+ }
+ $deleted_semicolon_count++;
+ write_logfile_entry("Deleted unnecessary ';'\n"); # i hope ;)
+}
+
+sub note_embedded_tab {
+ $embedded_tab_count++;
+ $last_embedded_tab_at = $input_line_number;
+ if ( !$first_embedded_tab_at ) {
+ $first_embedded_tab_at = $last_embedded_tab_at;
+ }
+
+ if ( $embedded_tab_count <= MAX_NAG_MESSAGES ) {
+ write_logfile_entry("Embedded tabs in quote or pattern\n");
+ }
+}
+
+sub starting_one_line_block {
+
+ # after seeing an opening curly brace, look for the closing brace
+ # and see if the entire block will fit on a line. This routine is
+ # not always right because it uses the old whitespace, so a check
+ # is made later (at the closing brace) to make sure we really
+ # have a one-line block. We have to do this preliminary check,
+ # though, because otherwise we would always break at a semicolon
+ # within a one-line block if the block contains multiple statements.
+
+ my ( $j, $jmax, $level, $slevel, $ci_level, $rtokens, $rtoken_type,
+ $rblock_type )
+ = @_;
+
+ # kill any current block - we can only go 1 deep
+ destroy_one_line_block();
+
+ # return value:
+ # 1=distance from start of block to opening brace exceeds line length
+ # 0=otherwise
+
+ my $i_start = 0;
+
+ # shouldn't happen: there must have been a prior call to
+ # store_token_to_go to put the opening brace in the output stream
+ if ( $max_index_to_go < 0 ) {
+ warning("program bug: store_token_to_go called incorrectly\n");
+ report_definite_bug();
+ }
+ else {
+
+ # cannot use one-line blocks with cuddled else else/elsif lines
+ if ( ( $tokens_to_go[0] eq '}' ) && $rOpts_cuddled_else ) {
+ return 0;
+ }
+ }
+
+ my $block_type = $$rblock_type[$j];
+
+ # find the starting keyword for this block (such as 'if', 'else', ...)
+
+ if ( $block_type =~ /^[\{\}\;\:]$/ ) {
+ $i_start = $max_index_to_go;
+ }
+
+ elsif ( $last_last_nonblank_token_to_go eq ')' ) {
+
+ # For something like "if (xxx) {", the keyword "if" will be
+ # just after the most recent break. This will be 0 unless
+ # we have just killed a one-line block and are starting another.
+ # (doif.t)
+ $i_start = $index_max_forced_break + 1;
+ if ( $types_to_go[$i_start] eq 'b' ) {
+ $i_start++;
+ }
+
+ unless ( $tokens_to_go[$i_start] eq $block_type ) {
+ return 0;
+ }
+ }
+
+ # the previous nonblank token should start these block types
+ elsif (
+ ( $last_last_nonblank_token_to_go eq $block_type )
+ || ( $block_type =~ /^sub/
+ && $last_last_nonblank_token_to_go =~ /^sub/ )
+ )
+ {
+ $i_start = $last_last_nonblank_index_to_go;
+ }
+
+ # patch for SWITCH/CASE to retain one-line case/when blocks
+ elsif ( $block_type eq 'case' || $block_type eq 'when' ) {
+ $i_start = $index_max_forced_break + 1;
+ if ( $types_to_go[$i_start] eq 'b' ) {
+ $i_start++;
+ }
+ unless ( $tokens_to_go[$i_start] eq $block_type ) {
+ return 0;
+ }
+ }
+
+ else {
+ return 1;
+ }
+
+ my $pos = total_line_length( $i_start, $max_index_to_go ) - 1;
+
+ my $i;
+
+ # see if length is too long to even start
+ if ( $pos > $rOpts_maximum_line_length ) {
+ return 1;
+ }
+
+ for ( $i = $j + 1 ; $i <= $jmax ; $i++ ) {
+
+ # old whitespace could be arbitrarily large, so don't use it
+ if ( $$rtoken_type[$i] eq 'b' ) { $pos += 1 }
+ else { $pos += length( $$rtokens[$i] ) }
+
+ # Return false result if we exceed the maximum line length,
+ if ( $pos > $rOpts_maximum_line_length ) {
+ return 0;
+ }
+
+ # or encounter another opening brace before finding the closing brace.
+ elsif ($$rtokens[$i] eq '{'
+ && $$rtoken_type[$i] eq '{'
+ && $$rblock_type[$i] )
+ {
+ return 0;
+ }
+
+ # if we find our closing brace..
+ elsif ($$rtokens[$i] eq '}'
+ && $$rtoken_type[$i] eq '}'
+ && $$rblock_type[$i] )
+ {
+
+ # be sure any trailing comment also fits on the line
+ my $i_nonblank =
+ ( $$rtoken_type[ $i + 1 ] eq 'b' ) ? $i + 2 : $i + 1;
+
+ if ( $$rtoken_type[$i_nonblank] eq '#' ) {
+ $pos += length( $$rtokens[$i_nonblank] );
+
+ if ( $i_nonblank > $i + 1 ) {
+ $pos += length( $$rtokens[ $i + 1 ] );
+ }
+
+ if ( $pos > $rOpts_maximum_line_length ) {
+ return 0;
+ }
+ }
+
+ # ok, it's a one-line block
+ create_one_line_block( $i_start, 20 );
+ return 0;
+ }
+
+ # just keep going for other characters
+ else {
+ }
+ }
+
+ # Allow certain types of new one-line blocks to form by joining
+ # input lines. These can be safely done, but for other block types,
+ # we keep old one-line blocks but do not form new ones. It is not
+ # always a good idea to make as many one-line blocks as possible,
+ # so other types are not done. The user can always use -mangle.
+ if ( $is_sort_map_grep_eval{$block_type} ) {
+ create_one_line_block( $i_start, 1 );
+ }
+
+ return 0;
+}
+
+sub unstore_token_to_go {
+
+ # remove most recent token from output stream
+ if ( $max_index_to_go > 0 ) {
+ $max_index_to_go--;
+ }
+ else {
+ $max_index_to_go = UNDEFINED_INDEX;
+ }
+
+}
+
+sub want_blank_line {
+ flush();
+ $file_writer_object->want_blank_line();
+}
+
+sub write_unindented_line {
+ flush();
+ $file_writer_object->write_line( $_[0] );
+}
+
+sub undo_lp_ci {
+
+ # If there is a single, long parameter within parens, like this:
+ #
+ # $self->command( "/msg "
+ # . $infoline->chan
+ # . " You said $1, but did you know that it's square was "
+ # . $1 * $1 . " ?" );
+ #
+ # we can remove the continuation indentation of the 2nd and higher lines
+ # to achieve this effect, which is more pleasing:
+ #
+ # $self->command("/msg "
+ # . $infoline->chan
+ # . " You said $1, but did you know that it's square was "
+ # . $1 * $1 . " ?");
+
+ my ( $line_open, $i_start, $closing_index, $ri_first, $ri_last ) = @_;
+ my $max_line = @$ri_first - 1;
+
+ # must be multiple lines
+ return unless $max_line > $line_open;
+
+ my $lev_start = $levels_to_go[$i_start];
+ my $ci_start_plus = 1 + $ci_levels_to_go[$i_start];
+
+ # see if all additional lines in this container have continuation
+ # indentation
+ my $n;
+ my $line_1 = 1 + $line_open;
+ for ( $n = $line_1 ; $n <= $max_line ; ++$n ) {
+ my $ibeg = $$ri_first[$n];
+ my $iend = $$ri_last[$n];
+ if ( $ibeg eq $closing_index ) { $n--; last }
+ return if ( $lev_start != $levels_to_go[$ibeg] );
+ return if ( $ci_start_plus != $ci_levels_to_go[$ibeg] );
+ last if ( $closing_index <= $iend );
+ }
+
+ # we can reduce the indentation of all continuation lines
+ my $continuation_line_count = $n - $line_open;
+ @ci_levels_to_go[ @$ri_first[ $line_1 .. $n ] ] =
+ (0) x ($continuation_line_count);
+ @leading_spaces_to_go[ @$ri_first[ $line_1 .. $n ] ] =
+ @reduced_spaces_to_go[ @$ri_first[ $line_1 .. $n ] ];
+}
+
+sub set_logical_padding {
+
+ # Look at a batch of lines and see if extra padding can improve the
+ # alignment when there are certain leading operators. Here is an
+ # example, in which some extra space is introduced before
+ # '( $year' to make it line up with the subsequent lines:
+ #
+ # if ( ( $Year < 1601 )
+ # || ( $Year > 2899 )
+ # || ( $EndYear < 1601 )
+ # || ( $EndYear > 2899 ) )
+ # {
+ # &Error_OutOfRange;
+ # }
+ #
+ my ( $ri_first, $ri_last ) = @_;
+ my $max_line = @$ri_first - 1;
+
+ my ( $ibeg, $ibeg_next, $ibegm, $iend, $iendm, $ipad, $line, $pad_spaces,
+ $tok_next, $type_next, $has_leading_op_next, $has_leading_op );
+
+ # looking at each line of this batch..
+ foreach $line ( 0 .. $max_line - 1 ) {
+
+ # see if the next line begins with a logical operator
+ $ibeg = $$ri_first[$line];
+ $iend = $$ri_last[$line];
+ $ibeg_next = $$ri_first[ $line + 1 ];
+ $tok_next = $tokens_to_go[$ibeg_next];
+ $type_next = $types_to_go[$ibeg_next];
+
+ $has_leading_op_next = ( $tok_next =~ /^\w/ )
+ ? $is_chain_operator{$tok_next} # + - * / : ? && ||
+ : $is_chain_operator{$type_next}; # and, or
+
+ next unless ($has_leading_op_next);
+
+ # next line must not be at lesser depth
+ next
+ if ( $nesting_depth_to_go[$ibeg] > $nesting_depth_to_go[$ibeg_next] );
+
+ # identify the token in this line to be padded on the left
+ $ipad = undef;
+
+ # handle lines at same depth...
+ if ( $nesting_depth_to_go[$ibeg] == $nesting_depth_to_go[$ibeg_next] ) {
+
+ # if this is not first line of the batch ...
+ if ( $line > 0 ) {
+
+ # and we have leading operator..
+ next if $has_leading_op;
+
+ # Introduce padding if..
+ # 1. the previous line is at lesser depth, or
+ # 2. the previous line ends in an assignment
+ # 3. the previous line ends in a 'return'
+ # 4. the previous line ends in a comma
+ # Example 1: previous line at lesser depth
+ # if ( ( $Year < 1601 ) # <- we are here but
+ # || ( $Year > 2899 ) # list has not yet
+ # || ( $EndYear < 1601 ) # collapsed vertically
+ # || ( $EndYear > 2899 ) )
+ # {
+ #
+ # Example 2: previous line ending in assignment:
+ # $leapyear =
+ # $year % 4 ? 0 # <- We are here
+ # : $year % 100 ? 1
+ # : $year % 400 ? 0
+ # : 1;
+ #
+ # Example 3: previous line ending in comma:
+ # push @expr,
+ # /test/ ? undef
+ # : eval($_) ? 1
+ # : eval($_) ? 1
+ # : 0;
+
+ # be sure levels agree (do not indent after an indented 'if')
+ next if ( $levels_to_go[$ibeg] ne $levels_to_go[$ibeg_next] );
+
+ # allow padding on first line after a comma but only if:
+ # (1) this is line 2 and
+ # (2) there are at more than three lines and
+ # (3) lines 3 and 4 have the same leading operator
+ # These rules try to prevent padding within a long
+ # comma-separated list.
+ my $ok_comma;
+ if ( $types_to_go[$iendm] eq ','
+ && $line == 1
+ && $max_line > 2 )
+ {
+ my $ibeg_next_next = $$ri_first[ $line + 2 ];
+ my $tok_next_next = $tokens_to_go[$ibeg_next_next];
+ $ok_comma = $tok_next_next eq $tok_next;
+ }
+
+ next
+ unless (
+ $is_assignment{ $types_to_go[$iendm] }
+ || $ok_comma
+ || ( $nesting_depth_to_go[$ibegm] <
+ $nesting_depth_to_go[$ibeg] )
+ || ( $types_to_go[$iendm] eq 'k'
+ && $tokens_to_go[$iendm] eq 'return' )
+ );
+
+ # we will add padding before the first token
+ $ipad = $ibeg;
+ }
+
+ # for first line of the batch..
+ else {
+
+ # WARNING: Never indent if first line is starting in a
+ # continued quote, which would change the quote.
+ next if $starting_in_quote;
+
+ # if this is text after closing '}'
+ # then look for an interior token to pad
+ if ( $types_to_go[$ibeg] eq '}' ) {
+
+ }
+
+ # otherwise, we might pad if it looks really good
+ else {
+
+ # we might pad token $ibeg, so be sure that it
+ # is at the same depth as the next line.
+ next
+ if ( $nesting_depth_to_go[$ibeg] !=
+ $nesting_depth_to_go[$ibeg_next] );
+
+ # We can pad on line 1 of a statement if at least 3
+ # lines will be aligned. Otherwise, it
+ # can look very confusing.
+
+ # We have to be careful not to pad if there are too few
+ # lines. The current rule is:
+ # (1) in general we require at least 3 consecutive lines
+ # with the same leading chain operator token,
+ # (2) but an exception is that we only require two lines
+ # with leading colons if there are no more lines. For example,
+ # the first $i in the following snippet would get padding
+ # by the second rule:
+ #
+ # $i == 1 ? ( "First", "Color" )
+ # : $i == 2 ? ( "Then", "Rarity" )
+ # : ( "Then", "Name" );
+
+ if ( $max_line > 1 ) {
+ my $leading_token = $tokens_to_go[$ibeg_next];
+ my $tokens_differ;
+
+ # never indent line 1 of a '.' series because
+ # previous line is most likely at same level.
+ # TODO: we should also look at the leasing_spaces
+ # of the last output line and skip if it is same
+ # as this line.
+ next if ( $leading_token eq '.' );
+
+ my $count = 1;
+ foreach my $l ( 2 .. 3 ) {
+ last if ( $line + $l > $max_line );
+ my $ibeg_next_next = $$ri_first[ $line + $l ];
+ if ( $tokens_to_go[$ibeg_next_next] ne
+ $leading_token )
+ {
+ $tokens_differ = 1;
+ last;
+ }
+ $count++;
+ }
+ next if ($tokens_differ);
+ next if ( $count < 3 && $leading_token ne ':' );
+ $ipad = $ibeg;
+ }
+ else {
+ next;
+ }
+ }
+ }
+ }
+
+ # find interior token to pad if necessary
+ if ( !defined($ipad) ) {
+
+ for ( my $i = $ibeg ; ( $i < $iend ) && !$ipad ; $i++ ) {
+
+ # find any unclosed container
+ next
+ unless ( $type_sequence_to_go[$i]
+ && $mate_index_to_go[$i] > $iend );
+
+ # find next nonblank token to pad
+ $ipad = $i + 1;
+ if ( $types_to_go[$ipad] eq 'b' ) {
+ $ipad++;
+ last if ( $ipad > $iend );
+ }
+ }
+ last unless $ipad;
+ }
+
+ # next line must not be at greater depth
+ my $iend_next = $$ri_last[ $line + 1 ];
+ next
+ if ( $nesting_depth_to_go[ $iend_next + 1 ] >
+ $nesting_depth_to_go[$ipad] );
+
+ # lines must be somewhat similar to be padded..
+ my $inext_next = $ibeg_next + 1;
+ if ( $types_to_go[$inext_next] eq 'b' ) {
+ $inext_next++;
+ }
+ my $type = $types_to_go[$ipad];
+ my $type_next = $types_to_go[ $ipad + 1 ];
+
+ # see if there are multiple continuation lines
+ my $logical_continuation_lines = 1;
+ if ( $line + 2 <= $max_line ) {
+ my $leading_token = $tokens_to_go[$ibeg_next];
+ my $ibeg_next_next = $$ri_first[ $line + 2 ];
+ if ( $tokens_to_go[$ibeg_next_next] eq $leading_token
+ && $nesting_depth_to_go[$ibeg_next] eq
+ $nesting_depth_to_go[$ibeg_next_next] )
+ {
+ $logical_continuation_lines++;
+ }
+ }
+
+ # see if leading types match
+ my $types_match = $types_to_go[$inext_next] eq $type;
+ my $matches_without_bang;
+
+ # if first line has leading ! then compare the following token
+ if ( !$types_match && $type eq '!' ) {
+ $types_match = $matches_without_bang =
+ $types_to_go[$inext_next] eq $types_to_go[ $ipad + 1 ];
+ }
+
+ if (
+
+ # either we have multiple continuation lines to follow
+ # and we are not padding the first token
+ ( $logical_continuation_lines > 1 && $ipad > 0 )
+
+ # or..
+ || (
+
+ # types must match
+ $types_match
+
+ # and keywords must match if keyword
+ && !(
+ $type eq 'k'
+ && $tokens_to_go[$ipad] ne $tokens_to_go[$inext_next]
+ )
+ )
+ )
+ {
+
+ #----------------------begin special checks--------------
+ #
+ # SPECIAL CHECK 1:
+ # A check is needed before we can make the pad.
+ # If we are in a list with some long items, we want each
+ # item to stand out. So in the following example, the
+ # first line begining with '$casefold->' would look good
+ # padded to align with the next line, but then it
+ # would be indented more than the last line, so we
+ # won't do it.
+ #
+ # ok(
+ # $casefold->{code} eq '0041'
+ # && $casefold->{status} eq 'C'
+ # && $casefold->{mapping} eq '0061',
+ # 'casefold 0x41'
+ # );
+ #
+ # Note:
+ # It would be faster, and almost as good, to use a comma
+ # count, and not pad if comma_count > 1 and the previous
+ # line did not end with a comma.
+ #
+ my $ok_to_pad = 1;
+
+ my $ibg = $$ri_first[ $line + 1 ];
+ my $depth = $nesting_depth_to_go[ $ibg + 1 ];
+
+ # just use simplified formula for leading spaces to avoid
+ # needless sub calls
+ my $lsp = $levels_to_go[$ibg] + $ci_levels_to_go[$ibg];
+
+ # look at each line beyond the next ..
+ my $l = $line + 1;
+ foreach $l ( $line + 2 .. $max_line ) {
+ my $ibg = $$ri_first[$l];
+
+ # quit looking at the end of this container
+ last
+ if ( $nesting_depth_to_go[ $ibg + 1 ] < $depth )
+ || ( $nesting_depth_to_go[$ibg] < $depth );
+
+ # cannot do the pad if a later line would be
+ # outdented more
+ if ( $levels_to_go[$ibg] + $ci_levels_to_go[$ibg] < $lsp ) {
+ $ok_to_pad = 0;
+ last;
+ }
+ }
+
+ # don't pad if we end in a broken list
+ if ( $l == $max_line ) {
+ my $i2 = $$ri_last[$l];
+ if ( $types_to_go[$i2] eq '#' ) {
+ my $i1 = $$ri_first[$l];
+ next
+ if (
+ terminal_type( \@types_to_go, \@block_type_to_go, $i1,
+ $i2 ) eq ','
+ );
+ }
+ }
+
+ # SPECIAL CHECK 2:
+ # a minus may introduce a quoted variable, and we will
+ # add the pad only if this line begins with a bare word,
+ # such as for the word 'Button' here:
+ # [
+ # Button => "Print letter \"~$_\"",
+ # -command => [ sub { print "$_[0]\n" }, $_ ],
+ # -accelerator => "Meta+$_"
+ # ];
+ #
+ # On the other hand, if 'Button' is quoted, it looks best
+ # not to pad:
+ # [
+ # 'Button' => "Print letter \"~$_\"",
+ # -command => [ sub { print "$_[0]\n" }, $_ ],
+ # -accelerator => "Meta+$_"
+ # ];
+ if ( $types_to_go[$ibeg_next] eq 'm' ) {
+ $ok_to_pad = 0 if $types_to_go[$ibeg] eq 'Q';
+ }
+
+ next unless $ok_to_pad;
+
+ #----------------------end special check---------------
+
+ my $length_1 = total_line_length( $ibeg, $ipad - 1 );
+ my $length_2 = total_line_length( $ibeg_next, $inext_next - 1 );
+ $pad_spaces = $length_2 - $length_1;
+
+ # If the first line has a leading ! and the second does
+ # not, then remove one space to try to align the next
+ # leading characters, which are often the same. For example:
+ # if ( !$ts
+ # || $ts == $self->Holder
+ # || $self->Holder->Type eq "Arena" )
+ #
+ # This usually helps readability, but if there are subsequent
+ # ! operators things will still get messed up. For example:
+ #
+ # if ( !exists $Net::DNS::typesbyname{$qtype}
+ # && exists $Net::DNS::classesbyname{$qtype}
+ # && !exists $Net::DNS::classesbyname{$qclass}
+ # && exists $Net::DNS::typesbyname{$qclass} )
+ # We can't fix that.
+ if ($matches_without_bang) { $pad_spaces-- }
+
+ # make sure this won't change if -lp is used
+ my $indentation_1 = $leading_spaces_to_go[$ibeg];
+ if ( ref($indentation_1) ) {
+ if ( $indentation_1->get_RECOVERABLE_SPACES() == 0 ) {
+ my $indentation_2 = $leading_spaces_to_go[$ibeg_next];
+ unless ( $indentation_2->get_RECOVERABLE_SPACES() == 0 ) {
+ $pad_spaces = 0;
+ }
+ }
+ }
+
+ # we might be able to handle a pad of -1 by removing a blank
+ # token
+ if ( $pad_spaces < 0 ) {
+
+ if ( $pad_spaces == -1 ) {
+ if ( $ipad > $ibeg && $types_to_go[ $ipad - 1 ] eq 'b' ) {
+ $tokens_to_go[ $ipad - 1 ] = '';
+ }
+ }
+ $pad_spaces = 0;
+ }
+
+ # now apply any padding for alignment
+ if ( $ipad >= 0 && $pad_spaces ) {
+
+ my $length_t = total_line_length( $ibeg, $iend );
+ if ( $pad_spaces + $length_t <= $rOpts_maximum_line_length ) {
+ $tokens_to_go[$ipad] =
+ ' ' x $pad_spaces . $tokens_to_go[$ipad];
+ }
+ }
+ }
+ }
+ continue {
+ $iendm = $iend;
+ $ibegm = $ibeg;
+ $has_leading_op = $has_leading_op_next;
+ } # end of loop over lines
+ return;
+}
+
+sub correct_lp_indentation {
+
+ # When the -lp option is used, we need to make a last pass through
+ # each line to correct the indentation positions in case they differ
+ # from the predictions. This is necessary because perltidy uses a
+ # predictor/corrector method for aligning with opening parens. The
+ # predictor is usually good, but sometimes stumbles. The corrector
+ # tries to patch things up once the actual opening paren locations
+ # are known.
+ my ( $ri_first, $ri_last ) = @_;
+ my $do_not_pad = 0;
+
+ # Note on flag '$do_not_pad':
+ # We want to avoid a situation like this, where the aligner inserts
+ # whitespace before the '=' to align it with a previous '=', because
+ # otherwise the parens might become mis-aligned in a situation like
+ # this, where the '=' has become aligned with the previous line,
+ # pushing the opening '(' forward beyond where we want it.
+ #
+ # $mkFloor::currentRoom = '';
+ # $mkFloor::c_entry = $c->Entry(
+ # -width => '10',
+ # -relief => 'sunken',
+ # ...
+ # );
+ #
+ # We leave it to the aligner to decide how to do this.
+
+ # first remove continuation indentation if appropriate
+ my $max_line = @$ri_first - 1;
+
+ # looking at each line of this batch..
+ my ( $ibeg, $iend );
+ my $line;
+ foreach $line ( 0 .. $max_line ) {
+ $ibeg = $$ri_first[$line];
+ $iend = $$ri_last[$line];
+
+ # looking at each token in this output line..
+ my $i;
+ foreach $i ( $ibeg .. $iend ) {
+
+ # How many space characters to place before this token
+ # for special alignment. Actual padding is done in the
+ # continue block.
+
+ # looking for next unvisited indentation item
+ my $indentation = $leading_spaces_to_go[$i];
+ if ( !$indentation->get_MARKED() ) {
+ $indentation->set_MARKED(1);
+
+ # looking for indentation item for which we are aligning
+ # with parens, braces, and brackets
+ next unless ( $indentation->get_ALIGN_PAREN() );
+
+ # skip closed container on this line
+ if ( $i > $ibeg ) {
+ my $im = $i - 1;
+ if ( $types_to_go[$im] eq 'b' && $im > $ibeg ) { $im-- }
+ if ( $type_sequence_to_go[$im]
+ && $mate_index_to_go[$im] <= $iend )
+ {
+ next;
+ }
+ }
+
+ if ( $line == 1 && $i == $ibeg ) {
+ $do_not_pad = 1;
+ }
+
+ # Ok, let's see what the error is and try to fix it
+ my $actual_pos;
+ my $predicted_pos = $indentation->get_SPACES();
+ if ( $i > $ibeg ) {
+
+ # token is mid-line - use length to previous token
+ $actual_pos = total_line_length( $ibeg, $i - 1 );
+
+ # for mid-line token, we must check to see if all
+ # additional lines have continuation indentation,
+ # and remove it if so. Otherwise, we do not get
+ # good alignment.
+ my $closing_index = $indentation->get_CLOSED();
+ if ( $closing_index > $iend ) {
+ my $ibeg_next = $$ri_first[ $line + 1 ];
+ if ( $ci_levels_to_go[$ibeg_next] > 0 ) {
+ undo_lp_ci( $line, $i, $closing_index, $ri_first,
+ $ri_last );
+ }
+ }
+ }
+ elsif ( $line > 0 ) {
+
+ # handle case where token starts a new line;
+ # use length of previous line
+ my $ibegm = $$ri_first[ $line - 1 ];
+ my $iendm = $$ri_last[ $line - 1 ];
+ $actual_pos = total_line_length( $ibegm, $iendm );
+
+ # follow -pt style
+ ++$actual_pos
+ if ( $types_to_go[ $iendm + 1 ] eq 'b' );
+ }
+ else {
+
+ # token is first character of first line of batch
+ $actual_pos = $predicted_pos;
+ }
+
+ my $move_right = $actual_pos - $predicted_pos;
+
+ # done if no error to correct (gnu2.t)
+ if ( $move_right == 0 ) {
+ $indentation->set_RECOVERABLE_SPACES($move_right);
+ next;
+ }
+
+ # if we have not seen closure for this indentation in
+ # this batch, we can only pass on a request to the
+ # vertical aligner
+ my $closing_index = $indentation->get_CLOSED();
+
+ if ( $closing_index < 0 ) {
+ $indentation->set_RECOVERABLE_SPACES($move_right);
+ next;
+ }
+
+ # If necessary, look ahead to see if there is really any
+ # leading whitespace dependent on this whitespace, and
+ # also find the longest line using this whitespace.
+ # Since it is always safe to move left if there are no
+ # dependents, we only need to do this if we may have
+ # dependent nodes or need to move right.
+
+ my $right_margin = 0;
+ my $have_child = $indentation->get_HAVE_CHILD();
+
+ my %saw_indentation;
+ my $line_count = 1;
+ $saw_indentation{$indentation} = $indentation;
+
+ if ( $have_child || $move_right > 0 ) {
+ $have_child = 0;
+ my $max_length = 0;
+ if ( $i == $ibeg ) {
+ $max_length = total_line_length( $ibeg, $iend );
+ }
+
+ # look ahead at the rest of the lines of this batch..
+ my $line_t;
+ foreach $line_t ( $line + 1 .. $max_line ) {
+ my $ibeg_t = $$ri_first[$line_t];
+ my $iend_t = $$ri_last[$line_t];
+ last if ( $closing_index <= $ibeg_t );
+
+ # remember all different indentation objects
+ my $indentation_t = $leading_spaces_to_go[$ibeg_t];
+ $saw_indentation{$indentation_t} = $indentation_t;
+ $line_count++;
+
+ # remember longest line in the group
+ my $length_t = total_line_length( $ibeg_t, $iend_t );
+ if ( $length_t > $max_length ) {
+ $max_length = $length_t;
+ }
+ }
+ $right_margin = $rOpts_maximum_line_length - $max_length;
+ if ( $right_margin < 0 ) { $right_margin = 0 }
+ }
+
+ my $first_line_comma_count =
+ grep { $_ eq ',' } @types_to_go[ $ibeg .. $iend ];
+ my $comma_count = $indentation->get_COMMA_COUNT();
+ my $arrow_count = $indentation->get_ARROW_COUNT();
+
+ # This is a simple approximate test for vertical alignment:
+ # if we broke just after an opening paren, brace, bracket,
+ # and there are 2 or more commas in the first line,
+ # and there are no '=>'s,
+ # then we are probably vertically aligned. We could set
+ # an exact flag in sub scan_list, but this is good
+ # enough.
+ my $indentation_count = keys %saw_indentation;
+ my $is_vertically_aligned =
+ ( $i == $ibeg
+ && $first_line_comma_count > 1
+ && $indentation_count == 1
+ && ( $arrow_count == 0 || $arrow_count == $line_count ) );
+
+ # Make the move if possible ..
+ if (
+
+ # we can always move left
+ $move_right < 0
+
+ # but we should only move right if we are sure it will
+ # not spoil vertical alignment
+ || ( $comma_count == 0 )
+ || ( $comma_count > 0 && !$is_vertically_aligned )
+ )
+ {
+ my $move =
+ ( $move_right <= $right_margin )
+ ? $move_right
+ : $right_margin;
+
+ foreach ( keys %saw_indentation ) {
+ $saw_indentation{$_}
+ ->permanently_decrease_AVAILABLE_SPACES( -$move );
+ }
+ }
+
+ # Otherwise, record what we want and the vertical aligner
+ # will try to recover it.
+ else {
+ $indentation->set_RECOVERABLE_SPACES($move_right);
+ }
+ }
+ }
+ }
+ return $do_not_pad;
+}
+
+# flush is called to output any tokens in the pipeline, so that
+# an alternate source of lines can be written in the correct order
+
+sub flush {
+ destroy_one_line_block();
+ output_line_to_go();
+ Perl::Tidy::VerticalAligner::flush();
+}
+
+sub reset_block_text_accumulator {
+
+ # save text after 'if' and 'elsif' to append after 'else'
+ if ($accumulating_text_for_block) {
+
+ if ( $accumulating_text_for_block =~ /^(if|elsif)$/ ) {
+ push @{$rleading_block_if_elsif_text}, $leading_block_text;
+ }
+ }
+ $accumulating_text_for_block = "";
+ $leading_block_text = "";
+ $leading_block_text_level = 0;
+ $leading_block_text_length_exceeded = 0;
+ $leading_block_text_line_number = 0;
+ $leading_block_text_line_length = 0;
+}
+
+sub set_block_text_accumulator {
+ my $i = shift;
+ $accumulating_text_for_block = $tokens_to_go[$i];
+ if ( $accumulating_text_for_block !~ /^els/ ) {
+ $rleading_block_if_elsif_text = [];
+ }
+ $leading_block_text = "";
+ $leading_block_text_level = $levels_to_go[$i];
+ $leading_block_text_line_number =
+ $vertical_aligner_object->get_output_line_number();
+ $leading_block_text_length_exceeded = 0;
+
+ # this will contain the column number of the last character
+ # of the closing side comment
+ $leading_block_text_line_length =
+ length($accumulating_text_for_block) +
+ length( $rOpts->{'closing-side-comment-prefix'} ) +
+ $leading_block_text_level * $rOpts_indent_columns + 3;
+}
+
+sub accumulate_block_text {
+ my $i = shift;
+
+ # accumulate leading text for -csc, ignoring any side comments
+ if ( $accumulating_text_for_block
+ && !$leading_block_text_length_exceeded
+ && $types_to_go[$i] ne '#' )
+ {
+
+ my $added_length = length( $tokens_to_go[$i] );
+ $added_length += 1 if $i == 0;
+ my $new_line_length = $leading_block_text_line_length + $added_length;
+
+ # we can add this text if we don't exceed some limits..
+ if (
+
+ # we must not have already exceeded the text length limit
+ length($leading_block_text) <
+ $rOpts_closing_side_comment_maximum_text
+
+ # and either:
+ # the new total line length must be below the line length limit
+ # or the new length must be below the text length limit
+ # (ie, we may allow one token to exceed the text length limit)
+ && ( $new_line_length < $rOpts_maximum_line_length
+ || length($leading_block_text) + $added_length <
+ $rOpts_closing_side_comment_maximum_text )
+
+ # UNLESS: we are adding a closing paren before the brace we seek.
+ # This is an attempt to avoid situations where the ... to be
+ # added are longer than the omitted right paren, as in:
+
+ # foreach my $item (@a_rather_long_variable_name_here) {
+ # &whatever;
+ # } ## end foreach my $item (@a_rather_long_variable_name_here...
+
+ || (
+ $tokens_to_go[$i] eq ')'
+ && (
+ (
+ $i + 1 <= $max_index_to_go
+ && $block_type_to_go[ $i + 1 ] eq
+ $accumulating_text_for_block
+ )
+ || ( $i + 2 <= $max_index_to_go
+ && $block_type_to_go[ $i + 2 ] eq
+ $accumulating_text_for_block )
+ )
+ )
+ )
+ {
+
+ # add an extra space at each newline
+ if ( $i == 0 ) { $leading_block_text .= ' ' }
+
+ # add the token text
+ $leading_block_text .= $tokens_to_go[$i];
+ $leading_block_text_line_length = $new_line_length;
+ }
+
+ # show that text was truncated if necessary
+ elsif ( $types_to_go[$i] ne 'b' ) {
+ $leading_block_text_length_exceeded = 1;
+ $leading_block_text .= '...';
+ }
+ }
+}
+
+{
+ my %is_if_elsif_else_unless_while_until_for_foreach;
+
+ BEGIN {
+
+ # These block types may have text between the keyword and opening
+ # curly. Note: 'else' does not, but must be included to allow trailing
+ # if/elsif text to be appended.
+ # patch for SWITCH/CASE: added 'case' and 'when'
+ @_ = qw(if elsif else unless while until for foreach case when);
+ @is_if_elsif_else_unless_while_until_for_foreach{@_} = (1) x scalar(@_);
+ }
+
+ sub accumulate_csc_text {
+
+ # called once per output buffer when -csc is used. Accumulates
+ # the text placed after certain closing block braces.
+ # Defines and returns the following for this buffer:
+
+ my $block_leading_text = ""; # the leading text of the last '}'
+ my $rblock_leading_if_elsif_text;
+ my $i_block_leading_text =
+ -1; # index of token owning block_leading_text
+ my $block_line_count = 100; # how many lines the block spans
+ my $terminal_type = 'b'; # type of last nonblank token
+ my $i_terminal = 0; # index of last nonblank token
+ my $terminal_block_type = "";
+
+ for my $i ( 0 .. $max_index_to_go ) {
+ my $type = $types_to_go[$i];
+ my $block_type = $block_type_to_go[$i];
+ my $token = $tokens_to_go[$i];
+
+ # remember last nonblank token type
+ if ( $type ne '#' && $type ne 'b' ) {
+ $terminal_type = $type;
+ $terminal_block_type = $block_type;
+ $i_terminal = $i;
+ }
+
+ my $type_sequence = $type_sequence_to_go[$i];
+ if ( $block_type && $type_sequence ) {
+
+ if ( $token eq '}' ) {
+
+ # restore any leading text saved when we entered this block
+ if ( defined( $block_leading_text{$type_sequence} ) ) {
+ ( $block_leading_text, $rblock_leading_if_elsif_text ) =
+ @{ $block_leading_text{$type_sequence} };
+ $i_block_leading_text = $i;
+ delete $block_leading_text{$type_sequence};
+ $rleading_block_if_elsif_text =
+ $rblock_leading_if_elsif_text;
+ }
+
+ # if we run into a '}' then we probably started accumulating
+ # at something like a trailing 'if' clause..no harm done.
+ if ( $accumulating_text_for_block
+ && $levels_to_go[$i] <= $leading_block_text_level )
+ {
+ my $lev = $levels_to_go[$i];
+ reset_block_text_accumulator();
+ }
+
+ if ( defined( $block_opening_line_number{$type_sequence} ) )
+ {
+ my $output_line_number =
+ $vertical_aligner_object->get_output_line_number();
+ $block_line_count =
+ $output_line_number -
+ $block_opening_line_number{$type_sequence} + 1;
+ delete $block_opening_line_number{$type_sequence};
+ }
+ else {
+
+ # Error: block opening line undefined for this line..
+ # This shouldn't be possible, but it is not a
+ # significant problem.
+ }
+ }
+
+ elsif ( $token eq '{' ) {
+
+ my $line_number =
+ $vertical_aligner_object->get_output_line_number();
+ $block_opening_line_number{$type_sequence} = $line_number;
+
+ if ( $accumulating_text_for_block
+ && $levels_to_go[$i] == $leading_block_text_level )
+ {
+
+ if ( $accumulating_text_for_block eq $block_type ) {
+
+ # save any leading text before we enter this block
+ $block_leading_text{$type_sequence} = [
+ $leading_block_text,
+ $rleading_block_if_elsif_text
+ ];
+ $block_opening_line_number{$type_sequence} =
+ $leading_block_text_line_number;
+ reset_block_text_accumulator();
+ }
+ else {
+
+ # shouldn't happen, but not a serious error.
+ # We were accumulating -csc text for block type
+ # $accumulating_text_for_block and unexpectedly
+ # encountered a '{' for block type $block_type.
+ }
+ }
+ }
+ }
+
+ if ( $type eq 'k'
+ && $csc_new_statement_ok
+ && $is_if_elsif_else_unless_while_until_for_foreach{$token}
+ && $token =~ /$closing_side_comment_list_pattern/o )
+ {
+ set_block_text_accumulator($i);
+ }
+ else {
+
+ # note: ignoring type 'q' because of tricks being played
+ # with 'q' for hanging side comments
+ if ( $type ne 'b' && $type ne '#' && $type ne 'q' ) {
+ $csc_new_statement_ok =
+ ( $block_type || $type eq 'J' || $type eq ';' );
+ }
+ if ( $type eq ';'
+ && $accumulating_text_for_block
+ && $levels_to_go[$i] == $leading_block_text_level )
+ {
+ reset_block_text_accumulator();
+ }
+ else {
+ accumulate_block_text($i);
+ }
+ }
+ }
+
+ # Treat an 'else' block specially by adding preceding 'if' and
+ # 'elsif' text. Otherwise, the 'end else' is not helpful,
+ # especially for cuddled-else formatting.
+ if ( $terminal_block_type =~ /^els/ && $rblock_leading_if_elsif_text ) {
+ $block_leading_text =
+ make_else_csc_text( $i_terminal, $terminal_block_type,
+ $block_leading_text, $rblock_leading_if_elsif_text );
+ }
+
+ return ( $terminal_type, $i_terminal, $i_block_leading_text,
+ $block_leading_text, $block_line_count );
+ }
+}
+
+sub make_else_csc_text {
+
+ # create additional -csc text for an 'else' and optionally 'elsif',
+ # depending on the value of switch
+ # $rOpts_closing_side_comment_else_flag:
+ #
+ # = 0 add 'if' text to trailing else
+ # = 1 same as 0 plus:
+ # add 'if' to 'elsif's if can fit in line length
+ # add last 'elsif' to trailing else if can fit in one line
+ # = 2 same as 1 but do not check if exceed line length
+ #
+ # $rif_elsif_text = a reference to a list of all previous closing
+ # side comments created for this if block
+ #
+ my ( $i_terminal, $block_type, $block_leading_text, $rif_elsif_text ) = @_;
+ my $csc_text = $block_leading_text;
+
+ if ( $block_type eq 'elsif' && $rOpts_closing_side_comment_else_flag == 0 )
+ {
+ return $csc_text;
+ }
+
+ my $count = @{$rif_elsif_text};
+ return $csc_text unless ($count);
+
+ my $if_text = '[ if' . $rif_elsif_text->[0];
+
+ # always show the leading 'if' text on 'else'
+ if ( $block_type eq 'else' ) {
+ $csc_text .= $if_text;
+ }
+
+ # see if that's all
+ if ( $rOpts_closing_side_comment_else_flag == 0 ) {
+ return $csc_text;
+ }
+
+ my $last_elsif_text = "";
+ if ( $count > 1 ) {
+ $last_elsif_text = ' [elsif' . $rif_elsif_text->[ $count - 1 ];
+ if ( $count > 2 ) { $last_elsif_text = ' [...' . $last_elsif_text; }
+ }
+
+ # tentatively append one more item
+ my $saved_text = $csc_text;
+ if ( $block_type eq 'else' ) {
+ $csc_text .= $last_elsif_text;
+ }
+ else {
+ $csc_text .= ' ' . $if_text;
+ }
+
+ # all done if no length checks requested
+ if ( $rOpts_closing_side_comment_else_flag == 2 ) {
+ return $csc_text;
+ }
+
+ # undo it if line length exceeded
+ my $length =
+ length($csc_text) +
+ length($block_type) +
+ length( $rOpts->{'closing-side-comment-prefix'} ) +
+ $levels_to_go[$i_terminal] * $rOpts_indent_columns + 3;
+ if ( $length > $rOpts_maximum_line_length ) {
+ $csc_text = $saved_text;
+ }
+ return $csc_text;
+}
+
+sub add_closing_side_comment {
+
+ # add closing side comments after closing block braces if -csc used
+ my $cscw_block_comment;
+
+ #---------------------------------------------------------------
+ # Step 1: loop through all tokens of this line to accumulate
+ # the text needed to create the closing side comments. Also see
+ # how the line ends.
+ #---------------------------------------------------------------
+
+ my ( $terminal_type, $i_terminal, $i_block_leading_text,
+ $block_leading_text, $block_line_count )
+ = accumulate_csc_text();
+
+ #---------------------------------------------------------------
+ # Step 2: make the closing side comment if this ends a block
+ #---------------------------------------------------------------
+ my $have_side_comment = $i_terminal != $max_index_to_go;
+
+ # if this line might end in a block closure..
+ if (
+ $terminal_type eq '}'
+
+ # ..and either
+ && (
+
+ # the block is long enough
+ ( $block_line_count >= $rOpts->{'closing-side-comment-interval'} )
+
+ # or there is an existing comment to check
+ || ( $have_side_comment
+ && $rOpts->{'closing-side-comment-warnings'} )
+ )
+
+ # .. and if this is one of the types of interest
+ && $block_type_to_go[$i_terminal] =~
+ /$closing_side_comment_list_pattern/o
+
+ # .. but not an anonymous sub
+ # These are not normally of interest, and their closing braces are
+ # often followed by commas or semicolons anyway. This also avoids
+ # possible erratic output due to line numbering inconsistencies
+ # in the cases where their closing braces terminate a line.
+ && $block_type_to_go[$i_terminal] ne 'sub'
+
+ # ..and the corresponding opening brace must is not in this batch
+ # (because we do not need to tag one-line blocks, although this
+ # should also be caught with a positive -csci value)
+ && $mate_index_to_go[$i_terminal] < 0
+
+ # ..and either
+ && (
+
+ # this is the last token (line doesnt have a side comment)
+ !$have_side_comment
+
+ # or the old side comment is a closing side comment
+ || $tokens_to_go[$max_index_to_go] =~
+ /$closing_side_comment_prefix_pattern/o
+ )
+ )
+ {
+
+ # then make the closing side comment text
+ my $token =
+"$rOpts->{'closing-side-comment-prefix'} $block_type_to_go[$i_terminal]";
+
+ # append any extra descriptive text collected above
+ if ( $i_block_leading_text == $i_terminal ) {
+ $token .= $block_leading_text;
+ }
+ $token =~ s/\s*$//; # trim any trailing whitespace
+
+ # handle case of existing closing side comment
+ if ($have_side_comment) {
+
+ # warn if requested and tokens differ significantly
+ if ( $rOpts->{'closing-side-comment-warnings'} ) {
+ my $old_csc = $tokens_to_go[$max_index_to_go];
+ my $new_csc = $token;
+ $new_csc =~ s/(\.\.\.)\s*$//; # trim trailing '...'
+ my $new_trailing_dots = $1;
+ $old_csc =~ s/\.\.\.\s*$//;
+ $new_csc =~ s/\s+//g; # trim all whitespace
+ $old_csc =~ s/\s+//g;
+
+ # Patch to handle multiple closing side comments at
+ # else and elsif's. These have become too complicated
+ # to check, so if we see an indication of
+ # '[ if' or '[ # elsif', then assume they were made
+ # by perltidy.
+ if ( $block_type_to_go[$i_terminal] eq 'else' ) {
+ if ( $old_csc =~ /\[\s*elsif/ ) { $old_csc = $new_csc }
+ }
+ elsif ( $block_type_to_go[$i_terminal] eq 'elsif' ) {
+ if ( $old_csc =~ /\[\s*if/ ) { $old_csc = $new_csc }
+ }
+
+ # if old comment is contained in new comment,
+ # only compare the common part.
+ if ( length($new_csc) > length($old_csc) ) {
+ $new_csc = substr( $new_csc, 0, length($old_csc) );
+ }
+
+ # if the new comment is shorter and has been limited,
+ # only compare the common part.
+ if ( length($new_csc) < length($old_csc) && $new_trailing_dots )
+ {
+ $old_csc = substr( $old_csc, 0, length($new_csc) );
+ }
+
+ # any remaining difference?
+ if ( $new_csc ne $old_csc ) {
+
+ # just leave the old comment if we are below the threshold
+ # for creating side comments
+ if ( $block_line_count <
+ $rOpts->{'closing-side-comment-interval'} )
+ {
+ $token = undef;
+ }
+
+ # otherwise we'll make a note of it
+ else {
+
+ warning(
+"perltidy -cscw replaced: $tokens_to_go[$max_index_to_go]\n"
+ );
+
+ # save the old side comment in a new trailing block comment
+ my ( $day, $month, $year ) = (localtime)[ 3, 4, 5 ];
+ $year += 1900;
+ $month += 1;
+ $cscw_block_comment =
+"## perltidy -cscw $year-$month-$day: $tokens_to_go[$max_index_to_go]";
+ }
+ }
+ else {
+
+ # No differences.. we can safely delete old comment if we
+ # are below the threshold
+ if ( $block_line_count <
+ $rOpts->{'closing-side-comment-interval'} )
+ {
+ $token = undef;
+ unstore_token_to_go()
+ if ( $types_to_go[$max_index_to_go] eq '#' );
+ unstore_token_to_go()
+ if ( $types_to_go[$max_index_to_go] eq 'b' );
+ }
+ }
+ }
+
+ # switch to the new csc (unless we deleted it!)
+ $tokens_to_go[$max_index_to_go] = $token if $token;
+ }
+
+ # handle case of NO existing closing side comment
+ else {
+
+ # insert the new side comment into the output token stream
+ my $type = '#';
+ my $block_type = '';
+ my $type_sequence = '';
+ my $container_environment =
+ $container_environment_to_go[$max_index_to_go];
+ my $level = $levels_to_go[$max_index_to_go];
+ my $slevel = $nesting_depth_to_go[$max_index_to_go];
+ my $no_internal_newlines = 0;
+
+ my $nesting_blocks = $nesting_blocks_to_go[$max_index_to_go];
+ my $ci_level = $ci_levels_to_go[$max_index_to_go];
+ my $in_continued_quote = 0;
+
+ # first insert a blank token
+ insert_new_token_to_go( ' ', 'b', $slevel, $no_internal_newlines );
+
+ # then the side comment
+ insert_new_token_to_go( $token, $type, $slevel,
+ $no_internal_newlines );
+ }
+ }
+ return $cscw_block_comment;
+}
+
+sub previous_nonblank_token {
+ my ($i) = @_;
+ my $name = "";
+ my $im = $i - 1;
+ return "" if ( $im < 0 );
+ if ( $types_to_go[$im] eq 'b' ) { $im--; }
+ return "" if ( $im < 0 );
+ $name = $tokens_to_go[$im];
+
+ # prepend any sub name to an isolated -> to avoid unwanted alignments
+ # [test case is test8/penco.pl]
+ if ( $name eq '->' ) {
+ $im--;
+ if ( $im >= 0 && $types_to_go[$im] ne 'b' ) {
+ $name = $tokens_to_go[$im] . $name;
+ }
+ }
+ return $name;
+}
+
+sub send_lines_to_vertical_aligner {
+
+ my ( $ri_first, $ri_last, $do_not_pad ) = @_;
+
+ my $rindentation_list = [0]; # ref to indentations for each line
+
+ # define the array @matching_token_to_go for the output tokens
+ # which will be non-blank for each special token (such as =>)
+ # for which alignment is required.
+ set_vertical_alignment_markers( $ri_first, $ri_last );
+
+ # flush if necessary to avoid unwanted alignment
+ my $must_flush = 0;
+ if ( @$ri_first > 1 ) {
+
+ # flush before a long if statement
+ if ( $types_to_go[0] eq 'k' && $tokens_to_go[0] =~ /^(if|unless)$/ ) {
+ $must_flush = 1;
+ }
+ }
+ if ($must_flush) {
+ Perl::Tidy::VerticalAligner::flush();
+ }
+
+ set_logical_padding( $ri_first, $ri_last );
+
+ # loop to prepare each line for shipment
+ my $n_last_line = @$ri_first - 1;
+ my $in_comma_list;
+ for my $n ( 0 .. $n_last_line ) {
+ my $ibeg = $$ri_first[$n];
+ my $iend = $$ri_last[$n];
+
+ my ( $rtokens, $rfields, $rpatterns ) =
+ make_alignment_patterns( $ibeg, $iend );
+
+ my ( $indentation, $lev, $level_end, $terminal_type,
+ $is_semicolon_terminated, $is_outdented_line )
+ = set_adjusted_indentation( $ibeg, $iend, $rfields, $rpatterns,
+ $ri_first, $ri_last, $rindentation_list );
+
+ # we will allow outdenting of long lines..
+ my $outdent_long_lines = (
+
+ # which are long quotes, if allowed
+ ( $types_to_go[$ibeg] eq 'Q' && $rOpts->{'outdent-long-quotes'} )
+
+ # which are long block comments, if allowed
+ || (
+ $types_to_go[$ibeg] eq '#'
+ && $rOpts->{'outdent-long-comments'}
+
+ # but not if this is a static block comment
+ && !$is_static_block_comment
+ )
+ );
+
+ my $level_jump =
+ $nesting_depth_to_go[ $iend + 1 ] - $nesting_depth_to_go[$ibeg];
+
+ my $rvertical_tightness_flags =
+ set_vertical_tightness_flags( $n, $n_last_line, $ibeg, $iend,
+ $ri_first, $ri_last );
+
+ # flush an outdented line to avoid any unwanted vertical alignment
+ Perl::Tidy::VerticalAligner::flush() if ($is_outdented_line);
+
+ my $is_terminal_ternary = 0;
+ if ( $tokens_to_go[$ibeg] eq ':'
+ || $n > 0 && $tokens_to_go[ $$ri_last[ $n - 1 ] ] eq ':' )
+ {
+ if ( ( $terminal_type eq ';' && $level_end <= $lev )
+ || ( $level_end < $lev ) )
+ {
+ $is_terminal_ternary = 1;
+ }
+ }
+
+ # send this new line down the pipe
+ my $forced_breakpoint = $forced_breakpoint_to_go[$iend];
+ Perl::Tidy::VerticalAligner::append_line(
+ $lev,
+ $level_end,
+ $indentation,
+ $rfields,
+ $rtokens,
+ $rpatterns,
+ $forced_breakpoint_to_go[$iend] || $in_comma_list,
+ $outdent_long_lines,
+ $is_terminal_ternary,
+ $is_semicolon_terminated,
+ $do_not_pad,
+ $rvertical_tightness_flags,
+ $level_jump,
+ );
+ $in_comma_list =
+ $tokens_to_go[$iend] eq ',' && $forced_breakpoint_to_go[$iend];
+
+ # flush an outdented line to avoid any unwanted vertical alignment
+ Perl::Tidy::VerticalAligner::flush() if ($is_outdented_line);
+
+ $do_not_pad = 0;
+
+ } # end of loop to output each line
+
+ # remember indentation of lines containing opening containers for
+ # later use by sub set_adjusted_indentation
+ save_opening_indentation( $ri_first, $ri_last, $rindentation_list );
+}
+
+{ # begin make_alignment_patterns
+
+ my %block_type_map;
+ my %keyword_map;
+
+ BEGIN {
+
+ # map related block names into a common name to
+ # allow alignment
+ %block_type_map = (
+ 'unless' => 'if',
+ 'else' => 'if',
+ 'elsif' => 'if',
+ 'when' => 'if',
+ 'default' => 'if',
+ 'case' => 'if',
+ 'sort' => 'map',
+ 'grep' => 'map',
+ );
+
+ # map certain keywords to the same 'if' class to align
+ # long if/elsif sequences. [elsif.pl]
+ %keyword_map = (
+ 'unless' => 'if',
+ 'else' => 'if',
+ 'elsif' => 'if',
+ 'when' => 'given',
+ 'default' => 'given',
+ 'case' => 'switch',
+
+ # treat an 'undef' similar to numbers and quotes
+ 'undef' => 'Q',
+ );
+ }
+
+ sub make_alignment_patterns {
+
+ # Here we do some important preliminary work for the
+ # vertical aligner. We create three arrays for one
+ # output line. These arrays contain strings that can
+ # be tested by the vertical aligner to see if
+ # consecutive lines can be aligned vertically.
+ #
+ # The three arrays are indexed on the vertical
+ # alignment fields and are:
+ # @tokens - a list of any vertical alignment tokens for this line.
+ # These are tokens, such as '=' '&&' '#' etc which
+ # we want to might align vertically. These are
+ # decorated with various information such as
+ # nesting depth to prevent unwanted vertical
+ # alignment matches.
+ # @fields - the actual text of the line between the vertical alignment
+ # tokens.
+ # @patterns - a modified list of token types, one for each alignment
+ # field. These should normally each match before alignment is
+ # allowed, even when the alignment tokens match.
+ my ( $ibeg, $iend ) = @_;
+ my @tokens = ();
+ my @fields = ();
+ my @patterns = ();
+ my $i_start = $ibeg;
+ my $i;
+
+ my $depth = 0;
+ my @container_name = ("");
+ my @multiple_comma_arrows = (undef);
+
+ my $j = 0; # field index
+
+ $patterns[0] = "";
+ for $i ( $ibeg .. $iend ) {
+
+ # Keep track of containers balanced on this line only.
+ # These are used below to prevent unwanted cross-line alignments.
+ # Unbalanced containers already avoid aligning across
+ # container boundaries.
+ if ( $tokens_to_go[$i] eq '(' ) {
+
+ # if container is balanced on this line...
+ my $i_mate = $mate_index_to_go[$i];
+ if ( $i_mate > $i && $i_mate <= $iend ) {
+ $depth++;
+ my $seqno = $type_sequence_to_go[$i];
+ my $count = comma_arrow_count($seqno);
+ $multiple_comma_arrows[$depth] = $count && $count > 1;
+
+ # Append the previous token name to make the container name
+ # more unique. This name will also be given to any commas
+ # within this container, and it helps avoid undesirable
+ # alignments of different types of containers.
+ my $name = previous_nonblank_token($i);
+ $name =~ s/^->//;
+ $container_name[$depth] = "+" . $name;
+
+ # Make the container name even more unique if necessary.
+ # If we are not vertically aligning this opening paren,
+ # append a character count to avoid bad alignment because
+ # it usually looks bad to align commas within continers
+ # for which the opening parens do not align. Here
+ # is an example very BAD alignment of commas (because
+ # the atan2 functions are not all aligned):
+ # $XY =
+ # $X * $RTYSQP1 * atan2( $X, $RTYSQP1 ) +
+ # $Y * $RTXSQP1 * atan2( $Y, $RTXSQP1 ) -
+ # $X * atan2( $X, 1 ) -
+ # $Y * atan2( $Y, 1 );
+ #
+ # On the other hand, it is usually okay to align commas if
+ # opening parens align, such as:
+ # glVertex3d( $cx + $s * $xs, $cy, $z );
+ # glVertex3d( $cx, $cy + $s * $ys, $z );
+ # glVertex3d( $cx - $s * $xs, $cy, $z );
+ # glVertex3d( $cx, $cy - $s * $ys, $z );
+ #
+ # To distinguish between these situations, we will
+ # append the length of the line from the previous matching
+ # token, or beginning of line, to the function name. This
+ # will allow the vertical aligner to reject undesirable
+ # matches.
+
+ # if we are not aligning on this paren...
+ if ( $matching_token_to_go[$i] eq '' ) {
+
+ # Sum length from previous alignment, or start of line.
+ # Note that we have to sum token lengths here because
+ # padding has been done and so array $lengths_to_go
+ # is now wrong.
+ my $len =
+ length(
+ join( '', @tokens_to_go[ $i_start .. $i - 1 ] ) );
+ $len += leading_spaces_to_go($i_start)
+ if ( $i_start == $ibeg );
+
+ # tack length onto the container name to make unique
+ $container_name[$depth] .= "-" . $len;
+ }
+ }
+ }
+ elsif ( $tokens_to_go[$i] eq ')' ) {
+ $depth-- if $depth > 0;
+ }
+
+ # if we find a new synchronization token, we are done with
+ # a field
+ if ( $i > $i_start && $matching_token_to_go[$i] ne '' ) {
+
+ my $tok = my $raw_tok = $matching_token_to_go[$i];
+
+ # make separators in different nesting depths unique
+ # by appending the nesting depth digit.
+ if ( $raw_tok ne '#' ) {
+ $tok .= "$nesting_depth_to_go[$i]";
+ }
+
+ # also decorate commas with any container name to avoid
+ # unwanted cross-line alignments.
+ if ( $raw_tok eq ',' || $raw_tok eq '=>' ) {
+ if ( $container_name[$depth] ) {
+ $tok .= $container_name[$depth];
+ }
+ }
+
+ # Patch to avoid aligning leading and trailing if, unless.
+ # Mark trailing if, unless statements with container names.
+ # This makes them different from leading if, unless which
+ # are not so marked at present. If we ever need to name
+ # them too, we could use ci to distinguish them.
+ # Example problem to avoid:
+ # return ( 2, "DBERROR" )
+ # if ( $retval == 2 );
+ # if ( scalar @_ ) {
+ # my ( $a, $b, $c, $d, $e, $f ) = @_;
+ # }
+ if ( $raw_tok eq '(' ) {
+ my $ci = $ci_levels_to_go[$ibeg];
+ if ( $container_name[$depth] =~ /^\+(if|unless)/
+ && $ci )
+ {
+ $tok .= $container_name[$depth];
+ }
+ }
+
+ # Decorate block braces with block types to avoid
+ # unwanted alignments such as the following:
+ # foreach ( @{$routput_array} ) { $fh->print($_) }
+ # eval { $fh->close() };
+ if ( $raw_tok eq '{' && $block_type_to_go[$i] ) {
+ my $block_type = $block_type_to_go[$i];
+
+ # map certain related block types to allow
+ # else blocks to align
+ $block_type = $block_type_map{$block_type}
+ if ( defined( $block_type_map{$block_type} ) );
+
+ # remove sub names to allow one-line sub braces to align
+ # regardless of name
+ if ( $block_type =~ /^sub / ) { $block_type = 'sub' }
+
+ # allow all control-type blocks to align
+ if ( $block_type =~ /^[A-Z]+$/ ) { $block_type = 'BEGIN' }
+
+ $tok .= $block_type;
+ }
+
+ # concatenate the text of the consecutive tokens to form
+ # the field
+ push( @fields,
+ join( '', @tokens_to_go[ $i_start .. $i - 1 ] ) );
+
+ # store the alignment token for this field
+ push( @tokens, $tok );
+
+ # get ready for the next batch
+ $i_start = $i;
+ $j++;
+ $patterns[$j] = "";
+ }
+
+ # continue accumulating tokens
+ # handle non-keywords..
+ if ( $types_to_go[$i] ne 'k' ) {
+ my $type = $types_to_go[$i];
+
+ # Mark most things before arrows as a quote to
+ # get them to line up. Testfile: mixed.pl.
+ if ( ( $i < $iend - 1 ) && ( $type =~ /^[wnC]$/ ) ) {
+ my $next_type = $types_to_go[ $i + 1 ];
+ my $i_next_nonblank =
+ ( ( $next_type eq 'b' ) ? $i + 2 : $i + 1 );
+
+ if ( $types_to_go[$i_next_nonblank] eq '=>' ) {
+ $type = 'Q';
+
+ # Patch to ignore leading minus before words,
+ # by changing pattern 'mQ' into just 'Q',
+ # so that we can align things like this:
+ # Button => "Print letter \"~$_\"",
+ # -command => [ sub { print "$_[0]\n" }, $_ ],
+ if ( $patterns[$j] eq 'm' ) { $patterns[$j] = "" }
+ }
+ }
+
+ # patch to make numbers and quotes align
+ if ( $type eq 'n' ) { $type = 'Q' }
+
+ # patch to ignore any ! in patterns
+ if ( $type eq '!' ) { $type = '' }
+
+ $patterns[$j] .= $type;
+ }
+
+ # for keywords we have to use the actual text
+ else {
+
+ my $tok = $tokens_to_go[$i];
+
+ # but map certain keywords to a common string to allow
+ # alignment.
+ $tok = $keyword_map{$tok}
+ if ( defined( $keyword_map{$tok} ) );
+ $patterns[$j] .= $tok;
+ }
+ }
+
+ # done with this line .. join text of tokens to make the last field
+ push( @fields, join( '', @tokens_to_go[ $i_start .. $iend ] ) );
+ return ( \@tokens, \@fields, \@patterns );
+ }
+
+} # end make_alignment_patterns
+
+{ # begin unmatched_indexes
+
+ # closure to keep track of unbalanced containers.
+ # arrays shared by the routines in this block:
+ my @unmatched_opening_indexes_in_this_batch;
+ my @unmatched_closing_indexes_in_this_batch;
+ my %comma_arrow_count;
+
+ sub is_unbalanced_batch {
+ @unmatched_opening_indexes_in_this_batch +
+ @unmatched_closing_indexes_in_this_batch;
+ }
+
+ sub comma_arrow_count {
+ my $seqno = $_[0];
+ return $comma_arrow_count{$seqno};
+ }
+
+ sub match_opening_and_closing_tokens {
+
+ # Match up indexes of opening and closing braces, etc, in this batch.
+ # This has to be done after all tokens are stored because unstoring
+ # of tokens would otherwise cause trouble.
+
+ @unmatched_opening_indexes_in_this_batch = ();
+ @unmatched_closing_indexes_in_this_batch = ();
+ %comma_arrow_count = ();
+
+ my ( $i, $i_mate, $token );
+ foreach $i ( 0 .. $max_index_to_go ) {
+ if ( $type_sequence_to_go[$i] ) {
+ $token = $tokens_to_go[$i];
+ if ( $token =~ /^[\(\[\{\?]$/ ) {
+ push @unmatched_opening_indexes_in_this_batch, $i;
+ }
+ elsif ( $token =~ /^[\)\]\}\:]$/ ) {
+
+ $i_mate = pop @unmatched_opening_indexes_in_this_batch;
+ if ( defined($i_mate) && $i_mate >= 0 ) {
+ if ( $type_sequence_to_go[$i_mate] ==
+ $type_sequence_to_go[$i] )
+ {
+ $mate_index_to_go[$i] = $i_mate;
+ $mate_index_to_go[$i_mate] = $i;
+ }
+ else {
+ push @unmatched_opening_indexes_in_this_batch,
+ $i_mate;
+ push @unmatched_closing_indexes_in_this_batch, $i;
+ }
+ }
+ else {
+ push @unmatched_closing_indexes_in_this_batch, $i;
+ }
+ }
+ }
+ elsif ( $tokens_to_go[$i] eq '=>' ) {
+ if (@unmatched_opening_indexes_in_this_batch) {
+ my $j = $unmatched_opening_indexes_in_this_batch[-1];
+ my $seqno = $type_sequence_to_go[$j];
+ $comma_arrow_count{$seqno}++;
+ }
+ }
+ }
+ }
+
+ sub save_opening_indentation {
+
+ # This should be called after each batch of tokens is output. It
+ # saves indentations of lines of all unmatched opening tokens.
+ # These will be used by sub get_opening_indentation.
+
+ my ( $ri_first, $ri_last, $rindentation_list ) = @_;
+
+ # we no longer need indentations of any saved indentations which
+ # are unmatched closing tokens in this batch, because we will
+ # never encounter them again. So we can delete them to keep
+ # the hash size down.
+ foreach (@unmatched_closing_indexes_in_this_batch) {
+ my $seqno = $type_sequence_to_go[$_];
+ delete $saved_opening_indentation{$seqno};
+ }
+
+ # we need to save indentations of any unmatched opening tokens
+ # in this batch because we may need them in a subsequent batch.
+ foreach (@unmatched_opening_indexes_in_this_batch) {
+ my $seqno = $type_sequence_to_go[$_];
+ $saved_opening_indentation{$seqno} = [
+ lookup_opening_indentation(
+ $_, $ri_first, $ri_last, $rindentation_list
+ )
+ ];
+ }
+ }
+} # end unmatched_indexes
+
+sub get_opening_indentation {
+
+ # get the indentation of the line which output the opening token
+ # corresponding to a given closing token in the current output batch.
+ #
+ # given:
+ # $i_closing - index in this line of a closing token ')' '}' or ']'
+ #
+ # $ri_first - reference to list of the first index $i for each output
+ # line in this batch
+ # $ri_last - reference to list of the last index $i for each output line
+ # in this batch
+ # $rindentation_list - reference to a list containing the indentation
+ # used for each line.
+ #
+ # return:
+ # -the indentation of the line which contained the opening token
+ # which matches the token at index $i_opening
+ # -and its offset (number of columns) from the start of the line
+ #
+ my ( $i_closing, $ri_first, $ri_last, $rindentation_list ) = @_;
+
+ # first, see if the opening token is in the current batch
+ my $i_opening = $mate_index_to_go[$i_closing];
+ my ( $indent, $offset, $is_leading, $exists );
+ $exists = 1;
+ if ( $i_opening >= 0 ) {
+
+ # it is..look up the indentation
+ ( $indent, $offset, $is_leading ) =
+ lookup_opening_indentation( $i_opening, $ri_first, $ri_last,
+ $rindentation_list );
+ }
+
+ # if not, it should have been stored in the hash by a previous batch
+ else {
+ my $seqno = $type_sequence_to_go[$i_closing];
+ if ($seqno) {
+ if ( $saved_opening_indentation{$seqno} ) {
+ ( $indent, $offset, $is_leading ) =
+ @{ $saved_opening_indentation{$seqno} };
+ }
+
+ # some kind of serious error
+ # (example is badfile.t)
+ else {
+ $indent = 0;
+ $offset = 0;
+ $is_leading = 0;
+ $exists = 0;
+ }
+ }
+
+ # if no sequence number it must be an unbalanced container
+ else {
+ $indent = 0;
+ $offset = 0;
+ $is_leading = 0;
+ $exists = 0;
+ }
+ }
+ return ( $indent, $offset, $is_leading, $exists );
+}
+
+sub lookup_opening_indentation {
+
+ # get the indentation of the line in the current output batch
+ # which output a selected opening token
+ #
+ # given:
+ # $i_opening - index of an opening token in the current output batch
+ # whose line indentation we need
+ # $ri_first - reference to list of the first index $i for each output
+ # line in this batch
+ # $ri_last - reference to list of the last index $i for each output line
+ # in this batch
+ # $rindentation_list - reference to a list containing the indentation
+ # used for each line. (NOTE: the first slot in
+ # this list is the last returned line number, and this is
+ # followed by the list of indentations).
+ #
+ # return
+ # -the indentation of the line which contained token $i_opening
+ # -and its offset (number of columns) from the start of the line
+
+ my ( $i_opening, $ri_start, $ri_last, $rindentation_list ) = @_;
+
+ my $nline = $rindentation_list->[0]; # line number of previous lookup
+
+ # reset line location if necessary
+ $nline = 0 if ( $i_opening < $ri_start->[$nline] );
+
+ # find the correct line
+ unless ( $i_opening > $ri_last->[-1] ) {
+ while ( $i_opening > $ri_last->[$nline] ) { $nline++; }
+ }
+
+ # error - token index is out of bounds - shouldn't happen
+ else {
+ warning(
+"non-fatal program bug in lookup_opening_indentation - index out of range\n"
+ );
+ report_definite_bug();
+ $nline = $#{$ri_last};
+ }
+
+ $rindentation_list->[0] =
+ $nline; # save line number to start looking next call
+ my $ibeg = $ri_start->[$nline];
+ my $offset = token_sequence_length( $ibeg, $i_opening ) - 1;
+ my $is_leading = ( $ibeg == $i_opening );
+ return ( $rindentation_list->[ $nline + 1 ], $offset, $is_leading );
+}
+
+{
+ my %is_if_elsif_else_unless_while_until_for_foreach;
+
+ BEGIN {
+
+ # These block types may have text between the keyword and opening
+ # curly. Note: 'else' does not, but must be included to allow trailing
+ # if/elsif text to be appended.
+ # patch for SWITCH/CASE: added 'case' and 'when'
+ @_ = qw(if elsif else unless while until for foreach case when);
+ @is_if_elsif_else_unless_while_until_for_foreach{@_} = (1) x scalar(@_);
+ }
+
+ sub set_adjusted_indentation {
+
+ # This routine has the final say regarding the actual indentation of
+ # a line. It starts with the basic indentation which has been
+ # defined for the leading token, and then takes into account any
+ # options that the user has set regarding special indenting and
+ # outdenting.
+
+ my ( $ibeg, $iend, $rfields, $rpatterns, $ri_first, $ri_last,
+ $rindentation_list )
+ = @_;
+
+ # we need to know the last token of this line
+ my ( $terminal_type, $i_terminal ) =
+ terminal_type( \@types_to_go, \@block_type_to_go, $ibeg, $iend );
+
+ my $is_outdented_line = 0;
+
+ my $is_semicolon_terminated = $terminal_type eq ';'
+ && $nesting_depth_to_go[$iend] < $nesting_depth_to_go[$ibeg];
+
+ ##########################################################
+ # Section 1: set a flag and a default indentation
+ #
+ # Most lines are indented according to the initial token.
+ # But it is common to outdent to the level just after the
+ # terminal token in certain cases...
+ # adjust_indentation flag:
+ # 0 - do not adjust
+ # 1 - outdent
+ # 2 - vertically align with opening token
+ # 3 - indent
+ ##########################################################
+ my $adjust_indentation = 0;
+ my $default_adjust_indentation = $adjust_indentation;
+
+ my (
+ $opening_indentation, $opening_offset,
+ $is_leading, $opening_exists
+ );
+
+ # if we are at a closing token of some type..
+ if ( $types_to_go[$ibeg] =~ /^[\)\}\]]$/ ) {
+
+ # get the indentation of the line containing the corresponding
+ # opening token
+ (
+ $opening_indentation, $opening_offset,
+ $is_leading, $opening_exists
+ )
+ = get_opening_indentation( $ibeg, $ri_first, $ri_last,
+ $rindentation_list );
+
+ # First set the default behavior:
+ # default behavior is to outdent closing lines
+ # of the form: "); }; ]; )->xxx;"
+ if (
+ $is_semicolon_terminated
+
+ # and 'cuddled parens' of the form: ")->pack("
+ || (
+ $terminal_type eq '('
+ && $types_to_go[$ibeg] eq ')'
+ && ( $nesting_depth_to_go[$iend] + 1 ==
+ $nesting_depth_to_go[$ibeg] )
+ )
+ )
+ {
+ $adjust_indentation = 1;
+ }
+
+ # TESTING: outdent something like '),'
+ if (
+ $terminal_type eq ','
+
+ # allow just one character before the comma
+ && $i_terminal == $ibeg + 1
+
+ # requre LIST environment; otherwise, we may outdent too much --
+ # this can happen in calls without parentheses (overload.t);
+ && $container_environment_to_go[$i_terminal] eq 'LIST'
+ )
+ {
+ $adjust_indentation = 1;
+ }
+
+ # undo continuation indentation of a terminal closing token if
+ # it is the last token before a level decrease. This will allow
+ # a closing token to line up with its opening counterpart, and
+ # avoids a indentation jump larger than 1 level.
+ if ( $types_to_go[$i_terminal] =~ /^[\}\]\)R]$/
+ && $i_terminal == $ibeg )
+ {
+ my $ci = $ci_levels_to_go[$ibeg];
+ my $lev = $levels_to_go[$ibeg];
+ my $next_type = $types_to_go[ $ibeg + 1 ];
+ my $i_next_nonblank =
+ ( ( $next_type eq 'b' ) ? $ibeg + 2 : $ibeg + 1 );
+ if ( $i_next_nonblank <= $max_index_to_go
+ && $levels_to_go[$i_next_nonblank] < $lev )
+ {
+ $adjust_indentation = 1;
+ }
+ }
+
+ $default_adjust_indentation = $adjust_indentation;
+
+ # Now modify default behavior according to user request:
+ # handle option to indent non-blocks of the form ); }; ];
+ # But don't do special indentation to something like ')->pack('
+ if ( !$block_type_to_go[$ibeg] ) {
+ my $cti = $closing_token_indentation{ $tokens_to_go[$ibeg] };
+ if ( $cti == 1 ) {
+ if ( $i_terminal <= $ibeg + 1
+ || $is_semicolon_terminated )
+ {
+ $adjust_indentation = 2;
+ }
+ else {
+ $adjust_indentation = 0;
+ }
+ }
+ elsif ( $cti == 2 ) {
+ if ($is_semicolon_terminated) {
+ $adjust_indentation = 3;
+ }
+ else {
+ $adjust_indentation = 0;
+ }
+ }
+ elsif ( $cti == 3 ) {
+ $adjust_indentation = 3;
+ }
+ }
+
+ # handle option to indent blocks
+ else {
+ if (
+ $rOpts->{'indent-closing-brace'}
+ && (
+ $i_terminal == $ibeg # isolated terminal '}'
+ || $is_semicolon_terminated
+ )
+ ) # } xxxx ;
+ {
+ $adjust_indentation = 3;
+ }
+ }
+ }
+
+ # if at ');', '};', '>;', and '];' of a terminal qw quote
+ elsif ($$rpatterns[0] =~ /^qb*;$/
+ && $$rfields[0] =~ /^([\)\}\]\>]);$/ )
+ {
+ if ( $closing_token_indentation{$1} == 0 ) {
+ $adjust_indentation = 1;
+ }
+ else {
+ $adjust_indentation = 3;
+ }
+ }
+
+ # if line begins with a ':', align it with any
+ # previous line leading with corresponding ?
+ elsif ( $types_to_go[$ibeg] eq ':' ) {
+ (
+ $opening_indentation, $opening_offset,
+ $is_leading, $opening_exists
+ )
+ = get_opening_indentation( $ibeg, $ri_first, $ri_last,
+ $rindentation_list );
+ if ($is_leading) { $adjust_indentation = 2; }
+ }
+
+ ##########################################################
+ # Section 2: set indentation according to flag set above
+ #
+ # Select the indentation object to define leading
+ # whitespace. If we are outdenting something like '} } );'
+ # then we want to use one level below the last token
+ # ($i_terminal) in order to get it to fully outdent through
+ # all levels.
+ ##########################################################
+ my $indentation;
+ my $lev;
+ my $level_end = $levels_to_go[$iend];
+
+ if ( $adjust_indentation == 0 ) {
+ $indentation = $leading_spaces_to_go[$ibeg];
+ $lev = $levels_to_go[$ibeg];
+ }
+ elsif ( $adjust_indentation == 1 ) {
+ $indentation = $reduced_spaces_to_go[$i_terminal];
+ $lev = $levels_to_go[$i_terminal];
+ }
+
+ # handle indented closing token which aligns with opening token
+ elsif ( $adjust_indentation == 2 ) {
+
+ # handle option to align closing token with opening token
+ $lev = $levels_to_go[$ibeg];
+
+ # calculate spaces needed to align with opening token
+ my $space_count =
+ get_SPACES($opening_indentation) + $opening_offset;
+
+ # Indent less than the previous line.
+ #
+ # Problem: For -lp we don't exactly know what it was if there
+ # were recoverable spaces sent to the aligner. A good solution
+ # would be to force a flush of the vertical alignment buffer, so
+ # that we would know. For now, this rule is used for -lp:
+ #
+ # When the last line did not start with a closing token we will
+ # be optimistic that the aligner will recover everything wanted.
+ #
+ # This rule will prevent us from breaking a hierarchy of closing
+ # tokens, and in a worst case will leave a closing paren too far
+ # indented, but this is better than frequently leaving it not
+ # indented enough.
+ my $last_spaces = get_SPACES($last_indentation_written);
+ if ( $last_leading_token !~ /^[\}\]\)]$/ ) {
+ $last_spaces +=
+ get_RECOVERABLE_SPACES($last_indentation_written);
+ }
+
+ # reset the indentation to the new space count if it works
+ # only options are all or none: nothing in-between looks good
+ $lev = $levels_to_go[$ibeg];
+ if ( $space_count < $last_spaces ) {
+ if ($rOpts_line_up_parentheses) {
+ my $lev = $levels_to_go[$ibeg];
+ $indentation =
+ new_lp_indentation_item( $space_count, $lev, 0, 0, 0 );
+ }
+ else {
+ $indentation = $space_count;
+ }
+ }
+
+ # revert to default if it doesnt work
+ else {
+ $space_count = leading_spaces_to_go($ibeg);
+ if ( $default_adjust_indentation == 0 ) {
+ $indentation = $leading_spaces_to_go[$ibeg];
+ }
+ elsif ( $default_adjust_indentation == 1 ) {
+ $indentation = $reduced_spaces_to_go[$i_terminal];
+ $lev = $levels_to_go[$i_terminal];
+ }
+ }
+ }
+
+ # Full indentaion of closing tokens (-icb and -icp or -cti=2)
+ else {
+
+ # handle -icb (indented closing code block braces)
+ # Updated method for indented block braces: indent one full level if
+ # there is no continuation indentation. This will occur for major
+ # structures such as sub, if, else, but not for things like map
+ # blocks.
+ #
+ # Note: only code blocks without continuation indentation are
+ # handled here (if, else, unless, ..). In the following snippet,
+ # the terminal brace of the sort block will have continuation
+ # indentation as shown so it will not be handled by the coding
+ # here. We would have to undo the continuation indentation to do
+ # this, but it probably looks ok as is. This is a possible future
+ # update for semicolon terminated lines.
+ #
+ # if ($sortby eq 'date' or $sortby eq 'size') {
+ # @files = sort {
+ # $file_data{$a}{$sortby} <=> $file_data{$b}{$sortby}
+ # or $a cmp $b
+ # } @files;
+ # }
+ #
+ if ( $block_type_to_go[$ibeg]
+ && $ci_levels_to_go[$i_terminal] == 0 )
+ {
+ my $spaces = get_SPACES( $leading_spaces_to_go[$i_terminal] );
+ $indentation = $spaces + $rOpts_indent_columns;
+
+ # NOTE: for -lp we could create a new indentation object, but
+ # there is probably no need to do it
+ }
+
+ # handle -icp and any -icb block braces which fall through above
+ # test such as the 'sort' block mentioned above.
+ else {
+
+ # There are currently two ways to handle -icp...
+ # One way is to use the indentation of the previous line:
+ # $indentation = $last_indentation_written;
+
+ # The other way is to use the indentation that the previous line
+ # would have had if it hadn't been adjusted:
+ $indentation = $last_unadjusted_indentation;
+
+ # Current method: use the minimum of the two. This avoids
+ # inconsistent indentation.
+ if ( get_SPACES($last_indentation_written) <
+ get_SPACES($indentation) )
+ {
+ $indentation = $last_indentation_written;
+ }
+ }
+
+ # use previous indentation but use own level
+ # to cause list to be flushed properly
+ $lev = $levels_to_go[$ibeg];
+ }
+
+ # remember indentation except for multi-line quotes, which get
+ # no indentation
+ unless ( $ibeg == 0 && $starting_in_quote ) {
+ $last_indentation_written = $indentation;
+ $last_unadjusted_indentation = $leading_spaces_to_go[$ibeg];
+ $last_leading_token = $tokens_to_go[$ibeg];
+ }
+
+ # be sure lines with leading closing tokens are not outdented more
+ # than the line which contained the corresponding opening token.
+
+ #############################################################
+ # updated per bug report in alex_bug.pl: we must not
+ # mess with the indentation of closing logical braces so
+ # we must treat something like '} else {' as if it were
+ # an isolated brace my $is_isolated_block_brace = (
+ # $iend == $ibeg ) && $block_type_to_go[$ibeg];
+ #############################################################
+ my $is_isolated_block_brace = $block_type_to_go[$ibeg]
+ && ( $iend == $ibeg
+ || $is_if_elsif_else_unless_while_until_for_foreach{
+ $block_type_to_go[$ibeg] } );
+
+ # only do this for a ':; which is aligned with its leading '?'
+ my $is_unaligned_colon = $types_to_go[$ibeg] eq ':' && !$is_leading;
+ if ( defined($opening_indentation)
+ && !$is_isolated_block_brace
+ && !$is_unaligned_colon )
+ {
+ if ( get_SPACES($opening_indentation) > get_SPACES($indentation) ) {
+ $indentation = $opening_indentation;
+ }
+ }
+
+ # remember the indentation of each line of this batch
+ push @{$rindentation_list}, $indentation;
+
+ # outdent lines with certain leading tokens...
+ if (
+
+ # must be first word of this batch
+ $ibeg == 0
+
+ # and ...
+ && (
+
+ # certain leading keywords if requested
+ (
+ $rOpts->{'outdent-keywords'}
+ && $types_to_go[$ibeg] eq 'k'
+ && $outdent_keyword{ $tokens_to_go[$ibeg] }
+ )
+
+ # or labels if requested
+ || ( $rOpts->{'outdent-labels'} && $types_to_go[$ibeg] eq 'J' )
+
+ # or static block comments if requested
+ || ( $types_to_go[$ibeg] eq '#'
+ && $rOpts->{'outdent-static-block-comments'}
+ && $is_static_block_comment )
+ )
+ )
+
+ {
+ my $space_count = leading_spaces_to_go($ibeg);
+ if ( $space_count > 0 ) {
+ $space_count -= $rOpts_continuation_indentation;
+ $is_outdented_line = 1;
+ if ( $space_count < 0 ) { $space_count = 0 }
+
+ # do not promote a spaced static block comment to non-spaced;
+ # this is not normally necessary but could be for some
+ # unusual user inputs (such as -ci = -i)
+ if ( $types_to_go[$ibeg] eq '#' && $space_count == 0 ) {
+ $space_count = 1;
+ }
+
+ if ($rOpts_line_up_parentheses) {
+ $indentation =
+ new_lp_indentation_item( $space_count, $lev, 0, 0, 0 );
+ }
+ else {
+ $indentation = $space_count;
+ }
+ }
+ }
+
+ return ( $indentation, $lev, $level_end, $terminal_type,
+ $is_semicolon_terminated, $is_outdented_line );
+ }
+}
+
+sub set_vertical_tightness_flags {
+
+ my ( $n, $n_last_line, $ibeg, $iend, $ri_first, $ri_last ) = @_;
+
+ # Define vertical tightness controls for the nth line of a batch.
+ # We create an array of parameters which tell the vertical aligner
+ # if we should combine this line with the next line to achieve the
+ # desired vertical tightness. The array of parameters contains:
+ #
+ # [0] type: 1=is opening tok 2=is closing tok 3=is opening block brace
+ # [1] flag: if opening: 1=no multiple steps, 2=multiple steps ok
+ # if closing: spaces of padding to use
+ # [2] sequence number of container
+ # [3] valid flag: do not append if this flag is false. Will be
+ # true if appropriate -vt flag is set. Otherwise, Will be
+ # made true only for 2 line container in parens with -lp
+ #
+ # These flags are used by sub set_leading_whitespace in
+ # the vertical aligner
+
+ my $rvertical_tightness_flags = [ 0, 0, 0, 0, 0, 0 ];
+
+ # For non-BLOCK tokens, we will need to examine the next line
+ # too, so we won't consider the last line.
+ if ( $n < $n_last_line ) {
+
+ # see if last token is an opening token...not a BLOCK...
+ my $ibeg_next = $$ri_first[ $n + 1 ];
+ my $token_end = $tokens_to_go[$iend];
+ my $iend_next = $$ri_last[ $n + 1 ];
+ if (
+ $type_sequence_to_go[$iend]
+ && !$block_type_to_go[$iend]
+ && $is_opening_token{$token_end}
+ && (
+ $opening_vertical_tightness{$token_end} > 0
+
+ # allow 2-line method call to be closed up
+ || ( $rOpts_line_up_parentheses
+ && $token_end eq '('
+ && $iend > $ibeg
+ && $types_to_go[ $iend - 1 ] ne 'b' )
+ )
+ )
+ {
+
+ # avoid multiple jumps in nesting depth in one line if
+ # requested
+ my $ovt = $opening_vertical_tightness{$token_end};
+ my $iend_next = $$ri_last[ $n + 1 ];
+ unless (
+ $ovt < 2
+ && ( $nesting_depth_to_go[ $iend_next + 1 ] !=
+ $nesting_depth_to_go[$ibeg_next] )
+ )
+ {
+
+ # If -vt flag has not been set, mark this as invalid
+ # and aligner will validate it if it sees the closing paren
+ # within 2 lines.
+ my $valid_flag = $ovt;
+ @{$rvertical_tightness_flags} =
+ ( 1, $ovt, $type_sequence_to_go[$iend], $valid_flag );
+ }
+ }
+
+ # see if first token of next line is a closing token...
+ # ..and be sure this line does not have a side comment
+ my $token_next = $tokens_to_go[$ibeg_next];
+ if ( $type_sequence_to_go[$ibeg_next]
+ && !$block_type_to_go[$ibeg_next]
+ && $is_closing_token{$token_next}
+ && $types_to_go[$iend] !~ '#' ) # for safety, shouldn't happen!
+ {
+ my $ovt = $opening_vertical_tightness{$token_next};
+ my $cvt = $closing_vertical_tightness{$token_next};
+ if (
+
+ # never append a trailing line like )->pack(
+ # because it will throw off later alignment
+ (
+ $nesting_depth_to_go[$ibeg_next] ==
+ $nesting_depth_to_go[ $iend_next + 1 ] + 1
+ )
+ && (
+ $cvt == 2
+ || (
+ $container_environment_to_go[$ibeg_next] ne 'LIST'
+ && (
+ $cvt == 1
+
+ # allow closing up 2-line method calls
+ || ( $rOpts_line_up_parentheses
+ && $token_next eq ')' )
+ )
+ )
+ )
+ )
+ {
+
+ # decide which trailing closing tokens to append..
+ my $ok = 0;
+ if ( $cvt == 2 || $iend_next == $ibeg_next ) { $ok = 1 }
+ else {
+ my $str = join( '',
+ @types_to_go[ $ibeg_next + 1 .. $ibeg_next + 2 ] );
+
+ # append closing token if followed by comment or ';'
+ if ( $str =~ /^b?[#;]/ ) { $ok = 1 }
+ }
+
+ if ($ok) {
+ my $valid_flag = $cvt;
+ @{$rvertical_tightness_flags} = (
+ 2,
+ $tightness{$token_next} == 2 ? 0 : 1,
+ $type_sequence_to_go[$ibeg_next], $valid_flag,
+ );
+ }
+ }
+ }
+
+ # Opening Token Right
+ # If requested, move an isolated trailing opening token to the end of
+ # the previous line which ended in a comma. We could do this
+ # in sub recombine_breakpoints but that would cause problems
+ # with -lp formatting. The problem is that indentation will
+ # quickly move far to the right in nested expressions. By
+ # doing it after indentation has been set, we avoid changes
+ # to the indentation. Actual movement of the token takes place
+ # in sub write_leader_and_string.
+ if (
+ $opening_token_right{ $tokens_to_go[$ibeg_next] }
+
+ # previous line is not opening
+ # (use -sot to combine with it)
+ && !$is_opening_token{$token_end}
+
+ # previous line ended in one of these
+ # (add other cases if necessary; '=>' and '.' are not necessary
+ ##&& ($is_opening_token{$token_end} || $token_end eq ',')
+ && !$block_type_to_go[$ibeg_next]
+
+ # this is a line with just an opening token
+ && ( $iend_next == $ibeg_next
+ || $iend_next == $ibeg_next + 2
+ && $types_to_go[$iend_next] eq '#' )
+
+ # looks bad if we align vertically with the wrong container
+ && $tokens_to_go[$ibeg] ne $tokens_to_go[$ibeg_next]
+ )
+ {
+ my $valid_flag = 1;
+ my $spaces = ( $types_to_go[ $ibeg_next - 1 ] eq 'b' ) ? 1 : 0;
+ @{$rvertical_tightness_flags} =
+ ( 2, $spaces, $type_sequence_to_go[$ibeg_next], $valid_flag, );
+ }
+
+ # Stacking of opening and closing tokens
+ my $stackable;
+ my $token_beg_next = $tokens_to_go[$ibeg_next];
+
+ # patch to make something like 'qw(' behave like an opening paren
+ # (aran.t)
+ if ( $types_to_go[$ibeg_next] eq 'q' ) {
+ if ( $token_beg_next =~ /^qw\s*([\[\(\{])$/ ) {
+ $token_beg_next = $1;
+ }
+ }
+
+ if ( $is_closing_token{$token_end}
+ && $is_closing_token{$token_beg_next} )
+ {
+ $stackable = $stack_closing_token{$token_beg_next}
+ unless ( $block_type_to_go[$ibeg_next] )
+ ; # shouldn't happen; just checking
+ }
+ elsif ($is_opening_token{$token_end}
+ && $is_opening_token{$token_beg_next} )
+ {
+ $stackable = $stack_opening_token{$token_beg_next}
+ unless ( $block_type_to_go[$ibeg_next] )
+ ; # shouldn't happen; just checking
+ }
+
+ if ($stackable) {
+
+ my $is_semicolon_terminated;
+ if ( $n + 1 == $n_last_line ) {
+ my ( $terminal_type, $i_terminal ) = terminal_type(
+ \@types_to_go, \@block_type_to_go,
+ $ibeg_next, $iend_next
+ );
+ $is_semicolon_terminated = $terminal_type eq ';'
+ && $nesting_depth_to_go[$iend_next] <
+ $nesting_depth_to_go[$ibeg_next];
+ }
+
+ # this must be a line with just an opening token
+ # or end in a semicolon
+ if (
+ $is_semicolon_terminated
+ || ( $iend_next == $ibeg_next
+ || $iend_next == $ibeg_next + 2
+ && $types_to_go[$iend_next] eq '#' )
+ )
+ {
+ my $valid_flag = 1;
+ my $spaces = ( $types_to_go[ $ibeg_next - 1 ] eq 'b' ) ? 1 : 0;
+ @{$rvertical_tightness_flags} =
+ ( 2, $spaces, $type_sequence_to_go[$ibeg_next], $valid_flag,
+ );
+ }
+ }
+ }
+
+ # Check for a last line with isolated opening BLOCK curly
+ elsif ($rOpts_block_brace_vertical_tightness
+ && $ibeg eq $iend
+ && $types_to_go[$iend] eq '{'
+ && $block_type_to_go[$iend] =~
+ /$block_brace_vertical_tightness_pattern/o )
+ {
+ @{$rvertical_tightness_flags} =
+ ( 3, $rOpts_block_brace_vertical_tightness, 0, 1 );
+ }
+
+ # pack in the sequence numbers of the ends of this line
+ $rvertical_tightness_flags->[4] = get_seqno($ibeg);
+ $rvertical_tightness_flags->[5] = get_seqno($iend);
+ return $rvertical_tightness_flags;
+}
+
+sub get_seqno {
+
+ # get opening and closing sequence numbers of a token for the vertical
+ # aligner. Assign qw quotes a value to allow qw opening and closing tokens
+ # to be treated somewhat like opening and closing tokens for stacking
+ # tokens by the vertical aligner.
+ my ($ii) = @_;
+ my $seqno = $type_sequence_to_go[$ii];
+ if ( $types_to_go[$ii] eq 'q' ) {
+ my $SEQ_QW = -1;
+ if ( $ii > 0 ) {
+ $seqno = $SEQ_QW if ( $tokens_to_go[$ii] =~ /^qw\s*[\(\{\[]/ );
+ }
+ else {
+ if ( !$ending_in_quote ) {
+ $seqno = $SEQ_QW if ( $tokens_to_go[$ii] =~ /[\)\}\]]$/ );
+ }
+ }
+ }
+ return ($seqno);
+}
+
+{
+ my %is_vertical_alignment_type;
+ my %is_vertical_alignment_keyword;
+
+ BEGIN {
+
+ @_ = qw#
+ = **= += *= &= <<= &&= -= /= |= >>= ||= //= .= %= ^= x=
+ { ? : => =~ && || // ~~ !~~
+ #;
+ @is_vertical_alignment_type{@_} = (1) x scalar(@_);
+
+ @_ = qw(if unless and or err eq ne for foreach while until);
+ @is_vertical_alignment_keyword{@_} = (1) x scalar(@_);
+ }
+
+ sub set_vertical_alignment_markers {
+
+ # This routine takes the first step toward vertical alignment of the
+ # lines of output text. It looks for certain tokens which can serve as
+ # vertical alignment markers (such as an '=').
+ #
+ # Method: We look at each token $i in this output batch and set
+ # $matching_token_to_go[$i] equal to those tokens at which we would
+ # accept vertical alignment.
+
+ # nothing to do if we aren't allowed to change whitespace
+ if ( !$rOpts_add_whitespace ) {
+ for my $i ( 0 .. $max_index_to_go ) {
+ $matching_token_to_go[$i] = '';
+ }
+ return;
+ }
+
+ my ( $ri_first, $ri_last ) = @_;
+
+ # remember the index of last nonblank token before any sidecomment
+ my $i_terminal = $max_index_to_go;
+ if ( $types_to_go[$i_terminal] eq '#' ) {
+ if ( $i_terminal > 0 && $types_to_go[ --$i_terminal ] eq 'b' ) {
+ if ( $i_terminal > 0 ) { --$i_terminal }
+ }
+ }
+
+ # look at each line of this batch..
+ my $last_vertical_alignment_before_index;
+ my $vert_last_nonblank_type;
+ my $vert_last_nonblank_token;
+ my $vert_last_nonblank_block_type;
+ my $max_line = @$ri_first - 1;
+ my ( $i, $type, $token, $block_type, $alignment_type );
+ my ( $ibeg, $iend, $line );
+
+ foreach $line ( 0 .. $max_line ) {
+ $ibeg = $$ri_first[$line];
+ $iend = $$ri_last[$line];
+ $last_vertical_alignment_before_index = -1;
+ $vert_last_nonblank_type = '';
+ $vert_last_nonblank_token = '';
+ $vert_last_nonblank_block_type = '';
+
+ # look at each token in this output line..
+ foreach $i ( $ibeg .. $iend ) {
+ $alignment_type = '';
+ $type = $types_to_go[$i];
+ $block_type = $block_type_to_go[$i];
+ $token = $tokens_to_go[$i];
+
+ # check for flag indicating that we should not align
+ # this token
+ if ( $matching_token_to_go[$i] ) {
+ $matching_token_to_go[$i] = '';
+ next;
+ }
+
+ #--------------------------------------------------------
+ # First see if we want to align BEFORE this token
+ #--------------------------------------------------------
+
+ # The first possible token that we can align before
+ # is index 2 because: 1) it doesn't normally make sense to
+ # align before the first token and 2) the second
+ # token must be a blank if we are to align before
+ # the third
+ if ( $i < $ibeg + 2 ) { }
+
+ # must follow a blank token
+ elsif ( $types_to_go[ $i - 1 ] ne 'b' ) { }
+
+ # align a side comment --
+ elsif ( $type eq '#' ) {
+
+ unless (
+
+ # it is a static side comment
+ (
+ $rOpts->{'static-side-comments'}
+ && $token =~ /$static_side_comment_pattern/o
+ )
+
+ # or a closing side comment
+ || ( $vert_last_nonblank_block_type
+ && $token =~
+ /$closing_side_comment_prefix_pattern/o )
+ )
+ {
+ $alignment_type = $type;
+ } ## Example of a static side comment
+ }
+
+ # otherwise, do not align two in a row to create a
+ # blank field
+ elsif ( $last_vertical_alignment_before_index == $i - 2 ) { }
+
+ # align before one of these keywords
+ # (within a line, since $i>1)
+ elsif ( $type eq 'k' ) {
+
+ # /^(if|unless|and|or|eq|ne)$/
+ if ( $is_vertical_alignment_keyword{$token} ) {
+ $alignment_type = $token;
+ }
+ }
+
+ # align before one of these types..
+ # Note: add '.' after new vertical aligner is operational
+ elsif ( $is_vertical_alignment_type{$type} ) {
+ $alignment_type = $token;
+
+ # Do not align a terminal token. Although it might
+ # occasionally look ok to do this, it has been found to be
+ # a good general rule. The main problems are:
+ # (1) that the terminal token (such as an = or :) might get
+ # moved far to the right where it is hard to see because
+ # nothing follows it, and
+ # (2) doing so may prevent other good alignments.
+ if ( $i == $iend || $i >= $i_terminal ) {
+ $alignment_type = "";
+ }
+
+ # Do not align leading ': (' or '. ('. This would prevent
+ # alignment in something like the following:
+ # $extra_space .=
+ # ( $input_line_number < 10 ) ? " "
+ # : ( $input_line_number < 100 ) ? " "
+ # : "";
+ # or
+ # $code =
+ # ( $case_matters ? $accessor : " lc($accessor) " )
+ # . ( $yesno ? " eq " : " ne " )
+ if ( $i == $ibeg + 2
+ && $types_to_go[$ibeg] =~ /^[\.\:]$/
+ && $types_to_go[ $i - 1 ] eq 'b' )
+ {
+ $alignment_type = "";
+ }
+
+ # For a paren after keyword, only align something like this:
+ # if ( $a ) { &a }
+ # elsif ( $b ) { &b }
+ if ( $token eq '(' && $vert_last_nonblank_type eq 'k' ) {
+ $alignment_type = ""
+ unless $vert_last_nonblank_token =~
+ /^(if|unless|elsif)$/;
+ }
+
+ # be sure the alignment tokens are unique
+ # This didn't work well: reason not determined
+ # if ($token ne $type) {$alignment_type .= $type}
+ }
+
+ # NOTE: This is deactivated because it causes the previous
+ # if/elsif alignment to fail
+ #elsif ( $type eq '}' && $token eq '}' && $block_type_to_go[$i])
+ #{ $alignment_type = $type; }
+
+ if ($alignment_type) {
+ $last_vertical_alignment_before_index = $i;
+ }
+
+ #--------------------------------------------------------
+ # Next see if we want to align AFTER the previous nonblank
+ #--------------------------------------------------------
+
+ # We want to line up ',' and interior ';' tokens, with the added
+ # space AFTER these tokens. (Note: interior ';' is included
+ # because it may occur in short blocks).
+ if (
+
+ # we haven't already set it
+ !$alignment_type
+
+ # and its not the first token of the line
+ && ( $i > $ibeg )
+
+ # and it follows a blank
+ && $types_to_go[ $i - 1 ] eq 'b'
+
+ # and previous token IS one of these:
+ && ( $vert_last_nonblank_type =~ /^[\,\;]$/ )
+
+ # and it's NOT one of these
+ && ( $type !~ /^[b\#\)\]\}]$/ )
+
+ # then go ahead and align
+ )
+
+ {
+ $alignment_type = $vert_last_nonblank_type;
+ }
+
+ #--------------------------------------------------------
+ # then store the value
+ #--------------------------------------------------------
+ $matching_token_to_go[$i] = $alignment_type;
+ if ( $type ne 'b' ) {
+ $vert_last_nonblank_type = $type;
+ $vert_last_nonblank_token = $token;
+ $vert_last_nonblank_block_type = $block_type;
+ }
+ }
+ }
+ }
+}
+
+sub terminal_type {
+
+ # returns type of last token on this line (terminal token), as follows:
+ # returns # for a full-line comment
+ # returns ' ' for a blank line
+ # otherwise returns final token type
+
+ my ( $rtype, $rblock_type, $ibeg, $iend ) = @_;
+
+ # check for full-line comment..
+ if ( $$rtype[$ibeg] eq '#' ) {
+ return wantarray ? ( $$rtype[$ibeg], $ibeg ) : $$rtype[$ibeg];
+ }
+ else {
+
+ # start at end and walk bakwards..
+ for ( my $i = $iend ; $i >= $ibeg ; $i-- ) {
+
+ # skip past any side comment and blanks
+ next if ( $$rtype[$i] eq 'b' );
+ next if ( $$rtype[$i] eq '#' );
+
+ # found it..make sure it is a BLOCK termination,
+ # but hide a terminal } after sort/grep/map because it is not
+ # necessarily the end of the line. (terminal.t)
+ my $terminal_type = $$rtype[$i];
+ if (
+ $terminal_type eq '}'
+ && ( !$$rblock_type[$i]
+ || ( $is_sort_map_grep_eval_do{ $$rblock_type[$i] } ) )
+ )
+ {
+ $terminal_type = 'b';
+ }
+ return wantarray ? ( $terminal_type, $i ) : $terminal_type;
+ }
+
+ # empty line
+ return wantarray ? ( ' ', $ibeg ) : ' ';
+ }
+}
+
+{
+ my %is_good_keyword_breakpoint;
+ my %is_lt_gt_le_ge;
+
+ sub set_bond_strengths {
+
+ BEGIN {
+
+ @_ = qw(if unless while until for foreach);
+ @is_good_keyword_breakpoint{@_} = (1) x scalar(@_);
+
+ @_ = qw(lt gt le ge);
+ @is_lt_gt_le_ge{@_} = (1) x scalar(@_);
+
+ ###############################################################
+ # NOTE: NO_BREAK's set here are HINTS which may not be honored;
+ # essential NO_BREAKS's must be enforced in section 2, below.
+ ###############################################################
+
+ # adding NEW_TOKENS: add a left and right bond strength by
+ # mimmicking what is done for an existing token type. You
+ # can skip this step at first and take the default, then
+ # tweak later to get desired results.
+
+ # The bond strengths should roughly follow precenence order where
+ # possible. If you make changes, please check the results very
+ # carefully on a variety of scripts.
+
+ # no break around possible filehandle
+ $left_bond_strength{'Z'} = NO_BREAK;
+ $right_bond_strength{'Z'} = NO_BREAK;
+
+ # never put a bare word on a new line:
+ # example print (STDERR, "bla"); will fail with break after (
+ $left_bond_strength{'w'} = NO_BREAK;
+
+ # blanks always have infinite strength to force breaks after real tokens
+ $right_bond_strength{'b'} = NO_BREAK;
+
+ # try not to break on exponentation
+ @_ = qw" ** .. ... <=> ";
+ @left_bond_strength{@_} = (STRONG) x scalar(@_);
+ @right_bond_strength{@_} = (STRONG) x scalar(@_);
+
+ # The comma-arrow has very low precedence but not a good break point
+ $left_bond_strength{'=>'} = NO_BREAK;
+ $right_bond_strength{'=>'} = NOMINAL;
+
+ # ok to break after label
+ $left_bond_strength{'J'} = NO_BREAK;
+ $right_bond_strength{'J'} = NOMINAL;
+ $left_bond_strength{'j'} = STRONG;
+ $right_bond_strength{'j'} = STRONG;
+ $left_bond_strength{'A'} = STRONG;
+ $right_bond_strength{'A'} = STRONG;
+
+ $left_bond_strength{'->'} = STRONG;
+ $right_bond_strength{'->'} = VERY_STRONG;
+
+ # breaking AFTER modulus operator is ok:
+ @_ = qw" % ";
+ @left_bond_strength{@_} = (STRONG) x scalar(@_);
+ @right_bond_strength{@_} =
+ ( 0.1 * NOMINAL + 0.9 * STRONG ) x scalar(@_);
+
+ # Break AFTER math operators * and /
+ @_ = qw" * / x ";
+ @left_bond_strength{@_} = (STRONG) x scalar(@_);
+ @right_bond_strength{@_} = (NOMINAL) x scalar(@_);
+
+ # Break AFTER weakest math operators + and -
+ # Make them weaker than * but a bit stronger than '.'
+ @_ = qw" + - ";
+ @left_bond_strength{@_} = (STRONG) x scalar(@_);
+ @right_bond_strength{@_} =
+ ( 0.91 * NOMINAL + 0.09 * WEAK ) x scalar(@_);
+
+ # breaking BEFORE these is just ok:
+ @_ = qw" >> << ";
+ @right_bond_strength{@_} = (STRONG) x scalar(@_);
+ @left_bond_strength{@_} = (NOMINAL) x scalar(@_);
+
+ # breaking before the string concatenation operator seems best
+ # because it can be hard to see at the end of a line
+ $right_bond_strength{'.'} = STRONG;
+ $left_bond_strength{'.'} = 0.9 * NOMINAL + 0.1 * WEAK;
+
+ @_ = qw"} ] ) ";
+ @left_bond_strength{@_} = (STRONG) x scalar(@_);
+ @right_bond_strength{@_} = (NOMINAL) x scalar(@_);
+
+ # make these a little weaker than nominal so that they get
+ # favored for end-of-line characters
+ @_ = qw"!= == =~ !~ ~~ !~~";
+ @left_bond_strength{@_} = (STRONG) x scalar(@_);
+ @right_bond_strength{@_} =
+ ( 0.9 * NOMINAL + 0.1 * WEAK ) x scalar(@_);
+
+ # break AFTER these
+ @_ = qw" < > | & >= <=";
+ @left_bond_strength{@_} = (VERY_STRONG) x scalar(@_);
+ @right_bond_strength{@_} =
+ ( 0.8 * NOMINAL + 0.2 * WEAK ) x scalar(@_);
+
+ # breaking either before or after a quote is ok
+ # but bias for breaking before a quote
+ $left_bond_strength{'Q'} = NOMINAL;
+ $right_bond_strength{'Q'} = NOMINAL + 0.02;
+ $left_bond_strength{'q'} = NOMINAL;
+ $right_bond_strength{'q'} = NOMINAL;
+
+ # starting a line with a keyword is usually ok
+ $left_bond_strength{'k'} = NOMINAL;
+
+ # we usually want to bond a keyword strongly to what immediately
+ # follows, rather than leaving it stranded at the end of a line
+ $right_bond_strength{'k'} = STRONG;
+
+ $left_bond_strength{'G'} = NOMINAL;
+ $right_bond_strength{'G'} = STRONG;
+
+ # it is good to break AFTER various assignment operators
+ @_ = qw(
+ = **= += *= &= <<= &&=
+ -= /= |= >>= ||= //=
+ .= %= ^=
+ x=
+ );
+ @left_bond_strength{@_} = (STRONG) x scalar(@_);
+ @right_bond_strength{@_} =
+ ( 0.4 * WEAK + 0.6 * VERY_WEAK ) x scalar(@_);
+
+ # break BEFORE '&&' and '||' and '//'
+ # set strength of '||' to same as '=' so that chains like
+ # $a = $b || $c || $d will break before the first '||'
+ $right_bond_strength{'||'} = NOMINAL;
+ $left_bond_strength{'||'} = $right_bond_strength{'='};
+
+ # same thing for '//'
+ $right_bond_strength{'//'} = NOMINAL;
+ $left_bond_strength{'//'} = $right_bond_strength{'='};
+
+ # set strength of && a little higher than ||
+ $right_bond_strength{'&&'} = NOMINAL;
+ $left_bond_strength{'&&'} = $left_bond_strength{'||'} + 0.1;
+
+ $left_bond_strength{';'} = VERY_STRONG;
+ $right_bond_strength{';'} = VERY_WEAK;
+ $left_bond_strength{'f'} = VERY_STRONG;
+
+ # make right strength of for ';' a little less than '='
+ # to make for contents break after the ';' to avoid this:
+ # for ( $j = $number_of_fields - 1 ; $j < $item_count ; $j +=
+ # $number_of_fields )
+ # and make it weaker than ',' and 'and' too
+ $right_bond_strength{'f'} = VERY_WEAK - 0.03;
+
+ # The strengths of ?/: should be somewhere between
+ # an '=' and a quote (NOMINAL),
+ # make strength of ':' slightly less than '?' to help
+ # break long chains of ? : after the colons
+ $left_bond_strength{':'} = 0.4 * WEAK + 0.6 * NOMINAL;
+ $right_bond_strength{':'} = NO_BREAK;
+ $left_bond_strength{'?'} = $left_bond_strength{':'} + 0.01;
+ $right_bond_strength{'?'} = NO_BREAK;
+
+ $left_bond_strength{','} = VERY_STRONG;
+ $right_bond_strength{','} = VERY_WEAK;
+
+ # Set bond strengths of certain keywords
+ # make 'or', 'err', 'and' slightly weaker than a ','
+ $left_bond_strength{'and'} = VERY_WEAK - 0.01;
+ $left_bond_strength{'or'} = VERY_WEAK - 0.02;
+ $left_bond_strength{'err'} = VERY_WEAK - 0.02;
+ $left_bond_strength{'xor'} = NOMINAL;
+ $right_bond_strength{'and'} = NOMINAL;
+ $right_bond_strength{'or'} = NOMINAL;
+ $right_bond_strength{'err'} = NOMINAL;
+ $right_bond_strength{'xor'} = STRONG;
+ }
+
+ # patch-its always ok to break at end of line
+ $nobreak_to_go[$max_index_to_go] = 0;
+
+ # adding a small 'bias' to strengths is a simple way to make a line
+ # break at the first of a sequence of identical terms. For example,
+ # to force long string of conditional operators to break with
+ # each line ending in a ':', we can add a small number to the bond
+ # strength of each ':'
+ my $colon_bias = 0;
+ my $amp_bias = 0;
+ my $bar_bias = 0;
+ my $and_bias = 0;
+ my $or_bias = 0;
+ my $dot_bias = 0;
+ my $f_bias = 0;
+ my $code_bias = -.01;
+ my $type = 'b';
+ my $token = ' ';
+ my $last_type;
+ my $last_nonblank_type = $type;
+ my $last_nonblank_token = $token;
+ my $delta_bias = 0.0001;
+ my $list_str = $left_bond_strength{'?'};
+
+ my ( $block_type, $i_next, $i_next_nonblank, $next_nonblank_token,
+ $next_nonblank_type, $next_token, $next_type, $total_nesting_depth,
+ );
+
+ # preliminary loop to compute bond strengths
+ for ( my $i = 0 ; $i <= $max_index_to_go ; $i++ ) {
+ $last_type = $type;
+ if ( $type ne 'b' ) {
+ $last_nonblank_type = $type;
+ $last_nonblank_token = $token;
+ }
+ $type = $types_to_go[$i];
+
+ # strength on both sides of a blank is the same
+ if ( $type eq 'b' && $last_type ne 'b' ) {
+ $bond_strength_to_go[$i] = $bond_strength_to_go[ $i - 1 ];
+ next;
+ }
+
+ $token = $tokens_to_go[$i];
+ $block_type = $block_type_to_go[$i];
+ $i_next = $i + 1;
+ $next_type = $types_to_go[$i_next];
+ $next_token = $tokens_to_go[$i_next];
+ $total_nesting_depth = $nesting_depth_to_go[$i_next];
+ $i_next_nonblank = ( ( $next_type eq 'b' ) ? $i + 2 : $i + 1 );
+ $next_nonblank_type = $types_to_go[$i_next_nonblank];
+ $next_nonblank_token = $tokens_to_go[$i_next_nonblank];
+
+ # Some token chemistry... The decision about where to break a
+ # line depends upon a "bond strength" between tokens. The LOWER
+ # the bond strength, the MORE likely a break. The strength
+ # values are based on trial-and-error, and need to be tweaked
+ # occasionally to get desired results. Things to keep in mind
+ # are:
+ # 1. relative strengths are important. small differences
+ # in strengths can make big formatting differences.
+ # 2. each indentation level adds one unit of bond strength
+ # 3. a value of NO_BREAK makes an unbreakable bond
+ # 4. a value of VERY_WEAK is the strength of a ','
+ # 5. values below NOMINAL are considered ok break points
+ # 6. values above NOMINAL are considered poor break points
+ # We are computing the strength of the bond between the current
+ # token and the NEXT token.
+ my $bond_str = VERY_STRONG; # a default, high strength
+
+ #---------------------------------------------------------------
+ # section 1:
+ # use minimum of left and right bond strengths if defined;
+ # digraphs and trigraphs like to break on their left
+ #---------------------------------------------------------------
+ my $bsr = $right_bond_strength{$type};
+
+ if ( !defined($bsr) ) {
+
+ if ( $is_digraph{$type} || $is_trigraph{$type} ) {
+ $bsr = STRONG;
+ }
+ else {
+ $bsr = VERY_STRONG;
+ }
+ }
+
+ # define right bond strengths of certain keywords
+ if ( $type eq 'k' && defined( $right_bond_strength{$token} ) ) {
+ $bsr = $right_bond_strength{$token};
+ }
+ elsif ( $token eq 'ne' or $token eq 'eq' ) {
+ $bsr = NOMINAL;
+ }
+ my $bsl = $left_bond_strength{$next_nonblank_type};
+
+ # set terminal bond strength to the nominal value
+ # this will cause good preceding breaks to be retained
+ if ( $i_next_nonblank > $max_index_to_go ) {
+ $bsl = NOMINAL;
+ }
+
+ if ( !defined($bsl) ) {
+
+ if ( $is_digraph{$next_nonblank_type}
+ || $is_trigraph{$next_nonblank_type} )
+ {
+ $bsl = WEAK;
+ }
+ else {
+ $bsl = VERY_STRONG;
+ }
+ }
+
+ # define right bond strengths of certain keywords
+ if ( $next_nonblank_type eq 'k'
+ && defined( $left_bond_strength{$next_nonblank_token} ) )
+ {
+ $bsl = $left_bond_strength{$next_nonblank_token};
+ }
+ elsif ($next_nonblank_token eq 'ne'
+ or $next_nonblank_token eq 'eq' )
+ {
+ $bsl = NOMINAL;
+ }
+ elsif ( $is_lt_gt_le_ge{$next_nonblank_token} ) {
+ $bsl = 0.9 * NOMINAL + 0.1 * STRONG;
+ }
+
+ # Note: it might seem that we would want to keep a NO_BREAK if
+ # either token has this value. This didn't work, because in an
+ # arrow list, it prevents the comma from separating from the
+ # following bare word (which is probably quoted by its arrow).
+ # So necessary NO_BREAK's have to be handled as special cases
+ # in the final section.
+ $bond_str = ( $bsr < $bsl ) ? $bsr : $bsl;
+ my $bond_str_1 = $bond_str;
+
+ #---------------------------------------------------------------
+ # section 2:
+ # special cases
+ #---------------------------------------------------------------
+
+ # allow long lines before final { in an if statement, as in:
+ # if (..........
+ # ..........)
+ # {
+ #
+ # Otherwise, the line before the { tends to be too short.
+ if ( $type eq ')' ) {
+ if ( $next_nonblank_type eq '{' ) {
+ $bond_str = VERY_WEAK + 0.03;
+ }
+ }
+
+ elsif ( $type eq '(' ) {
+ if ( $next_nonblank_type eq '{' ) {
+ $bond_str = NOMINAL;
+ }
+ }
+
+ # break on something like '} (', but keep this stronger than a ','
+ # example is in 'howe.pl'
+ elsif ( $type eq 'R' or $type eq '}' ) {
+ if ( $next_nonblank_type eq '(' ) {
+ $bond_str = 0.8 * VERY_WEAK + 0.2 * WEAK;
+ }
+ }
+
+ #-----------------------------------------------------------------
+ # adjust bond strength bias
+ #-----------------------------------------------------------------
+
+ # TESTING: add any bias set by sub scan_list at old comma
+ # break points.
+ elsif ( $type eq ',' ) {
+ $bond_str += $bond_strength_to_go[$i];
+ }
+
+ elsif ( $type eq 'f' ) {
+ $bond_str += $f_bias;
+ $f_bias += $delta_bias;
+ }
+
+ # in long ?: conditionals, bias toward just one set per line (colon.t)
+ elsif ( $type eq ':' ) {
+ if ( !$want_break_before{$type} ) {
+ $bond_str += $colon_bias;
+ $colon_bias += $delta_bias;
+ }
+ }
+
+ if ( $next_nonblank_type eq ':'
+ && $want_break_before{$next_nonblank_type} )
+ {
+ $bond_str += $colon_bias;
+ $colon_bias += $delta_bias;
+ }
+
+ # if leading '.' is used, align all but 'short' quotes;
+ # the idea is to not place something like "\n" on a single line.
+ elsif ( $next_nonblank_type eq '.' ) {
+ if ( $want_break_before{'.'} ) {
+ unless (
+ $last_nonblank_type eq '.'
+ && (
+ length($token) <=
+ $rOpts_short_concatenation_item_length )
+ && ( $token !~ /^[\)\]\}]$/ )
+ )
+ {
+ $dot_bias += $delta_bias;
+ }
+ $bond_str += $dot_bias;
+ }
+ }
+ elsif ($next_nonblank_type eq '&&'
+ && $want_break_before{$next_nonblank_type} )
+ {
+ $bond_str += $amp_bias;
+ $amp_bias += $delta_bias;
+ }
+ elsif ($next_nonblank_type eq '||'
+ && $want_break_before{$next_nonblank_type} )
+ {
+ $bond_str += $bar_bias;
+ $bar_bias += $delta_bias;
+ }
+ elsif ( $next_nonblank_type eq 'k' ) {
+
+ if ( $next_nonblank_token eq 'and'
+ && $want_break_before{$next_nonblank_token} )
+ {
+ $bond_str += $and_bias;
+ $and_bias += $delta_bias;
+ }
+ elsif ($next_nonblank_token =~ /^(or|err)$/
+ && $want_break_before{$next_nonblank_token} )
+ {
+ $bond_str += $or_bias;
+ $or_bias += $delta_bias;
+ }
+
+ # FIXME: needs more testing
+ elsif ( $is_keyword_returning_list{$next_nonblank_token} ) {
+ $bond_str = $list_str if ( $bond_str > $list_str );
+ }
+ elsif ( $token eq 'err'
+ && !$want_break_before{$token} )
+ {
+ $bond_str += $or_bias;
+ $or_bias += $delta_bias;
+ }
+ }
+
+ if ( $type eq ':'
+ && !$want_break_before{$type} )
+ {
+ $bond_str += $colon_bias;
+ $colon_bias += $delta_bias;
+ }
+ elsif ( $type eq '&&'
+ && !$want_break_before{$type} )
+ {
+ $bond_str += $amp_bias;
+ $amp_bias += $delta_bias;
+ }
+ elsif ( $type eq '||'
+ && !$want_break_before{$type} )
+ {
+ $bond_str += $bar_bias;
+ $bar_bias += $delta_bias;
+ }
+ elsif ( $type eq 'k' ) {
+
+ if ( $token eq 'and'
+ && !$want_break_before{$token} )
+ {
+ $bond_str += $and_bias;
+ $and_bias += $delta_bias;
+ }
+ elsif ( $token eq 'or'
+ && !$want_break_before{$token} )
+ {
+ $bond_str += $or_bias;
+ $or_bias += $delta_bias;
+ }
+ }
+
+ # keep matrix and hash indices together
+ # but make them a little below STRONG to allow breaking open
+ # something like {'some-word'}{'some-very-long-word'} at the }{
+ # (bracebrk.t)
+ if ( ( $type eq ']' or $type eq 'R' )
+ && ( $next_nonblank_type eq '[' or $next_nonblank_type eq 'L' )
+ )
+ {
+ $bond_str = 0.9 * STRONG + 0.1 * NOMINAL;
+ }
+
+ if ( $next_nonblank_token =~ /^->/ ) {
+
+ # increase strength to the point where a break in the following
+ # will be after the opening paren rather than at the arrow:
+ # $a->$b($c);
+ if ( $type eq 'i' ) {
+ $bond_str = 1.45 * STRONG;
+ }
+
+ elsif ( $type =~ /^[\)\]\}R]$/ ) {
+ $bond_str = 0.1 * STRONG + 0.9 * NOMINAL;
+ }
+
+ # otherwise make strength before an '->' a little over a '+'
+ else {
+ if ( $bond_str <= NOMINAL ) {
+ $bond_str = NOMINAL + 0.01;
+ }
+ }
+ }
+
+ if ( $token eq ')' && $next_nonblank_token eq '[' ) {
+ $bond_str = 0.2 * STRONG + 0.8 * NOMINAL;
+ }
+
+ # map1.t -- correct for a quirk in perl
+ if ( $token eq '('
+ && $next_nonblank_type eq 'i'
+ && $last_nonblank_type eq 'k'
+ && $is_sort_map_grep{$last_nonblank_token} )
+
+ # /^(sort|map|grep)$/ )
+ {
+ $bond_str = NO_BREAK;
+ }
+
+ # extrude.t: do not break before paren at:
+ # -l pid_filename(
+ if ( $last_nonblank_type eq 'F' && $next_nonblank_token eq '(' ) {
+ $bond_str = NO_BREAK;
+ }
+
+ # good to break after end of code blocks
+ if ( $type eq '}' && $block_type ) {
+
+ $bond_str = 0.5 * WEAK + 0.5 * VERY_WEAK + $code_bias;
+ $code_bias += $delta_bias;
+ }
+
+ if ( $type eq 'k' ) {
+
+ # allow certain control keywords to stand out
+ if ( $next_nonblank_type eq 'k'
+ && $is_last_next_redo_return{$token} )
+ {
+ $bond_str = 0.45 * WEAK + 0.55 * VERY_WEAK;
+ }
+
+# Don't break after keyword my. This is a quick fix for a
+# rare problem with perl. An example is this line from file
+# Container.pm:
+# foreach my $question( Debian::DebConf::ConfigDb::gettree( $this->{'question'} ) )
+
+ if ( $token eq 'my' ) {
+ $bond_str = NO_BREAK;
+ }
+
+ }
+
+ # good to break before 'if', 'unless', etc
+ if ( $is_if_brace_follower{$next_nonblank_token} ) {
+ $bond_str = VERY_WEAK;
+ }
+
+ if ( $next_nonblank_type eq 'k' ) {
+
+ # keywords like 'unless', 'if', etc, within statements
+ # make good breaks
+ if ( $is_good_keyword_breakpoint{$next_nonblank_token} ) {
+ $bond_str = VERY_WEAK / 1.05;
+ }
+ }
+
+ # try not to break before a comma-arrow
+ elsif ( $next_nonblank_type eq '=>' ) {
+ if ( $bond_str < STRONG ) { $bond_str = STRONG }
+ }
+
+ #----------------------------------------------------------------------
+ # only set NO_BREAK's from here on
+ #----------------------------------------------------------------------
+ if ( $type eq 'C' or $type eq 'U' ) {
+
+ # use strict requires that bare word and => not be separated
+ if ( $next_nonblank_type eq '=>' ) {
+ $bond_str = NO_BREAK;
+ }
+
+ # Never break between a bareword and a following paren because
+ # perl may give an error. For example, if a break is placed
+ # between 'to_filehandle' and its '(' the following line will
+ # give a syntax error [Carp.pm]: my( $no) =fileno(
+ # to_filehandle( $in)) ;
+ if ( $next_nonblank_token eq '(' ) {
+ $bond_str = NO_BREAK;
+ }
+ }
+
+ # use strict requires that bare word within braces not start new line
+ elsif ( $type eq 'L' ) {
+
+ if ( $next_nonblank_type eq 'w' ) {
+ $bond_str = NO_BREAK;
+ }
+ }
+
+ # in older version of perl, use strict can cause problems with
+ # breaks before bare words following opening parens. For example,
+ # this will fail under older versions if a break is made between
+ # '(' and 'MAIL':
+ # use strict;
+ # open( MAIL, "a long filename or command");
+ # close MAIL;
+ elsif ( $type eq '{' ) {
+
+ if ( $token eq '(' && $next_nonblank_type eq 'w' ) {
+
+ # but it's fine to break if the word is followed by a '=>'
+ # or if it is obviously a sub call
+ my $i_next_next_nonblank = $i_next_nonblank + 1;
+ my $next_next_type = $types_to_go[$i_next_next_nonblank];
+ if ( $next_next_type eq 'b'
+ && $i_next_nonblank < $max_index_to_go )
+ {
+ $i_next_next_nonblank++;
+ $next_next_type = $types_to_go[$i_next_next_nonblank];
+ }
+
+ ##if ( $next_next_type ne '=>' ) {
+ # these are ok: '->xxx', '=>', '('
+
+ # We'll check for an old breakpoint and keep a leading
+ # bareword if it was that way in the input file.
+ # Presumably it was ok that way. For example, the
+ # following would remain unchanged:
+ #
+ # @months = (
+ # January, February, March, April,
+ # May, June, July, August,
+ # September, October, November, December,
+ # );
+ #
+ # This should be sufficient:
+ if ( !$old_breakpoint_to_go[$i]
+ && ( $next_next_type eq ',' || $next_next_type eq '}' )
+ )
+ {
+ $bond_str = NO_BREAK;
+ }
+ }
+ }
+
+ elsif ( $type eq 'w' ) {
+
+ if ( $next_nonblank_type eq 'R' ) {
+ $bond_str = NO_BREAK;
+ }
+
+ # use strict requires that bare word and => not be separated
+ if ( $next_nonblank_type eq '=>' ) {
+ $bond_str = NO_BREAK;
+ }
+ }
+
+ # in fact, use strict hates bare words on any new line. For
+ # example, a break before the underscore here provokes the
+ # wrath of use strict:
+ # if ( -r $fn && ( -s _ || $AllowZeroFilesize)) {
+ elsif ( $type eq 'F' ) {
+ $bond_str = NO_BREAK;
+ }
+
+ # use strict does not allow separating type info from trailing { }
+ # testfile is readmail.pl
+ elsif ( $type eq 't' or $type eq 'i' ) {
+
+ if ( $next_nonblank_type eq 'L' ) {
+ $bond_str = NO_BREAK;
+ }
+ }
+
+ # Do not break between a possible filehandle and a ? or / and do
+ # not introduce a break after it if there is no blank
+ # (extrude.t)
+ elsif ( $type eq 'Z' ) {
+
+ # dont break..
+ if (
+
+ # if there is no blank and we do not want one. Examples:
+ # print $x++ # do not break after $x
+ # print HTML"HELLO" # break ok after HTML
+ (
+ $next_type ne 'b'
+ && defined( $want_left_space{$next_type} )
+ && $want_left_space{$next_type} == WS_NO
+ )
+
+ # or we might be followed by the start of a quote
+ || $next_nonblank_type =~ /^[\/\?]$/
+ )
+ {
+ $bond_str = NO_BREAK;
+ }
+ }
+
+ # Do not break before a possible file handle
+ if ( $next_nonblank_type eq 'Z' ) {
+ $bond_str = NO_BREAK;
+ }
+
+ # As a defensive measure, do not break between a '(' and a
+ # filehandle. In some cases, this can cause an error. For
+ # example, the following program works:
+ # my $msg="hi!\n";
+ # print
+ # ( STDOUT
+ # $msg
+ # );
+ #
+ # But this program fails:
+ # my $msg="hi!\n";
+ # print
+ # (
+ # STDOUT
+ # $msg
+ # );
+ #
+ # This is normally only a problem with the 'extrude' option
+ if ( $next_nonblank_type eq 'Y' && $token eq '(' ) {
+ $bond_str = NO_BREAK;
+ }
+
+ # Breaking before a ++ can cause perl to guess wrong. For
+ # example the following line will cause a syntax error
+ # with -extrude if we break between '$i' and '++' [fixstyle2]
+ # print( ( $i++ & 1 ) ? $_ : ( $change{$_} || $_ ) );
+ elsif ( $next_nonblank_type eq '++' ) {
+ $bond_str = NO_BREAK;
+ }
+
+ # Breaking before a ? before a quote can cause trouble if
+ # they are not separated by a blank.
+ # Example: a syntax error occurs if you break before the ? here
+ # my$logic=join$all?' && ':' || ',@regexps;
+ # From: Professional_Perl_Programming_Code/multifind.pl
+ elsif ( $next_nonblank_type eq '?' ) {
+ $bond_str = NO_BREAK
+ if ( $types_to_go[ $i_next_nonblank + 1 ] eq 'Q' );
+ }
+
+ # Breaking before a . followed by a number
+ # can cause trouble if there is no intervening space
+ # Example: a syntax error occurs if you break before the .2 here
+ # $str .= pack($endian.2, ensurrogate($ord));
+ # From: perl58/Unicode.pm
+ elsif ( $next_nonblank_type eq '.' ) {
+ $bond_str = NO_BREAK
+ if ( $types_to_go[ $i_next_nonblank + 1 ] eq 'n' );
+ }
+
+ # patch to put cuddled elses back together when on multiple
+ # lines, as in: } \n else \n { \n
+ if ($rOpts_cuddled_else) {
+
+ if ( ( $token eq 'else' ) && ( $next_nonblank_type eq '{' )
+ || ( $type eq '}' ) && ( $next_nonblank_token eq 'else' ) )
+ {
+ $bond_str = NO_BREAK;
+ }
+ }
+
+ # keep '}' together with ';'
+ if ( ( $token eq '}' ) && ( $next_nonblank_type eq ';' ) ) {
+ $bond_str = NO_BREAK;
+ }
+
+ # never break between sub name and opening paren
+ if ( ( $type eq 'w' ) && ( $next_nonblank_token eq '(' ) ) {
+ $bond_str = NO_BREAK;
+ }
+
+ #---------------------------------------------------------------
+ # section 3:
+ # now take nesting depth into account
+ #---------------------------------------------------------------
+ # final strength incorporates the bond strength and nesting depth
+ my $strength;
+
+ if ( defined($bond_str) && !$nobreak_to_go[$i] ) {
+ if ( $total_nesting_depth > 0 ) {
+ $strength = $bond_str + $total_nesting_depth;
+ }
+ else {
+ $strength = $bond_str;
+ }
+ }
+ else {
+ $strength = NO_BREAK;
+ }
+
+ # always break after side comment
+ if ( $type eq '#' ) { $strength = 0 }
+
+ $bond_strength_to_go[$i] = $strength;
+
+ FORMATTER_DEBUG_FLAG_BOND && do {
+ my $str = substr( $token, 0, 15 );
+ $str .= ' ' x ( 16 - length($str) );
+ print
+"BOND: i=$i $str $type $next_nonblank_type depth=$total_nesting_depth strength=$bond_str_1 -> $bond_str -> $strength \n";
+ };
+ }
+ }
+
+}
+
+sub pad_array_to_go {
+
+ # to simplify coding in scan_list and set_bond_strengths, it helps
+ # to create some extra blank tokens at the end of the arrays
+ $tokens_to_go[ $max_index_to_go + 1 ] = '';
+ $tokens_to_go[ $max_index_to_go + 2 ] = '';
+ $types_to_go[ $max_index_to_go + 1 ] = 'b';
+ $types_to_go[ $max_index_to_go + 2 ] = 'b';
+ $nesting_depth_to_go[ $max_index_to_go + 1 ] =
+ $nesting_depth_to_go[$max_index_to_go];
+
+ # /^[R\}\)\]]$/
+ if ( $is_closing_type{ $types_to_go[$max_index_to_go] } ) {
+ if ( $nesting_depth_to_go[$max_index_to_go] <= 0 ) {
+
+ # shouldn't happen:
+ unless ( get_saw_brace_error() ) {
+ warning(
+"Program bug in scan_list: hit nesting error which should have been caught\n"
+ );
+ report_definite_bug();
+ }
+ }
+ else {
+ $nesting_depth_to_go[ $max_index_to_go + 1 ] -= 1;
+ }
+ }
+
+ # /^[L\{\(\[]$/
+ elsif ( $is_opening_type{ $types_to_go[$max_index_to_go] } ) {
+ $nesting_depth_to_go[ $max_index_to_go + 1 ] += 1;
+ }
+}
+
+{ # begin scan_list
+
+ my (
+ $block_type, $current_depth,
+ $depth, $i,
+ $i_last_nonblank_token, $last_colon_sequence_number,
+ $last_nonblank_token, $last_nonblank_type,
+ $last_old_breakpoint_count, $minimum_depth,
+ $next_nonblank_block_type, $next_nonblank_token,
+ $next_nonblank_type, $old_breakpoint_count,
+ $starting_breakpoint_count, $starting_depth,
+ $token, $type,
+ $type_sequence,
+ );
+
+ my (
+ @breakpoint_stack, @breakpoint_undo_stack,
+ @comma_index, @container_type,
+ @identifier_count_stack, @index_before_arrow,
+ @interrupted_list, @item_count_stack,
+ @last_comma_index, @last_dot_index,
+ @last_nonblank_type, @old_breakpoint_count_stack,
+ @opening_structure_index_stack, @rfor_semicolon_list,
+ @has_old_logical_breakpoints, @rand_or_list,
+ @i_equals,
+ );
+
+ # routine to define essential variables when we go 'up' to
+ # a new depth
+ sub check_for_new_minimum_depth {
+ my $depth = shift;
+ if ( $depth < $minimum_depth ) {
+
+ $minimum_depth = $depth;
+
+ # these arrays need not retain values between calls
+ $breakpoint_stack[$depth] = $starting_breakpoint_count;
+ $container_type[$depth] = "";
+ $identifier_count_stack[$depth] = 0;
+ $index_before_arrow[$depth] = -1;
+ $interrupted_list[$depth] = 1;
+ $item_count_stack[$depth] = 0;
+ $last_nonblank_type[$depth] = "";
+ $opening_structure_index_stack[$depth] = -1;
+
+ $breakpoint_undo_stack[$depth] = undef;
+ $comma_index[$depth] = undef;
+ $last_comma_index[$depth] = undef;
+ $last_dot_index[$depth] = undef;
+ $old_breakpoint_count_stack[$depth] = undef;
+ $has_old_logical_breakpoints[$depth] = 0;
+ $rand_or_list[$depth] = [];
+ $rfor_semicolon_list[$depth] = [];
+ $i_equals[$depth] = -1;
+
+ # these arrays must retain values between calls
+ if ( !defined( $has_broken_sublist[$depth] ) ) {
+ $dont_align[$depth] = 0;
+ $has_broken_sublist[$depth] = 0;
+ $want_comma_break[$depth] = 0;
+ }
+ }
+ }
+
+ # routine to decide which commas to break at within a container;
+ # returns:
+ # $bp_count = number of comma breakpoints set
+ # $do_not_break_apart = a flag indicating if container need not
+ # be broken open
+ sub set_comma_breakpoints {
+
+ my $dd = shift;
+ my $bp_count = 0;
+ my $do_not_break_apart = 0;
+
+ # anything to do?
+ if ( $item_count_stack[$dd] ) {
+
+ # handle commas not in containers...
+ if ( $dont_align[$dd] ) {
+ do_uncontained_comma_breaks($dd);
+ }
+
+ # handle commas within containers...
+ else {
+ my $fbc = $forced_breakpoint_count;
+
+ # always open comma lists not preceded by keywords,
+ # barewords, identifiers (that is, anything that doesn't
+ # look like a function call)
+ my $must_break_open = $last_nonblank_type[$dd] !~ /^[kwiU]$/;
+
+ set_comma_breakpoints_do(
+ $dd,
+ $opening_structure_index_stack[$dd],
+ $i,
+ $item_count_stack[$dd],
+ $identifier_count_stack[$dd],
+ $comma_index[$dd],
+ $next_nonblank_type,
+ $container_type[$dd],
+ $interrupted_list[$dd],
+ \$do_not_break_apart,
+ $must_break_open,
+ );
+ $bp_count = $forced_breakpoint_count - $fbc;
+ $do_not_break_apart = 0 if $must_break_open;
+ }
+ }
+ return ( $bp_count, $do_not_break_apart );
+ }
+
+ sub do_uncontained_comma_breaks {
+
+ # Handle commas not in containers...
+ # This is a catch-all routine for commas that we
+ # don't know what to do with because the don't fall
+ # within containers. We will bias the bond strength
+ # to break at commas which ended lines in the input
+ # file. This usually works better than just trying
+ # to put as many items on a line as possible. A
+ # downside is that if the input file is garbage it
+ # won't work very well. However, the user can always
+ # prevent following the old breakpoints with the
+ # -iob flag.
+ my $dd = shift;
+ my $bias = -.01;
+ foreach my $ii ( @{ $comma_index[$dd] } ) {
+ if ( $old_breakpoint_to_go[$ii] ) {
+ $bond_strength_to_go[$ii] = $bias;
+
+ # reduce bias magnitude to force breaks in order
+ $bias *= 0.99;
+ }
+ }
+
+ # Also put a break before the first comma if
+ # (1) there was a break there in the input, and
+ # (2) that was exactly one previous break in the input
+ #
+ # For example, we will follow the user and break after
+ # 'print' in this snippet:
+ # print
+ # "conformability (Not the same dimension)\n",
+ # "\t", $have, " is ", text_unit($hu), "\n",
+ # "\t", $want, " is ", text_unit($wu), "\n",
+ # ;
+ my $i_first_comma = $comma_index[$dd]->[0];
+ if ( $old_breakpoint_to_go[$i_first_comma] ) {
+ my $level_comma = $levels_to_go[$i_first_comma];
+ my $ibreak = -1;
+ my $obp_count = 0;
+ for ( my $ii = $i_first_comma - 1 ; $ii >= 0 ; $ii -= 1 ) {
+ if ( $old_breakpoint_to_go[$ii] ) {
+ $obp_count++;
+ last if ( $obp_count > 1 );
+ $ibreak = $ii
+ if ( $levels_to_go[$ii] == $level_comma );
+ }
+ }
+ if ( $ibreak >= 0 && $obp_count == 1 ) {
+ set_forced_breakpoint($ibreak);
+ }
+ }
+ }
+
+ my %is_logical_container;
+
+ BEGIN {
+ @_ = qw# if elsif unless while and or err not && | || ? : ! #;
+ @is_logical_container{@_} = (1) x scalar(@_);
+ }
+
+ sub set_for_semicolon_breakpoints {
+ my $dd = shift;
+ foreach ( @{ $rfor_semicolon_list[$dd] } ) {
+ set_forced_breakpoint($_);
+ }
+ }
+
+ sub set_logical_breakpoints {
+ my $dd = shift;
+ if (
+ $item_count_stack[$dd] == 0
+ && $is_logical_container{ $container_type[$dd] }
+
+ # TESTING:
+ || $has_old_logical_breakpoints[$dd]
+ )
+ {
+
+ # Look for breaks in this order:
+ # 0 1 2 3
+ # or and || &&
+ foreach my $i ( 0 .. 3 ) {
+ if ( $rand_or_list[$dd][$i] ) {
+ foreach ( @{ $rand_or_list[$dd][$i] } ) {
+ set_forced_breakpoint($_);
+ }
+
+ # break at any 'if' and 'unless' too
+ foreach ( @{ $rand_or_list[$dd][4] } ) {
+ set_forced_breakpoint($_);
+ }
+ $rand_or_list[$dd] = [];
+ last;
+ }
+ }
+ }
+ }
+
+ sub is_unbreakable_container {
+
+ # never break a container of one of these types
+ # because bad things can happen (map1.t)
+ my $dd = shift;
+ $is_sort_map_grep{ $container_type[$dd] };
+ }
+
+ sub scan_list {
+
+ # This routine is responsible for setting line breaks for all lists,
+ # so that hierarchical structure can be displayed and so that list
+ # items can be vertically aligned. The output of this routine is
+ # stored in the array @forced_breakpoint_to_go, which is used to set
+ # final breakpoints.
+
+ $starting_depth = $nesting_depth_to_go[0];
+
+ $block_type = ' ';
+ $current_depth = $starting_depth;
+ $i = -1;
+ $last_colon_sequence_number = -1;
+ $last_nonblank_token = ';';
+ $last_nonblank_type = ';';
+ $last_nonblank_block_type = ' ';
+ $last_old_breakpoint_count = 0;
+ $minimum_depth = $current_depth + 1; # forces update in check below
+ $old_breakpoint_count = 0;
+ $starting_breakpoint_count = $forced_breakpoint_count;
+ $token = ';';
+ $type = ';';
+ $type_sequence = '';
+
+ check_for_new_minimum_depth($current_depth);
+
+ my $is_long_line = excess_line_length( 0, $max_index_to_go ) > 0;
+ my $want_previous_breakpoint = -1;
+
+ my $saw_good_breakpoint;
+ my $i_line_end = -1;
+ my $i_line_start = -1;
+
+ # loop over all tokens in this batch
+ while ( ++$i <= $max_index_to_go ) {
+ if ( $type ne 'b' ) {
+ $i_last_nonblank_token = $i - 1;
+ $last_nonblank_type = $type;
+ $last_nonblank_token = $token;
+ $last_nonblank_block_type = $block_type;
+ }
+ $type = $types_to_go[$i];
+ $block_type = $block_type_to_go[$i];
+ $token = $tokens_to_go[$i];
+ $type_sequence = $type_sequence_to_go[$i];
+ my $next_type = $types_to_go[ $i + 1 ];
+ my $next_token = $tokens_to_go[ $i + 1 ];
+ my $i_next_nonblank = ( ( $next_type eq 'b' ) ? $i + 2 : $i + 1 );
+ $next_nonblank_type = $types_to_go[$i_next_nonblank];
+ $next_nonblank_token = $tokens_to_go[$i_next_nonblank];
+ $next_nonblank_block_type = $block_type_to_go[$i_next_nonblank];
+
+ # set break if flag was set
+ if ( $want_previous_breakpoint >= 0 ) {
+ set_forced_breakpoint($want_previous_breakpoint);
+ $want_previous_breakpoint = -1;
+ }
+
+ $last_old_breakpoint_count = $old_breakpoint_count;
+ if ( $old_breakpoint_to_go[$i] ) {
+ $i_line_end = $i;
+ $i_line_start = $i_next_nonblank;
+
+ $old_breakpoint_count++;
+
+ # Break before certain keywords if user broke there and
+ # this is a 'safe' break point. The idea is to retain
+ # any preferred breaks for sequential list operations,
+ # like a schwartzian transform.
+ if ($rOpts_break_at_old_keyword_breakpoints) {
+ if (
+ $next_nonblank_type eq 'k'
+ && $is_keyword_returning_list{$next_nonblank_token}
+ && ( $type =~ /^[=\)\]\}Riw]$/
+ || $type eq 'k'
+ && $is_keyword_returning_list{$token} )
+ )
+ {
+
+ # we actually have to set this break next time through
+ # the loop because if we are at a closing token (such
+ # as '}') which forms a one-line block, this break might
+ # get undone.
+ $want_previous_breakpoint = $i;
+ }
+ }
+ }
+ next if ( $type eq 'b' );
+ $depth = $nesting_depth_to_go[ $i + 1 ];
+
+ # safety check - be sure we always break after a comment
+ # Shouldn't happen .. an error here probably means that the
+ # nobreak flag did not get turned off correctly during
+ # formatting.
+ if ( $type eq '#' ) {
+ if ( $i != $max_index_to_go ) {
+ warning(
+"Non-fatal program bug: backup logic needed to break after a comment\n"
+ );
+ report_definite_bug();
+ $nobreak_to_go[$i] = 0;
+ set_forced_breakpoint($i);
+ }
+ }
+
+ # Force breakpoints at certain tokens in long lines.
+ # Note that such breakpoints will be undone later if these tokens
+ # are fully contained within parens on a line.
+ if (
+
+ # break before a keyword within a line
+ $type eq 'k'
+ && $i > 0
+
+ # if one of these keywords:
+ && $token =~ /^(if|unless|while|until|for)$/
+
+ # but do not break at something like '1 while'
+ && ( $last_nonblank_type ne 'n' || $i > 2 )
+
+ # and let keywords follow a closing 'do' brace
+ && $last_nonblank_block_type ne 'do'
+
+ && (
+ $is_long_line
+
+ # or container is broken (by side-comment, etc)
+ || ( $next_nonblank_token eq '('
+ && $mate_index_to_go[$i_next_nonblank] < $i )
+ )
+ )
+ {
+ set_forced_breakpoint( $i - 1 );
+ }
+
+ # remember locations of '||' and '&&' for possible breaks if we
+ # decide this is a long logical expression.
+ if ( $type eq '||' ) {
+ push @{ $rand_or_list[$depth][2] }, $i;
+ ++$has_old_logical_breakpoints[$depth]
+ if ( ( $i == $i_line_start || $i == $i_line_end )
+ && $rOpts_break_at_old_logical_breakpoints );
+ }
+ elsif ( $type eq '&&' ) {
+ push @{ $rand_or_list[$depth][3] }, $i;
+ ++$has_old_logical_breakpoints[$depth]
+ if ( ( $i == $i_line_start || $i == $i_line_end )
+ && $rOpts_break_at_old_logical_breakpoints );
+ }
+ elsif ( $type eq 'f' ) {
+ push @{ $rfor_semicolon_list[$depth] }, $i;
+ }
+ elsif ( $type eq 'k' ) {
+ if ( $token eq 'and' ) {
+ push @{ $rand_or_list[$depth][1] }, $i;
+ ++$has_old_logical_breakpoints[$depth]
+ if ( ( $i == $i_line_start || $i == $i_line_end )
+ && $rOpts_break_at_old_logical_breakpoints );
+ }
+
+ # break immediately at 'or's which are probably not in a logical
+ # block -- but we will break in logical breaks below so that
+ # they do not add to the forced_breakpoint_count
+ elsif ( $token eq 'or' ) {
+ push @{ $rand_or_list[$depth][0] }, $i;
+ ++$has_old_logical_breakpoints[$depth]
+ if ( ( $i == $i_line_start || $i == $i_line_end )
+ && $rOpts_break_at_old_logical_breakpoints );
+ if ( $is_logical_container{ $container_type[$depth] } ) {
+ }
+ else {
+ if ($is_long_line) { set_forced_breakpoint($i) }
+ elsif ( ( $i == $i_line_start || $i == $i_line_end )
+ && $rOpts_break_at_old_logical_breakpoints )
+ {
+ $saw_good_breakpoint = 1;
+ }
+ }
+ }
+ elsif ( $token eq 'if' || $token eq 'unless' ) {
+ push @{ $rand_or_list[$depth][4] }, $i;
+ if ( ( $i == $i_line_start || $i == $i_line_end )
+ && $rOpts_break_at_old_logical_breakpoints )
+ {
+ set_forced_breakpoint($i);
+ }
+ }
+ }
+ elsif ( $is_assignment{$type} ) {
+ $i_equals[$depth] = $i;
+ }
+
+ if ($type_sequence) {
+
+ # handle any postponed closing breakpoints
+ if ( $token =~ /^[\)\]\}\:]$/ ) {
+ if ( $type eq ':' ) {
+ $last_colon_sequence_number = $type_sequence;
+
+ # TESTING: retain break at a ':' line break
+ if ( ( $i == $i_line_start || $i == $i_line_end )
+ && $rOpts_break_at_old_ternary_breakpoints )
+ {
+
+ # TESTING:
+ set_forced_breakpoint($i);
+
+ # break at previous '='
+ if ( $i_equals[$depth] > 0 ) {
+ set_forced_breakpoint( $i_equals[$depth] );
+ $i_equals[$depth] = -1;
+ }
+ }
+ }
+ if ( defined( $postponed_breakpoint{$type_sequence} ) ) {
+ my $inc = ( $type eq ':' ) ? 0 : 1;
+ set_forced_breakpoint( $i - $inc );
+ delete $postponed_breakpoint{$type_sequence};
+ }
+ }
+
+ # set breaks at ?/: if they will get separated (and are
+ # not a ?/: chain), or if the '?' is at the end of the
+ # line
+ elsif ( $token eq '?' ) {
+ my $i_colon = $mate_index_to_go[$i];
+ if (
+ $i_colon <= 0 # the ':' is not in this batch
+ || $i == 0 # this '?' is the first token of the line
+ || $i ==
+ $max_index_to_go # or this '?' is the last token
+ )
+ {
+
+ # don't break at a '?' if preceded by ':' on
+ # this line of previous ?/: pair on this line.
+ # This is an attempt to preserve a chain of ?/:
+ # expressions (elsif2.t). And don't break if
+ # this has a side comment.
+ set_forced_breakpoint($i)
+ unless (
+ $type_sequence == (
+ $last_colon_sequence_number +
+ TYPE_SEQUENCE_INCREMENT
+ )
+ || $tokens_to_go[$max_index_to_go] eq '#'
+ );
+ set_closing_breakpoint($i);
+ }
+ }
+ }
+
+#print "LISTX sees: i=$i type=$type tok=$token block=$block_type depth=$depth\n";
+
+ #------------------------------------------------------------
+ # Handle Increasing Depth..
+ #
+ # prepare for a new list when depth increases
+ # token $i is a '(','{', or '['
+ #------------------------------------------------------------
+ if ( $depth > $current_depth ) {
+
+ $breakpoint_stack[$depth] = $forced_breakpoint_count;
+ $breakpoint_undo_stack[$depth] = $forced_breakpoint_undo_count;
+ $has_broken_sublist[$depth] = 0;
+ $identifier_count_stack[$depth] = 0;
+ $index_before_arrow[$depth] = -1;
+ $interrupted_list[$depth] = 0;
+ $item_count_stack[$depth] = 0;
+ $last_comma_index[$depth] = undef;
+ $last_dot_index[$depth] = undef;
+ $last_nonblank_type[$depth] = $last_nonblank_type;
+ $old_breakpoint_count_stack[$depth] = $old_breakpoint_count;
+ $opening_structure_index_stack[$depth] = $i;
+ $rand_or_list[$depth] = [];
+ $rfor_semicolon_list[$depth] = [];
+ $i_equals[$depth] = -1;
+ $want_comma_break[$depth] = 0;
+ $container_type[$depth] =
+ ( $last_nonblank_type =~ /^(k|=>|&&|\|\||\?|\:|\.)$/ )
+ ? $last_nonblank_token
+ : "";
+ $has_old_logical_breakpoints[$depth] = 0;
+
+ # if line ends here then signal closing token to break
+ if ( $next_nonblank_type eq 'b' || $next_nonblank_type eq '#' )
+ {
+ set_closing_breakpoint($i);
+ }
+
+ # Not all lists of values should be vertically aligned..
+ $dont_align[$depth] =
+
+ # code BLOCKS are handled at a higher level
+ ( $block_type ne "" )
+
+ # certain paren lists
+ || ( $type eq '(' ) && (
+
+ # it does not usually look good to align a list of
+ # identifiers in a parameter list, as in:
+ # my($var1, $var2, ...)
+ # (This test should probably be refined, for now I'm just
+ # testing for any keyword)
+ ( $last_nonblank_type eq 'k' )
+
+ # a trailing '(' usually indicates a non-list
+ || ( $next_nonblank_type eq '(' )
+ );
+
+ # patch to outdent opening brace of long if/for/..
+ # statements (like this one). See similar coding in
+ # set_continuation breaks. We have also catch it here for
+ # short line fragments which otherwise will not go through
+ # set_continuation_breaks.
+ if (
+ $block_type
+
+ # if we have the ')' but not its '(' in this batch..
+ && ( $last_nonblank_token eq ')' )
+ && $mate_index_to_go[$i_last_nonblank_token] < 0
+
+ # and user wants brace to left
+ && !$rOpts->{'opening-brace-always-on-right'}
+
+ && ( $type eq '{' ) # should be true
+ && ( $token eq '{' ) # should be true
+ )
+ {
+ set_forced_breakpoint( $i - 1 );
+ }
+ }
+
+ #------------------------------------------------------------
+ # Handle Decreasing Depth..
+ #
+ # finish off any old list when depth decreases
+ # token $i is a ')','}', or ']'
+ #------------------------------------------------------------
+ elsif ( $depth < $current_depth ) {
+
+ check_for_new_minimum_depth($depth);
+
+ # force all outer logical containers to break after we see on
+ # old breakpoint
+ $has_old_logical_breakpoints[$depth] ||=
+ $has_old_logical_breakpoints[$current_depth];
+
+ # Patch to break between ') {' if the paren list is broken.
+ # There is similar logic in set_continuation_breaks for
+ # non-broken lists.
+ if ( $token eq ')'
+ && $next_nonblank_block_type
+ && $interrupted_list[$current_depth]
+ && $next_nonblank_type eq '{'
+ && !$rOpts->{'opening-brace-always-on-right'} )
+ {
+ set_forced_breakpoint($i);
+ }
+
+#print "LISTY sees: i=$i type=$type tok=$token block=$block_type depth=$depth next=$next_nonblank_type next_block=$next_nonblank_block_type inter=$interrupted_list[$current_depth]\n";
+
+ # set breaks at commas if necessary
+ my ( $bp_count, $do_not_break_apart ) =
+ set_comma_breakpoints($current_depth);
+
+ my $i_opening = $opening_structure_index_stack[$current_depth];
+ my $saw_opening_structure = ( $i_opening >= 0 );
+
+ # this term is long if we had to break at interior commas..
+ my $is_long_term = $bp_count > 0;
+
+ # ..or if the length between opening and closing parens exceeds
+ # allowed line length
+ if ( !$is_long_term && $saw_opening_structure ) {
+ my $i_opening_minus = find_token_starting_list($i_opening);
+
+ # Note: we have to allow for one extra space after a
+ # closing token so that we do not strand a comma or
+ # semicolon, hence the '>=' here (oneline.t)
+ $is_long_term =
+ excess_line_length( $i_opening_minus, $i ) >= 0;
+ }
+
+ # We've set breaks after all comma-arrows. Now we have to
+ # undo them if this can be a one-line block
+ # (the only breakpoints set will be due to comma-arrows)
+ if (
+
+ # user doesn't require breaking after all comma-arrows
+ ( $rOpts_comma_arrow_breakpoints != 0 )
+
+ # and if the opening structure is in this batch
+ && $saw_opening_structure
+
+ # and either on the same old line
+ && (
+ $old_breakpoint_count_stack[$current_depth] ==
+ $last_old_breakpoint_count
+
+ # or user wants to form long blocks with arrows
+ || $rOpts_comma_arrow_breakpoints == 2
+ )
+
+ # and we made some breakpoints between the opening and closing
+ && ( $breakpoint_undo_stack[$current_depth] <
+ $forced_breakpoint_undo_count )
+
+ # and this block is short enough to fit on one line
+ # Note: use < because need 1 more space for possible comma
+ && !$is_long_term
+
+ )
+ {
+ undo_forced_breakpoint_stack(
+ $breakpoint_undo_stack[$current_depth] );
+ }
+
+ # now see if we have any comma breakpoints left
+ my $has_comma_breakpoints =
+ ( $breakpoint_stack[$current_depth] !=
+ $forced_breakpoint_count );
+
+ # update broken-sublist flag of the outer container
+ $has_broken_sublist[$depth] =
+ $has_broken_sublist[$depth]
+ || $has_broken_sublist[$current_depth]
+ || $is_long_term
+ || $has_comma_breakpoints;
+
+# Having come to the closing ')', '}', or ']', now we have to decide if we
+# should 'open up' the structure by placing breaks at the opening and
+# closing containers. This is a tricky decision. Here are some of the
+# basic considerations:
+#
+# -If this is a BLOCK container, then any breakpoints will have already
+# been set (and according to user preferences), so we need do nothing here.
+#
+# -If we have a comma-separated list for which we can align the list items,
+# then we need to do so because otherwise the vertical aligner cannot
+# currently do the alignment.
+#
+# -If this container does itself contain a container which has been broken
+# open, then it should be broken open to properly show the structure.
+#
+# -If there is nothing to align, and no other reason to break apart,
+# then do not do it.
+#
+# We will not break open the parens of a long but 'simple' logical expression.
+# For example:
+#
+# This is an example of a simple logical expression and its formatting:
+#
+# if ( $bigwasteofspace1 && $bigwasteofspace2
+# || $bigwasteofspace3 && $bigwasteofspace4 )
+#
+# Most people would prefer this than the 'spacey' version:
+#
+# if (
+# $bigwasteofspace1 && $bigwasteofspace2
+# || $bigwasteofspace3 && $bigwasteofspace4
+# )
+#
+# To illustrate the rules for breaking logical expressions, consider:
+#
+# FULLY DENSE:
+# if ( $opt_excl
+# and ( exists $ids_excl_uc{$id_uc}
+# or grep $id_uc =~ /$_/, @ids_excl_uc ))
+#
+# This is on the verge of being difficult to read. The current default is to
+# open it up like this:
+#
+# DEFAULT:
+# if (
+# $opt_excl
+# and ( exists $ids_excl_uc{$id_uc}
+# or grep $id_uc =~ /$_/, @ids_excl_uc )
+# )
+#
+# This is a compromise which tries to avoid being too dense and to spacey.
+# A more spaced version would be:
+#
+# SPACEY:
+# if (
+# $opt_excl
+# and (
+# exists $ids_excl_uc{$id_uc}
+# or grep $id_uc =~ /$_/, @ids_excl_uc
+# )
+# )
+#
+# Some people might prefer the spacey version -- an option could be added. The
+# innermost expression contains a long block '( exists $ids_... ')'.
+#
+# Here is how the logic goes: We will force a break at the 'or' that the
+# innermost expression contains, but we will not break apart its opening and
+# closing containers because (1) it contains no multi-line sub-containers itself,
+# and (2) there is no alignment to be gained by breaking it open like this
+#
+# and (
+# exists $ids_excl_uc{$id_uc}
+# or grep $id_uc =~ /$_/, @ids_excl_uc
+# )
+#
+# (although this looks perfectly ok and might be good for long expressions). The
+# outer 'if' container, though, contains a broken sub-container, so it will be
+# broken open to avoid too much density. Also, since it contains no 'or's, there
+# will be a forced break at its 'and'.
+
+ # set some flags telling something about this container..
+ my $is_simple_logical_expression = 0;
+ if ( $item_count_stack[$current_depth] == 0
+ && $saw_opening_structure
+ && $tokens_to_go[$i_opening] eq '('
+ && $is_logical_container{ $container_type[$current_depth] }
+ )
+ {
+
+ # This seems to be a simple logical expression with
+ # no existing breakpoints. Set a flag to prevent
+ # opening it up.
+ if ( !$has_comma_breakpoints ) {
+ $is_simple_logical_expression = 1;
+ }
+
+ # This seems to be a simple logical expression with
+ # breakpoints (broken sublists, for example). Break
+ # at all 'or's and '||'s.
+ else {
+ set_logical_breakpoints($current_depth);
+ }
+ }
+
+ if ( $is_long_term
+ && @{ $rfor_semicolon_list[$current_depth] } )
+ {
+ set_for_semicolon_breakpoints($current_depth);
+
+ # open up a long 'for' or 'foreach' container to allow
+ # leading term alignment unless -lp is used.
+ $has_comma_breakpoints = 1
+ unless $rOpts_line_up_parentheses;
+ }
+
+ if (
+
+ # breaks for code BLOCKS are handled at a higher level
+ !$block_type
+
+ # we do not need to break at the top level of an 'if'
+ # type expression
+ && !$is_simple_logical_expression
+
+ ## modification to keep ': (' containers vertically tight;
+ ## but probably better to let user set -vt=1 to avoid
+ ## inconsistency with other paren types
+ ## && ($container_type[$current_depth] ne ':')
+
+ # otherwise, we require one of these reasons for breaking:
+ && (
+
+ # - this term has forced line breaks
+ $has_comma_breakpoints
+
+ # - the opening container is separated from this batch
+ # for some reason (comment, blank line, code block)
+ # - this is a non-paren container spanning multiple lines
+ || !$saw_opening_structure
+
+ # - this is a long block contained in another breakable
+ # container
+ || ( $is_long_term
+ && $container_environment_to_go[$i_opening] ne
+ 'BLOCK' )
+ )
+ )
+ {
+
+ # For -lp option, we must put a breakpoint before
+ # the token which has been identified as starting
+ # this indentation level. This is necessary for
+ # proper alignment.
+ if ( $rOpts_line_up_parentheses && $saw_opening_structure )
+ {
+ my $item = $leading_spaces_to_go[ $i_opening + 1 ];
+ if ( $i_opening + 1 < $max_index_to_go
+ && $types_to_go[ $i_opening + 1 ] eq 'b' )
+ {
+ $item = $leading_spaces_to_go[ $i_opening + 2 ];
+ }
+ if ( defined($item) ) {
+ my $i_start_2 = $item->get_STARTING_INDEX();
+ if (
+ defined($i_start_2)
+
+ # we are breaking after an opening brace, paren,
+ # so don't break before it too
+ && $i_start_2 ne $i_opening
+ )
+ {
+
+ # Only break for breakpoints at the same
+ # indentation level as the opening paren
+ my $test1 = $nesting_depth_to_go[$i_opening];
+ my $test2 = $nesting_depth_to_go[$i_start_2];
+ if ( $test2 == $test1 ) {
+ set_forced_breakpoint( $i_start_2 - 1 );
+ }
+ }
+ }
+ }
+
+ # break after opening structure.
+ # note: break before closing structure will be automatic
+ if ( $minimum_depth <= $current_depth ) {
+
+ set_forced_breakpoint($i_opening)
+ unless ( $do_not_break_apart
+ || is_unbreakable_container($current_depth) );
+
+ # break at '.' of lower depth level before opening token
+ if ( $last_dot_index[$depth] ) {
+ set_forced_breakpoint( $last_dot_index[$depth] );
+ }
+
+ # break before opening structure if preeced by another
+ # closing structure and a comma. This is normally
+ # done by the previous closing brace, but not
+ # if it was a one-line block.
+ if ( $i_opening > 2 ) {
+ my $i_prev =
+ ( $types_to_go[ $i_opening - 1 ] eq 'b' )
+ ? $i_opening - 2
+ : $i_opening - 1;
+
+ if ( $types_to_go[$i_prev] eq ','
+ && $types_to_go[ $i_prev - 1 ] =~ /^[\)\}]$/ )
+ {
+ set_forced_breakpoint($i_prev);
+ }
+
+ # also break before something like ':(' or '?('
+ # if appropriate.
+ elsif (
+ $types_to_go[$i_prev] =~ /^([k\:\?]|&&|\|\|)$/ )
+ {
+ my $token_prev = $tokens_to_go[$i_prev];
+ if ( $want_break_before{$token_prev} ) {
+ set_forced_breakpoint($i_prev);
+ }
+ }
+ }
+ }
+
+ # break after comma following closing structure
+ if ( $next_type eq ',' ) {
+ set_forced_breakpoint( $i + 1 );
+ }
+
+ # break before an '=' following closing structure
+ if (
+ $is_assignment{$next_nonblank_type}
+ && ( $breakpoint_stack[$current_depth] !=
+ $forced_breakpoint_count )
+ )
+ {
+ set_forced_breakpoint($i);
+ }
+
+ # break at any comma before the opening structure Added
+ # for -lp, but seems to be good in general. It isn't
+ # obvious how far back to look; the '5' below seems to
+ # work well and will catch the comma in something like
+ # push @list, myfunc( $param, $param, ..
+
+ my $icomma = $last_comma_index[$depth];
+ if ( defined($icomma) && ( $i_opening - $icomma ) < 5 ) {
+ unless ( $forced_breakpoint_to_go[$icomma] ) {
+ set_forced_breakpoint($icomma);
+ }
+ }
+ } # end logic to open up a container
+
+ # Break open a logical container open if it was already open
+ elsif ($is_simple_logical_expression
+ && $has_old_logical_breakpoints[$current_depth] )
+ {
+ set_logical_breakpoints($current_depth);
+ }
+
+ # Handle long container which does not get opened up
+ elsif ($is_long_term) {
+
+ # must set fake breakpoint to alert outer containers that
+ # they are complex
+ set_fake_breakpoint();
+ }
+ }
+
+ #------------------------------------------------------------
+ # Handle this token
+ #------------------------------------------------------------
+
+ $current_depth = $depth;
+
+ # handle comma-arrow
+ if ( $type eq '=>' ) {
+ next if ( $last_nonblank_type eq '=>' );
+ next if $rOpts_break_at_old_comma_breakpoints;
+ next if $rOpts_comma_arrow_breakpoints == 3;
+ $want_comma_break[$depth] = 1;
+ $index_before_arrow[$depth] = $i_last_nonblank_token;
+ next;
+ }
+
+ elsif ( $type eq '.' ) {
+ $last_dot_index[$depth] = $i;
+ }
+
+ # Turn off alignment if we are sure that this is not a list
+ # environment. To be safe, we will do this if we see certain
+ # non-list tokens, such as ';', and also the environment is
+ # not a list. Note that '=' could be in any of the = operators
+ # (lextest.t). We can't just use the reported environment
+ # because it can be incorrect in some cases.
+ elsif ( ( $type =~ /^[\;\<\>\~]$/ || $is_assignment{$type} )
+ && $container_environment_to_go[$i] ne 'LIST' )
+ {
+ $dont_align[$depth] = 1;
+ $want_comma_break[$depth] = 0;
+ $index_before_arrow[$depth] = -1;
+ }
+
+ # now just handle any commas
+ next unless ( $type eq ',' );
+
+ $last_dot_index[$depth] = undef;
+ $last_comma_index[$depth] = $i;
+
+ # break here if this comma follows a '=>'
+ # but not if there is a side comment after the comma
+ if ( $want_comma_break[$depth] ) {
+
+ if ( $next_nonblank_type =~ /^[\)\}\]R]$/ ) {
+ $want_comma_break[$depth] = 0;
+ $index_before_arrow[$depth] = -1;
+ next;
+ }
+
+ set_forced_breakpoint($i) unless ( $next_nonblank_type eq '#' );
+
+ # break before the previous token if it looks safe
+ # Example of something that we will not try to break before:
+ # DBI::SQL_SMALLINT() => $ado_consts->{adSmallInt},
+ # Also we don't want to break at a binary operator (like +):
+ # $c->createOval(
+ # $x + $R, $y +
+ # $R => $x - $R,
+ # $y - $R, -fill => 'black',
+ # );
+ my $ibreak = $index_before_arrow[$depth] - 1;
+ if ( $ibreak > 0
+ && $tokens_to_go[ $ibreak + 1 ] !~ /^[\)\}\]]$/ )
+ {
+ if ( $tokens_to_go[$ibreak] eq '-' ) { $ibreak-- }
+ if ( $types_to_go[$ibreak] eq 'b' ) { $ibreak-- }
+ if ( $types_to_go[$ibreak] =~ /^[,wiZCUG\(\{\[]$/ ) {
+
+ # don't break pointer calls, such as the following:
+ # File::Spec->curdir => 1,
+ # (This is tokenized as adjacent 'w' tokens)
+ if ( $tokens_to_go[ $ibreak + 1 ] !~ /^->/ ) {
+ set_forced_breakpoint($ibreak);
+ }
+ }
+ }
+
+ $want_comma_break[$depth] = 0;
+ $index_before_arrow[$depth] = -1;
+
+ # handle list which mixes '=>'s and ','s:
+ # treat any list items so far as an interrupted list
+ $interrupted_list[$depth] = 1;
+ next;
+ }
+
+ # break after all commas above starting depth
+ if ( $depth < $starting_depth && !$dont_align[$depth] ) {
+ set_forced_breakpoint($i) unless ( $next_nonblank_type eq '#' );
+ next;
+ }
+
+ # add this comma to the list..
+ my $item_count = $item_count_stack[$depth];
+ if ( $item_count == 0 ) {
+
+ # but do not form a list with no opening structure
+ # for example:
+
+ # open INFILE_COPY, ">$input_file_copy"
+ # or die ("very long message");
+
+ if ( ( $opening_structure_index_stack[$depth] < 0 )
+ && $container_environment_to_go[$i] eq 'BLOCK' )
+ {
+ $dont_align[$depth] = 1;
+ }
+ }
+
+ $comma_index[$depth][$item_count] = $i;
+ ++$item_count_stack[$depth];
+ if ( $last_nonblank_type =~ /^[iR\]]$/ ) {
+ $identifier_count_stack[$depth]++;
+ }
+ }
+
+ #-------------------------------------------
+ # end of loop over all tokens in this batch
+ #-------------------------------------------
+
+ # set breaks for any unfinished lists ..
+ for ( my $dd = $current_depth ; $dd >= $minimum_depth ; $dd-- ) {
+
+ $interrupted_list[$dd] = 1;
+ $has_broken_sublist[$dd] = 1 if ( $dd < $current_depth );
+ set_comma_breakpoints($dd);
+ set_logical_breakpoints($dd)
+ if ( $has_old_logical_breakpoints[$dd] );
+ set_for_semicolon_breakpoints($dd);
+
+ # break open container...
+ my $i_opening = $opening_structure_index_stack[$dd];
+ set_forced_breakpoint($i_opening)
+ unless (
+ is_unbreakable_container($dd)
+
+ # Avoid a break which would place an isolated ' or "
+ # on a line
+ || ( $type eq 'Q'
+ && $i_opening >= $max_index_to_go - 2
+ && $token =~ /^['"]$/ )
+ );
+ }
+
+ # Return a flag indicating if the input file had some good breakpoints.
+ # This flag will be used to force a break in a line shorter than the
+ # allowed line length.
+ if ( $has_old_logical_breakpoints[$current_depth] ) {
+ $saw_good_breakpoint = 1;
+ }
+ return $saw_good_breakpoint;
+ }
+} # end scan_list
+
+sub find_token_starting_list {
+
+ # When testing to see if a block will fit on one line, some
+ # previous token(s) may also need to be on the line; particularly
+ # if this is a sub call. So we will look back at least one
+ # token. NOTE: This isn't perfect, but not critical, because
+ # if we mis-identify a block, it will be wrapped and therefore
+ # fixed the next time it is formatted.
+ my $i_opening_paren = shift;
+ my $i_opening_minus = $i_opening_paren;
+ my $im1 = $i_opening_paren - 1;
+ my $im2 = $i_opening_paren - 2;
+ my $im3 = $i_opening_paren - 3;
+ my $typem1 = $types_to_go[$im1];
+ my $typem2 = $im2 >= 0 ? $types_to_go[$im2] : 'b';
+ if ( $typem1 eq ',' || ( $typem1 eq 'b' && $typem2 eq ',' ) ) {
+ $i_opening_minus = $i_opening_paren;
+ }
+ elsif ( $tokens_to_go[$i_opening_paren] eq '(' ) {
+ $i_opening_minus = $im1 if $im1 >= 0;
+
+ # walk back to improve length estimate
+ for ( my $j = $im1 ; $j >= 0 ; $j-- ) {
+ last if ( $types_to_go[$j] =~ /^[\(\[\{L\}\]\)Rb,]$/ );
+ $i_opening_minus = $j;
+ }
+ if ( $types_to_go[$i_opening_minus] eq 'b' ) { $i_opening_minus++ }
+ }
+ elsif ( $typem1 eq 'k' ) { $i_opening_minus = $im1 }
+ elsif ( $typem1 eq 'b' && $im2 >= 0 && $types_to_go[$im2] eq 'k' ) {
+ $i_opening_minus = $im2;
+ }
+ return $i_opening_minus;
+}
+
+{ # begin set_comma_breakpoints_do
+
+ my %is_keyword_with_special_leading_term;
+
+ BEGIN {
+
+ # These keywords have prototypes which allow a special leading item
+ # followed by a list
+ @_ =
+ qw(formline grep kill map printf sprintf push chmod join pack unshift);
+ @is_keyword_with_special_leading_term{@_} = (1) x scalar(@_);
+ }
+
+ sub set_comma_breakpoints_do {
+
+ # Given a list with some commas, set breakpoints at some of the
+ # commas, if necessary, to make it easy to read. This list is
+ # an example:
+ my (
+ $depth, $i_opening_paren, $i_closing_paren,
+ $item_count, $identifier_count, $rcomma_index,
+ $next_nonblank_type, $list_type, $interrupted,
+ $rdo_not_break_apart, $must_break_open,
+ ) = @_;
+
+ # nothing to do if no commas seen
+ return if ( $item_count < 1 );
+ my $i_first_comma = $$rcomma_index[0];
+ my $i_true_last_comma = $$rcomma_index[ $item_count - 1 ];
+ my $i_last_comma = $i_true_last_comma;
+ if ( $i_last_comma >= $max_index_to_go ) {
+ $i_last_comma = $$rcomma_index[ --$item_count - 1 ];
+ return if ( $item_count < 1 );
+ }
+
+ #---------------------------------------------------------------
+ # find lengths of all items in the list to calculate page layout
+ #---------------------------------------------------------------
+ my $comma_count = $item_count;
+ my @item_lengths;
+ my @i_term_begin;
+ my @i_term_end;
+ my @i_term_comma;
+ my $i_prev_plus;
+ my @max_length = ( 0, 0 );
+ my $first_term_length;
+ my $i = $i_opening_paren;
+ my $is_odd = 1;
+
+ for ( my $j = 0 ; $j < $comma_count ; $j++ ) {
+ $is_odd = 1 - $is_odd;
+ $i_prev_plus = $i + 1;
+ $i = $$rcomma_index[$j];
+
+ my $i_term_end =
+ ( $types_to_go[ $i - 1 ] eq 'b' ) ? $i - 2 : $i - 1;
+ my $i_term_begin =
+ ( $types_to_go[$i_prev_plus] eq 'b' )
+ ? $i_prev_plus + 1
+ : $i_prev_plus;
+ push @i_term_begin, $i_term_begin;
+ push @i_term_end, $i_term_end;
+ push @i_term_comma, $i;
+
+ # note: currently adding 2 to all lengths (for comma and space)
+ my $length =
+ 2 + token_sequence_length( $i_term_begin, $i_term_end );
+ push @item_lengths, $length;
+
+ if ( $j == 0 ) {
+ $first_term_length = $length;
+ }
+ else {
+
+ if ( $length > $max_length[$is_odd] ) {
+ $max_length[$is_odd] = $length;
+ }
+ }
+ }
+
+ # now we have to make a distinction between the comma count and item
+ # count, because the item count will be one greater than the comma
+ # count if the last item is not terminated with a comma
+ my $i_b =
+ ( $types_to_go[ $i_last_comma + 1 ] eq 'b' )
+ ? $i_last_comma + 1
+ : $i_last_comma;
+ my $i_e =
+ ( $types_to_go[ $i_closing_paren - 1 ] eq 'b' )
+ ? $i_closing_paren - 2
+ : $i_closing_paren - 1;
+ my $i_effective_last_comma = $i_last_comma;
+
+ my $last_item_length = token_sequence_length( $i_b + 1, $i_e );
+
+ if ( $last_item_length > 0 ) {
+
+ # add 2 to length because other lengths include a comma and a blank
+ $last_item_length += 2;
+ push @item_lengths, $last_item_length;
+ push @i_term_begin, $i_b + 1;
+ push @i_term_end, $i_e;
+ push @i_term_comma, undef;
+
+ my $i_odd = $item_count % 2;
+
+ if ( $last_item_length > $max_length[$i_odd] ) {
+ $max_length[$i_odd] = $last_item_length;
+ }
+
+ $item_count++;
+ $i_effective_last_comma = $i_e + 1;
+
+ if ( $types_to_go[ $i_b + 1 ] =~ /^[iR\]]$/ ) {
+ $identifier_count++;
+ }
+ }
+
+ #---------------------------------------------------------------
+ # End of length calculations
+ #---------------------------------------------------------------
+
+ #---------------------------------------------------------------
+ # Compound List Rule 1:
+ # Break at (almost) every comma for a list containing a broken
+ # sublist. This has higher priority than the Interrupted List
+ # Rule.
+ #---------------------------------------------------------------
+ if ( $has_broken_sublist[$depth] ) {
+
+ # Break at every comma except for a comma between two
+ # simple, small terms. This prevents long vertical
+ # columns of, say, just 0's.
+ my $small_length = 10; # 2 + actual maximum length wanted
+
+ # We'll insert a break in long runs of small terms to
+ # allow alignment in uniform tables.
+ my $skipped_count = 0;
+ my $columns = table_columns_available($i_first_comma);
+ my $fields = int( $columns / $small_length );
+ if ( $rOpts_maximum_fields_per_table
+ && $fields > $rOpts_maximum_fields_per_table )
+ {
+ $fields = $rOpts_maximum_fields_per_table;
+ }
+ my $max_skipped_count = $fields - 1;
+
+ my $is_simple_last_term = 0;
+ my $is_simple_next_term = 0;
+ foreach my $j ( 0 .. $item_count ) {
+ $is_simple_last_term = $is_simple_next_term;
+ $is_simple_next_term = 0;
+ if ( $j < $item_count
+ && $i_term_end[$j] == $i_term_begin[$j]
+ && $item_lengths[$j] <= $small_length )
+ {
+ $is_simple_next_term = 1;
+ }
+ next if $j == 0;
+ if ( $is_simple_last_term
+ && $is_simple_next_term
+ && $skipped_count < $max_skipped_count )
+ {
+ $skipped_count++;
+ }
+ else {
+ $skipped_count = 0;
+ my $i = $i_term_comma[ $j - 1 ];
+ last unless defined $i;
+ set_forced_breakpoint($i);
+ }
+ }
+
+ # always break at the last comma if this list is
+ # interrupted; we wouldn't want to leave a terminal '{', for
+ # example.
+ if ($interrupted) { set_forced_breakpoint($i_true_last_comma) }
+ return;
+ }
+
+#my ( $a, $b, $c ) = caller();
+#print "LISTX: in set_list $a $c interupt=$interrupted count=$item_count
+#i_first = $i_first_comma i_last=$i_last_comma max=$max_index_to_go\n";
+#print "depth=$depth has_broken=$has_broken_sublist[$depth] is_multi=$is_multiline opening_paren=($i_opening_paren) \n";
+
+ #---------------------------------------------------------------
+ # Interrupted List Rule:
+ # A list is is forced to use old breakpoints if it was interrupted
+ # by side comments or blank lines, or requested by user.
+ #---------------------------------------------------------------
+ if ( $rOpts_break_at_old_comma_breakpoints
+ || $interrupted
+ || $i_opening_paren < 0 )
+ {
+ copy_old_breakpoints( $i_first_comma, $i_true_last_comma );
+ return;
+ }
+
+ #---------------------------------------------------------------
+ # Looks like a list of items. We have to look at it and size it up.
+ #---------------------------------------------------------------
+
+ my $opening_token = $tokens_to_go[$i_opening_paren];
+ my $opening_environment =
+ $container_environment_to_go[$i_opening_paren];
+
+ #-------------------------------------------------------------------
+ # Return if this will fit on one line
+ #-------------------------------------------------------------------
+
+ my $i_opening_minus = find_token_starting_list($i_opening_paren);
+ return
+ unless excess_line_length( $i_opening_minus, $i_closing_paren ) > 0;
+
+ #-------------------------------------------------------------------
+ # Now we know that this block spans multiple lines; we have to set
+ # at least one breakpoint -- real or fake -- as a signal to break
+ # open any outer containers.
+ #-------------------------------------------------------------------
+ set_fake_breakpoint();
+
+ # be sure we do not extend beyond the current list length
+ if ( $i_effective_last_comma >= $max_index_to_go ) {
+ $i_effective_last_comma = $max_index_to_go - 1;
+ }
+
+ # Set a flag indicating if we need to break open to keep -lp
+ # items aligned. This is necessary if any of the list terms
+ # exceeds the available space after the '('.
+ my $need_lp_break_open = $must_break_open;
+ if ( $rOpts_line_up_parentheses && !$must_break_open ) {
+ my $columns_if_unbroken = $rOpts_maximum_line_length -
+ total_line_length( $i_opening_minus, $i_opening_paren );
+ $need_lp_break_open =
+ ( $max_length[0] > $columns_if_unbroken )
+ || ( $max_length[1] > $columns_if_unbroken )
+ || ( $first_term_length > $columns_if_unbroken );
+ }
+
+ # Specify if the list must have an even number of fields or not.
+ # It is generally safest to assume an even number, because the
+ # list items might be a hash list. But if we can be sure that
+ # it is not a hash, then we can allow an odd number for more
+ # flexibility.
+ my $odd_or_even = 2; # 1 = odd field count ok, 2 = want even count
+
+ if ( $identifier_count >= $item_count - 1
+ || $is_assignment{$next_nonblank_type}
+ || ( $list_type && $list_type ne '=>' && $list_type !~ /^[\:\?]$/ )
+ )
+ {
+ $odd_or_even = 1;
+ }
+
+ # do we have a long first term which should be
+ # left on a line by itself?
+ my $use_separate_first_term = (
+ $odd_or_even == 1 # only if we can use 1 field/line
+ && $item_count > 3 # need several items
+ && $first_term_length >
+ 2 * $max_length[0] - 2 # need long first term
+ && $first_term_length >
+ 2 * $max_length[1] - 2 # need long first term
+ );
+
+ # or do we know from the type of list that the first term should
+ # be placed alone?
+ if ( !$use_separate_first_term ) {
+ if ( $is_keyword_with_special_leading_term{$list_type} ) {
+ $use_separate_first_term = 1;
+
+ # should the container be broken open?
+ if ( $item_count < 3 ) {
+ if ( $i_first_comma - $i_opening_paren < 4 ) {
+ $$rdo_not_break_apart = 1;
+ }
+ }
+ elsif ($first_term_length < 20
+ && $i_first_comma - $i_opening_paren < 4 )
+ {
+ my $columns = table_columns_available($i_first_comma);
+ if ( $first_term_length < $columns ) {
+ $$rdo_not_break_apart = 1;
+ }
+ }
+ }
+ }
+
+ # if so,
+ if ($use_separate_first_term) {
+
+ # ..set a break and update starting values
+ $use_separate_first_term = 1;
+ set_forced_breakpoint($i_first_comma);
+ $i_opening_paren = $i_first_comma;
+ $i_first_comma = $$rcomma_index[1];
+ $item_count--;
+ return if $comma_count == 1;
+ shift @item_lengths;
+ shift @i_term_begin;
+ shift @i_term_end;
+ shift @i_term_comma;
+ }
+
+ # if not, update the metrics to include the first term
+ else {
+ if ( $first_term_length > $max_length[0] ) {
+ $max_length[0] = $first_term_length;
+ }
+ }
+
+ # Field width parameters
+ my $pair_width = ( $max_length[0] + $max_length[1] );
+ my $max_width =
+ ( $max_length[0] > $max_length[1] ) ? $max_length[0] : $max_length[1];
+
+ # Number of free columns across the page width for laying out tables
+ my $columns = table_columns_available($i_first_comma);
+
+ # Estimated maximum number of fields which fit this space
+ # This will be our first guess
+ my $number_of_fields_max =
+ maximum_number_of_fields( $columns, $odd_or_even, $max_width,
+ $pair_width );
+ my $number_of_fields = $number_of_fields_max;
+
+ # Find the best-looking number of fields
+ # and make this our second guess if possible
+ my ( $number_of_fields_best, $ri_ragged_break_list,
+ $new_identifier_count )
+ = study_list_complexity( \@i_term_begin, \@i_term_end, \@item_lengths,
+ $max_width );
+
+ if ( $number_of_fields_best != 0
+ && $number_of_fields_best < $number_of_fields_max )
+ {
+ $number_of_fields = $number_of_fields_best;
+ }
+
+ # ----------------------------------------------------------------------
+ # If we are crowded and the -lp option is being used, try to
+ # undo some indentation
+ # ----------------------------------------------------------------------
+ if (
+ $rOpts_line_up_parentheses
+ && (
+ $number_of_fields == 0
+ || ( $number_of_fields == 1
+ && $number_of_fields != $number_of_fields_best )
+ )
+ )
+ {
+ my $available_spaces = get_AVAILABLE_SPACES_to_go($i_first_comma);
+ if ( $available_spaces > 0 ) {
+
+ my $spaces_wanted = $max_width - $columns; # for 1 field
+
+ if ( $number_of_fields_best == 0 ) {
+ $number_of_fields_best =
+ get_maximum_fields_wanted( \@item_lengths );
+ }
+
+ if ( $number_of_fields_best != 1 ) {
+ my $spaces_wanted_2 =
+ 1 + $pair_width - $columns; # for 2 fields
+ if ( $available_spaces > $spaces_wanted_2 ) {
+ $spaces_wanted = $spaces_wanted_2;
+ }
+ }
+
+ if ( $spaces_wanted > 0 ) {
+ my $deleted_spaces =
+ reduce_lp_indentation( $i_first_comma, $spaces_wanted );
+
+ # redo the math
+ if ( $deleted_spaces > 0 ) {
+ $columns = table_columns_available($i_first_comma);
+ $number_of_fields_max =
+ maximum_number_of_fields( $columns, $odd_or_even,
+ $max_width, $pair_width );
+ $number_of_fields = $number_of_fields_max;
+
+ if ( $number_of_fields_best == 1
+ && $number_of_fields >= 1 )
+ {
+ $number_of_fields = $number_of_fields_best;
+ }
+ }
+ }
+ }
+ }
+
+ # try for one column if two won't work
+ if ( $number_of_fields <= 0 ) {
+ $number_of_fields = int( $columns / $max_width );
+ }
+
+ # The user can place an upper bound on the number of fields,
+ # which can be useful for doing maintenance on tables
+ if ( $rOpts_maximum_fields_per_table
+ && $number_of_fields > $rOpts_maximum_fields_per_table )
+ {
+ $number_of_fields = $rOpts_maximum_fields_per_table;
+ }
+
+ # How many columns (characters) and lines would this container take
+ # if no additional whitespace were added?
+ my $packed_columns = token_sequence_length( $i_opening_paren + 1,
+ $i_effective_last_comma + 1 );
+ if ( $columns <= 0 ) { $columns = 1 } # avoid divide by zero
+ my $packed_lines = 1 + int( $packed_columns / $columns );
+
+ # are we an item contained in an outer list?
+ my $in_hierarchical_list = $next_nonblank_type =~ /^[\}\,]$/;
+
+ if ( $number_of_fields <= 0 ) {
+
+# #---------------------------------------------------------------
+# # We're in trouble. We can't find a single field width that works.
+# # There is no simple answer here; we may have a single long list
+# # item, or many.
+# #---------------------------------------------------------------
+#
+# In many cases, it may be best to not force a break if there is just one
+# comma, because the standard continuation break logic will do a better
+# job without it.
+#
+# In the common case that all but one of the terms can fit
+# on a single line, it may look better not to break open the
+# containing parens. Consider, for example
+#
+# $color =
+# join ( '/',
+# sort { $color_value{$::a} <=> $color_value{$::b}; }
+# keys %colors );
+#
+# which will look like this with the container broken:
+#
+# $color = join (
+# '/',
+# sort { $color_value{$::a} <=> $color_value{$::b}; } keys %colors
+# );
+#
+# Here is an example of this rule for a long last term:
+#
+# log_message( 0, 256, 128,
+# "Number of routes in adj-RIB-in to be considered: $peercount" );
+#
+# And here is an example with a long first term:
+#
+# $s = sprintf(
+# "%2d wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)",
+# $r, $pu, $ps, $cu, $cs, $tt
+# )
+# if $style eq 'all';
+
+ my $i_last_comma = $$rcomma_index[ $comma_count - 1 ];
+ my $long_last_term = excess_line_length( 0, $i_last_comma ) <= 0;
+ my $long_first_term =
+ excess_line_length( $i_first_comma + 1, $max_index_to_go ) <= 0;
+
+ # break at every comma ...
+ if (
+
+ # if requested by user or is best looking
+ $number_of_fields_best == 1
+
+ # or if this is a sublist of a larger list
+ || $in_hierarchical_list
+
+ # or if multiple commas and we dont have a long first or last
+ # term
+ || ( $comma_count > 1
+ && !( $long_last_term || $long_first_term ) )
+ )
+ {
+ foreach ( 0 .. $comma_count - 1 ) {
+ set_forced_breakpoint( $$rcomma_index[$_] );
+ }
+ }
+ elsif ($long_last_term) {
+
+ set_forced_breakpoint($i_last_comma);
+ $$rdo_not_break_apart = 1 unless $must_break_open;
+ }
+ elsif ($long_first_term) {
+
+ set_forced_breakpoint($i_first_comma);
+ }
+ else {
+
+ # let breaks be defined by default bond strength logic
+ }
+ return;
+ }
+
+ # --------------------------------------------------------
+ # We have a tentative field count that seems to work.
+ # How many lines will this require?
+ # --------------------------------------------------------
+ my $formatted_lines = $item_count / ($number_of_fields);
+ if ( $formatted_lines != int $formatted_lines ) {
+ $formatted_lines = 1 + int $formatted_lines;
+ }
+
+ # So far we've been trying to fill out to the right margin. But
+ # compact tables are easier to read, so let's see if we can use fewer
+ # fields without increasing the number of lines.
+ $number_of_fields =
+ compactify_table( $item_count, $number_of_fields, $formatted_lines,
+ $odd_or_even );
+
+ # How many spaces across the page will we fill?
+ my $columns_per_line =
+ ( int $number_of_fields / 2 ) * $pair_width +
+ ( $number_of_fields % 2 ) * $max_width;
+
+ my $formatted_columns;
+
+ if ( $number_of_fields > 1 ) {
+ $formatted_columns =
+ ( $pair_width * ( int( $item_count / 2 ) ) +
+ ( $item_count % 2 ) * $max_width );
+ }
+ else {
+ $formatted_columns = $max_width * $item_count;
+ }
+ if ( $formatted_columns < $packed_columns ) {
+ $formatted_columns = $packed_columns;
+ }
+
+ my $unused_columns = $formatted_columns - $packed_columns;
+
+ # set some empirical parameters to help decide if we should try to
+ # align; high sparsity does not look good, especially with few lines
+ my $sparsity = ($unused_columns) / ($formatted_columns);
+ my $max_allowed_sparsity =
+ ( $item_count < 3 ) ? 0.1
+ : ( $packed_lines == 1 ) ? 0.15
+ : ( $packed_lines == 2 ) ? 0.4
+ : 0.7;
+
+ # Begin check for shortcut methods, which avoid treating a list
+ # as a table for relatively small parenthesized lists. These
+ # are usually easier to read if not formatted as tables.
+ if (
+ $packed_lines <= 2 # probably can fit in 2 lines
+ && $item_count < 9 # doesn't have too many items
+ && $opening_environment eq 'BLOCK' # not a sub-container
+ && $opening_token eq '(' # is paren list
+ )
+ {
+
+ # Shortcut method 1: for -lp and just one comma:
+ # This is a no-brainer, just break at the comma.
+ if (
+ $rOpts_line_up_parentheses # -lp
+ && $item_count == 2 # two items, one comma
+ && !$must_break_open
+ )
+ {
+ my $i_break = $$rcomma_index[0];
+ set_forced_breakpoint($i_break);
+ $$rdo_not_break_apart = 1;
+ set_non_alignment_flags( $comma_count, $rcomma_index );
+ return;
+
+ }
+
+ # method 2 is for most small ragged lists which might look
+ # best if not displayed as a table.
+ if (
+ ( $number_of_fields == 2 && $item_count == 3 )
+ || (
+ $new_identifier_count > 0 # isn't all quotes
+ && $sparsity > 0.15
+ ) # would be fairly spaced gaps if aligned
+ )
+ {
+
+ my $break_count = set_ragged_breakpoints( \@i_term_comma,
+ $ri_ragged_break_list );
+ ++$break_count if ($use_separate_first_term);
+
+ # NOTE: we should really use the true break count here,
+ # which can be greater if there are large terms and
+ # little space, but usually this will work well enough.
+ unless ($must_break_open) {
+
+ if ( $break_count <= 1 ) {
+ $$rdo_not_break_apart = 1;
+ }
+ elsif ( $rOpts_line_up_parentheses && !$need_lp_break_open )
+ {
+ $$rdo_not_break_apart = 1;
+ }
+ }
+ set_non_alignment_flags( $comma_count, $rcomma_index );
+ return;
+ }
+
+ } # end shortcut methods
+
+ # debug stuff
+
+ FORMATTER_DEBUG_FLAG_SPARSE && do {
+ print
+"SPARSE:cols=$columns commas=$comma_count items:$item_count ids=$identifier_count pairwidth=$pair_width fields=$number_of_fields lines packed: $packed_lines packed_cols=$packed_columns fmtd:$formatted_lines cols /line:$columns_per_line unused:$unused_columns fmtd:$formatted_columns sparsity=$sparsity allow=$max_allowed_sparsity\n";
+
+ };
+
+ #---------------------------------------------------------------
+ # Compound List Rule 2:
+ # If this list is too long for one line, and it is an item of a
+ # larger list, then we must format it, regardless of sparsity
+ # (ian.t). One reason that we have to do this is to trigger
+ # Compound List Rule 1, above, which causes breaks at all commas of
+ # all outer lists. In this way, the structure will be properly
+ # displayed.
+ #---------------------------------------------------------------
+
+ # Decide if this list is too long for one line unless broken
+ my $total_columns = table_columns_available($i_opening_paren);
+ my $too_long = $packed_columns > $total_columns;
+
+ # For a paren list, include the length of the token just before the
+ # '(' because this is likely a sub call, and we would have to
+ # include the sub name on the same line as the list. This is still
+ # imprecise, but not too bad. (steve.t)
+ if ( !$too_long && $i_opening_paren > 0 && $opening_token eq '(' ) {
+
+ $too_long = excess_line_length( $i_opening_minus,
+ $i_effective_last_comma + 1 ) > 0;
+ }
+
+ # FIXME: For an item after a '=>', try to include the length of the
+ # thing before the '=>'. This is crude and should be improved by
+ # actually looking back token by token.
+ if ( !$too_long && $i_opening_paren > 0 && $list_type eq '=>' ) {
+ my $i_opening_minus = $i_opening_paren - 4;
+ if ( $i_opening_minus >= 0 ) {
+ $too_long = excess_line_length( $i_opening_minus,
+ $i_effective_last_comma + 1 ) > 0;
+ }
+ }
+
+ # Always break lists contained in '[' and '{' if too long for 1 line,
+ # and always break lists which are too long and part of a more complex
+ # structure.
+ my $must_break_open_container = $must_break_open
+ || ( $too_long
+ && ( $in_hierarchical_list || $opening_token ne '(' ) );
+
+#print "LISTX: next=$next_nonblank_type avail cols=$columns packed=$packed_columns must format = $must_break_open_container too-long=$too_long opening=$opening_token list_type=$list_type formatted_lines=$formatted_lines packed=$packed_lines max_sparsity= $max_allowed_sparsity sparsity=$sparsity \n";
+
+ #---------------------------------------------------------------
+ # The main decision:
+ # Now decide if we will align the data into aligned columns. Do not
+ # attempt to align columns if this is a tiny table or it would be
+ # too spaced. It seems that the more packed lines we have, the
+ # sparser the list that can be allowed and still look ok.
+ #---------------------------------------------------------------
+
+ if ( ( $formatted_lines < 3 && $packed_lines < $formatted_lines )
+ || ( $formatted_lines < 2 )
+ || ( $unused_columns > $max_allowed_sparsity * $formatted_columns )
+ )
+ {
+
+ #---------------------------------------------------------------
+ # too sparse: would look ugly if aligned in a table;
+ #---------------------------------------------------------------
+
+ # use old breakpoints if this is a 'big' list
+ # FIXME: goal is to improve set_ragged_breakpoints so that
+ # this is not necessary.
+ if ( $packed_lines > 2 && $item_count > 10 ) {
+ write_logfile_entry("List sparse: using old breakpoints\n");
+ copy_old_breakpoints( $i_first_comma, $i_last_comma );
+ }
+
+ # let the continuation logic handle it if 2 lines
+ else {
+
+ my $break_count = set_ragged_breakpoints( \@i_term_comma,
+ $ri_ragged_break_list );
+ ++$break_count if ($use_separate_first_term);
+
+ unless ($must_break_open_container) {
+ if ( $break_count <= 1 ) {
+ $$rdo_not_break_apart = 1;
+ }
+ elsif ( $rOpts_line_up_parentheses && !$need_lp_break_open )
+ {
+ $$rdo_not_break_apart = 1;
+ }
+ }
+ set_non_alignment_flags( $comma_count, $rcomma_index );
+ }
+ return;
+ }
+
+ #---------------------------------------------------------------
+ # go ahead and format as a table
+ #---------------------------------------------------------------
+ write_logfile_entry(
+ "List: auto formatting with $number_of_fields fields/row\n");
+
+ my $j_first_break =
+ $use_separate_first_term ? $number_of_fields : $number_of_fields - 1;
+
+ for (
+ my $j = $j_first_break ;
+ $j < $comma_count ;
+ $j += $number_of_fields
+ )
+ {
+ my $i = $$rcomma_index[$j];
+ set_forced_breakpoint($i);
+ }
+ return;
+ }
+}
+
+sub set_non_alignment_flags {
+
+ # set flag which indicates that these commas should not be
+ # aligned
+ my ( $comma_count, $rcomma_index ) = @_;
+ foreach ( 0 .. $comma_count - 1 ) {
+ $matching_token_to_go[ $$rcomma_index[$_] ] = 1;
+ }
+}
+
+sub study_list_complexity {
+
+ # Look for complex tables which should be formatted with one term per line.
+ # Returns the following:
+ #
+ # \@i_ragged_break_list = list of good breakpoints to avoid lines
+ # which are hard to read
+ # $number_of_fields_best = suggested number of fields based on
+ # complexity; = 0 if any number may be used.
+ #
+ my ( $ri_term_begin, $ri_term_end, $ritem_lengths, $max_width ) = @_;
+ my $item_count = @{$ri_term_begin};
+ my $complex_item_count = 0;
+ my $number_of_fields_best = $rOpts_maximum_fields_per_table;
+ my $i_max = @{$ritem_lengths} - 1;
+ ##my @item_complexity;
+
+ my $i_last_last_break = -3;
+ my $i_last_break = -2;
+ my @i_ragged_break_list;
+
+ my $definitely_complex = 30;
+ my $definitely_simple = 12;
+ my $quote_count = 0;
+
+ for my $i ( 0 .. $i_max ) {
+ my $ib = $ri_term_begin->[$i];
+ my $ie = $ri_term_end->[$i];
+
+ # define complexity: start with the actual term length
+ my $weighted_length = ( $ritem_lengths->[$i] - 2 );
+
+ ##TBD: join types here and check for variations
+ ##my $str=join "", @tokens_to_go[$ib..$ie];
+
+ my $is_quote = 0;
+ if ( $types_to_go[$ib] =~ /^[qQ]$/ ) {
+ $is_quote = 1;
+ $quote_count++;
+ }
+ elsif ( $types_to_go[$ib] =~ /^[w\-]$/ ) {
+ $quote_count++;
+ }
+
+ if ( $ib eq $ie ) {
+ if ( $is_quote && $tokens_to_go[$ib] =~ /\s/ ) {
+ $complex_item_count++;
+ $weighted_length *= 2;
+ }
+ else {
+ }
+ }
+ else {
+ if ( grep { $_ eq 'b' } @types_to_go[ $ib .. $ie ] ) {
+ $complex_item_count++;
+ $weighted_length *= 2;
+ }
+ if ( grep { $_ eq '..' } @types_to_go[ $ib .. $ie ] ) {
+ $weighted_length += 4;
+ }
+ }
+
+ # add weight for extra tokens.
+ $weighted_length += 2 * ( $ie - $ib );
+
+## my $BUB = join '', @tokens_to_go[$ib..$ie];
+## print "# COMPLEXITY:$weighted_length $BUB\n";
+
+##push @item_complexity, $weighted_length;
+
+ # now mark a ragged break after this item it if it is 'long and
+ # complex':
+ if ( $weighted_length >= $definitely_complex ) {
+
+ # if we broke after the previous term
+ # then break before it too
+ if ( $i_last_break == $i - 1
+ && $i > 1
+ && $i_last_last_break != $i - 2 )
+ {
+
+ ## FIXME: don't strand a small term
+ pop @i_ragged_break_list;
+ push @i_ragged_break_list, $i - 2;
+ push @i_ragged_break_list, $i - 1;
+ }
+
+ push @i_ragged_break_list, $i;
+ $i_last_last_break = $i_last_break;
+ $i_last_break = $i;
+ }
+
+ # don't break before a small last term -- it will
+ # not look good on a line by itself.
+ elsif ($i == $i_max
+ && $i_last_break == $i - 1
+ && $weighted_length <= $definitely_simple )
+ {
+ pop @i_ragged_break_list;
+ }
+ }
+
+ my $identifier_count = $i_max + 1 - $quote_count;
+
+ # Need more tuning here..
+ if ( $max_width > 12
+ && $complex_item_count > $item_count / 2
+ && $number_of_fields_best != 2 )
+ {
+ $number_of_fields_best = 1;
+ }
+
+ return ( $number_of_fields_best, \@i_ragged_break_list, $identifier_count );
+}
+
+sub get_maximum_fields_wanted {
+
+ # Not all tables look good with more than one field of items.
+ # This routine looks at a table and decides if it should be
+ # formatted with just one field or not.
+ # This coding is still under development.
+ my ($ritem_lengths) = @_;
+
+ my $number_of_fields_best = 0;
+
+ # For just a few items, we tentatively assume just 1 field.
+ my $item_count = @{$ritem_lengths};
+ if ( $item_count <= 5 ) {
+ $number_of_fields_best = 1;
+ }
+
+ # For larger tables, look at it both ways and see what looks best
+ else {
+
+ my $is_odd = 1;
+ my @max_length = ( 0, 0 );
+ my @last_length_2 = ( undef, undef );
+ my @first_length_2 = ( undef, undef );
+ my $last_length = undef;
+ my $total_variation_1 = 0;
+ my $total_variation_2 = 0;
+ my @total_variation_2 = ( 0, 0 );
+ for ( my $j = 0 ; $j < $item_count ; $j++ ) {
+
+ $is_odd = 1 - $is_odd;
+ my $length = $ritem_lengths->[$j];
+ if ( $length > $max_length[$is_odd] ) {
+ $max_length[$is_odd] = $length;
+ }
+
+ if ( defined($last_length) ) {
+ my $dl = abs( $length - $last_length );
+ $total_variation_1 += $dl;
+ }
+ $last_length = $length;
+
+ my $ll = $last_length_2[$is_odd];
+ if ( defined($ll) ) {
+ my $dl = abs( $length - $ll );
+ $total_variation_2[$is_odd] += $dl;
+ }
+ else {
+ $first_length_2[$is_odd] = $length;
+ }
+ $last_length_2[$is_odd] = $length;
+ }
+ $total_variation_2 = $total_variation_2[0] + $total_variation_2[1];
+
+ my $factor = ( $item_count > 10 ) ? 1 : ( $item_count > 5 ) ? 0.75 : 0;
+ unless ( $total_variation_2 < $factor * $total_variation_1 ) {
+ $number_of_fields_best = 1;
+ }
+ }
+ return ($number_of_fields_best);
+}
+
+sub table_columns_available {
+ my $i_first_comma = shift;
+ my $columns =
+ $rOpts_maximum_line_length - leading_spaces_to_go($i_first_comma);
+
+ # Patch: the vertical formatter does not line up lines whose lengths
+ # exactly equal the available line length because of allowances
+ # that must be made for side comments. Therefore, the number of
+ # available columns is reduced by 1 character.
+ $columns -= 1;
+ return $columns;
+}
+
+sub maximum_number_of_fields {
+
+ # how many fields will fit in the available space?
+ my ( $columns, $odd_or_even, $max_width, $pair_width ) = @_;
+ my $max_pairs = int( $columns / $pair_width );
+ my $number_of_fields = $max_pairs * 2;
+ if ( $odd_or_even == 1
+ && $max_pairs * $pair_width + $max_width <= $columns )
+ {
+ $number_of_fields++;
+ }
+ return $number_of_fields;
+}
+
+sub compactify_table {
+
+ # given a table with a certain number of fields and a certain number
+ # of lines, see if reducing the number of fields will make it look
+ # better.
+ my ( $item_count, $number_of_fields, $formatted_lines, $odd_or_even ) = @_;
+ if ( $number_of_fields >= $odd_or_even * 2 && $formatted_lines > 0 ) {
+ my $min_fields;
+
+ for (
+ $min_fields = $number_of_fields ;
+ $min_fields >= $odd_or_even
+ && $min_fields * $formatted_lines >= $item_count ;
+ $min_fields -= $odd_or_even
+ )
+ {
+ $number_of_fields = $min_fields;
+ }
+ }
+ return $number_of_fields;
+}
+
+sub set_ragged_breakpoints {
+
+ # Set breakpoints in a list that cannot be formatted nicely as a
+ # table.
+ my ( $ri_term_comma, $ri_ragged_break_list ) = @_;
+
+ my $break_count = 0;
+ foreach (@$ri_ragged_break_list) {
+ my $j = $ri_term_comma->[$_];
+ if ($j) {
+ set_forced_breakpoint($j);
+ $break_count++;
+ }
+ }
+ return $break_count;
+}
+
+sub copy_old_breakpoints {
+ my ( $i_first_comma, $i_last_comma ) = @_;
+ for my $i ( $i_first_comma .. $i_last_comma ) {
+ if ( $old_breakpoint_to_go[$i] ) {
+ set_forced_breakpoint($i);
+ }
+ }
+}
+
+sub set_nobreaks {
+ my ( $i, $j ) = @_;
+ if ( $i >= 0 && $i <= $j && $j <= $max_index_to_go ) {
+
+ FORMATTER_DEBUG_FLAG_NOBREAK && do {
+ my ( $a, $b, $c ) = caller();
+ print(
+"NOBREAK: forced_breakpoint $forced_breakpoint_count from $a $c with i=$i max=$max_index_to_go type=$types_to_go[$i]\n"
+ );
+ };
+
+ @nobreak_to_go[ $i .. $j ] = (1) x ( $j - $i + 1 );
+ }
+
+ # shouldn't happen; non-critical error
+ else {
+ FORMATTER_DEBUG_FLAG_NOBREAK && do {
+ my ( $a, $b, $c ) = caller();
+ print(
+"NOBREAK ERROR: from $a $c with i=$i j=$j max=$max_index_to_go\n"
+ );
+ };
+ }
+}
+
+sub set_fake_breakpoint {
+
+ # Just bump up the breakpoint count as a signal that there are breaks.
+ # This is useful if we have breaks but may want to postpone deciding where
+ # to make them.
+ $forced_breakpoint_count++;
+}
+
+sub set_forced_breakpoint {
+ my $i = shift;
+
+ return unless defined $i && $i >= 0;
+
+ # when called with certain tokens, use bond strengths to decide
+ # if we break before or after it
+ my $token = $tokens_to_go[$i];
+
+ if ( $token =~ /^([\=\.\,\:\?]|and|or|xor|&&|\|\|)$/ ) {
+ if ( $want_break_before{$token} && $i >= 0 ) { $i-- }
+ }
+
+ # breaks are forced before 'if' and 'unless'
+ elsif ( $is_if_unless{$token} ) { $i-- }
+
+ if ( $i >= 0 && $i <= $max_index_to_go ) {
+ my $i_nonblank = ( $types_to_go[$i] ne 'b' ) ? $i : $i - 1;
+
+ FORMATTER_DEBUG_FLAG_FORCE && do {
+ my ( $a, $b, $c ) = caller();
+ print
+"FORCE forced_breakpoint $forced_breakpoint_count from $a $c with i=$i_nonblank max=$max_index_to_go tok=$tokens_to_go[$i_nonblank] type=$types_to_go[$i_nonblank] nobr=$nobreak_to_go[$i_nonblank]\n";
+ };
+
+ if ( $i_nonblank >= 0 && $nobreak_to_go[$i_nonblank] == 0 ) {
+ $forced_breakpoint_to_go[$i_nonblank] = 1;
+
+ if ( $i_nonblank > $index_max_forced_break ) {
+ $index_max_forced_break = $i_nonblank;
+ }
+ $forced_breakpoint_count++;
+ $forced_breakpoint_undo_stack[ $forced_breakpoint_undo_count++ ] =
+ $i_nonblank;
+
+ # if we break at an opening container..break at the closing
+ if ( $tokens_to_go[$i_nonblank] =~ /^[\{\[\(\?]$/ ) {
+ set_closing_breakpoint($i_nonblank);
+ }
+ }
+ }
+}
+
+sub clear_breakpoint_undo_stack {
+ $forced_breakpoint_undo_count = 0;
+}
+
+sub undo_forced_breakpoint_stack {
+
+ my $i_start = shift;
+ if ( $i_start < 0 ) {
+ $i_start = 0;
+ my ( $a, $b, $c ) = caller();
+ warning(
+"Program Bug: undo_forced_breakpoint_stack from $a $c has i=$i_start "
+ );
+ }
+
+ while ( $forced_breakpoint_undo_count > $i_start ) {
+ my $i =
+ $forced_breakpoint_undo_stack[ --$forced_breakpoint_undo_count ];
+ if ( $i >= 0 && $i <= $max_index_to_go ) {
+ $forced_breakpoint_to_go[$i] = 0;
+ $forced_breakpoint_count--;
+
+ FORMATTER_DEBUG_FLAG_UNDOBP && do {
+ my ( $a, $b, $c ) = caller();
+ print(
+"UNDOBP: undo forced_breakpoint i=$i $forced_breakpoint_undo_count from $a $c max=$max_index_to_go\n"
+ );
+ };
+ }
+
+ # shouldn't happen, but not a critical error
+ else {
+ FORMATTER_DEBUG_FLAG_UNDOBP && do {
+ my ( $a, $b, $c ) = caller();
+ print(
+"Program Bug: undo_forced_breakpoint from $a $c has i=$i but max=$max_index_to_go"
+ );
+ };
+ }
+ }
+}
+
+{ # begin recombine_breakpoints
+
+ my %is_amp_amp;
+ my %is_ternary;
+ my %is_math_op;
+
+ BEGIN {
+
+ @_ = qw( && || );
+ @is_amp_amp{@_} = (1) x scalar(@_);
+
+ @_ = qw( ? : );
+ @is_ternary{@_} = (1) x scalar(@_);
+
+ @_ = qw( + - * / );
+ @is_math_op{@_} = (1) x scalar(@_);
+ }
+
+ sub recombine_breakpoints {
+
+ # sub set_continuation_breaks is very liberal in setting line breaks
+ # for long lines, always setting breaks at good breakpoints, even
+ # when that creates small lines. Occasionally small line fragments
+ # are produced which would look better if they were combined.
+ # That's the task of this routine, recombine_breakpoints.
+ #
+ # $ri_beg = ref to array of BEGinning indexes of each line
+ # $ri_end = ref to array of ENDing indexes of each line
+ my ( $ri_beg, $ri_end ) = @_;
+
+ my $more_to_do = 1;
+
+ # We keep looping over all of the lines of this batch
+ # until there are no more possible recombinations
+ my $nmax_last = @$ri_end;
+ while ($more_to_do) {
+ my $n_best = 0;
+ my $bs_best;
+ my $n;
+ my $nmax = @$ri_end - 1;
+
+ # safety check for infinite loop
+ unless ( $nmax < $nmax_last ) {
+
+ # shouldn't happen because splice below decreases nmax on each pass:
+ # but i get paranoid sometimes
+ die "Program bug-infinite loop in recombine breakpoints\n";
+ }
+ $nmax_last = $nmax;
+ $more_to_do = 0;
+ my $previous_outdentable_closing_paren;
+ my $leading_amp_count = 0;
+ my $this_line_is_semicolon_terminated;
+
+ # loop over all remaining lines in this batch
+ for $n ( 1 .. $nmax ) {
+
+ #----------------------------------------------------------
+ # If we join the current pair of lines,
+ # line $n-1 will become the left part of the joined line
+ # line $n will become the right part of the joined line
+ #
+ # Here are Indexes of the endpoint tokens of the two lines:
+ #
+ # -----line $n-1--- | -----line $n-----
+ # $ibeg_1 $iend_1 | $ibeg_2 $iend_2
+ # ^
+ # |
+ # We want to decide if we should remove the line break
+ # betwen the tokens at $iend_1 and $ibeg_2
+ #
+ # We will apply a number of ad-hoc tests to see if joining
+ # here will look ok. The code will just issue a 'next'
+ # command if the join doesn't look good. If we get through
+ # the gauntlet of tests, the lines will be recombined.
+ #----------------------------------------------------------
+ #
+ # beginning and ending tokens of the lines we are working on
+ my $ibeg_1 = $$ri_beg[ $n - 1 ];
+ my $iend_1 = $$ri_end[ $n - 1 ];
+ my $iend_2 = $$ri_end[$n];
+ my $ibeg_2 = $$ri_beg[$n];
+
+ my $ibeg_nmax = $$ri_beg[$nmax];
+
+ # some beginning indexes of other lines, which may not exist
+ my $ibeg_0 = $n > 1 ? $$ri_beg[ $n - 2 ] : -1;
+ my $ibeg_3 = $n < $nmax ? $$ri_beg[ $n + 1 ] : -1;
+ my $ibeg_4 = $n + 2 <= $nmax ? $$ri_beg[ $n + 2 ] : -1;
+
+ my $bs_tweak = 0;
+
+ #my $depth_increase=( $nesting_depth_to_go[$ibeg_2] -
+ # $nesting_depth_to_go[$ibeg_1] );
+
+##print "RECOMBINE: n=$n imid=$iend_1 if=$ibeg_1 type=$types_to_go[$ibeg_1] =$tokens_to_go[$ibeg_1] next_type=$types_to_go[$ibeg_2] next_tok=$tokens_to_go[$ibeg_2]\n";
+
+ # If line $n is the last line, we set some flags and
+ # do any special checks for it
+ if ( $n == $nmax ) {
+
+ # a terminal '{' should stay where it is
+ next if $types_to_go[$ibeg_2] eq '{';
+
+ # set flag if statement $n ends in ';'
+ $this_line_is_semicolon_terminated =
+ $types_to_go[$iend_2] eq ';'
+
+ # with possible side comment
+ || ( $types_to_go[$iend_2] eq '#'
+ && $iend_2 - $ibeg_2 >= 2
+ && $types_to_go[ $iend_2 - 2 ] eq ';'
+ && $types_to_go[ $iend_2 - 1 ] eq 'b' );
+ }
+
+ #----------------------------------------------------------
+ # Section 1: examine token at $iend_1 (right end of first line
+ # of pair)
+ #----------------------------------------------------------
+
+ # an isolated '}' may join with a ';' terminated segment
+ if ( $types_to_go[$iend_1] eq '}' ) {
+
+ # Check for cases where combining a semicolon terminated
+ # statement with a previous isolated closing paren will
+ # allow the combined line to be outdented. This is
+ # generally a good move. For example, we can join up
+ # the last two lines here:
+ # (
+ # $dev, $ino, $mode, $nlink, $uid, $gid, $rdev,
+ # $size, $atime, $mtime, $ctime, $blksize, $blocks
+ # )
+ # = stat($file);
+ #
+ # to get:
+ # (
+ # $dev, $ino, $mode, $nlink, $uid, $gid, $rdev,
+ # $size, $atime, $mtime, $ctime, $blksize, $blocks
+ # ) = stat($file);
+ #
+ # which makes the parens line up.
+ #
+ # Another example, from Joe Matarazzo, probably looks best
+ # with the 'or' clause appended to the trailing paren:
+ # $self->some_method(
+ # PARAM1 => 'foo',
+ # PARAM2 => 'bar'
+ # ) or die "Some_method didn't work";
+ #
+ $previous_outdentable_closing_paren =
+ $this_line_is_semicolon_terminated # ends in ';'
+ && $ibeg_1 == $iend_1 # only one token on last line
+ && $tokens_to_go[$iend_1] eq
+ ')' # must be structural paren
+
+ # only &&, ||, and : if no others seen
+ # (but note: our count made below could be wrong
+ # due to intervening comments)
+ && ( $leading_amp_count == 0
+ || $types_to_go[$ibeg_2] !~ /^(:|\&\&|\|\|)$/ )
+
+ # but leading colons probably line up with with a
+ # previous colon or question (count could be wrong).
+ && $types_to_go[$ibeg_2] ne ':'
+
+ # only one step in depth allowed. this line must not
+ # begin with a ')' itself.
+ && ( $nesting_depth_to_go[$iend_1] ==
+ $nesting_depth_to_go[$iend_2] + 1 );
+
+ next
+ unless (
+ $previous_outdentable_closing_paren
+
+ # handle '.' and '?' specially below
+ || ( $types_to_go[$ibeg_2] =~ /^[\.\?]$/ )
+ );
+ }
+
+ # do not recombine lines with ending &&, ||,
+ elsif ( $is_amp_amp{ $types_to_go[$iend_1] } ) {
+ next unless $want_break_before{ $types_to_go[$iend_1] };
+ }
+
+ # keep a terminal colon
+ elsif ( $types_to_go[$iend_1] eq ':' ) {
+ next unless $want_break_before{ $types_to_go[$iend_1] };
+ }
+
+ # Identify and recombine a broken ?/: chain
+ elsif ( $types_to_go[$iend_1] eq '?' ) {
+
+ # Do not recombine different levels
+ next
+ if ( $levels_to_go[$ibeg_1] ne $levels_to_go[$ibeg_2] );
+
+ # do not recombine unless next line ends in :
+ next unless $types_to_go[$iend_2] eq ':';
+ }
+
+ # for lines ending in a comma...
+ elsif ( $types_to_go[$iend_1] eq ',' ) {
+
+ # Do not recombine at comma which is following the
+ # input bias.
+ # TODO: might be best to make a special flag
+ next if ( $old_breakpoint_to_go[$iend_1] );
+
+ # an isolated '},' may join with an identifier + ';'
+ # this is useful for the class of a 'bless' statement (bless.t)
+ if ( $types_to_go[$ibeg_1] eq '}'
+ && $types_to_go[$ibeg_2] eq 'i' )
+ {
+ next
+ unless ( ( $ibeg_1 == ( $iend_1 - 1 ) )
+ && ( $iend_2 == ( $ibeg_2 + 1 ) )
+ && $this_line_is_semicolon_terminated );
+
+ # override breakpoint
+ $forced_breakpoint_to_go[$iend_1] = 0;
+ }
+
+ # but otherwise ..
+ else {
+
+ # do not recombine after a comma unless this will leave
+ # just 1 more line
+ next unless ( $n + 1 >= $nmax );
+
+ # do not recombine if there is a change in indentation depth
+ next
+ if (
+ $levels_to_go[$iend_1] != $levels_to_go[$iend_2] );
+
+ # do not recombine a "complex expression" after a
+ # comma. "complex" means no parens.
+ my $saw_paren;
+ foreach my $ii ( $ibeg_2 .. $iend_2 ) {
+ if ( $tokens_to_go[$ii] eq '(' ) {
+ $saw_paren = 1;
+ last;
+ }
+ }
+ next if $saw_paren;
+ }
+ }
+
+ # opening paren..
+ elsif ( $types_to_go[$iend_1] eq '(' ) {
+
+ # No longer doing this
+ }
+
+ elsif ( $types_to_go[$iend_1] eq ')' ) {
+
+ # No longer doing this
+ }
+
+ # keep a terminal for-semicolon
+ elsif ( $types_to_go[$iend_1] eq 'f' ) {
+ next;
+ }
+
+ # if '=' at end of line ...
+ elsif ( $is_assignment{ $types_to_go[$iend_1] } ) {
+
+ my $is_short_quote =
+ ( $types_to_go[$ibeg_2] eq 'Q'
+ && $ibeg_2 == $iend_2
+ && length( $tokens_to_go[$ibeg_2] ) <
+ $rOpts_short_concatenation_item_length );
+ my $is_ternary =
+ ( $types_to_go[$ibeg_1] eq '?'
+ && ( $ibeg_3 >= 0 && $types_to_go[$ibeg_3] eq ':' ) );
+
+ # always join an isolated '=', a short quote, or if this
+ # will put ?/: at start of adjacent lines
+ if ( $ibeg_1 != $iend_1
+ && !$is_short_quote
+ && !$is_ternary )
+ {
+ next
+ unless (
+ (
+
+ # unless we can reduce this to two lines
+ $nmax < $n + 2
+
+ # or three lines, the last with a leading semicolon
+ || ( $nmax == $n + 2
+ && $types_to_go[$ibeg_nmax] eq ';' )
+
+ # or the next line ends with a here doc
+ || $types_to_go[$iend_2] eq 'h'
+
+ # or the next line ends in an open paren or brace
+ # and the break hasn't been forced [dima.t]
+ || ( !$forced_breakpoint_to_go[$iend_1]
+ && $types_to_go[$iend_2] eq '{' )
+ )
+
+ # do not recombine if the two lines might align well
+ # this is a very approximate test for this
+ && ( $ibeg_3 >= 0
+ && $types_to_go[$ibeg_2] ne
+ $types_to_go[$ibeg_3] )
+ );
+
+ # -lp users often prefer this:
+ # my $title = function($env, $env, $sysarea,
+ # "bubba Borrower Entry");
+ # so we will recombine if -lp is used we have ending
+ # comma
+ if ( !$rOpts_line_up_parentheses
+ || $types_to_go[$iend_2] ne ',' )
+ {
+
+ # otherwise, scan the rhs line up to last token for
+ # complexity. Note that we are not counting the last
+ # token in case it is an opening paren.
+ my $tv = 0;
+ my $depth = $nesting_depth_to_go[$ibeg_2];
+ for ( my $i = $ibeg_2 + 1 ; $i < $iend_2 ; $i++ ) {
+ if ( $nesting_depth_to_go[$i] != $depth ) {
+ $tv++;
+ last if ( $tv > 1 );
+ }
+ $depth = $nesting_depth_to_go[$i];
+ }
+
+ # ok to recombine if no level changes before last token
+ if ( $tv > 0 ) {
+
+ # otherwise, do not recombine if more than two
+ # level changes.
+ next if ( $tv > 1 );
+
+ # check total complexity of the two adjacent lines
+ # that will occur if we do this join
+ my $istop =
+ ( $n < $nmax ) ? $$ri_end[ $n + 1 ] : $iend_2;
+ for ( my $i = $iend_2 ; $i <= $istop ; $i++ ) {
+ if ( $nesting_depth_to_go[$i] != $depth ) {
+ $tv++;
+ last if ( $tv > 2 );
+ }
+ $depth = $nesting_depth_to_go[$i];
+ }
+
+ # do not recombine if total is more than 2 level changes
+ next if ( $tv > 2 );
+ }
+ }
+ }
+
+ unless ( $tokens_to_go[$ibeg_2] =~ /^[\{\(\[]$/ ) {
+ $forced_breakpoint_to_go[$iend_1] = 0;
+ }
+ }
+
+ # for keywords..
+ elsif ( $types_to_go[$iend_1] eq 'k' ) {
+
+ # make major control keywords stand out
+ # (recombine.t)
+ next
+ if (
+
+ #/^(last|next|redo|return)$/
+ $is_last_next_redo_return{ $tokens_to_go[$iend_1] }
+
+ # but only if followed by multiple lines
+ && $n < $nmax
+ );
+
+ if ( $is_and_or{ $tokens_to_go[$iend_1] } ) {
+ next
+ unless $want_break_before{ $tokens_to_go[$iend_1] };
+ }
+ }
+
+ # handle trailing + - * /
+ elsif ( $is_math_op{ $types_to_go[$iend_1] } ) {
+
+ # combine lines if next line has single number
+ # or a short term followed by same operator
+ my $i_next_nonblank = $ibeg_2;
+ my $i_next_next = $i_next_nonblank + 1;
+ $i_next_next++ if ( $types_to_go[$i_next_next] eq 'b' );
+ my $number_follows = $types_to_go[$i_next_nonblank] eq 'n'
+ && (
+ $i_next_nonblank == $iend_2
+ || ( $i_next_next == $iend_2
+ && $is_math_op{ $types_to_go[$i_next_next] } )
+ || $types_to_go[$i_next_next] eq ';'
+ );
+
+ # find token before last operator of previous line
+ my $iend_1_minus = $iend_1;
+ $iend_1_minus--
+ if ( $iend_1_minus > $ibeg_1 );
+ $iend_1_minus--
+ if ( $types_to_go[$iend_1_minus] eq 'b'
+ && $iend_1_minus > $ibeg_1 );
+
+ my $short_term_follows =
+ ( $types_to_go[$iend_2] eq $types_to_go[$iend_1]
+ && $types_to_go[$iend_1_minus] =~ /^[in]$/
+ && $iend_2 <= $ibeg_2 + 2
+ && length( $tokens_to_go[$ibeg_2] ) <
+ $rOpts_short_concatenation_item_length );
+
+ next
+ unless ( $number_follows || $short_term_follows );
+ }
+
+ #----------------------------------------------------------
+ # Section 2: Now examine token at $ibeg_2 (left end of second
+ # line of pair)
+ #----------------------------------------------------------
+
+ # join lines identified above as capable of
+ # causing an outdented line with leading closing paren
+ if ($previous_outdentable_closing_paren) {
+ $forced_breakpoint_to_go[$iend_1] = 0;
+ }
+
+ # do not recombine lines with leading :
+ elsif ( $types_to_go[$ibeg_2] eq ':' ) {
+ $leading_amp_count++;
+ next if $want_break_before{ $types_to_go[$ibeg_2] };
+ }
+
+ # handle lines with leading &&, ||
+ elsif ( $is_amp_amp{ $types_to_go[$ibeg_2] } ) {
+
+ $leading_amp_count++;
+
+ # ok to recombine if it follows a ? or :
+ # and is followed by an open paren..
+ my $ok =
+ ( $is_ternary{ $types_to_go[$ibeg_1] }
+ && $tokens_to_go[$iend_2] eq '(' )
+
+ # or is followed by a ? or : at same depth
+ #
+ # We are looking for something like this. We can
+ # recombine the && line with the line above to make the
+ # structure more clear:
+ # return
+ # exists $G->{Attr}->{V}
+ # && exists $G->{Attr}->{V}->{$u}
+ # ? %{ $G->{Attr}->{V}->{$u} }
+ # : ();
+ #
+ # We should probably leave something like this alone:
+ # return
+ # exists $G->{Attr}->{E}
+ # && exists $G->{Attr}->{E}->{$u}
+ # && exists $G->{Attr}->{E}->{$u}->{$v}
+ # ? %{ $G->{Attr}->{E}->{$u}->{$v} }
+ # : ();
+ # so that we either have all of the &&'s (or ||'s)
+ # on one line, as in the first example, or break at
+ # each one as in the second example. However, it
+ # sometimes makes things worse to check for this because
+ # it prevents multiple recombinations. So this is not done.
+ || ( $ibeg_3 >= 0
+ && $is_ternary{ $types_to_go[$ibeg_3] }
+ && $nesting_depth_to_go[$ibeg_3] ==
+ $nesting_depth_to_go[$ibeg_2] );
+
+ next if !$ok && $want_break_before{ $types_to_go[$ibeg_2] };
+ $forced_breakpoint_to_go[$iend_1] = 0;
+
+ # tweak the bond strength to give this joint priority
+ # over ? and :
+ $bs_tweak = 0.25;
+ }
+
+ # Identify and recombine a broken ?/: chain
+ elsif ( $types_to_go[$ibeg_2] eq '?' ) {
+
+ # Do not recombine different levels
+ my $lev = $levels_to_go[$ibeg_2];
+ next if ( $lev ne $levels_to_go[$ibeg_1] );
+
+ # Do not recombine a '?' if either next line or
+ # previous line does not start with a ':'. The reasons
+ # are that (1) no alignment of the ? will be possible
+ # and (2) the expression is somewhat complex, so the
+ # '?' is harder to see in the interior of the line.
+ my $follows_colon =
+ $ibeg_1 >= 0 && $types_to_go[$ibeg_1] eq ':';
+ my $precedes_colon =
+ $ibeg_3 >= 0 && $types_to_go[$ibeg_3] eq ':';
+ next unless ( $follows_colon || $precedes_colon );
+
+ # we will always combining a ? line following a : line
+ if ( !$follows_colon ) {
+
+ # ...otherwise recombine only if it looks like a chain.
+ # we will just look at a few nearby lines to see if
+ # this looks like a chain.
+ my $local_count = 0;
+ foreach my $ii ( $ibeg_0, $ibeg_1, $ibeg_3, $ibeg_4 ) {
+ $local_count++
+ if $ii >= 0
+ && $types_to_go[$ii] eq ':'
+ && $levels_to_go[$ii] == $lev;
+ }
+ next unless ( $local_count > 1 );
+ }
+ $forced_breakpoint_to_go[$iend_1] = 0;
+ }
+
+ # do not recombine lines with leading '.'
+ elsif ( $types_to_go[$ibeg_2] =~ /^(\.)$/ ) {
+ my $i_next_nonblank = $ibeg_2 + 1;
+ if ( $types_to_go[$i_next_nonblank] eq 'b' ) {
+ $i_next_nonblank++;
+ }
+
+ next
+ unless (
+
+ # ... unless there is just one and we can reduce
+ # this to two lines if we do. For example, this
+ #
+ #
+ # $bodyA .=
+ # '($dummy, $pat) = &get_next_tex_cmd;' . '$args .= $pat;'
+ #
+ # looks better than this:
+ # $bodyA .= '($dummy, $pat) = &get_next_tex_cmd;'
+ # . '$args .= $pat;'
+
+ (
+ $n == 2
+ && $n == $nmax
+ && $types_to_go[$ibeg_1] ne $types_to_go[$ibeg_2]
+ )
+
+ # ... or this would strand a short quote , like this
+ # . "some long qoute"
+ # . "\n";
+ || ( $types_to_go[$i_next_nonblank] eq 'Q'
+ && $i_next_nonblank >= $iend_2 - 1
+ && length( $tokens_to_go[$i_next_nonblank] ) <
+ $rOpts_short_concatenation_item_length )
+ );
+ }
+
+ # handle leading keyword..
+ elsif ( $types_to_go[$ibeg_2] eq 'k' ) {
+
+ # handle leading "or"
+ if ( $tokens_to_go[$ibeg_2] eq 'or' ) {
+ next
+ unless (
+ $this_line_is_semicolon_terminated
+ && (
+
+ # following 'if' or 'unless' or 'or'
+ $types_to_go[$ibeg_1] eq 'k'
+ && $is_if_unless{ $tokens_to_go[$ibeg_1] }
+
+ # important: only combine a very simple or
+ # statement because the step below may have
+ # combined a trailing 'and' with this or,
+ # and we do not want to then combine
+ # everything together
+ && ( $iend_2 - $ibeg_2 <= 7 )
+ )
+ );
+ }
+
+ # handle leading 'and'
+ elsif ( $tokens_to_go[$ibeg_2] eq 'and' ) {
+
+ # Decide if we will combine a single terminal 'and'
+ # after an 'if' or 'unless'.
+
+ # This looks best with the 'and' on the same
+ # line as the 'if':
+ #
+ # $a = 1
+ # if $seconds and $nu < 2;
+ #
+ # But this looks better as shown:
+ #
+ # $a = 1
+ # if !$this->{Parents}{$_}
+ # or $this->{Parents}{$_} eq $_;
+ #
+ next
+ unless (
+ $this_line_is_semicolon_terminated
+ && (
+
+ # following 'if' or 'unless' or 'or'
+ $types_to_go[$ibeg_1] eq 'k'
+ && ( $is_if_unless{ $tokens_to_go[$ibeg_1] }
+ || $tokens_to_go[$ibeg_1] eq 'or' )
+ )
+ );
+ }
+
+ # handle leading "if" and "unless"
+ elsif ( $is_if_unless{ $tokens_to_go[$ibeg_2] } ) {
+
+ # FIXME: This is still experimental..may not be too useful
+ next
+ unless (
+ $this_line_is_semicolon_terminated
+
+ # previous line begins with 'and' or 'or'
+ && $types_to_go[$ibeg_1] eq 'k'
+ && $is_and_or{ $tokens_to_go[$ibeg_1] }
+
+ );
+ }
+
+ # handle all other leading keywords
+ else {
+
+ # keywords look best at start of lines,
+ # but combine things like "1 while"
+ unless ( $is_assignment{ $types_to_go[$iend_1] } ) {
+ next
+ if ( ( $types_to_go[$iend_1] ne 'k' )
+ && ( $tokens_to_go[$ibeg_2] ne 'while' ) );
+ }
+ }
+ }
+
+ # similar treatment of && and || as above for 'and' and 'or':
+ # NOTE: This block of code is currently bypassed because
+ # of a previous block but is retained for possible future use.
+ elsif ( $is_amp_amp{ $types_to_go[$ibeg_2] } ) {
+
+ # maybe looking at something like:
+ # unless $TEXTONLY || $item =~ m%</?(hr>|p>|a|img)%i;
+
+ next
+ unless (
+ $this_line_is_semicolon_terminated
+
+ # previous line begins with an 'if' or 'unless' keyword
+ && $types_to_go[$ibeg_1] eq 'k'
+ && $is_if_unless{ $tokens_to_go[$ibeg_1] }
+
+ );
+ }
+
+ # handle leading + - * /
+ elsif ( $is_math_op{ $types_to_go[$ibeg_2] } ) {
+ my $i_next_nonblank = $ibeg_2 + 1;
+ if ( $types_to_go[$i_next_nonblank] eq 'b' ) {
+ $i_next_nonblank++;
+ }
+
+ my $i_next_next = $i_next_nonblank + 1;
+ $i_next_next++ if ( $types_to_go[$i_next_next] eq 'b' );
+
+ my $is_number = (
+ $types_to_go[$i_next_nonblank] eq 'n'
+ && ( $i_next_nonblank >= $iend_2 - 1
+ || $types_to_go[$i_next_next] eq ';' )
+ );
+
+ my $iend_1_nonblank =
+ $types_to_go[$iend_1] eq 'b' ? $iend_1 - 1 : $iend_1;
+ my $iend_2_nonblank =
+ $types_to_go[$iend_2] eq 'b' ? $iend_2 - 1 : $iend_2;
+
+ my $is_short_term =
+ ( $types_to_go[$ibeg_2] eq $types_to_go[$ibeg_1]
+ && $types_to_go[$iend_2_nonblank] =~ /^[in]$/
+ && $types_to_go[$iend_1_nonblank] =~ /^[in]$/
+ && $iend_2_nonblank <= $ibeg_2 + 2
+ && length( $tokens_to_go[$iend_2_nonblank] ) <
+ $rOpts_short_concatenation_item_length );
+
+ # Combine these lines if this line is a single
+ # number, or if it is a short term with same
+ # operator as the previous line. For example, in
+ # the following code we will combine all of the
+ # short terms $A, $B, $C, $D, $E, $F, together
+ # instead of leaving them one per line:
+ # my $time =
+ # $A * $B * $C * $D * $E * $F *
+ # ( 2. * $eps * $sigma * $area ) *
+ # ( 1. / $tcold**3 - 1. / $thot**3 );
+ # This can be important in math-intensive code.
+ next
+ unless (
+ $is_number
+ || $is_short_term
+
+ # or if we can reduce this to two lines if we do.
+ || ( $n == 2
+ && $n == $nmax
+ && $types_to_go[$ibeg_1] ne $types_to_go[$ibeg_2] )
+ );
+ }
+
+ # handle line with leading = or similar
+ elsif ( $is_assignment{ $types_to_go[$ibeg_2] } ) {
+ next unless $n == 1;
+ next
+ unless (
+
+ # unless we can reduce this to two lines
+ $nmax == 2
+
+ # or three lines, the last with a leading semicolon
+ || ( $nmax == 3 && $types_to_go[$ibeg_nmax] eq ';' )
+
+ # or the next line ends with a here doc
+ || $types_to_go[$iend_2] eq 'h'
+ );
+ }
+
+ #----------------------------------------------------------
+ # Section 3:
+ # Combine the lines if we arrive here and it is possible
+ #----------------------------------------------------------
+
+ # honor hard breakpoints
+ next if ( $forced_breakpoint_to_go[$iend_1] > 0 );
+
+ my $bs = $bond_strength_to_go[$iend_1] + $bs_tweak;
+
+ # combined line cannot be too long
+ next
+ if excess_line_length( $ibeg_1, $iend_2 ) > 0;
+
+ # do not recombine if we would skip in indentation levels
+ if ( $n < $nmax ) {
+ my $if_next = $$ri_beg[ $n + 1 ];
+ next
+ if (
+ $levels_to_go[$ibeg_1] < $levels_to_go[$ibeg_2]
+ && $levels_to_go[$ibeg_2] < $levels_to_go[$if_next]
+
+ # but an isolated 'if (' is undesirable
+ && !(
+ $n == 1
+ && $iend_1 - $ibeg_1 <= 2
+ && $types_to_go[$ibeg_1] eq 'k'
+ && $tokens_to_go[$ibeg_1] eq 'if'
+ && $tokens_to_go[$iend_1] ne '('
+ )
+ );
+ }
+
+ # honor no-break's
+ next if ( $bs == NO_BREAK );
+
+ # remember the pair with the greatest bond strength
+ if ( !$n_best ) {
+ $n_best = $n;
+ $bs_best = $bs;
+ }
+ else {
+
+ if ( $bs > $bs_best ) {
+ $n_best = $n;
+ $bs_best = $bs;
+ }
+ }
+ }
+
+ # recombine the pair with the greatest bond strength
+ if ($n_best) {
+ splice @$ri_beg, $n_best, 1;
+ splice @$ri_end, $n_best - 1, 1;
+
+ # keep going if we are still making progress
+ $more_to_do++;
+ }
+ }
+ return ( $ri_beg, $ri_end );
+ }
+} # end recombine_breakpoints
+
+sub break_all_chain_tokens {
+
+ # scan the current breakpoints looking for breaks at certain "chain
+ # operators" (. : && || + etc) which often occur repeatedly in a long
+ # statement. If we see a break at any one, break at all similar tokens
+ # within the same container.
+ #
+ my ( $ri_left, $ri_right ) = @_;
+
+ my %saw_chain_type;
+ my %left_chain_type;
+ my %right_chain_type;
+ my %interior_chain_type;
+ my $nmax = @$ri_right - 1;
+
+ # scan the left and right end tokens of all lines
+ my $count = 0;
+ for my $n ( 0 .. $nmax ) {
+ my $il = $$ri_left[$n];
+ my $ir = $$ri_right[$n];
+ my $typel = $types_to_go[$il];
+ my $typer = $types_to_go[$ir];
+ $typel = '+' if ( $typel eq '-' ); # treat + and - the same
+ $typer = '+' if ( $typer eq '-' );
+ $typel = '*' if ( $typel eq '/' ); # treat * and / the same
+ $typer = '*' if ( $typer eq '/' );
+ my $tokenl = $tokens_to_go[$il];
+ my $tokenr = $tokens_to_go[$ir];
+
+ if ( $is_chain_operator{$tokenl} && $want_break_before{$typel} ) {
+ next if ( $typel eq '?' );
+ push @{ $left_chain_type{$typel} }, $il;
+ $saw_chain_type{$typel} = 1;
+ $count++;
+ }
+ if ( $is_chain_operator{$tokenr} && !$want_break_before{$typer} ) {
+ next if ( $typer eq '?' );
+ push @{ $right_chain_type{$typer} }, $ir;
+ $saw_chain_type{$typer} = 1;
+ $count++;
+ }
+ }
+ return unless $count;
+
+ # now look for any interior tokens of the same types
+ $count = 0;
+ for my $n ( 0 .. $nmax ) {
+ my $il = $$ri_left[$n];
+ my $ir = $$ri_right[$n];
+ for ( my $i = $il + 1 ; $i < $ir ; $i++ ) {
+ my $type = $types_to_go[$i];
+ $type = '+' if ( $type eq '-' );
+ $type = '*' if ( $type eq '/' );
+ if ( $saw_chain_type{$type} ) {
+ push @{ $interior_chain_type{$type} }, $i;
+ $count++;
+ }
+ }
+ }
+ return unless $count;
+
+ # now make a list of all new break points
+ my @insert_list;
+
+ # loop over all chain types
+ foreach my $type ( keys %saw_chain_type ) {
+
+ # quit if just ONE continuation line with leading . For example--
+ # print LATEXFILE '\framebox{\parbox[c][' . $h . '][t]{' . $w . '}{'
+ # . $contents;
+ last if ( $nmax == 1 && $type =~ /^[\.\+]$/ );
+
+ # loop over all interior chain tokens
+ foreach my $itest ( @{ $interior_chain_type{$type} } ) {
+
+ # loop over all left end tokens of same type
+ if ( $left_chain_type{$type} ) {
+ next if $nobreak_to_go[ $itest - 1 ];
+ foreach my $i ( @{ $left_chain_type{$type} } ) {
+ next unless in_same_container( $i, $itest );
+ push @insert_list, $itest - 1;
+
+ # Break at matching ? if this : is at a different level.
+ # For example, the ? before $THRf_DEAD in the following
+ # should get a break if its : gets a break.
+ #
+ # my $flags =
+ # ( $_ & 1 ) ? ( $_ & 4 ) ? $THRf_DEAD : $THRf_ZOMBIE
+ # : ( $_ & 4 ) ? $THRf_R_DETACHED
+ # : $THRf_R_JOINABLE;
+ if ( $type eq ':'
+ && $levels_to_go[$i] != $levels_to_go[$itest] )
+ {
+ my $i_question = $mate_index_to_go[$itest];
+ if ( $i_question > 0 ) {
+ push @insert_list, $i_question - 1;
+ }
+ }
+ last;
+ }
+ }
+
+ # loop over all right end tokens of same type
+ if ( $right_chain_type{$type} ) {
+ next if $nobreak_to_go[$itest];
+ foreach my $i ( @{ $right_chain_type{$type} } ) {
+ next unless in_same_container( $i, $itest );
+ push @insert_list, $itest;
+
+ # break at matching ? if this : is at a different level
+ if ( $type eq ':'
+ && $levels_to_go[$i] != $levels_to_go[$itest] )
+ {
+ my $i_question = $mate_index_to_go[$itest];
+ if ( $i_question >= 0 ) {
+ push @insert_list, $i_question;
+ }
+ }
+ last;
+ }
+ }
+ }
+ }
+
+ # insert any new break points
+ if (@insert_list) {
+ insert_additional_breaks( \@insert_list, $ri_left, $ri_right );
+ }
+}
+
+sub break_equals {
+
+ # Look for assignment operators that could use a breakpoint.
+ # For example, in the following snippet
+ #
+ # $HOME = $ENV{HOME}
+ # || $ENV{LOGDIR}
+ # || $pw[7]
+ # || die "no home directory for user $<";
+ #
+ # we could break at the = to get this, which is a little nicer:
+ # $HOME =
+ # $ENV{HOME}
+ # || $ENV{LOGDIR}
+ # || $pw[7]
+ # || die "no home directory for user $<";
+ #
+ # The logic here follows the logic in set_logical_padding, which
+ # will add the padding in the second line to improve alignment.
+ #
+ my ( $ri_left, $ri_right ) = @_;
+ my $nmax = @$ri_right - 1;
+ return unless ( $nmax >= 2 );
+
+ # scan the left ends of first two lines
+ my $tokbeg = "";
+ my $depth_beg;
+ for my $n ( 1 .. 2 ) {
+ my $il = $$ri_left[$n];
+ my $typel = $types_to_go[$il];
+ my $tokenl = $tokens_to_go[$il];
+
+ my $has_leading_op = ( $tokenl =~ /^\w/ )
+ ? $is_chain_operator{$tokenl} # + - * / : ? && ||
+ : $is_chain_operator{$typel}; # and, or
+ return unless ($has_leading_op);
+ if ( $n > 1 ) {
+ return
+ unless ( $tokenl eq $tokbeg
+ && $nesting_depth_to_go[$il] eq $depth_beg );
+ }
+ $tokbeg = $tokenl;
+ $depth_beg = $nesting_depth_to_go[$il];
+ }
+
+ # now look for any interior tokens of the same types
+ my $il = $$ri_left[0];
+ my $ir = $$ri_right[0];
+
+ # now make a list of all new break points
+ my @insert_list;
+ for ( my $i = $ir - 1 ; $i > $il ; $i-- ) {
+ my $type = $types_to_go[$i];
+ if ( $is_assignment{$type}
+ && $nesting_depth_to_go[$i] eq $depth_beg )
+ {
+ if ( $want_break_before{$type} ) {
+ push @insert_list, $i - 1;
+ }
+ else {
+ push @insert_list, $i;
+ }
+ }
+ }
+
+ # Break after a 'return' followed by a chain of operators
+ # return ( $^O !~ /win32|dos/i )
+ # && ( $^O ne 'VMS' )
+ # && ( $^O ne 'OS2' )
+ # && ( $^O ne 'MacOS' );
+ # To give:
+ # return
+ # ( $^O !~ /win32|dos/i )
+ # && ( $^O ne 'VMS' )
+ # && ( $^O ne 'OS2' )
+ # && ( $^O ne 'MacOS' );
+ my $i = 0;
+ if ( $types_to_go[$i] eq 'k'
+ && $tokens_to_go[$i] eq 'return'
+ && $ir > $il
+ && $nesting_depth_to_go[$i] eq $depth_beg )
+ {
+ push @insert_list, $i;
+ }
+
+ return unless (@insert_list);
+
+ # One final check...
+ # scan second and thrid lines and be sure there are no assignments
+ # we want to avoid breaking at an = to make something like this:
+ # unless ( $icon =
+ # $html_icons{"$type-$state"}
+ # or $icon = $html_icons{$type}
+ # or $icon = $html_icons{$state} )
+ for my $n ( 1 .. 2 ) {
+ my $il = $$ri_left[$n];
+ my $ir = $$ri_right[$n];
+ for ( my $i = $il + 1 ; $i <= $ir ; $i++ ) {
+ my $type = $types_to_go[$i];
+ return
+ if ( $is_assignment{$type}
+ && $nesting_depth_to_go[$i] eq $depth_beg );
+ }
+ }
+
+ # ok, insert any new break point
+ if (@insert_list) {
+ insert_additional_breaks( \@insert_list, $ri_left, $ri_right );
+ }
+}
+
+sub insert_final_breaks {
+
+ my ( $ri_left, $ri_right ) = @_;
+
+ my $nmax = @$ri_right - 1;
+
+ # scan the left and right end tokens of all lines
+ my $count = 0;
+ my $i_first_colon = -1;
+ for my $n ( 0 .. $nmax ) {
+ my $il = $$ri_left[$n];
+ my $ir = $$ri_right[$n];
+ my $typel = $types_to_go[$il];
+ my $typer = $types_to_go[$ir];
+ return if ( $typel eq '?' );
+ return if ( $typer eq '?' );
+ if ( $typel eq ':' ) { $i_first_colon = $il; last; }
+ elsif ( $typer eq ':' ) { $i_first_colon = $ir; last; }
+ }
+
+ # For long ternary chains,
+ # if the first : we see has its # ? is in the interior
+ # of a preceding line, then see if there are any good
+ # breakpoints before the ?.
+ if ( $i_first_colon > 0 ) {
+ my $i_question = $mate_index_to_go[$i_first_colon];
+ if ( $i_question > 0 ) {
+ my @insert_list;
+ for ( my $ii = $i_question - 1 ; $ii >= 0 ; $ii -= 1 ) {
+ my $token = $tokens_to_go[$ii];
+ my $type = $types_to_go[$ii];
+
+ # For now, a good break is either a comma or a 'return'.
+ if ( ( $type eq ',' || $type eq 'k' && $token eq 'return' )
+ && in_same_container( $ii, $i_question ) )
+ {
+ push @insert_list, $ii;
+ last;
+ }
+ }
+
+ # insert any new break points
+ if (@insert_list) {
+ insert_additional_breaks( \@insert_list, $ri_left, $ri_right );
+ }
+ }
+ }
+}
+
+sub in_same_container {
+
+ # check to see if tokens at i1 and i2 are in the
+ # same container, and not separated by a comma, ? or :
+ my ( $i1, $i2 ) = @_;
+ my $type = $types_to_go[$i1];
+ my $depth = $nesting_depth_to_go[$i1];
+ return unless ( $nesting_depth_to_go[$i2] == $depth );
+ if ( $i2 < $i1 ) { ( $i1, $i2 ) = ( $i2, $i1 ) }
+
+ ###########################################################
+ # This is potentially a very slow routine and not critical.
+ # For safety just give up for large differences.
+ # See test file 'infinite_loop.txt'
+ # TODO: replace this loop with a data structure
+ ###########################################################
+ return if ( $i2-$i1 > 200 );
+
+ for ( my $i = $i1 + 1 ; $i < $i2 ; $i++ ) {
+ next if ( $nesting_depth_to_go[$i] > $depth );
+ return if ( $nesting_depth_to_go[$i] < $depth );
+
+ my $tok = $tokens_to_go[$i];
+ $tok = ',' if $tok eq '=>'; # treat => same as ,
+
+ # Example: we would not want to break at any of these .'s
+ # : "<A HREF=\"#item_" . htmlify( 0, $s2 ) . "\">$str</A>"
+ if ( $type ne ':' ) {
+ return if ( $tok =~ /^[\,\:\?]$/ ) || $tok eq '||' || $tok eq 'or';
+ }
+ else {
+ return if ( $tok =~ /^[\,]$/ );
+ }
+ }
+ return 1;
+}
+
+sub set_continuation_breaks {
+
+ # Define an array of indexes for inserting newline characters to
+ # keep the line lengths below the maximum desired length. There is
+ # an implied break after the last token, so it need not be included.
+
+ # Method:
+ # This routine is part of series of routines which adjust line
+ # lengths. It is only called if a statement is longer than the
+ # maximum line length, or if a preliminary scanning located
+ # desirable break points. Sub scan_list has already looked at
+ # these tokens and set breakpoints (in array
+ # $forced_breakpoint_to_go[$i]) where it wants breaks (for example
+ # after commas, after opening parens, and before closing parens).
+ # This routine will honor these breakpoints and also add additional
+ # breakpoints as necessary to keep the line length below the maximum
+ # requested. It bases its decision on where the 'bond strength' is
+ # lowest.
+
+ # Output: returns references to the arrays:
+ # @i_first
+ # @i_last
+ # which contain the indexes $i of the first and last tokens on each
+ # line.
+
+ # In addition, the array:
+ # $forced_breakpoint_to_go[$i]
+ # may be updated to be =1 for any index $i after which there must be
+ # a break. This signals later routines not to undo the breakpoint.
+
+ my $saw_good_break = shift;
+ my @i_first = (); # the first index to output
+ my @i_last = (); # the last index to output
+ my @i_colon_breaks = (); # needed to decide if we have to break at ?'s
+ if ( $types_to_go[0] eq ':' ) { push @i_colon_breaks, 0 }
+
+ set_bond_strengths();
+
+ my $imin = 0;
+ my $imax = $max_index_to_go;
+ if ( $types_to_go[$imin] eq 'b' ) { $imin++ }
+ if ( $types_to_go[$imax] eq 'b' ) { $imax-- }
+ my $i_begin = $imin; # index for starting next iteration
+
+ my $leading_spaces = leading_spaces_to_go($imin);
+ my $line_count = 0;
+ my $last_break_strength = NO_BREAK;
+ my $i_last_break = -1;
+ my $max_bias = 0.001;
+ my $tiny_bias = 0.0001;
+ my $leading_alignment_token = "";
+ my $leading_alignment_type = "";
+
+ # see if any ?/:'s are in order
+ my $colons_in_order = 1;
+ my $last_tok = "";
+ my @colon_list = grep /^[\?\:]$/, @tokens_to_go[ 0 .. $max_index_to_go ];
+ my $colon_count = @colon_list;
+ foreach (@colon_list) {
+ if ( $_ eq $last_tok ) { $colons_in_order = 0; last }
+ $last_tok = $_;
+ }
+
+ # This is a sufficient but not necessary condition for colon chain
+ my $is_colon_chain = ( $colons_in_order && @colon_list > 2 );
+
+ #-------------------------------------------------------
+ # BEGINNING of main loop to set continuation breakpoints
+ # Keep iterating until we reach the end
+ #-------------------------------------------------------
+ while ( $i_begin <= $imax ) {
+ my $lowest_strength = NO_BREAK;
+ my $starting_sum = $lengths_to_go[$i_begin];
+ my $i_lowest = -1;
+ my $i_test = -1;
+ my $lowest_next_token = '';
+ my $lowest_next_type = 'b';
+ my $i_lowest_next_nonblank = -1;
+
+ #-------------------------------------------------------
+ # BEGINNING of inner loop to find the best next breakpoint
+ #-------------------------------------------------------
+ for ( $i_test = $i_begin ; $i_test <= $imax ; $i_test++ ) {
+ my $type = $types_to_go[$i_test];
+ my $token = $tokens_to_go[$i_test];
+ my $next_type = $types_to_go[ $i_test + 1 ];
+ my $next_token = $tokens_to_go[ $i_test + 1 ];
+ my $i_next_nonblank =
+ ( ( $next_type eq 'b' ) ? $i_test + 2 : $i_test + 1 );
+ my $next_nonblank_type = $types_to_go[$i_next_nonblank];
+ my $next_nonblank_token = $tokens_to_go[$i_next_nonblank];
+ my $next_nonblank_block_type = $block_type_to_go[$i_next_nonblank];
+ my $strength = $bond_strength_to_go[$i_test];
+ my $must_break = 0;
+
+ # FIXME: TESTING: Might want to be able to break after these
+ # force an immediate break at certain operators
+ # with lower level than the start of the line
+ if (
+ (
+ $next_nonblank_type =~ /^(\.|\&\&|\|\|)$/
+ || ( $next_nonblank_type eq 'k'
+ && $next_nonblank_token =~ /^(and|or)$/ )
+ )
+ && ( $nesting_depth_to_go[$i_begin] >
+ $nesting_depth_to_go[$i_next_nonblank] )
+ )
+ {
+ set_forced_breakpoint($i_next_nonblank);
+ }
+
+ if (
+
+ # Try to put a break where requested by scan_list
+ $forced_breakpoint_to_go[$i_test]
+
+ # break between ) { in a continued line so that the '{' can
+ # be outdented
+ # See similar logic in scan_list which catches instances
+ # where a line is just something like ') {'
+ || ( $line_count
+ && ( $token eq ')' )
+ && ( $next_nonblank_type eq '{' )
+ && ($next_nonblank_block_type)
+ && !$rOpts->{'opening-brace-always-on-right'} )
+
+ # There is an implied forced break at a terminal opening brace
+ || ( ( $type eq '{' ) && ( $i_test == $imax ) )
+ )
+ {
+
+ # Forced breakpoints must sometimes be overridden, for example
+ # because of a side comment causing a NO_BREAK. It is easier
+ # to catch this here than when they are set.
+ if ( $strength < NO_BREAK ) {
+ $strength = $lowest_strength - $tiny_bias;
+ $must_break = 1;
+ }
+ }
+
+ # quit if a break here would put a good terminal token on
+ # the next line and we already have a possible break
+ if (
+ !$must_break
+ && ( $next_nonblank_type =~ /^[\;\,]$/ )
+ && (
+ (
+ $leading_spaces +
+ $lengths_to_go[ $i_next_nonblank + 1 ] -
+ $starting_sum
+ ) > $rOpts_maximum_line_length
+ )
+ )
+ {
+ last if ( $i_lowest >= 0 );
+ }
+
+ # Avoid a break which would strand a single punctuation
+ # token. For example, we do not want to strand a leading
+ # '.' which is followed by a long quoted string.
+ if (
+ !$must_break
+ && ( $i_test == $i_begin )
+ && ( $i_test < $imax )
+ && ( $token eq $type )
+ && (
+ (
+ $leading_spaces +
+ $lengths_to_go[ $i_test + 1 ] -
+ $starting_sum
+ ) <= $rOpts_maximum_line_length
+ )
+ )
+ {
+ $i_test++;
+
+ if ( ( $i_test < $imax ) && ( $next_type eq 'b' ) ) {
+ $i_test++;
+ }
+ redo;
+ }
+
+ if ( ( $strength <= $lowest_strength ) && ( $strength < NO_BREAK ) )
+ {
+
+ # break at previous best break if it would have produced
+ # a leading alignment of certain common tokens, and it
+ # is different from the latest candidate break
+ last
+ if ($leading_alignment_type);
+
+ # Force at least one breakpoint if old code had good
+ # break It is only called if a breakpoint is required or
+ # desired. This will probably need some adjustments
+ # over time. A goal is to try to be sure that, if a new
+ # side comment is introduced into formated text, then
+ # the same breakpoints will occur. scbreak.t
+ last
+ if (
+ $i_test == $imax # we are at the end
+ && !$forced_breakpoint_count #
+ && $saw_good_break # old line had good break
+ && $type =~ /^[#;\{]$/ # and this line ends in
+ # ';' or side comment
+ && $i_last_break < 0 # and we haven't made a break
+ && $i_lowest > 0 # and we saw a possible break
+ && $i_lowest < $imax - 1 # (but not just before this ;)
+ && $strength - $lowest_strength < 0.5 * WEAK # and it's good
+ );
+
+ $lowest_strength = $strength;
+ $i_lowest = $i_test;
+ $lowest_next_token = $next_nonblank_token;
+ $lowest_next_type = $next_nonblank_type;
+ $i_lowest_next_nonblank = $i_next_nonblank;
+ last if $must_break;
+
+ # set flags to remember if a break here will produce a
+ # leading alignment of certain common tokens
+ if ( $line_count > 0
+ && $i_test < $imax
+ && ( $lowest_strength - $last_break_strength <= $max_bias )
+ )
+ {
+ my $i_last_end = $i_begin - 1;
+ if ( $types_to_go[$i_last_end] eq 'b' ) { $i_last_end -= 1 }
+ my $tok_beg = $tokens_to_go[$i_begin];
+ my $type_beg = $types_to_go[$i_begin];
+ if (
+
+ # check for leading alignment of certain tokens
+ (
+ $tok_beg eq $next_nonblank_token
+ && $is_chain_operator{$tok_beg}
+ && ( $type_beg eq 'k'
+ || $type_beg eq $tok_beg )
+ && $nesting_depth_to_go[$i_begin] >=
+ $nesting_depth_to_go[$i_next_nonblank]
+ )
+
+ || ( $tokens_to_go[$i_last_end] eq $token
+ && $is_chain_operator{$token}
+ && ( $type eq 'k' || $type eq $token )
+ && $nesting_depth_to_go[$i_last_end] >=
+ $nesting_depth_to_go[$i_test] )
+ )
+ {
+ $leading_alignment_token = $next_nonblank_token;
+ $leading_alignment_type = $next_nonblank_type;
+ }
+ }
+ }
+
+ my $too_long =
+ ( $i_test >= $imax )
+ ? 1
+ : (
+ (
+ $leading_spaces +
+ $lengths_to_go[ $i_test + 2 ] -
+ $starting_sum
+ ) > $rOpts_maximum_line_length
+ );
+
+ FORMATTER_DEBUG_FLAG_BREAK
+ && print
+"BREAK: testing i = $i_test imax=$imax $types_to_go[$i_test] $next_nonblank_type leading sp=($leading_spaces) next length = $lengths_to_go[$i_test+2] too_long=$too_long str=$strength\n";
+
+ # allow one extra terminal token after exceeding line length
+ # if it would strand this token.
+ if ( $rOpts_fuzzy_line_length
+ && $too_long
+ && ( $i_lowest == $i_test )
+ && ( length($token) > 1 )
+ && ( $next_nonblank_type =~ /^[\;\,]$/ ) )
+ {
+ $too_long = 0;
+ }
+
+ last
+ if (
+ ( $i_test == $imax ) # we're done if no more tokens,
+ || (
+ ( $i_lowest >= 0 ) # or no more space and we have a break
+ && $too_long
+ )
+ );
+ }
+
+ #-------------------------------------------------------
+ # END of inner loop to find the best next breakpoint
+ # Now decide exactly where to put the breakpoint
+ #-------------------------------------------------------
+
+ # it's always ok to break at imax if no other break was found
+ if ( $i_lowest < 0 ) { $i_lowest = $imax }
+
+ # semi-final index calculation
+ my $i_next_nonblank = (
+ ( $types_to_go[ $i_lowest + 1 ] eq 'b' )
+ ? $i_lowest + 2
+ : $i_lowest + 1
+ );
+ my $next_nonblank_type = $types_to_go[$i_next_nonblank];
+ my $next_nonblank_token = $tokens_to_go[$i_next_nonblank];
+
+ #-------------------------------------------------------
+ # ?/: rule 1 : if a break here will separate a '?' on this
+ # line from its closing ':', then break at the '?' instead.
+ #-------------------------------------------------------
+ my $i;
+ foreach $i ( $i_begin + 1 .. $i_lowest - 1 ) {
+ next unless ( $tokens_to_go[$i] eq '?' );
+
+ # do not break if probable sequence of ?/: statements
+ next if ($is_colon_chain);
+
+ # do not break if statement is broken by side comment
+ next
+ if (
+ $tokens_to_go[$max_index_to_go] eq '#'
+ && terminal_type( \@types_to_go, \@block_type_to_go, 0,
+ $max_index_to_go ) !~ /^[\;\}]$/
+ );
+
+ # no break needed if matching : is also on the line
+ next
+ if ( $mate_index_to_go[$i] >= 0
+ && $mate_index_to_go[$i] <= $i_next_nonblank );
+
+ $i_lowest = $i;
+ if ( $want_break_before{'?'} ) { $i_lowest-- }
+ last;
+ }
+
+ #-------------------------------------------------------
+ # END of inner loop to find the best next breakpoint:
+ # Break the line after the token with index i=$i_lowest
+ #-------------------------------------------------------
+
+ # final index calculation
+ $i_next_nonblank = (
+ ( $types_to_go[ $i_lowest + 1 ] eq 'b' )
+ ? $i_lowest + 2
+ : $i_lowest + 1
+ );
+ $next_nonblank_type = $types_to_go[$i_next_nonblank];
+ $next_nonblank_token = $tokens_to_go[$i_next_nonblank];
+
+ FORMATTER_DEBUG_FLAG_BREAK
+ && print "BREAK: best is i = $i_lowest strength = $lowest_strength\n";
+
+ #-------------------------------------------------------
+ # ?/: rule 2 : if we break at a '?', then break at its ':'
+ #
+ # Note: this rule is also in sub scan_list to handle a break
+ # at the start and end of a line (in case breaks are dictated
+ # by side comments).
+ #-------------------------------------------------------
+ if ( $next_nonblank_type eq '?' ) {
+ set_closing_breakpoint($i_next_nonblank);
+ }
+ elsif ( $types_to_go[$i_lowest] eq '?' ) {
+ set_closing_breakpoint($i_lowest);
+ }
+
+ #-------------------------------------------------------
+ # ?/: rule 3 : if we break at a ':' then we save
+ # its location for further work below. We may need to go
+ # back and break at its '?'.
+ #-------------------------------------------------------
+ if ( $next_nonblank_type eq ':' ) {
+ push @i_colon_breaks, $i_next_nonblank;
+ }
+ elsif ( $types_to_go[$i_lowest] eq ':' ) {
+ push @i_colon_breaks, $i_lowest;
+ }
+
+ # here we should set breaks for all '?'/':' pairs which are
+ # separated by this line
+
+ $line_count++;
+
+ # save this line segment, after trimming blanks at the ends
+ push( @i_first,
+ ( $types_to_go[$i_begin] eq 'b' ) ? $i_begin + 1 : $i_begin );
+ push( @i_last,
+ ( $types_to_go[$i_lowest] eq 'b' ) ? $i_lowest - 1 : $i_lowest );
+
+ # set a forced breakpoint at a container opening, if necessary, to
+ # signal a break at a closing container. Excepting '(' for now.
+ if ( $tokens_to_go[$i_lowest] =~ /^[\{\[]$/
+ && !$forced_breakpoint_to_go[$i_lowest] )
+ {
+ set_closing_breakpoint($i_lowest);
+ }
+
+ # get ready to go again
+ $i_begin = $i_lowest + 1;
+ $last_break_strength = $lowest_strength;
+ $i_last_break = $i_lowest;
+ $leading_alignment_token = "";
+ $leading_alignment_type = "";
+ $lowest_next_token = '';
+ $lowest_next_type = 'b';
+
+ if ( ( $i_begin <= $imax ) && ( $types_to_go[$i_begin] eq 'b' ) ) {
+ $i_begin++;
+ }
+
+ # update indentation size
+ if ( $i_begin <= $imax ) {
+ $leading_spaces = leading_spaces_to_go($i_begin);
+ }
+ }
+
+ #-------------------------------------------------------
+ # END of main loop to set continuation breakpoints
+ # Now go back and make any necessary corrections
+ #-------------------------------------------------------
+
+ #-------------------------------------------------------
+ # ?/: rule 4 -- if we broke at a ':', then break at
+ # corresponding '?' unless this is a chain of ?: expressions
+ #-------------------------------------------------------
+ if (@i_colon_breaks) {
+
+ # using a simple method for deciding if we are in a ?/: chain --
+ # this is a chain if it has multiple ?/: pairs all in order;
+ # otherwise not.
+ # Note that if line starts in a ':' we count that above as a break
+ my $is_chain = ( $colons_in_order && @i_colon_breaks > 1 );
+
+ unless ($is_chain) {
+ my @insert_list = ();
+ foreach (@i_colon_breaks) {
+ my $i_question = $mate_index_to_go[$_];
+ if ( $i_question >= 0 ) {
+ if ( $want_break_before{'?'} ) {
+ $i_question--;
+ if ( $i_question > 0
+ && $types_to_go[$i_question] eq 'b' )
+ {
+ $i_question--;
+ }
+ }
+
+ if ( $i_question >= 0 ) {
+ push @insert_list, $i_question;
+ }
+ }
+ insert_additional_breaks( \@insert_list, \@i_first, \@i_last );
+ }
+ }
+ }
+ return ( \@i_first, \@i_last, $colon_count );
+}
+
+sub insert_additional_breaks {
+
+ # this routine will add line breaks at requested locations after
+ # sub set_continuation_breaks has made preliminary breaks.
+
+ my ( $ri_break_list, $ri_first, $ri_last ) = @_;
+ my $i_f;
+ my $i_l;
+ my $line_number = 0;
+ my $i_break_left;
+ foreach $i_break_left ( sort { $a <=> $b } @$ri_break_list ) {
+
+ $i_f = $$ri_first[$line_number];
+ $i_l = $$ri_last[$line_number];
+ while ( $i_break_left >= $i_l ) {
+ $line_number++;
+
+ # shouldn't happen unless caller passes bad indexes
+ if ( $line_number >= @$ri_last ) {
+ warning(
+"Non-fatal program bug: couldn't set break at $i_break_left\n"
+ );
+ report_definite_bug();
+ return;
+ }
+ $i_f = $$ri_first[$line_number];
+ $i_l = $$ri_last[$line_number];
+ }
+
+ my $i_break_right = $i_break_left + 1;
+ if ( $types_to_go[$i_break_right] eq 'b' ) { $i_break_right++ }
+
+ if ( $i_break_left >= $i_f
+ && $i_break_left < $i_l
+ && $i_break_right > $i_f
+ && $i_break_right <= $i_l )
+ {
+ splice( @$ri_first, $line_number, 1, ( $i_f, $i_break_right ) );
+ splice( @$ri_last, $line_number, 1, ( $i_break_left, $i_l ) );
+ }
+ }
+}
+
+sub set_closing_breakpoint {
+
+ # set a breakpoint at a matching closing token
+ # at present, this is only used to break at a ':' which matches a '?'
+ my $i_break = shift;
+
+ if ( $mate_index_to_go[$i_break] >= 0 ) {
+
+ # CAUTION: infinite recursion possible here:
+ # set_closing_breakpoint calls set_forced_breakpoint, and
+ # set_forced_breakpoint call set_closing_breakpoint
+ # ( test files attrib.t, BasicLyx.pm.html).
+ # Don't reduce the '2' in the statement below
+ if ( $mate_index_to_go[$i_break] > $i_break + 2 ) {
+
+ # break before } ] and ), but sub set_forced_breakpoint will decide
+ # to break before or after a ? and :
+ my $inc = ( $tokens_to_go[$i_break] eq '?' ) ? 0 : 1;
+ set_forced_breakpoint( $mate_index_to_go[$i_break] - $inc );
+ }
+ }
+ else {
+ my $type_sequence = $type_sequence_to_go[$i_break];
+ if ($type_sequence) {
+ my $closing_token = $matching_token{ $tokens_to_go[$i_break] };
+ $postponed_breakpoint{$type_sequence} = 1;
+ }
+ }
+}
+
+# check to see if output line tabbing agrees with input line
+# this can be very useful for debugging a script which has an extra
+# or missing brace
+sub compare_indentation_levels {
+
+ my ( $python_indentation_level, $structural_indentation_level ) = @_;
+ if ( ( $python_indentation_level ne $structural_indentation_level ) ) {
+ $last_tabbing_disagreement = $input_line_number;
+
+ if ($in_tabbing_disagreement) {
+ }
+ else {
+ $tabbing_disagreement_count++;
+
+ if ( $tabbing_disagreement_count <= MAX_NAG_MESSAGES ) {
+ write_logfile_entry(
+"Start indentation disagreement: input=$python_indentation_level; output=$structural_indentation_level\n"
+ );
+ }
+ $in_tabbing_disagreement = $input_line_number;
+ $first_tabbing_disagreement = $in_tabbing_disagreement
+ unless ($first_tabbing_disagreement);
+ }
+ }
+ else {
+
+ if ($in_tabbing_disagreement) {
+
+ if ( $tabbing_disagreement_count <= MAX_NAG_MESSAGES ) {
+ write_logfile_entry(
+"End indentation disagreement from input line $in_tabbing_disagreement\n"
+ );
+
+ if ( $tabbing_disagreement_count == MAX_NAG_MESSAGES ) {
+ write_logfile_entry(
+ "No further tabbing disagreements will be noted\n");
+ }
+ }
+ $in_tabbing_disagreement = 0;
+ }
+ }
+}
+
+#####################################################################
+#
+# the Perl::Tidy::IndentationItem class supplies items which contain
+# how much whitespace should be used at the start of a line
+#
+#####################################################################
+
+package Perl::Tidy::IndentationItem;
+
+# Indexes for indentation items
+use constant SPACES => 0; # total leading white spaces
+use constant LEVEL => 1; # the indentation 'level'
+use constant CI_LEVEL => 2; # the 'continuation level'
+use constant AVAILABLE_SPACES => 3; # how many left spaces available
+ # for this level
+use constant CLOSED => 4; # index where we saw closing '}'
+use constant COMMA_COUNT => 5; # how many commas at this level?
+use constant SEQUENCE_NUMBER => 6; # output batch number
+use constant INDEX => 7; # index in output batch list
+use constant HAVE_CHILD => 8; # any dependents?
+use constant RECOVERABLE_SPACES => 9; # how many spaces to the right
+ # we would like to move to get
+ # alignment (negative if left)
+use constant ALIGN_PAREN => 10; # do we want to try to align
+ # with an opening structure?
+use constant MARKED => 11; # if visited by corrector logic
+use constant STACK_DEPTH => 12; # indentation nesting depth
+use constant STARTING_INDEX => 13; # first token index of this level
+use constant ARROW_COUNT => 14; # how many =>'s
+
+sub new {
+
+ # Create an 'indentation_item' which describes one level of leading
+ # whitespace when the '-lp' indentation is used. We return
+ # a reference to an anonymous array of associated variables.
+ # See above constants for storage scheme.
+ my (
+ $class, $spaces, $level,
+ $ci_level, $available_spaces, $index,
+ $gnu_sequence_number, $align_paren, $stack_depth,
+ $starting_index,
+ ) = @_;
+ my $closed = -1;
+ my $arrow_count = 0;
+ my $comma_count = 0;
+ my $have_child = 0;
+ my $want_right_spaces = 0;
+ my $marked = 0;
+ bless [
+ $spaces, $level, $ci_level,
+ $available_spaces, $closed, $comma_count,
+ $gnu_sequence_number, $index, $have_child,
+ $want_right_spaces, $align_paren, $marked,
+ $stack_depth, $starting_index, $arrow_count,
+ ], $class;
+}
+
+sub permanently_decrease_AVAILABLE_SPACES {
+
+ # make a permanent reduction in the available indentation spaces
+ # at one indentation item. NOTE: if there are child nodes, their
+ # total SPACES must be reduced by the caller.
+
+ my ( $item, $spaces_needed ) = @_;
+ my $available_spaces = $item->get_AVAILABLE_SPACES();
+ my $deleted_spaces =
+ ( $available_spaces > $spaces_needed )
+ ? $spaces_needed
+ : $available_spaces;
+ $item->decrease_AVAILABLE_SPACES($deleted_spaces);
+ $item->decrease_SPACES($deleted_spaces);
+ $item->set_RECOVERABLE_SPACES(0);
+
+ return $deleted_spaces;
+}
+
+sub tentatively_decrease_AVAILABLE_SPACES {
+
+ # We are asked to tentatively delete $spaces_needed of indentation
+ # for a indentation item. We may want to undo this later. NOTE: if
+ # there are child nodes, their total SPACES must be reduced by the
+ # caller.
+ my ( $item, $spaces_needed ) = @_;
+ my $available_spaces = $item->get_AVAILABLE_SPACES();
+ my $deleted_spaces =
+ ( $available_spaces > $spaces_needed )
+ ? $spaces_needed
+ : $available_spaces;
+ $item->decrease_AVAILABLE_SPACES($deleted_spaces);
+ $item->decrease_SPACES($deleted_spaces);
+ $item->increase_RECOVERABLE_SPACES($deleted_spaces);
+ return $deleted_spaces;
+}
+
+sub get_STACK_DEPTH {
+ my $self = shift;
+ return $self->[STACK_DEPTH];
+}
+
+sub get_SPACES {
+ my $self = shift;
+ return $self->[SPACES];
+}
+
+sub get_MARKED {
+ my $self = shift;
+ return $self->[MARKED];
+}
+
+sub set_MARKED {
+ my ( $self, $value ) = @_;
+ if ( defined($value) ) {
+ $self->[MARKED] = $value;
+ }
+ return $self->[MARKED];
+}
+
+sub get_AVAILABLE_SPACES {
+ my $self = shift;
+ return $self->[AVAILABLE_SPACES];
+}
+
+sub decrease_SPACES {
+ my ( $self, $value ) = @_;
+ if ( defined($value) ) {
+ $self->[SPACES] -= $value;
+ }
+ return $self->[SPACES];
+}
+
+sub decrease_AVAILABLE_SPACES {
+ my ( $self, $value ) = @_;
+ if ( defined($value) ) {
+ $self->[AVAILABLE_SPACES] -= $value;
+ }
+ return $self->[AVAILABLE_SPACES];
+}
+
+sub get_ALIGN_PAREN {
+ my $self = shift;
+ return $self->[ALIGN_PAREN];
+}
+
+sub get_RECOVERABLE_SPACES {
+ my $self = shift;
+ return $self->[RECOVERABLE_SPACES];
+}
+
+sub set_RECOVERABLE_SPACES {
+ my ( $self, $value ) = @_;
+ if ( defined($value) ) {
+ $self->[RECOVERABLE_SPACES] = $value;
+ }
+ return $self->[RECOVERABLE_SPACES];
+}
+
+sub increase_RECOVERABLE_SPACES {
+ my ( $self, $value ) = @_;
+ if ( defined($value) ) {
+ $self->[RECOVERABLE_SPACES] += $value;
+ }
+ return $self->[RECOVERABLE_SPACES];
+}
+
+sub get_CI_LEVEL {
+ my $self = shift;
+ return $self->[CI_LEVEL];
+}
+
+sub get_LEVEL {
+ my $self = shift;
+ return $self->[LEVEL];
+}
+
+sub get_SEQUENCE_NUMBER {
+ my $self = shift;
+ return $self->[SEQUENCE_NUMBER];
+}
+
+sub get_INDEX {
+ my $self = shift;
+ return $self->[INDEX];
+}
+
+sub get_STARTING_INDEX {
+ my $self = shift;
+ return $self->[STARTING_INDEX];
+}
+
+sub set_HAVE_CHILD {
+ my ( $self, $value ) = @_;
+ if ( defined($value) ) {
+ $self->[HAVE_CHILD] = $value;
+ }
+ return $self->[HAVE_CHILD];
+}
+
+sub get_HAVE_CHILD {
+ my $self = shift;
+ return $self->[HAVE_CHILD];
+}
+
+sub set_ARROW_COUNT {
+ my ( $self, $value ) = @_;
+ if ( defined($value) ) {
+ $self->[ARROW_COUNT] = $value;
+ }
+ return $self->[ARROW_COUNT];
+}
+
+sub get_ARROW_COUNT {
+ my $self = shift;
+ return $self->[ARROW_COUNT];
+}
+
+sub set_COMMA_COUNT {
+ my ( $self, $value ) = @_;
+ if ( defined($value) ) {
+ $self->[COMMA_COUNT] = $value;
+ }
+ return $self->[COMMA_COUNT];
+}
+
+sub get_COMMA_COUNT {
+ my $self = shift;
+ return $self->[COMMA_COUNT];
+}
+
+sub set_CLOSED {
+ my ( $self, $value ) = @_;
+ if ( defined($value) ) {
+ $self->[CLOSED] = $value;
+ }
+ return $self->[CLOSED];
+}
+
+sub get_CLOSED {
+ my $self = shift;
+ return $self->[CLOSED];
+}
+
+#####################################################################
+#
+# the Perl::Tidy::VerticalAligner::Line class supplies an object to
+# contain a single output line
+#
+#####################################################################
+
+package Perl::Tidy::VerticalAligner::Line;
+
+{
+
+ use strict;
+ use Carp;
+
+ use constant JMAX => 0;
+ use constant JMAX_ORIGINAL_LINE => 1;
+ use constant RTOKENS => 2;
+ use constant RFIELDS => 3;
+ use constant RPATTERNS => 4;
+ use constant INDENTATION => 5;
+ use constant LEADING_SPACE_COUNT => 6;
+ use constant OUTDENT_LONG_LINES => 7;
+ use constant LIST_TYPE => 8;
+ use constant IS_HANGING_SIDE_COMMENT => 9;
+ use constant RALIGNMENTS => 10;
+ use constant MAXIMUM_LINE_LENGTH => 11;
+ use constant RVERTICAL_TIGHTNESS_FLAGS => 12;
+
+ my %_index_map;
+ $_index_map{jmax} = JMAX;
+ $_index_map{jmax_original_line} = JMAX_ORIGINAL_LINE;
+ $_index_map{rtokens} = RTOKENS;
+ $_index_map{rfields} = RFIELDS;
+ $_index_map{rpatterns} = RPATTERNS;
+ $_index_map{indentation} = INDENTATION;
+ $_index_map{leading_space_count} = LEADING_SPACE_COUNT;
+ $_index_map{outdent_long_lines} = OUTDENT_LONG_LINES;
+ $_index_map{list_type} = LIST_TYPE;
+ $_index_map{is_hanging_side_comment} = IS_HANGING_SIDE_COMMENT;
+ $_index_map{ralignments} = RALIGNMENTS;
+ $_index_map{maximum_line_length} = MAXIMUM_LINE_LENGTH;
+ $_index_map{rvertical_tightness_flags} = RVERTICAL_TIGHTNESS_FLAGS;
+
+ my @_default_data = ();
+ $_default_data[JMAX] = undef;
+ $_default_data[JMAX_ORIGINAL_LINE] = undef;
+ $_default_data[RTOKENS] = undef;
+ $_default_data[RFIELDS] = undef;
+ $_default_data[RPATTERNS] = undef;
+ $_default_data[INDENTATION] = undef;
+ $_default_data[LEADING_SPACE_COUNT] = undef;
+ $_default_data[OUTDENT_LONG_LINES] = undef;
+ $_default_data[LIST_TYPE] = undef;
+ $_default_data[IS_HANGING_SIDE_COMMENT] = undef;
+ $_default_data[RALIGNMENTS] = [];
+ $_default_data[MAXIMUM_LINE_LENGTH] = undef;
+ $_default_data[RVERTICAL_TIGHTNESS_FLAGS] = undef;
+
+ {
+
+ # methods to count object population
+ my $_count = 0;
+ sub get_count { $_count; }
+ sub _increment_count { ++$_count }
+ sub _decrement_count { --$_count }
+ }
+
+ # Constructor may be called as a class method
+ sub new {
+ my ( $caller, %arg ) = @_;
+ my $caller_is_obj = ref($caller);
+ my $class = $caller_is_obj || $caller;
+ no strict "refs";
+ my $self = bless [], $class;
+
+ $self->[RALIGNMENTS] = [];
+
+ my $index;
+ foreach ( keys %_index_map ) {
+ $index = $_index_map{$_};
+ if ( exists $arg{$_} ) { $self->[$index] = $arg{$_} }
+ elsif ($caller_is_obj) { $self->[$index] = $caller->[$index] }
+ else { $self->[$index] = $_default_data[$index] }
+ }
+
+ $self->_increment_count();
+ return $self;
+ }
+
+ sub DESTROY {
+ $_[0]->_decrement_count();
+ }
+
+ sub get_jmax { $_[0]->[JMAX] }
+ sub get_jmax_original_line { $_[0]->[JMAX_ORIGINAL_LINE] }
+ sub get_rtokens { $_[0]->[RTOKENS] }
+ sub get_rfields { $_[0]->[RFIELDS] }
+ sub get_rpatterns { $_[0]->[RPATTERNS] }
+ sub get_indentation { $_[0]->[INDENTATION] }
+ sub get_leading_space_count { $_[0]->[LEADING_SPACE_COUNT] }
+ sub get_outdent_long_lines { $_[0]->[OUTDENT_LONG_LINES] }
+ sub get_list_type { $_[0]->[LIST_TYPE] }
+ sub get_is_hanging_side_comment { $_[0]->[IS_HANGING_SIDE_COMMENT] }
+ sub get_rvertical_tightness_flags { $_[0]->[RVERTICAL_TIGHTNESS_FLAGS] }
+
+ sub set_column { $_[0]->[RALIGNMENTS]->[ $_[1] ]->set_column( $_[2] ) }
+ sub get_alignment { $_[0]->[RALIGNMENTS]->[ $_[1] ] }
+ sub get_alignments { @{ $_[0]->[RALIGNMENTS] } }
+ sub get_column { $_[0]->[RALIGNMENTS]->[ $_[1] ]->get_column() }
+
+ sub get_starting_column {
+ $_[0]->[RALIGNMENTS]->[ $_[1] ]->get_starting_column();
+ }
+
+ sub increment_column {
+ $_[0]->[RALIGNMENTS]->[ $_[1] ]->increment_column( $_[2] );
+ }
+ sub set_alignments { my $self = shift; @{ $self->[RALIGNMENTS] } = @_; }
+
+ sub current_field_width {
+ my $self = shift;
+ my ($j) = @_;
+ if ( $j == 0 ) {
+ return $self->get_column($j);
+ }
+ else {
+ return $self->get_column($j) - $self->get_column( $j - 1 );
+ }
+ }
+
+ sub field_width_growth {
+ my $self = shift;
+ my $j = shift;
+ return $self->get_column($j) - $self->get_starting_column($j);
+ }
+
+ sub starting_field_width {
+ my $self = shift;
+ my $j = shift;
+ if ( $j == 0 ) {
+ return $self->get_starting_column($j);
+ }
+ else {
+ return $self->get_starting_column($j) -
+ $self->get_starting_column( $j - 1 );
+ }
+ }
+
+ sub increase_field_width {
+
+ my $self = shift;
+ my ( $j, $pad ) = @_;
+ my $jmax = $self->get_jmax();
+ for my $k ( $j .. $jmax ) {
+ $self->increment_column( $k, $pad );
+ }
+ }
+
+ sub get_available_space_on_right {
+ my $self = shift;
+ my $jmax = $self->get_jmax();
+ return $self->[MAXIMUM_LINE_LENGTH] - $self->get_column($jmax);
+ }
+
+ sub set_jmax { $_[0]->[JMAX] = $_[1] }
+ sub set_jmax_original_line { $_[0]->[JMAX_ORIGINAL_LINE] = $_[1] }
+ sub set_rtokens { $_[0]->[RTOKENS] = $_[1] }
+ sub set_rfields { $_[0]->[RFIELDS] = $_[1] }
+ sub set_rpatterns { $_[0]->[RPATTERNS] = $_[1] }
+ sub set_indentation { $_[0]->[INDENTATION] = $_[1] }
+ sub set_leading_space_count { $_[0]->[LEADING_SPACE_COUNT] = $_[1] }
+ sub set_outdent_long_lines { $_[0]->[OUTDENT_LONG_LINES] = $_[1] }
+ sub set_list_type { $_[0]->[LIST_TYPE] = $_[1] }
+ sub set_is_hanging_side_comment { $_[0]->[IS_HANGING_SIDE_COMMENT] = $_[1] }
+ sub set_alignment { $_[0]->[RALIGNMENTS]->[ $_[1] ] = $_[2] }
+
+}
+
+#####################################################################
+#
+# the Perl::Tidy::VerticalAligner::Alignment class holds information
+# on a single column being aligned
+#
+#####################################################################
+package Perl::Tidy::VerticalAligner::Alignment;
+
+{
+
+ use strict;
+
+ #use Carp;
+
+ # Symbolic array indexes
+ use constant COLUMN => 0; # the current column number
+ use constant STARTING_COLUMN => 1; # column number when created
+ use constant MATCHING_TOKEN => 2; # what token we are matching
+ use constant STARTING_LINE => 3; # the line index of creation
+ use constant ENDING_LINE => 4; # the most recent line to use it
+ use constant SAVED_COLUMN => 5; # the most recent line to use it
+ use constant SERIAL_NUMBER => 6; # unique number for this alignment
+ # (just its index in an array)
+
+ # Correspondence between variables and array indexes
+ my %_index_map;
+ $_index_map{column} = COLUMN;
+ $_index_map{starting_column} = STARTING_COLUMN;
+ $_index_map{matching_token} = MATCHING_TOKEN;
+ $_index_map{starting_line} = STARTING_LINE;
+ $_index_map{ending_line} = ENDING_LINE;
+ $_index_map{saved_column} = SAVED_COLUMN;
+ $_index_map{serial_number} = SERIAL_NUMBER;
+
+ my @_default_data = ();
+ $_default_data[COLUMN] = undef;
+ $_default_data[STARTING_COLUMN] = undef;
+ $_default_data[MATCHING_TOKEN] = undef;
+ $_default_data[STARTING_LINE] = undef;
+ $_default_data[ENDING_LINE] = undef;
+ $_default_data[SAVED_COLUMN] = undef;
+ $_default_data[SERIAL_NUMBER] = undef;
+
+ # class population count
+ {
+ my $_count = 0;
+ sub get_count { $_count; }
+ sub _increment_count { ++$_count }
+ sub _decrement_count { --$_count }
+ }
+
+ # constructor
+ sub new {
+ my ( $caller, %arg ) = @_;
+ my $caller_is_obj = ref($caller);
+ my $class = $caller_is_obj || $caller;
+ no strict "refs";
+ my $self = bless [], $class;
+
+ foreach ( keys %_index_map ) {
+ my $index = $_index_map{$_};
+ if ( exists $arg{$_} ) { $self->[$index] = $arg{$_} }
+ elsif ($caller_is_obj) { $self->[$index] = $caller->[$index] }
+ else { $self->[$index] = $_default_data[$index] }
+ }
+ $self->_increment_count();
+ return $self;
+ }
+
+ sub DESTROY {
+ $_[0]->_decrement_count();
+ }
+
+ sub get_column { return $_[0]->[COLUMN] }
+ sub get_starting_column { return $_[0]->[STARTING_COLUMN] }
+ sub get_matching_token { return $_[0]->[MATCHING_TOKEN] }
+ sub get_starting_line { return $_[0]->[STARTING_LINE] }
+ sub get_ending_line { return $_[0]->[ENDING_LINE] }
+ sub get_serial_number { return $_[0]->[SERIAL_NUMBER] }
+
+ sub set_column { $_[0]->[COLUMN] = $_[1] }
+ sub set_starting_column { $_[0]->[STARTING_COLUMN] = $_[1] }
+ sub set_matching_token { $_[0]->[MATCHING_TOKEN] = $_[1] }
+ sub set_starting_line { $_[0]->[STARTING_LINE] = $_[1] }
+ sub set_ending_line { $_[0]->[ENDING_LINE] = $_[1] }
+ sub increment_column { $_[0]->[COLUMN] += $_[1] }
+
+ sub save_column { $_[0]->[SAVED_COLUMN] = $_[0]->[COLUMN] }
+ sub restore_column { $_[0]->[COLUMN] = $_[0]->[SAVED_COLUMN] }
+
+}
+
+package Perl::Tidy::VerticalAligner;
+
+# The Perl::Tidy::VerticalAligner package collects output lines and
+# attempts to line up certain common tokens, such as => and #, which are
+# identified by the calling routine.
+#
+# There are two main routines: append_line and flush. Append acts as a
+# storage buffer, collecting lines into a group which can be vertically
+# aligned. When alignment is no longer possible or desirable, it dumps
+# the group to flush.
+#
+# append_line -----> flush
+#
+# collects writes
+# vertical one
+# groups group
+
+BEGIN {
+
+ # Caution: these debug flags produce a lot of output
+ # They should all be 0 except when debugging small scripts
+
+ use constant VALIGN_DEBUG_FLAG_APPEND => 0;
+ use constant VALIGN_DEBUG_FLAG_APPEND0 => 0;
+ use constant VALIGN_DEBUG_FLAG_TERNARY => 0;
+
+ my $debug_warning = sub {
+ print "VALIGN_DEBUGGING with key $_[0]\n";
+ };
+
+ VALIGN_DEBUG_FLAG_APPEND && $debug_warning->('APPEND');
+ VALIGN_DEBUG_FLAG_APPEND0 && $debug_warning->('APPEND0');
+
+}
+
+use vars qw(
+ $vertical_aligner_self
+ $current_line
+ $maximum_alignment_index
+ $ralignment_list
+ $maximum_jmax_seen
+ $minimum_jmax_seen
+ $previous_minimum_jmax_seen
+ $previous_maximum_jmax_seen
+ $maximum_line_index
+ $group_level
+ $group_type
+ $group_maximum_gap
+ $marginal_match
+ $last_group_level_written
+ $last_leading_space_count
+ $extra_indent_ok
+ $zero_count
+ @group_lines
+ $last_comment_column
+ $last_side_comment_line_number
+ $last_side_comment_length
+ $last_side_comment_level
+ $outdented_line_count
+ $first_outdented_line_at
+ $last_outdented_line_at
+ $diagnostics_object
+ $logger_object
+ $file_writer_object
+ @side_comment_history
+ $comment_leading_space_count
+ $is_matching_terminal_line
+
+ $cached_line_text
+ $cached_line_type
+ $cached_line_flag
+ $cached_seqno
+ $cached_line_valid
+ $cached_line_leading_space_count
+ $cached_seqno_string
+
+ $seqno_string
+ $last_nonblank_seqno_string
+
+ $rOpts
+
+ $rOpts_maximum_line_length
+ $rOpts_continuation_indentation
+ $rOpts_indent_columns
+ $rOpts_tabs
+ $rOpts_entab_leading_whitespace
+ $rOpts_valign
+
+ $rOpts_fixed_position_side_comment
+ $rOpts_minimum_space_to_comment
+
+);
+
+sub initialize {
+
+ my $class;
+
+ ( $class, $rOpts, $file_writer_object, $logger_object, $diagnostics_object )
+ = @_;
+
+ # variables describing the entire space group:
+ $ralignment_list = [];
+ $group_level = 0;
+ $last_group_level_written = -1;
+ $extra_indent_ok = 0; # can we move all lines to the right?
+ $last_side_comment_length = 0;
+ $maximum_jmax_seen = 0;
+ $minimum_jmax_seen = 0;
+ $previous_minimum_jmax_seen = 0;
+ $previous_maximum_jmax_seen = 0;
+
+ # variables describing each line of the group
+ @group_lines = (); # list of all lines in group
+
+ $outdented_line_count = 0;
+ $first_outdented_line_at = 0;
+ $last_outdented_line_at = 0;
+ $last_side_comment_line_number = 0;
+ $last_side_comment_level = -1;
+ $is_matching_terminal_line = 0;
+
+ # most recent 3 side comments; [ line number, column ]
+ $side_comment_history[0] = [ -300, 0 ];
+ $side_comment_history[1] = [ -200, 0 ];
+ $side_comment_history[2] = [ -100, 0 ];
+
+ # write_leader_and_string cache:
+ $cached_line_text = "";
+ $cached_line_type = 0;
+ $cached_line_flag = 0;
+ $cached_seqno = 0;
+ $cached_line_valid = 0;
+ $cached_line_leading_space_count = 0;
+ $cached_seqno_string = "";
+
+ # string of sequence numbers joined together
+ $seqno_string = "";
+ $last_nonblank_seqno_string = "";
+
+ # frequently used parameters
+ $rOpts_indent_columns = $rOpts->{'indent-columns'};
+ $rOpts_tabs = $rOpts->{'tabs'};
+ $rOpts_entab_leading_whitespace = $rOpts->{'entab-leading-whitespace'};
+ $rOpts_fixed_position_side_comment =
+ $rOpts->{'fixed-position-side-comment'};
+ $rOpts_minimum_space_to_comment = $rOpts->{'minimum-space-to-comment'};
+ $rOpts_maximum_line_length = $rOpts->{'maximum-line-length'};
+ $rOpts_valign = $rOpts->{'valign'};
+
+ forget_side_comment();
+
+ initialize_for_new_group();
+
+ $vertical_aligner_self = {};
+ bless $vertical_aligner_self, $class;
+ return $vertical_aligner_self;
+}
+
+sub initialize_for_new_group {
+ $maximum_line_index = -1; # lines in the current group
+ $maximum_alignment_index = -1; # alignments in current group
+ $zero_count = 0; # count consecutive lines without tokens
+ $current_line = undef; # line being matched for alignment
+ $group_maximum_gap = 0; # largest gap introduced
+ $group_type = "";
+ $marginal_match = 0;
+ $comment_leading_space_count = 0;
+ $last_leading_space_count = 0;
+}
+
+# interface to Perl::Tidy::Diagnostics routines
+sub write_diagnostics {
+ if ($diagnostics_object) {
+ $diagnostics_object->write_diagnostics(@_);
+ }
+}
+
+# interface to Perl::Tidy::Logger routines
+sub warning {
+ if ($logger_object) {
+ $logger_object->warning(@_);
+ }
+}
+
+sub write_logfile_entry {
+ if ($logger_object) {
+ $logger_object->write_logfile_entry(@_);
+ }
+}
+
+sub report_definite_bug {
+ if ($logger_object) {
+ $logger_object->report_definite_bug();
+ }
+}
+
+sub get_SPACES {
+
+ # return the number of leading spaces associated with an indentation
+ # variable $indentation is either a constant number of spaces or an
+ # object with a get_SPACES method.
+ my $indentation = shift;
+ return ref($indentation) ? $indentation->get_SPACES() : $indentation;
+}
+
+sub get_RECOVERABLE_SPACES {
+
+ # return the number of spaces (+ means shift right, - means shift left)
+ # that we would like to shift a group of lines with the same indentation
+ # to get them to line up with their opening parens
+ my $indentation = shift;
+ return ref($indentation) ? $indentation->get_RECOVERABLE_SPACES() : 0;
+}
+
+sub get_STACK_DEPTH {
+
+ my $indentation = shift;
+ return ref($indentation) ? $indentation->get_STACK_DEPTH() : 0;
+}
+
+sub make_alignment {
+ my ( $col, $token ) = @_;
+
+ # make one new alignment at column $col which aligns token $token
+ ++$maximum_alignment_index;
+ my $alignment = new Perl::Tidy::VerticalAligner::Alignment(
+ column => $col,
+ starting_column => $col,
+ matching_token => $token,
+ starting_line => $maximum_line_index,
+ ending_line => $maximum_line_index,
+ serial_number => $maximum_alignment_index,
+ );
+ $ralignment_list->[$maximum_alignment_index] = $alignment;
+ return $alignment;
+}
+
+sub dump_alignments {
+ print
+"Current Alignments:\ni\ttoken\tstarting_column\tcolumn\tstarting_line\tending_line\n";
+ for my $i ( 0 .. $maximum_alignment_index ) {
+ my $column = $ralignment_list->[$i]->get_column();
+ my $starting_column = $ralignment_list->[$i]->get_starting_column();
+ my $matching_token = $ralignment_list->[$i]->get_matching_token();
+ my $starting_line = $ralignment_list->[$i]->get_starting_line();
+ my $ending_line = $ralignment_list->[$i]->get_ending_line();
+ print
+"$i\t$matching_token\t$starting_column\t$column\t$starting_line\t$ending_line\n";
+ }
+}
+
+sub save_alignment_columns {
+ for my $i ( 0 .. $maximum_alignment_index ) {
+ $ralignment_list->[$i]->save_column();
+ }
+}
+
+sub restore_alignment_columns {
+ for my $i ( 0 .. $maximum_alignment_index ) {
+ $ralignment_list->[$i]->restore_column();
+ }
+}
+
+sub forget_side_comment {
+ $last_comment_column = 0;
+}
+
+sub append_line {
+
+ # sub append is called to place one line in the current vertical group.
+ #
+ # The input parameters are:
+ # $level = indentation level of this line
+ # $rfields = reference to array of fields
+ # $rpatterns = reference to array of patterns, one per field
+ # $rtokens = reference to array of tokens starting fields 1,2,..
+ #
+ # Here is an example of what this package does. In this example,
+ # we are trying to line up both the '=>' and the '#'.
+ #
+ # '18' => 'grave', # \`
+ # '19' => 'acute', # `'
+ # '20' => 'caron', # \v
+ # <-tabs-><f1-><--field 2 ---><-f3->
+ # | | | |
+ # | | | |
+ # col1 col2 col3 col4
+ #
+ # The calling routine has already broken the entire line into 3 fields as
+ # indicated. (So the work of identifying promising common tokens has
+ # already been done).
+ #
+ # In this example, there will be 2 tokens being matched: '=>' and '#'.
+ # They are the leading parts of fields 2 and 3, but we do need to know
+ # what they are so that we can dump a group of lines when these tokens
+ # change.
+ #
+ # The fields contain the actual characters of each field. The patterns
+ # are like the fields, but they contain mainly token types instead
+ # of tokens, so they have fewer characters. They are used to be
+ # sure we are matching fields of similar type.
+ #
+ # In this example, there will be 4 column indexes being adjusted. The
+ # first one is always at zero. The interior columns are at the start of
+ # the matching tokens, and the last one tracks the maximum line length.
+ #
+ # Basically, each time a new line comes in, it joins the current vertical
+ # group if possible. Otherwise it causes the current group to be dumped
+ # and a new group is started.
+ #
+ # For each new group member, the column locations are increased, as
+ # necessary, to make room for the new fields. When the group is finally
+ # output, these column numbers are used to compute the amount of spaces of
+ # padding needed for each field.
+ #
+ # Programming note: the fields are assumed not to have any tab characters.
+ # Tabs have been previously removed except for tabs in quoted strings and
+ # side comments. Tabs in these fields can mess up the column counting.
+ # The log file warns the user if there are any such tabs.
+
+ my (
+ $level, $level_end,
+ $indentation, $rfields,
+ $rtokens, $rpatterns,
+ $is_forced_break, $outdent_long_lines,
+ $is_terminal_ternary, $is_terminal_statement,
+ $do_not_pad, $rvertical_tightness_flags,
+ $level_jump,
+ ) = @_;
+
+ # number of fields is $jmax
+ # number of tokens between fields is $jmax-1
+ my $jmax = $#{$rfields};
+
+ my $leading_space_count = get_SPACES($indentation);
+
+ # set outdented flag to be sure we either align within statements or
+ # across statement boundaries, but not both.
+ my $is_outdented = $last_leading_space_count > $leading_space_count;
+ $last_leading_space_count = $leading_space_count;
+
+ # Patch: undo for hanging side comment
+ my $is_hanging_side_comment =
+ ( $jmax == 1 && $rtokens->[0] eq '#' && $rfields->[0] =~ /^\s*$/ );
+ $is_outdented = 0 if $is_hanging_side_comment;
+
+ VALIGN_DEBUG_FLAG_APPEND0 && do {
+ print
+"APPEND0: entering lines=$maximum_line_index new #fields= $jmax, leading_count=$leading_space_count last_cmt=$last_comment_column force=$is_forced_break\n";
+ };
+
+ # Validate cached line if necessary: If we can produce a container
+ # with just 2 lines total by combining an existing cached opening
+ # token with the closing token to follow, then we will mark both
+ # cached flags as valid.
+ if ($rvertical_tightness_flags) {
+ if ( $maximum_line_index <= 0
+ && $cached_line_type
+ && $cached_seqno
+ && $rvertical_tightness_flags->[2]
+ && $rvertical_tightness_flags->[2] == $cached_seqno )
+ {
+ $rvertical_tightness_flags->[3] ||= 1;
+ $cached_line_valid ||= 1;
+ }
+ }
+
+ # do not join an opening block brace with an unbalanced line
+ # unless requested with a flag value of 2
+ if ( $cached_line_type == 3
+ && $maximum_line_index < 0
+ && $cached_line_flag < 2
+ && $level_jump != 0 )
+ {
+ $cached_line_valid = 0;
+ }
+
+ # patch until new aligner is finished
+ if ($do_not_pad) { my_flush() }
+
+ # shouldn't happen:
+ if ( $level < 0 ) { $level = 0 }
+
+ # do not align code across indentation level changes
+ # or if vertical alignment is turned off for debugging
+ if ( $level != $group_level || $is_outdented || !$rOpts_valign ) {
+
+ # we are allowed to shift a group of lines to the right if its
+ # level is greater than the previous and next group
+ $extra_indent_ok =
+ ( $level < $group_level && $last_group_level_written < $group_level );
+
+ my_flush();
+
+ # If we know that this line will get flushed out by itself because
+ # of level changes, we can leave the extra_indent_ok flag set.
+ # That way, if we get an external flush call, we will still be
+ # able to do some -lp alignment if necessary.
+ $extra_indent_ok = ( $is_terminal_statement && $level > $group_level );
+
+ $group_level = $level;
+
+ # wait until after the above flush to get the leading space
+ # count because it may have been changed if the -icp flag is in
+ # effect
+ $leading_space_count = get_SPACES($indentation);
+
+ }
+
+ # --------------------------------------------------------------------
+ # Patch to collect outdentable block COMMENTS
+ # --------------------------------------------------------------------
+ my $is_blank_line = "";
+ my $is_block_comment = ( $jmax == 0 && $rfields->[0] =~ /^#/ );
+ if ( $group_type eq 'COMMENT' ) {
+ if (
+ (
+ $is_block_comment
+ && $outdent_long_lines
+ && $leading_space_count == $comment_leading_space_count
+ )
+ || $is_blank_line
+ )
+ {
+ $group_lines[ ++$maximum_line_index ] = $rfields->[0];
+ return;
+ }
+ else {
+ my_flush();
+ }
+ }
+
+ # --------------------------------------------------------------------
+ # add dummy fields for terminal ternary
+ # --------------------------------------------------------------------
+ my $j_terminal_match;
+ if ( $is_terminal_ternary && $current_line ) {
+ $j_terminal_match =
+ fix_terminal_ternary( $rfields, $rtokens, $rpatterns );
+ $jmax = @{$rfields} - 1;
+ }
+
+ # --------------------------------------------------------------------
+ # add dummy fields for else statement
+ # --------------------------------------------------------------------
+ if ( $rfields->[0] =~ /^else\s*$/
+ && $current_line
+ && $level_jump == 0 )
+ {
+ $j_terminal_match = fix_terminal_else( $rfields, $rtokens, $rpatterns );
+ $jmax = @{$rfields} - 1;
+ }
+
+ # --------------------------------------------------------------------
+ # Step 1. Handle simple line of code with no fields to match.
+ # --------------------------------------------------------------------
+ if ( $jmax <= 0 ) {
+ $zero_count++;
+
+ if ( $maximum_line_index >= 0
+ && !get_RECOVERABLE_SPACES( $group_lines[0]->get_indentation() ) )
+ {
+
+ # flush the current group if it has some aligned columns..
+ if ( $group_lines[0]->get_jmax() > 1 ) { my_flush() }
+
+ # flush current group if we are just collecting side comments..
+ elsif (
+
+ # ...and we haven't seen a comment lately
+ ( $zero_count > 3 )
+
+ # ..or if this new line doesn't fit to the left of the comments
+ || ( ( $leading_space_count + length( $$rfields[0] ) ) >
+ $group_lines[0]->get_column(0) )
+ )
+ {
+ my_flush();
+ }
+ }
+
+ # patch to start new COMMENT group if this comment may be outdented
+ if ( $is_block_comment
+ && $outdent_long_lines
+ && $maximum_line_index < 0 )
+ {
+ $group_type = 'COMMENT';
+ $comment_leading_space_count = $leading_space_count;
+ $group_lines[ ++$maximum_line_index ] = $rfields->[0];
+ return;
+ }
+
+ # just write this line directly if no current group, no side comment,
+ # and no space recovery is needed.
+ if ( $maximum_line_index < 0 && !get_RECOVERABLE_SPACES($indentation) )
+ {
+ write_leader_and_string( $leading_space_count, $$rfields[0], 0,
+ $outdent_long_lines, $rvertical_tightness_flags );
+ return;
+ }
+ }
+ else {
+ $zero_count = 0;
+ }
+
+ # programming check: (shouldn't happen)
+ # an error here implies an incorrect call was made
+ if ( $jmax > 0 && ( $#{$rtokens} != ( $jmax - 1 ) ) ) {
+ warning(
+"Program bug in Perl::Tidy::VerticalAligner - number of tokens = $#{$rtokens} should be one less than number of fields: $#{$rfields})\n"
+ );
+ report_definite_bug();
+ }
+
+ # --------------------------------------------------------------------
+ # create an object to hold this line
+ # --------------------------------------------------------------------
+ my $new_line = new Perl::Tidy::VerticalAligner::Line(
+ jmax => $jmax,
+ jmax_original_line => $jmax,
+ rtokens => $rtokens,
+ rfields => $rfields,
+ rpatterns => $rpatterns,
+ indentation => $indentation,
+ leading_space_count => $leading_space_count,
+ outdent_long_lines => $outdent_long_lines,
+ list_type => "",
+ is_hanging_side_comment => $is_hanging_side_comment,
+ maximum_line_length => $rOpts->{'maximum-line-length'},
+ rvertical_tightness_flags => $rvertical_tightness_flags,
+ );
+
+ # Initialize a global flag saying if the last line of the group should
+ # match end of group and also terminate the group. There should be no
+ # returns between here and where the flag is handled at the bottom.
+ my $col_matching_terminal = 0;
+ if ( defined($j_terminal_match) ) {
+
+ # remember the column of the terminal ? or { to match with
+ $col_matching_terminal = $current_line->get_column($j_terminal_match);
+
+ # set global flag for sub decide_if_aligned
+ $is_matching_terminal_line = 1;
+ }
+
+ # --------------------------------------------------------------------
+ # It simplifies things to create a zero length side comment
+ # if none exists.
+ # --------------------------------------------------------------------
+ make_side_comment( $new_line, $level_end );
+
+ # --------------------------------------------------------------------
+ # Decide if this is a simple list of items.
+ # There are 3 list types: none, comma, comma-arrow.
+ # We use this below to be less restrictive in deciding what to align.
+ # --------------------------------------------------------------------
+ if ($is_forced_break) {
+ decide_if_list($new_line);
+ }
+
+ if ($current_line) {
+
+ # --------------------------------------------------------------------
+ # Allow hanging side comment to join current group, if any
+ # This will help keep side comments aligned, because otherwise we
+ # will have to start a new group, making alignment less likely.
+ # --------------------------------------------------------------------
+ join_hanging_comment( $new_line, $current_line )
+ if $is_hanging_side_comment;
+
+ # --------------------------------------------------------------------
+ # If there is just one previous line, and it has more fields
+ # than the new line, try to join fields together to get a match with
+ # the new line. At the present time, only a single leading '=' is
+ # allowed to be compressed out. This is useful in rare cases where
+ # a table is forced to use old breakpoints because of side comments,
+ # and the table starts out something like this:
+ # my %MonthChars = ('0', 'Jan', # side comment
+ # '1', 'Feb',
+ # '2', 'Mar',
+ # Eliminating the '=' field will allow the remaining fields to line up.
+ # This situation does not occur if there are no side comments
+ # because scan_list would put a break after the opening '('.
+ # --------------------------------------------------------------------
+ eliminate_old_fields( $new_line, $current_line );
+
+ # --------------------------------------------------------------------
+ # If the new line has more fields than the current group,
+ # see if we can match the first fields and combine the remaining
+ # fields of the new line.
+ # --------------------------------------------------------------------
+ eliminate_new_fields( $new_line, $current_line );
+
+ # --------------------------------------------------------------------
+ # Flush previous group unless all common tokens and patterns match..
+ # --------------------------------------------------------------------
+ check_match( $new_line, $current_line );
+
+ # --------------------------------------------------------------------
+ # See if there is space for this line in the current group (if any)
+ # --------------------------------------------------------------------
+ if ($current_line) {
+ check_fit( $new_line, $current_line );
+ }
+ }
+
+ # --------------------------------------------------------------------
+ # Append this line to the current group (or start new group)
+ # --------------------------------------------------------------------
+ accept_line($new_line);
+
+ # Future update to allow this to vary:
+ $current_line = $new_line if ( $maximum_line_index == 0 );
+
+ # output this group if it ends in a terminal else or ternary line
+ if ( defined($j_terminal_match) ) {
+
+ # if there is only one line in the group (maybe due to failure to match
+ # perfectly with previous lines), then align the ? or { of this
+ # terminal line with the previous one unless that would make the line
+ # too long
+ if ( $maximum_line_index == 0 ) {
+ my $col_now = $current_line->get_column($j_terminal_match);
+ my $pad = $col_matching_terminal - $col_now;
+ my $padding_available =
+ $current_line->get_available_space_on_right();
+ if ( $pad > 0 && $pad <= $padding_available ) {
+ $current_line->increase_field_width( $j_terminal_match, $pad );
+ }
+ }
+ my_flush();
+ $is_matching_terminal_line = 0;
+ }
+
+ # --------------------------------------------------------------------
+ # Step 8. Some old debugging stuff
+ # --------------------------------------------------------------------
+ VALIGN_DEBUG_FLAG_APPEND && do {
+ print "APPEND fields:";
+ dump_array(@$rfields);
+ print "APPEND tokens:";
+ dump_array(@$rtokens);
+ print "APPEND patterns:";
+ dump_array(@$rpatterns);
+ dump_alignments();
+ };
+
+ return;
+}
+
+sub join_hanging_comment {
+
+ my $line = shift;
+ my $jmax = $line->get_jmax();
+ return 0 unless $jmax == 1; # must be 2 fields
+ my $rtokens = $line->get_rtokens();
+ return 0 unless $$rtokens[0] eq '#'; # the second field is a comment..
+ my $rfields = $line->get_rfields();
+ return 0 unless $$rfields[0] =~ /^\s*$/; # the first field is empty...
+ my $old_line = shift;
+ my $maximum_field_index = $old_line->get_jmax();
+ return 0
+ unless $maximum_field_index > $jmax; # the current line has more fields
+ my $rpatterns = $line->get_rpatterns();
+
+ $line->set_is_hanging_side_comment(1);
+ $jmax = $maximum_field_index;
+ $line->set_jmax($jmax);
+ $$rfields[$jmax] = $$rfields[1];
+ $$rtokens[ $jmax - 1 ] = $$rtokens[0];
+ $$rpatterns[ $jmax - 1 ] = $$rpatterns[0];
+ for ( my $j = 1 ; $j < $jmax ; $j++ ) {
+ $$rfields[$j] = " "; # NOTE: caused glitch unless 1 blank, why?
+ $$rtokens[ $j - 1 ] = "";
+ $$rpatterns[ $j - 1 ] = "";
+ }
+ return 1;
+}
+
+sub eliminate_old_fields {
+
+ my $new_line = shift;
+ my $jmax = $new_line->get_jmax();
+ if ( $jmax > $maximum_jmax_seen ) { $maximum_jmax_seen = $jmax }
+ if ( $jmax < $minimum_jmax_seen ) { $minimum_jmax_seen = $jmax }
+
+ # there must be one previous line
+ return unless ( $maximum_line_index == 0 );
+
+ my $old_line = shift;
+ my $maximum_field_index = $old_line->get_jmax();
+
+ ###############################################
+ # this line must have fewer fields
+ return unless $maximum_field_index > $jmax;
+ ###############################################
+
+ # Identify specific cases where field elimination is allowed:
+ # case=1: both lines have comma-separated lists, and the first
+ # line has an equals
+ # case=2: both lines have leading equals
+
+ # case 1 is the default
+ my $case = 1;
+
+ # See if case 2: both lines have leading '='
+ # We'll require smiliar leading patterns in this case
+ my $old_rtokens = $old_line->get_rtokens();
+ my $rtokens = $new_line->get_rtokens();
+ my $rpatterns = $new_line->get_rpatterns();
+ my $old_rpatterns = $old_line->get_rpatterns();
+ if ( $rtokens->[0] =~ /^=\d*$/
+ && $old_rtokens->[0] eq $rtokens->[0]
+ && $old_rpatterns->[0] eq $rpatterns->[0] )
+ {
+ $case = 2;
+ }
+
+ # not too many fewer fields in new line for case 1
+ return unless ( $case != 1 || $maximum_field_index - 2 <= $jmax );
+
+ # case 1 must have side comment
+ my $old_rfields = $old_line->get_rfields();
+ return
+ if ( $case == 1
+ && length( $$old_rfields[$maximum_field_index] ) == 0 );
+
+ my $rfields = $new_line->get_rfields();
+
+ my $hid_equals = 0;
+
+ my @new_alignments = ();
+ my @new_fields = ();
+ my @new_matching_patterns = ();
+ my @new_matching_tokens = ();
+
+ my $j = 0;
+ my $k;
+ my $current_field = '';
+ my $current_pattern = '';
+
+ # loop over all old tokens
+ my $in_match = 0;
+ for ( $k = 0 ; $k < $maximum_field_index ; $k++ ) {
+ $current_field .= $$old_rfields[$k];
+ $current_pattern .= $$old_rpatterns[$k];
+ last if ( $j > $jmax - 1 );
+
+ if ( $$old_rtokens[$k] eq $$rtokens[$j] ) {
+ $in_match = 1;
+ $new_fields[$j] = $current_field;
+ $new_matching_patterns[$j] = $current_pattern;
+ $current_field = '';
+ $current_pattern = '';
+ $new_matching_tokens[$j] = $$old_rtokens[$k];
+ $new_alignments[$j] = $old_line->get_alignment($k);
+ $j++;
+ }
+ else {
+
+ if ( $$old_rtokens[$k] =~ /^\=\d*$/ ) {
+ last if ( $case == 2 ); # avoid problems with stuff
+ # like: $a=$b=$c=$d;
+ $hid_equals = 1;
+ }
+ last
+ if ( $in_match && $case == 1 )
+ ; # disallow gaps in matching field types in case 1
+ }
+ }
+
+ # Modify the current state if we are successful.
+ # We must exactly reach the ends of both lists for success.
+ if ( ( $j == $jmax )
+ && ( $current_field eq '' )
+ && ( $case != 1 || $hid_equals ) )
+ {
+ $k = $maximum_field_index;
+ $current_field .= $$old_rfields[$k];
+ $current_pattern .= $$old_rpatterns[$k];
+ $new_fields[$j] = $current_field;
+ $new_matching_patterns[$j] = $current_pattern;
+
+ $new_alignments[$j] = $old_line->get_alignment($k);
+ $maximum_field_index = $j;
+
+ $old_line->set_alignments(@new_alignments);
+ $old_line->set_jmax($jmax);
+ $old_line->set_rtokens( \@new_matching_tokens );
+ $old_line->set_rfields( \@new_fields );
+ $old_line->set_rpatterns( \@$rpatterns );
+ }
+}
+
+# create an empty side comment if none exists
+sub make_side_comment {
+ my $new_line = shift;
+ my $level_end = shift;
+ my $jmax = $new_line->get_jmax();
+ my $rtokens = $new_line->get_rtokens();
+
+ # if line does not have a side comment...
+ if ( ( $jmax == 0 ) || ( $$rtokens[ $jmax - 1 ] ne '#' ) ) {
+ my $rfields = $new_line->get_rfields();
+ my $rpatterns = $new_line->get_rpatterns();
+ $$rtokens[$jmax] = '#';
+ $$rfields[ ++$jmax ] = '';
+ $$rpatterns[$jmax] = '#';
+ $new_line->set_jmax($jmax);
+ $new_line->set_jmax_original_line($jmax);
+ }
+
+ # line has a side comment..
+ else {
+
+ # don't remember old side comment location for very long
+ my $line_number = $vertical_aligner_self->get_output_line_number();
+ my $rfields = $new_line->get_rfields();
+ if (
+ $line_number - $last_side_comment_line_number > 12
+
+ # and don't remember comment location across block level changes
+ || ( $level_end < $last_side_comment_level && $$rfields[0] =~ /^}/ )
+ )
+ {
+ forget_side_comment();
+ }
+ $last_side_comment_line_number = $line_number;
+ $last_side_comment_level = $level_end;
+ }
+}
+
+sub decide_if_list {
+
+ my $line = shift;
+
+ # A list will be taken to be a line with a forced break in which all
+ # of the field separators are commas or comma-arrows (except for the
+ # trailing #)
+
+ # List separator tokens are things like ',3' or '=>2',
+ # where the trailing digit is the nesting depth. Allow braces
+ # to allow nested list items.
+ my $rtokens = $line->get_rtokens();
+ my $test_token = $$rtokens[0];
+ if ( $test_token =~ /^(\,|=>)/ ) {
+ my $list_type = $test_token;
+ my $jmax = $line->get_jmax();
+
+ foreach ( 1 .. $jmax - 2 ) {
+ if ( $$rtokens[$_] !~ /^(\,|=>|\{)/ ) {
+ $list_type = "";
+ last;
+ }
+ }
+ $line->set_list_type($list_type);
+ }
+}
+
+sub eliminate_new_fields {
+
+ return unless ( $maximum_line_index >= 0 );
+ my ( $new_line, $old_line ) = @_;
+ my $jmax = $new_line->get_jmax();
+
+ my $old_rtokens = $old_line->get_rtokens();
+ my $rtokens = $new_line->get_rtokens();
+ my $is_assignment =
+ ( $rtokens->[0] =~ /^=\d*$/ && ( $old_rtokens->[0] eq $rtokens->[0] ) );
+
+ # must be monotonic variation
+ return unless ( $is_assignment || $previous_maximum_jmax_seen <= $jmax );
+
+ # must be more fields in the new line
+ my $maximum_field_index = $old_line->get_jmax();
+ return unless ( $maximum_field_index < $jmax );
+
+ unless ($is_assignment) {
+ return
+ unless ( $old_line->get_jmax_original_line() == $minimum_jmax_seen )
+ ; # only if monotonic
+
+ # never combine fields of a comma list
+ return
+ unless ( $maximum_field_index > 1 )
+ && ( $new_line->get_list_type() !~ /^,/ );
+ }
+
+ my $rfields = $new_line->get_rfields();
+ my $rpatterns = $new_line->get_rpatterns();
+ my $old_rpatterns = $old_line->get_rpatterns();
+
+ # loop over all OLD tokens except comment and check match
+ my $match = 1;
+ my $k;
+ for ( $k = 0 ; $k < $maximum_field_index - 1 ; $k++ ) {
+ if ( ( $$old_rtokens[$k] ne $$rtokens[$k] )
+ || ( $$old_rpatterns[$k] ne $$rpatterns[$k] ) )
+ {
+ $match = 0;
+ last;
+ }
+ }
+
+ # first tokens agree, so combine extra new tokens
+ if ($match) {
+ for $k ( $maximum_field_index .. $jmax - 1 ) {
+
+ $$rfields[ $maximum_field_index - 1 ] .= $$rfields[$k];
+ $$rfields[$k] = "";
+ $$rpatterns[ $maximum_field_index - 1 ] .= $$rpatterns[$k];
+ $$rpatterns[$k] = "";
+ }
+
+ $$rtokens[ $maximum_field_index - 1 ] = '#';
+ $$rfields[$maximum_field_index] = $$rfields[$jmax];
+ $$rpatterns[$maximum_field_index] = $$rpatterns[$jmax];
+ $jmax = $maximum_field_index;
+ }
+ $new_line->set_jmax($jmax);
+}
+
+sub fix_terminal_ternary {
+
+ # Add empty fields as necessary to align a ternary term
+ # like this:
+ #
+ # my $leapyear =
+ # $year % 4 ? 0
+ # : $year % 100 ? 1
+ # : $year % 400 ? 0
+ # : 1;
+ #
+ # returns 1 if the terminal item should be indented
+
+ my ( $rfields, $rtokens, $rpatterns ) = @_;
+
+ my $jmax = @{$rfields} - 1;
+ my $old_line = $group_lines[$maximum_line_index];
+ my $rfields_old = $old_line->get_rfields();
+
+ my $rpatterns_old = $old_line->get_rpatterns();
+ my $rtokens_old = $old_line->get_rtokens();
+ my $maximum_field_index = $old_line->get_jmax();
+
+ # look for the question mark after the :
+ my ($jquestion);
+ my $depth_question;
+ my $pad = "";
+ for ( my $j = 0 ; $j < $maximum_field_index ; $j++ ) {
+ my $tok = $rtokens_old->[$j];
+ if ( $tok =~ /^\?(\d+)$/ ) {
+ $depth_question = $1;
+
+ # depth must be correct
+ next unless ( $depth_question eq $group_level );
+
+ $jquestion = $j;
+ if ( $rfields_old->[ $j + 1 ] =~ /^(\?\s*)/ ) {
+ $pad = " " x length($1);
+ }
+ else {
+ return; # shouldn't happen
+ }
+ last;
+ }
+ }
+ return unless ( defined($jquestion) ); # shouldn't happen
+
+ # Now splice the tokens and patterns of the previous line
+ # into the else line to insure a match. Add empty fields
+ # as necessary.
+ my $jadd = $jquestion;
+
+ # Work on copies of the actual arrays in case we have
+ # to return due to an error
+ my @fields = @{$rfields};
+ my @patterns = @{$rpatterns};
+ my @tokens = @{$rtokens};
+
+ VALIGN_DEBUG_FLAG_TERNARY && do {
+ local $" = '><';
+ print "CURRENT FIELDS=<@{$rfields_old}>\n";
+ print "CURRENT TOKENS=<@{$rtokens_old}>\n";
+ print "CURRENT PATTERNS=<@{$rpatterns_old}>\n";
+ print "UNMODIFIED FIELDS=<@{$rfields}>\n";
+ print "UNMODIFIED TOKENS=<@{$rtokens}>\n";
+ print "UNMODIFIED PATTERNS=<@{$rpatterns}>\n";
+ };
+
+ # handle cases of leading colon on this line
+ if ( $fields[0] =~ /^(:\s*)(.*)$/ ) {
+
+ my ( $colon, $therest ) = ( $1, $2 );
+
+ # Handle sub-case of first field with leading colon plus additional code
+ # This is the usual situation as at the '1' below:
+ # ...
+ # : $year % 400 ? 0
+ # : 1;
+ if ($therest) {
+
+ # Split the first field after the leading colon and insert padding.
+ # Note that this padding will remain even if the terminal value goes
+ # out on a separate line. This does not seem to look to bad, so no
+ # mechanism has been included to undo it.
+ my $field1 = shift @fields;
+ unshift @fields, ( $colon, $pad . $therest );
+
+ # change the leading pattern from : to ?
+ return unless ( $patterns[0] =~ s/^\:/?/ );
+
+ # install leading tokens and patterns of existing line
+ unshift( @tokens, @{$rtokens_old}[ 0 .. $jquestion ] );
+ unshift( @patterns, @{$rpatterns_old}[ 0 .. $jquestion ] );
+
+ # insert appropriate number of empty fields
+ splice( @fields, 1, 0, ('') x $jadd ) if $jadd;
+ }
+
+ # handle sub-case of first field just equal to leading colon.
+ # This can happen for example in the example below where
+ # the leading '(' would create a new alignment token
+ # : ( $name =~ /[]}]$/ ) ? ( $mname = $name )
+ # : ( $mname = $name . '->' );
+ else {
+
+ return unless ( $jmax > 0 && $tokens[0] ne '#' ); # shouldn't happen
+
+ # prepend a leading ? onto the second pattern
+ $patterns[1] = "?b" . $patterns[1];
+
+ # pad the second field
+ $fields[1] = $pad . $fields[1];
+
+ # install leading tokens and patterns of existing line, replacing
+ # leading token and inserting appropriate number of empty fields
+ splice( @tokens, 0, 1, @{$rtokens_old}[ 0 .. $jquestion ] );
+ splice( @patterns, 1, 0, @{$rpatterns_old}[ 1 .. $jquestion ] );
+ splice( @fields, 1, 0, ('') x $jadd ) if $jadd;
+ }
+ }
+
+ # Handle case of no leading colon on this line. This will
+ # be the case when -wba=':' is used. For example,
+ # $year % 400 ? 0 :
+ # 1;
+ else {
+
+ # install leading tokens and patterns of existing line
+ $patterns[0] = '?' . 'b' . $patterns[0];
+ unshift( @tokens, @{$rtokens_old}[ 0 .. $jquestion ] );
+ unshift( @patterns, @{$rpatterns_old}[ 0 .. $jquestion ] );
+
+ # insert appropriate number of empty fields
+ $jadd = $jquestion + 1;
+ $fields[0] = $pad . $fields[0];
+ splice( @fields, 0, 0, ('') x $jadd ) if $jadd;
+ }
+
+ VALIGN_DEBUG_FLAG_TERNARY && do {
+ local $" = '><';
+ print "MODIFIED TOKENS=<@tokens>\n";
+ print "MODIFIED PATTERNS=<@patterns>\n";
+ print "MODIFIED FIELDS=<@fields>\n";
+ };
+
+ # all ok .. update the arrays
+ @{$rfields} = @fields;
+ @{$rtokens} = @tokens;
+ @{$rpatterns} = @patterns;
+
+ # force a flush after this line
+ return $jquestion;
+}
+
+sub fix_terminal_else {
+
+ # Add empty fields as necessary to align a balanced terminal
+ # else block to a previous if/elsif/unless block,
+ # like this:
+ #
+ # if ( 1 || $x ) { print "ok 13\n"; }
+ # else { print "not ok 13\n"; }
+ #
+ # returns 1 if the else block should be indented
+ #
+ my ( $rfields, $rtokens, $rpatterns ) = @_;
+ my $jmax = @{$rfields} - 1;
+ return unless ( $jmax > 0 );
+
+ # check for balanced else block following if/elsif/unless
+ my $rfields_old = $current_line->get_rfields();
+
+ # TBD: add handling for 'case'
+ return unless ( $rfields_old->[0] =~ /^(if|elsif|unless)\s*$/ );
+
+ # look for the opening brace after the else, and extrace the depth
+ my $tok_brace = $rtokens->[0];
+ my $depth_brace;
+ if ( $tok_brace =~ /^\{(\d+)/ ) { $depth_brace = $1; }
+
+ # probably: "else # side_comment"
+ else { return }
+
+ my $rpatterns_old = $current_line->get_rpatterns();
+ my $rtokens_old = $current_line->get_rtokens();
+ my $maximum_field_index = $current_line->get_jmax();
+
+ # be sure the previous if/elsif is followed by an opening paren
+ my $jparen = 0;
+ my $tok_paren = '(' . $depth_brace;
+ my $tok_test = $rtokens_old->[$jparen];
+ return unless ( $tok_test eq $tok_paren ); # shouldn't happen
+
+ # Now find the opening block brace
+ my ($jbrace);
+ for ( my $j = 1 ; $j < $maximum_field_index ; $j++ ) {
+ my $tok = $rtokens_old->[$j];
+ if ( $tok eq $tok_brace ) {
+ $jbrace = $j;
+ last;
+ }
+ }
+ return unless ( defined($jbrace) ); # shouldn't happen
+
+ # Now splice the tokens and patterns of the previous line
+ # into the else line to insure a match. Add empty fields
+ # as necessary.
+ my $jadd = $jbrace - $jparen;
+ splice( @{$rtokens}, 0, 0, @{$rtokens_old}[ $jparen .. $jbrace - 1 ] );
+ splice( @{$rpatterns}, 1, 0, @{$rpatterns_old}[ $jparen + 1 .. $jbrace ] );
+ splice( @{$rfields}, 1, 0, ('') x $jadd );
+
+ # force a flush after this line if it does not follow a case
+ return $jbrace
+ unless ( $rfields_old->[0] =~ /^case\s*$/ );
+}
+
+{ # sub check_match
+ my %is_good_alignment;
+
+ BEGIN {
+
+ # Vertically aligning on certain "good" tokens is usually okay
+ # so we can be less restrictive in marginal cases.
+ @_ = qw( { ? => = );
+ push @_, (',');
+ @is_good_alignment{@_} = (1) x scalar(@_);
+ }
+
+ sub check_match {
+
+ # See if the current line matches the current vertical alignment group.
+ # If not, flush the current group.
+ my $new_line = shift;
+ my $old_line = shift;
+
+ # uses global variables:
+ # $previous_minimum_jmax_seen
+ # $maximum_jmax_seen
+ # $maximum_line_index
+ # $marginal_match
+ my $jmax = $new_line->get_jmax();
+ my $maximum_field_index = $old_line->get_jmax();
+
+ # flush if this line has too many fields
+ if ( $jmax > $maximum_field_index ) { goto NO_MATCH }
+
+ # flush if adding this line would make a non-monotonic field count
+ if (
+ ( $maximum_field_index > $jmax ) # this has too few fields
+ && (
+ ( $previous_minimum_jmax_seen <
+ $jmax ) # and wouldn't be monotonic
+ || ( $old_line->get_jmax_original_line() != $maximum_jmax_seen )
+ )
+ )
+ {
+ goto NO_MATCH;
+ }
+
+ # otherwise see if this line matches the current group
+ my $jmax_original_line = $new_line->get_jmax_original_line();
+ my $is_hanging_side_comment = $new_line->get_is_hanging_side_comment();
+ my $rtokens = $new_line->get_rtokens();
+ my $rfields = $new_line->get_rfields();
+ my $rpatterns = $new_line->get_rpatterns();
+ my $list_type = $new_line->get_list_type();
+
+ my $group_list_type = $old_line->get_list_type();
+ my $old_rpatterns = $old_line->get_rpatterns();
+ my $old_rtokens = $old_line->get_rtokens();
+
+ my $jlimit = $jmax - 1;
+ if ( $maximum_field_index > $jmax ) {
+ $jlimit = $jmax_original_line;
+ --$jlimit unless ( length( $new_line->get_rfields()->[$jmax] ) );
+ }
+
+ # handle comma-separated lists ..
+ if ( $group_list_type && ( $list_type eq $group_list_type ) ) {
+ for my $j ( 0 .. $jlimit ) {
+ my $old_tok = $$old_rtokens[$j];
+ next unless $old_tok;
+ my $new_tok = $$rtokens[$j];
+ next unless $new_tok;
+
+ # lists always match ...
+ # unless they would align any '=>'s with ','s
+ goto NO_MATCH
+ if ( $old_tok =~ /^=>/ && $new_tok =~ /^,/
+ || $new_tok =~ /^=>/ && $old_tok =~ /^,/ );
+ }
+ }
+
+ # do detailed check for everything else except hanging side comments
+ elsif ( !$is_hanging_side_comment ) {
+
+ my $leading_space_count = $new_line->get_leading_space_count();
+
+ my $max_pad = 0;
+ my $min_pad = 0;
+ my $saw_good_alignment;
+
+ for my $j ( 0 .. $jlimit ) {
+
+ my $old_tok = $$old_rtokens[$j];
+ my $new_tok = $$rtokens[$j];
+
+ # Note on encoding used for alignment tokens:
+ # -------------------------------------------
+ # Tokens are "decorated" with information which can help
+ # prevent unwanted alignments. Consider for example the
+ # following two lines:
+ # local ( $xn, $xd ) = split( '/', &'rnorm(@_) );
+ # local ( $i, $f ) = &'bdiv( $xn, $xd );
+ # There are three alignment tokens in each line, a comma,
+ # an =, and a comma. In the first line these three tokens
+ # are encoded as:
+ # ,4+local-18 =3 ,4+split-7
+ # and in the second line they are encoded as
+ # ,4+local-18 =3 ,4+&'bdiv-8
+ # Tokens always at least have token name and nesting
+ # depth. So in this example the ='s are at depth 3 and
+ # the ,'s are at depth 4. This prevents aligning tokens
+ # of different depths. Commas contain additional
+ # information, as follows:
+ # , {depth} + {container name} - {spaces to opening paren}
+ # This allows us to reject matching the rightmost commas
+ # in the above two lines, since they are for different
+ # function calls. This encoding is done in
+ # 'sub send_lines_to_vertical_aligner'.
+
+ # Pick off actual token.
+ # Everything up to the first digit is the actual token.
+ my $alignment_token = $new_tok;
+ if ( $alignment_token =~ /^([^\d]+)/ ) { $alignment_token = $1 }
+
+ # see if the decorated tokens match
+ my $tokens_match = $new_tok eq $old_tok
+
+ # Exception for matching terminal : of ternary statement..
+ # consider containers prefixed by ? and : a match
+ || ( $new_tok =~ /^,\d*\+\:/ && $old_tok =~ /^,\d*\+\?/ );
+
+ # No match if the alignment tokens differ...
+ if ( !$tokens_match ) {
+
+ # ...Unless this is a side comment
+ if (
+ $j == $jlimit
+
+ # and there is either at least one alignment token
+ # or this is a single item following a list. This
+ # latter rule is required for 'December' to join
+ # the following list:
+ # my (@months) = (
+ # '', 'January', 'February', 'March',
+ # 'April', 'May', 'June', 'July',
+ # 'August', 'September', 'October', 'November',
+ # 'December'
+ # );
+ # If it doesn't then the -lp formatting will fail.
+ && ( $j > 0 || $old_tok =~ /^,/ )
+ )
+ {
+ $marginal_match = 1
+ if ( $marginal_match == 0
+ && $maximum_line_index == 0 );
+ last;
+ }
+
+ goto NO_MATCH;
+ }
+
+ # Calculate amount of padding required to fit this in.
+ # $pad is the number of spaces by which we must increase
+ # the current field to squeeze in this field.
+ my $pad =
+ length( $$rfields[$j] ) - $old_line->current_field_width($j);
+ if ( $j == 0 ) { $pad += $leading_space_count; }
+
+ # remember max pads to limit marginal cases
+ if ( $alignment_token ne '#' ) {
+ if ( $pad > $max_pad ) { $max_pad = $pad }
+ if ( $pad < $min_pad ) { $min_pad = $pad }
+ }
+ if ( $is_good_alignment{$alignment_token} ) {
+ $saw_good_alignment = 1;
+ }
+
+ # If patterns don't match, we have to be careful...
+ if ( $$old_rpatterns[$j] ne $$rpatterns[$j] ) {
+
+ # flag this as a marginal match since patterns differ
+ $marginal_match = 1
+ if ( $marginal_match == 0 && $maximum_line_index == 0 );
+
+ # We have to be very careful about aligning commas
+ # when the pattern's don't match, because it can be
+ # worse to create an alignment where none is needed
+ # than to omit one. Here's an example where the ','s
+ # are not in named continers. The first line below
+ # should not match the next two:
+ # ( $a, $b ) = ( $b, $r );
+ # ( $x1, $x2 ) = ( $x2 - $q * $x1, $x1 );
+ # ( $y1, $y2 ) = ( $y2 - $q * $y1, $y1 );
+ if ( $alignment_token eq ',' ) {
+
+ # do not align commas unless they are in named containers
+ goto NO_MATCH unless ( $new_tok =~ /[A-Za-z]/ );
+ }
+
+ # do not align parens unless patterns match;
+ # large ugly spaces can occur in math expressions.
+ elsif ( $alignment_token eq '(' ) {
+
+ # But we can allow a match if the parens don't
+ # require any padding.
+ if ( $pad != 0 ) { goto NO_MATCH }
+ }
+
+ # Handle an '=' alignment with different patterns to
+ # the left.
+ elsif ( $alignment_token eq '=' ) {
+
+ # It is best to be a little restrictive when
+ # aligning '=' tokens. Here is an example of
+ # two lines that we will not align:
+ # my $variable=6;
+ # $bb=4;
+ # The problem is that one is a 'my' declaration,
+ # and the other isn't, so they're not very similar.
+ # We will filter these out by comparing the first
+ # letter of the pattern. This is crude, but works
+ # well enough.
+ if (
+ substr( $$old_rpatterns[$j], 0, 1 ) ne
+ substr( $$rpatterns[$j], 0, 1 ) )
+ {
+ goto NO_MATCH;
+ }
+
+ # If we pass that test, we'll call it a marginal match.
+ # Here is an example of a marginal match:
+ # $done{$$op} = 1;
+ # $op = compile_bblock($op);
+ # The left tokens are both identifiers, but
+ # one accesses a hash and the other doesn't.
+ # We'll let this be a tentative match and undo
+ # it later if we don't find more than 2 lines
+ # in the group.
+ elsif ( $maximum_line_index == 0 ) {
+ $marginal_match =
+ 2; # =2 prevents being undone below
+ }
+ }
+ }
+
+ # Don't let line with fewer fields increase column widths
+ # ( align3.t )
+ if ( $maximum_field_index > $jmax ) {
+
+ # Exception: suspend this rule to allow last lines to join
+ if ( $pad > 0 ) { goto NO_MATCH; }
+ }
+ } ## end for my $j ( 0 .. $jlimit)
+
+ # Turn off the "marginal match" flag in some cases...
+ # A "marginal match" occurs when the alignment tokens agree
+ # but there are differences in the other tokens (patterns).
+ # If we leave the marginal match flag set, then the rule is that we
+ # will align only if there are more than two lines in the group.
+ # We will turn of the flag if we almost have a match
+ # and either we have seen a good alignment token or we
+ # just need a small pad (2 spaces) to fit. These rules are
+ # the result of experimentation. Tokens which misaligned by just
+ # one or two characters are annoying. On the other hand,
+ # large gaps to less important alignment tokens are also annoying.
+ if ( $marginal_match == 1
+ && $jmax == $maximum_field_index
+ && ( $saw_good_alignment || ( $max_pad < 3 && $min_pad > -3 ) )
+ )
+ {
+ $marginal_match = 0;
+ }
+ ##print "marginal=$marginal_match saw=$saw_good_alignment jmax=$jmax max=$maximum_field_index maxpad=$max_pad minpad=$min_pad\n";
+ }
+
+ # We have a match (even if marginal).
+ # If the current line has fewer fields than the current group
+ # but otherwise matches, copy the remaining group fields to
+ # make it a perfect match.
+ if ( $maximum_field_index > $jmax ) {
+ my $comment = $$rfields[$jmax];
+ for $jmax ( $jlimit .. $maximum_field_index ) {
+ $$rtokens[$jmax] = $$old_rtokens[$jmax];
+ $$rfields[ ++$jmax ] = '';
+ $$rpatterns[$jmax] = $$old_rpatterns[$jmax];
+ }
+ $$rfields[$jmax] = $comment;
+ $new_line->set_jmax($jmax);
+ }
+ return;
+
+ NO_MATCH:
+ ##print "BUBBA: no match jmax=$jmax max=$maximum_field_index $group_list_type lines=$maximum_line_index token=$$old_rtokens[0]\n";
+ my_flush();
+ return;
+ }
+}
+
+sub check_fit {
+
+ return unless ( $maximum_line_index >= 0 );
+ my $new_line = shift;
+ my $old_line = shift;
+
+ my $jmax = $new_line->get_jmax();
+ my $leading_space_count = $new_line->get_leading_space_count();
+ my $is_hanging_side_comment = $new_line->get_is_hanging_side_comment();
+ my $rtokens = $new_line->get_rtokens();
+ my $rfields = $new_line->get_rfields();
+ my $rpatterns = $new_line->get_rpatterns();
+
+ my $group_list_type = $group_lines[0]->get_list_type();
+
+ my $padding_so_far = 0;
+ my $padding_available = $old_line->get_available_space_on_right();
+
+ # save current columns in case this doesn't work
+ save_alignment_columns();
+
+ my ( $j, $pad, $eight );
+ my $maximum_field_index = $old_line->get_jmax();
+ for $j ( 0 .. $jmax ) {
+
+ $pad = length( $$rfields[$j] ) - $old_line->current_field_width($j);
+
+ if ( $j == 0 ) {
+ $pad += $leading_space_count;
+ }
+
+ # remember largest gap of the group, excluding gap to side comment
+ if ( $pad < 0
+ && $group_maximum_gap < -$pad
+ && $j > 0
+ && $j < $jmax - 1 )
+ {
+ $group_maximum_gap = -$pad;
+ }
+
+ next if $pad < 0;
+
+ ## This patch helps sometimes, but it doesn't check to see if
+ ## the line is too long even without the side comment. It needs
+ ## to be reworked.
+ ##don't let a long token with no trailing side comment push
+ ##side comments out, or end a group. (sidecmt1.t)
+ ##next if ($j==$jmax-1 && length($$rfields[$jmax])==0);
+
+ # This line will need space; lets see if we want to accept it..
+ if (
+
+ # not if this won't fit
+ ( $pad > $padding_available )
+
+ # previously, there were upper bounds placed on padding here
+ # (maximum_whitespace_columns), but they were not really helpful
+
+ )
+ {
+
+ # revert to starting state then flush; things didn't work out
+ restore_alignment_columns();
+ my_flush();
+ last;
+ }
+
+ # patch to avoid excessive gaps in previous lines,
+ # due to a line of fewer fields.
+ # return join( ".",
+ # $self->{"dfi"}, $self->{"aa"}, $self->rsvd, $self->{"rd"},
+ # $self->{"area"}, $self->{"id"}, $self->{"sel"} );
+ next if ( $jmax < $maximum_field_index && $j == $jmax - 1 );
+
+ # looks ok, squeeze this field in
+ $old_line->increase_field_width( $j, $pad );
+ $padding_available -= $pad;
+
+ # remember largest gap of the group, excluding gap to side comment
+ if ( $pad > $group_maximum_gap && $j > 0 && $j < $jmax - 1 ) {
+ $group_maximum_gap = $pad;
+ }
+ }
+}
+
+sub accept_line {
+
+ # The current line either starts a new alignment group or is
+ # accepted into the current alignment group.
+ my $new_line = shift;
+ $group_lines[ ++$maximum_line_index ] = $new_line;
+
+ # initialize field lengths if starting new group
+ if ( $maximum_line_index == 0 ) {
+
+ my $jmax = $new_line->get_jmax();
+ my $rfields = $new_line->get_rfields();
+ my $rtokens = $new_line->get_rtokens();
+ my $j;
+ my $col = $new_line->get_leading_space_count();
+
+ for $j ( 0 .. $jmax ) {
+ $col += length( $$rfields[$j] );
+
+ # create initial alignments for the new group
+ my $token = "";
+ if ( $j < $jmax ) { $token = $$rtokens[$j] }
+ my $alignment = make_alignment( $col, $token );
+ $new_line->set_alignment( $j, $alignment );
+ }
+
+ $maximum_jmax_seen = $jmax;
+ $minimum_jmax_seen = $jmax;
+ }
+
+ # use previous alignments otherwise
+ else {
+ my @new_alignments =
+ $group_lines[ $maximum_line_index - 1 ]->get_alignments();
+ $new_line->set_alignments(@new_alignments);
+ }
+
+ # remember group jmax extremes for next call to append_line
+ $previous_minimum_jmax_seen = $minimum_jmax_seen;
+ $previous_maximum_jmax_seen = $maximum_jmax_seen;
+}
+
+sub dump_array {
+
+ # debug routine to dump array contents
+ local $" = ')(';
+ print "(@_)\n";
+}
+
+# flush() sends the current Perl::Tidy::VerticalAligner group down the
+# pipeline to Perl::Tidy::FileWriter.
+
+# This is the external flush, which also empties the cache
+sub flush {
+
+ if ( $maximum_line_index < 0 ) {
+ if ($cached_line_type) {
+ $seqno_string = $cached_seqno_string;
+ entab_and_output( $cached_line_text,
+ $cached_line_leading_space_count,
+ $last_group_level_written );
+ $cached_line_type = 0;
+ $cached_line_text = "";
+ $cached_seqno_string = "";
+ }
+ }
+ else {
+ my_flush();
+ }
+}
+
+# This is the internal flush, which leaves the cache intact
+sub my_flush {
+
+ return if ( $maximum_line_index < 0 );
+
+ # handle a group of comment lines
+ if ( $group_type eq 'COMMENT' ) {
+
+ VALIGN_DEBUG_FLAG_APPEND0 && do {
+ my ( $a, $b, $c ) = caller();
+ print
+"APPEND0: Flush called from $a $b $c for COMMENT group: lines=$maximum_line_index \n";
+
+ };
+ my $leading_space_count = $comment_leading_space_count;
+ my $leading_string = get_leading_string($leading_space_count);
+
+ # zero leading space count if any lines are too long
+ my $max_excess = 0;
+ for my $i ( 0 .. $maximum_line_index ) {
+ my $str = $group_lines[$i];
+ my $excess =
+ length($str) + $leading_space_count - $rOpts_maximum_line_length;
+ if ( $excess > $max_excess ) {
+ $max_excess = $excess;
+ }
+ }
+
+ if ( $max_excess > 0 ) {
+ $leading_space_count -= $max_excess;
+ if ( $leading_space_count < 0 ) { $leading_space_count = 0 }
+ $last_outdented_line_at =
+ $file_writer_object->get_output_line_number();
+ unless ($outdented_line_count) {
+ $first_outdented_line_at = $last_outdented_line_at;
+ }
+ $outdented_line_count += ( $maximum_line_index + 1 );
+ }
+
+ # write the group of lines
+ my $outdent_long_lines = 0;
+ for my $i ( 0 .. $maximum_line_index ) {
+ write_leader_and_string( $leading_space_count, $group_lines[$i], 0,
+ $outdent_long_lines, "" );
+ }
+ }
+
+ # handle a group of code lines
+ else {
+
+ VALIGN_DEBUG_FLAG_APPEND0 && do {
+ my $group_list_type = $group_lines[0]->get_list_type();
+ my ( $a, $b, $c ) = caller();
+ my $maximum_field_index = $group_lines[0]->get_jmax();
+ print
+"APPEND0: Flush called from $a $b $c fields=$maximum_field_index list=$group_list_type lines=$maximum_line_index extra=$extra_indent_ok\n";
+
+ };
+
+ # some small groups are best left unaligned
+ my $do_not_align = decide_if_aligned();
+
+ # optimize side comment location
+ $do_not_align = adjust_side_comment($do_not_align);
+
+ # recover spaces for -lp option if possible
+ my $extra_leading_spaces = get_extra_leading_spaces();
+
+ # all lines of this group have the same basic leading spacing
+ my $group_leader_length = $group_lines[0]->get_leading_space_count();
+
+ # add extra leading spaces if helpful
+ my $min_ci_gap = improve_continuation_indentation( $do_not_align,
+ $group_leader_length );
+
+ # loop to output all lines
+ for my $i ( 0 .. $maximum_line_index ) {
+ my $line = $group_lines[$i];
+ write_vertically_aligned_line( $line, $min_ci_gap, $do_not_align,
+ $group_leader_length, $extra_leading_spaces );
+ }
+ }
+ initialize_for_new_group();
+}
+
+sub decide_if_aligned {
+
+ # Do not try to align two lines which are not really similar
+ return unless $maximum_line_index == 1;
+ return if ($is_matching_terminal_line);
+
+ my $group_list_type = $group_lines[0]->get_list_type();
+
+ my $do_not_align = (
+
+ # always align lists
+ !$group_list_type
+
+ && (
+
+ # don't align if it was just a marginal match
+ $marginal_match
+
+ # don't align two lines with big gap
+ || $group_maximum_gap > 12
+
+ # or lines with differing number of alignment tokens
+ # TODO: this could be improved. It occasionally rejects
+ # good matches.
+ || $previous_maximum_jmax_seen != $previous_minimum_jmax_seen
+ )
+ );
+
+ # But try to convert them into a simple comment group if the first line
+ # a has side comment
+ my $rfields = $group_lines[0]->get_rfields();
+ my $maximum_field_index = $group_lines[0]->get_jmax();
+ if ( $do_not_align
+ && ( $maximum_line_index > 0 )
+ && ( length( $$rfields[$maximum_field_index] ) > 0 ) )
+ {
+ combine_fields();
+ $do_not_align = 0;
+ }
+ return $do_not_align;
+}
+
+sub adjust_side_comment {
+
+ my $do_not_align = shift;
+
+ # let's see if we can move the side comment field out a little
+ # to improve readability (the last field is always a side comment field)
+ my $have_side_comment = 0;
+ my $first_side_comment_line = -1;
+ my $maximum_field_index = $group_lines[0]->get_jmax();
+ for my $i ( 0 .. $maximum_line_index ) {
+ my $line = $group_lines[$i];
+
+ if ( length( $line->get_rfields()->[$maximum_field_index] ) ) {
+ $have_side_comment = 1;
+ $first_side_comment_line = $i;
+ last;
+ }
+ }
+
+ my $kmax = $maximum_field_index + 1;
+
+ if ($have_side_comment) {
+
+ my $line = $group_lines[0];
+
+ # the maximum space without exceeding the line length:
+ my $avail = $line->get_available_space_on_right();
+
+ # try to use the previous comment column
+ my $side_comment_column = $line->get_column( $kmax - 2 );
+ my $move = $last_comment_column - $side_comment_column;
+
+## my $sc_line0 = $side_comment_history[0]->[0];
+## my $sc_col0 = $side_comment_history[0]->[1];
+## my $sc_line1 = $side_comment_history[1]->[0];
+## my $sc_col1 = $side_comment_history[1]->[1];
+## my $sc_line2 = $side_comment_history[2]->[0];
+## my $sc_col2 = $side_comment_history[2]->[1];
+##
+## # FUTURE UPDATES:
+## # Be sure to ignore 'do not align' and '} # end comments'
+## # Find first $move > 0 and $move <= $avail as follows:
+## # 1. try sc_col1 if sc_col1 == sc_col0 && (line-sc_line0) < 12
+## # 2. try sc_col2 if (line-sc_line2) < 12
+## # 3. try min possible space, plus up to 8,
+## # 4. try min possible space
+
+ if ( $kmax > 0 && !$do_not_align ) {
+
+ # but if this doesn't work, give up and use the minimum space
+ if ( $move > $avail ) {
+ $move = $rOpts_minimum_space_to_comment - 1;
+ }
+
+ # but we want some minimum space to the comment
+ my $min_move = $rOpts_minimum_space_to_comment - 1;
+ if ( $move >= 0
+ && $last_side_comment_length > 0
+ && ( $first_side_comment_line == 0 )
+ && $group_level == $last_group_level_written )
+ {
+ $min_move = 0;
+ }
+
+ if ( $move < $min_move ) {
+ $move = $min_move;
+ }
+
+ # prevously, an upper bound was placed on $move here,
+ # (maximum_space_to_comment), but it was not helpful
+
+ # don't exceed the available space
+ if ( $move > $avail ) { $move = $avail }
+
+ # we can only increase space, never decrease
+ if ( $move > 0 ) {
+ $line->increase_field_width( $maximum_field_index - 1, $move );
+ }
+
+ # remember this column for the next group
+ $last_comment_column = $line->get_column( $kmax - 2 );
+ }
+ else {
+
+ # try to at least line up the existing side comment location
+ if ( $kmax > 0 && $move > 0 && $move < $avail ) {
+ $line->increase_field_width( $maximum_field_index - 1, $move );
+ $do_not_align = 0;
+ }
+
+ # reset side comment column if we can't align
+ else {
+ forget_side_comment();
+ }
+ }
+ }
+ return $do_not_align;
+}
+
+sub improve_continuation_indentation {
+ my ( $do_not_align, $group_leader_length ) = @_;
+
+ # See if we can increase the continuation indentation
+ # to move all continuation lines closer to the next field
+ # (unless it is a comment).
+ #
+ # '$min_ci_gap'is the extra indentation that we may need to introduce.
+ # We will only introduce this to fields which already have some ci.
+ # Without this variable, we would occasionally get something like this
+ # (Complex.pm):
+ #
+ # use overload '+' => \&plus,
+ # '-' => \&minus,
+ # '*' => \&multiply,
+ # ...
+ # 'tan' => \&tan,
+ # 'atan2' => \&atan2,
+ #
+ # Whereas with this variable, we can shift variables over to get this:
+ #
+ # use overload '+' => \&plus,
+ # '-' => \&minus,
+ # '*' => \&multiply,
+ # ...
+ # 'tan' => \&tan,
+ # 'atan2' => \&atan2,
+
+ ## BUB: Deactivated####################
+ # The trouble with this patch is that it may, for example,
+ # move in some 'or's or ':'s, and leave some out, so that the
+ # left edge alignment suffers.
+ return 0;
+ ###########################################
+
+ my $maximum_field_index = $group_lines[0]->get_jmax();
+
+ my $min_ci_gap = $rOpts_maximum_line_length;
+ if ( $maximum_field_index > 1 && !$do_not_align ) {
+
+ for my $i ( 0 .. $maximum_line_index ) {
+ my $line = $group_lines[$i];
+ my $leading_space_count = $line->get_leading_space_count();
+ my $rfields = $line->get_rfields();
+
+ my $gap =
+ $line->get_column(0) -
+ $leading_space_count -
+ length( $$rfields[0] );
+
+ if ( $leading_space_count > $group_leader_length ) {
+ if ( $gap < $min_ci_gap ) { $min_ci_gap = $gap }
+ }
+ }
+
+ if ( $min_ci_gap >= $rOpts_maximum_line_length ) {
+ $min_ci_gap = 0;
+ }
+ }
+ else {
+ $min_ci_gap = 0;
+ }
+ return $min_ci_gap;
+}
+
+sub write_vertically_aligned_line {
+
+ my ( $line, $min_ci_gap, $do_not_align, $group_leader_length,
+ $extra_leading_spaces )
+ = @_;
+ my $rfields = $line->get_rfields();
+ my $leading_space_count = $line->get_leading_space_count();
+ my $outdent_long_lines = $line->get_outdent_long_lines();
+ my $maximum_field_index = $line->get_jmax();
+ my $rvertical_tightness_flags = $line->get_rvertical_tightness_flags();
+
+ # add any extra spaces
+ if ( $leading_space_count > $group_leader_length ) {
+ $leading_space_count += $min_ci_gap;
+ }
+
+ my $str = $$rfields[0];
+
+ # loop to concatenate all fields of this line and needed padding
+ my $total_pad_count = 0;
+ my ( $j, $pad );
+ for $j ( 1 .. $maximum_field_index ) {
+
+ # skip zero-length side comments
+ last
+ if ( ( $j == $maximum_field_index )
+ && ( !defined( $$rfields[$j] ) || ( length( $$rfields[$j] ) == 0 ) )
+ );
+
+ # compute spaces of padding before this field
+ my $col = $line->get_column( $j - 1 );
+ $pad = $col - ( length($str) + $leading_space_count );
+
+ if ($do_not_align) {
+ $pad =
+ ( $j < $maximum_field_index )
+ ? 0
+ : $rOpts_minimum_space_to_comment - 1;
+ }
+
+ # if the -fpsc flag is set, move the side comment to the selected
+ # column if and only if it is possible, ignoring constraints on
+ # line length and minimum space to comment
+ if ( $rOpts_fixed_position_side_comment && $j == $maximum_field_index )
+ {
+ my $newpad = $pad + $rOpts_fixed_position_side_comment - $col - 1;
+ if ( $newpad >= 0 ) { $pad = $newpad; }
+ }
+
+ # accumulate the padding
+ if ( $pad > 0 ) { $total_pad_count += $pad; }
+
+ # add this field
+ if ( !defined $$rfields[$j] ) {
+ write_diagnostics("UNDEFined field at j=$j\n");
+ }
+
+ # only add padding when we have a finite field;
+ # this avoids extra terminal spaces if we have empty fields
+ if ( length( $$rfields[$j] ) > 0 ) {
+ $str .= ' ' x $total_pad_count;
+ $total_pad_count = 0;
+ $str .= $$rfields[$j];
+ }
+ else {
+ $total_pad_count = 0;
+ }
+
+ # update side comment history buffer
+ if ( $j == $maximum_field_index ) {
+ my $lineno = $file_writer_object->get_output_line_number();
+ shift @side_comment_history;
+ push @side_comment_history, [ $lineno, $col ];
+ }
+ }
+
+ my $side_comment_length = ( length( $$rfields[$maximum_field_index] ) );
+
+ # ship this line off
+ write_leader_and_string( $leading_space_count + $extra_leading_spaces,
+ $str, $side_comment_length, $outdent_long_lines,
+ $rvertical_tightness_flags );
+}
+
+sub get_extra_leading_spaces {
+
+ #----------------------------------------------------------
+ # Define any extra indentation space (for the -lp option).
+ # Here is why:
+ # If a list has side comments, sub scan_list must dump the
+ # list before it sees everything. When this happens, it sets
+ # the indentation to the standard scheme, but notes how
+ # many spaces it would have liked to use. We may be able
+ # to recover that space here in the event that that all of the
+ # lines of a list are back together again.
+ #----------------------------------------------------------
+
+ my $extra_leading_spaces = 0;
+ if ($extra_indent_ok) {
+ my $object = $group_lines[0]->get_indentation();
+ if ( ref($object) ) {
+ my $extra_indentation_spaces_wanted =
+ get_RECOVERABLE_SPACES($object);
+
+ # all indentation objects must be the same
+ my $i;
+ for $i ( 1 .. $maximum_line_index ) {
+ if ( $object != $group_lines[$i]->get_indentation() ) {
+ $extra_indentation_spaces_wanted = 0;
+ last;
+ }
+ }
+
+ if ($extra_indentation_spaces_wanted) {
+
+ # the maximum space without exceeding the line length:
+ my $avail = $group_lines[0]->get_available_space_on_right();
+ $extra_leading_spaces =
+ ( $avail > $extra_indentation_spaces_wanted )
+ ? $extra_indentation_spaces_wanted
+ : $avail;
+
+ # update the indentation object because with -icp the terminal
+ # ');' will use the same adjustment.
+ $object->permanently_decrease_AVAILABLE_SPACES(
+ -$extra_leading_spaces );
+ }
+ }
+ }
+ return $extra_leading_spaces;
+}
+
+sub combine_fields {
+
+ # combine all fields except for the comment field ( sidecmt.t )
+ # Uses global variables:
+ # @group_lines
+ # $maximum_line_index
+ my ( $j, $k );
+ my $maximum_field_index = $group_lines[0]->get_jmax();
+ for ( $j = 0 ; $j <= $maximum_line_index ; $j++ ) {
+ my $line = $group_lines[$j];
+ my $rfields = $line->get_rfields();
+ foreach ( 1 .. $maximum_field_index - 1 ) {
+ $$rfields[0] .= $$rfields[$_];
+ }
+ $$rfields[1] = $$rfields[$maximum_field_index];
+
+ $line->set_jmax(1);
+ $line->set_column( 0, 0 );
+ $line->set_column( 1, 0 );
+
+ }
+ $maximum_field_index = 1;
+
+ for $j ( 0 .. $maximum_line_index ) {
+ my $line = $group_lines[$j];
+ my $rfields = $line->get_rfields();
+ for $k ( 0 .. $maximum_field_index ) {
+ my $pad = length( $$rfields[$k] ) - $line->current_field_width($k);
+ if ( $k == 0 ) {
+ $pad += $group_lines[$j]->get_leading_space_count();
+ }
+
+ if ( $pad > 0 ) { $line->increase_field_width( $k, $pad ) }
+
+ }
+ }
+}
+
+sub get_output_line_number {
+
+ # the output line number reported to a caller is the number of items
+ # written plus the number of items in the buffer
+ my $self = shift;
+ 1 + $maximum_line_index + $file_writer_object->get_output_line_number();
+}
+
+sub write_leader_and_string {
+
+ my ( $leading_space_count, $str, $side_comment_length, $outdent_long_lines,
+ $rvertical_tightness_flags )
+ = @_;
+
+ # handle outdenting of long lines:
+ if ($outdent_long_lines) {
+ my $excess =
+ length($str) -
+ $side_comment_length +
+ $leading_space_count -
+ $rOpts_maximum_line_length;
+ if ( $excess > 0 ) {
+ $leading_space_count = 0;
+ $last_outdented_line_at =
+ $file_writer_object->get_output_line_number();
+
+ unless ($outdented_line_count) {
+ $first_outdented_line_at = $last_outdented_line_at;
+ }
+ $outdented_line_count++;
+ }
+ }
+
+ # Make preliminary leading whitespace. It could get changed
+ # later by entabbing, so we have to keep track of any changes
+ # to the leading_space_count from here on.
+ my $leading_string =
+ $leading_space_count > 0 ? ( ' ' x $leading_space_count ) : "";
+
+ # Unpack any recombination data; it was packed by
+ # sub send_lines_to_vertical_aligner. Contents:
+ #
+ # [0] type: 1=opening 2=closing 3=opening block brace
+ # [1] flag: if opening: 1=no multiple steps, 2=multiple steps ok
+ # if closing: spaces of padding to use
+ # [2] sequence number of container
+ # [3] valid flag: do not append if this flag is false
+ #
+ my ( $open_or_close, $tightness_flag, $seqno, $valid, $seqno_beg,
+ $seqno_end );
+ if ($rvertical_tightness_flags) {
+ (
+ $open_or_close, $tightness_flag, $seqno, $valid, $seqno_beg,
+ $seqno_end
+ ) = @{$rvertical_tightness_flags};
+ }
+
+ $seqno_string = $seqno_end;
+
+ # handle any cached line ..
+ # either append this line to it or write it out
+ if ( length($cached_line_text) ) {
+
+ if ( !$cached_line_valid ) {
+ entab_and_output( $cached_line_text,
+ $cached_line_leading_space_count,
+ $last_group_level_written );
+ }
+
+ # handle cached line with opening container token
+ elsif ( $cached_line_type == 1 || $cached_line_type == 3 ) {
+
+ my $gap = $leading_space_count - length($cached_line_text);
+
+ # handle option of just one tight opening per line:
+ if ( $cached_line_flag == 1 ) {
+ if ( defined($open_or_close) && $open_or_close == 1 ) {
+ $gap = -1;
+ }
+ }
+
+ if ( $gap >= 0 ) {
+ $leading_string = $cached_line_text . ' ' x $gap;
+ $leading_space_count = $cached_line_leading_space_count;
+ $seqno_string = $cached_seqno_string . ':' . $seqno_beg;
+ }
+ else {
+ entab_and_output( $cached_line_text,
+ $cached_line_leading_space_count,
+ $last_group_level_written );
+ }
+ }
+
+ # handle cached line to place before this closing container token
+ else {
+ my $test_line = $cached_line_text . ' ' x $cached_line_flag . $str;
+
+ if ( length($test_line) <= $rOpts_maximum_line_length ) {
+
+ $seqno_string = $cached_seqno_string . ':' . $seqno_beg;
+
+ # Patch to outdent closing tokens ending # in ');'
+ # If we are joining a line like ');' to a previous stacked
+ # set of closing tokens, then decide if we may outdent the
+ # combined stack to the indentation of the ');'. Since we
+ # should not normally outdent any of the other tokens more than
+ # the indentation of the lines that contained them, we will
+ # only do this if all of the corresponding opening
+ # tokens were on the same line. This can happen with
+ # -sot and -sct. For example, it is ok here:
+ # __PACKAGE__->load_components( qw(
+ # PK::Auto
+ # Core
+ # ));
+ #
+ # But, for example, we do not outdent in this example because
+ # that would put the closing sub brace out farther than the
+ # opening sub brace:
+ #
+ # perltidy -sot -sct
+ # $c->Tk::bind(
+ # '<Control-f>' => sub {
+ # my ($c) = @_;
+ # my $e = $c->XEvent;
+ # itemsUnderArea $c;
+ # } );
+ #
+ if ( $str =~ /^\);/ && $cached_line_text =~ /^[\)\}\]\s]*$/ ) {
+
+ # The way to tell this is if the stacked sequence numbers
+ # of this output line are the reverse of the stacked
+ # sequence numbers of the previous non-blank line of
+ # sequence numbers. So we can join if the previous
+ # nonblank string of tokens is the mirror image. For
+ # example if stack )}] is 13:8:6 then we are looking for a
+ # leading stack like [{( which is 6:8:13 We only need to
+ # check the two ends, because the intermediate tokens must
+ # fall in order. Note on speed: having to split on colons
+ # and eliminate multiple colons might appear to be slow,
+ # but it's not an issue because we almost never come
+ # through here. In a typical file we don't.
+ $seqno_string =~ s/^:+//;
+ $last_nonblank_seqno_string =~ s/^:+//;
+ $seqno_string =~ s/:+/:/g;
+ $last_nonblank_seqno_string =~ s/:+/:/g;
+
+ # how many spaces can we outdent?
+ my $diff =
+ $cached_line_leading_space_count - $leading_space_count;
+ if ( $diff > 0
+ && length($seqno_string)
+ && length($last_nonblank_seqno_string) ==
+ length($seqno_string) )
+ {
+ my @seqno_last =
+ ( split ':', $last_nonblank_seqno_string );
+ my @seqno_now = ( split ':', $seqno_string );
+ if ( $seqno_now[-1] == $seqno_last[0]
+ && $seqno_now[0] == $seqno_last[-1] )
+ {
+
+ # OK to outdent ..
+ # for absolute safety, be sure we only remove
+ # whitespace
+ my $ws = substr( $test_line, 0, $diff );
+ if ( ( length($ws) == $diff ) && $ws =~ /^\s+$/ ) {
+
+ $test_line = substr( $test_line, $diff );
+ $cached_line_leading_space_count -= $diff;
+ }
+
+ # shouldn't happen, but not critical:
+ ##else {
+ ## ERROR transferring indentation here
+ ##}
+ }
+ }
+ }
+
+ $str = $test_line;
+ $leading_string = "";
+ $leading_space_count = $cached_line_leading_space_count;
+ }
+ else {
+ entab_and_output( $cached_line_text,
+ $cached_line_leading_space_count,
+ $last_group_level_written );
+ }
+ }
+ }
+ $cached_line_type = 0;
+ $cached_line_text = "";
+
+ # make the line to be written
+ my $line = $leading_string . $str;
+
+ # write or cache this line
+ if ( !$open_or_close || $side_comment_length > 0 ) {
+ entab_and_output( $line, $leading_space_count, $group_level );
+ }
+ else {
+ $cached_line_text = $line;
+ $cached_line_type = $open_or_close;
+ $cached_line_flag = $tightness_flag;
+ $cached_seqno = $seqno;
+ $cached_line_valid = $valid;
+ $cached_line_leading_space_count = $leading_space_count;
+ $cached_seqno_string = $seqno_string;
+ }
+
+ $last_group_level_written = $group_level;
+ $last_side_comment_length = $side_comment_length;
+ $extra_indent_ok = 0;
+}
+
+sub entab_and_output {
+ my ( $line, $leading_space_count, $level ) = @_;
+
+ # The line is currently correct if there is no tabbing (recommended!)
+ # We may have to lop off some leading spaces and replace with tabs.
+ if ( $leading_space_count > 0 ) {
+
+ # Nothing to do if no tabs
+ if ( !( $rOpts_tabs || $rOpts_entab_leading_whitespace )
+ || $rOpts_indent_columns <= 0 )
+ {
+
+ # nothing to do
+ }
+
+ # Handle entab option
+ elsif ($rOpts_entab_leading_whitespace) {
+ my $space_count =
+ $leading_space_count % $rOpts_entab_leading_whitespace;
+ my $tab_count =
+ int( $leading_space_count / $rOpts_entab_leading_whitespace );
+ my $leading_string = "\t" x $tab_count . ' ' x $space_count;
+ if ( $line =~ /^\s{$leading_space_count,$leading_space_count}/ ) {
+ substr( $line, 0, $leading_space_count ) = $leading_string;
+ }
+ else {
+
+ # REMOVE AFTER TESTING
+ # shouldn't happen - program error counting whitespace
+ # we'll skip entabbing
+ warning(
+"Error entabbing in entab_and_output: expected count=$leading_space_count\n"
+ );
+ }
+ }
+
+ # Handle option of one tab per level
+ else {
+ my $leading_string = ( "\t" x $level );
+ my $space_count =
+ $leading_space_count - $level * $rOpts_indent_columns;
+
+ # shouldn't happen:
+ if ( $space_count < 0 ) {
+ warning(
+"Error entabbing in append_line: for level=$group_level count=$leading_space_count\n"
+ );
+ $leading_string = ( ' ' x $leading_space_count );
+ }
+ else {
+ $leading_string .= ( ' ' x $space_count );
+ }
+ if ( $line =~ /^\s{$leading_space_count,$leading_space_count}/ ) {
+ substr( $line, 0, $leading_space_count ) = $leading_string;
+ }
+ else {
+
+ # REMOVE AFTER TESTING
+ # shouldn't happen - program error counting whitespace
+ # we'll skip entabbing
+ warning(
+"Error entabbing in entab_and_output: expected count=$leading_space_count\n"
+ );
+ }
+ }
+ }
+ $file_writer_object->write_code_line( $line . "\n" );
+ if ($seqno_string) {
+ $last_nonblank_seqno_string = $seqno_string;
+ }
+}
+
+{ # begin get_leading_string
+
+ my @leading_string_cache;
+
+ sub get_leading_string {
+
+ # define the leading whitespace string for this line..
+ my $leading_whitespace_count = shift;
+
+ # Handle case of zero whitespace, which includes multi-line quotes
+ # (which may have a finite level; this prevents tab problems)
+ if ( $leading_whitespace_count <= 0 ) {
+ return "";
+ }
+
+ # look for previous result
+ elsif ( $leading_string_cache[$leading_whitespace_count] ) {
+ return $leading_string_cache[$leading_whitespace_count];
+ }
+
+ # must compute a string for this number of spaces
+ my $leading_string;
+
+ # Handle simple case of no tabs
+ if ( !( $rOpts_tabs || $rOpts_entab_leading_whitespace )
+ || $rOpts_indent_columns <= 0 )
+ {
+ $leading_string = ( ' ' x $leading_whitespace_count );
+ }
+
+ # Handle entab option
+ elsif ($rOpts_entab_leading_whitespace) {
+ my $space_count =
+ $leading_whitespace_count % $rOpts_entab_leading_whitespace;
+ my $tab_count = int(
+ $leading_whitespace_count / $rOpts_entab_leading_whitespace );
+ $leading_string = "\t" x $tab_count . ' ' x $space_count;
+ }
+
+ # Handle option of one tab per level
+ else {
+ $leading_string = ( "\t" x $group_level );
+ my $space_count =
+ $leading_whitespace_count - $group_level * $rOpts_indent_columns;
+
+ # shouldn't happen:
+ if ( $space_count < 0 ) {
+ warning(
+"Error in append_line: for level=$group_level count=$leading_whitespace_count\n"
+ );
+ $leading_string = ( ' ' x $leading_whitespace_count );
+ }
+ else {
+ $leading_string .= ( ' ' x $space_count );
+ }
+ }
+ $leading_string_cache[$leading_whitespace_count] = $leading_string;
+ return $leading_string;
+ }
+} # end get_leading_string
+
+sub report_anything_unusual {
+ my $self = shift;
+ if ( $outdented_line_count > 0 ) {
+ write_logfile_entry(
+ "$outdented_line_count long lines were outdented:\n");
+ write_logfile_entry(
+ " First at output line $first_outdented_line_at\n");
+
+ if ( $outdented_line_count > 1 ) {
+ write_logfile_entry(
+ " Last at output line $last_outdented_line_at\n");
+ }
+ write_logfile_entry(
+ " use -noll to prevent outdenting, -l=n to increase line length\n"
+ );
+ write_logfile_entry("\n");
+ }
+}
+
+#####################################################################
+#
+# the Perl::Tidy::FileWriter class writes the output file
+#
+#####################################################################
+
+package Perl::Tidy::FileWriter;
+
+# Maximum number of little messages; probably need not be changed.
+use constant MAX_NAG_MESSAGES => 6;
+
+sub write_logfile_entry {
+ my $self = shift;
+ my $logger_object = $self->{_logger_object};
+ if ($logger_object) {
+ $logger_object->write_logfile_entry(@_);
+ }
+}
+
+sub new {
+ my $class = shift;
+ my ( $line_sink_object, $rOpts, $logger_object ) = @_;
+
+ bless {
+ _line_sink_object => $line_sink_object,
+ _logger_object => $logger_object,
+ _rOpts => $rOpts,
+ _output_line_number => 1,
+ _consecutive_blank_lines => 0,
+ _consecutive_nonblank_lines => 0,
+ _first_line_length_error => 0,
+ _max_line_length_error => 0,
+ _last_line_length_error => 0,
+ _first_line_length_error_at => 0,
+ _max_line_length_error_at => 0,
+ _last_line_length_error_at => 0,
+ _line_length_error_count => 0,
+ _max_output_line_length => 0,
+ _max_output_line_length_at => 0,
+ }, $class;
+}
+
+sub tee_on {
+ my $self = shift;
+ $self->{_line_sink_object}->tee_on();
+}
+
+sub tee_off {
+ my $self = shift;
+ $self->{_line_sink_object}->tee_off();
+}
+
+sub get_output_line_number {
+ my $self = shift;
+ return $self->{_output_line_number};
+}
+
+sub decrement_output_line_number {
+ my $self = shift;
+ $self->{_output_line_number}--;
+}
+
+sub get_consecutive_nonblank_lines {
+ my $self = shift;
+ return $self->{_consecutive_nonblank_lines};
+}
+
+sub reset_consecutive_blank_lines {
+ my $self = shift;
+ $self->{_consecutive_blank_lines} = 0;
+}
+
+sub want_blank_line {
+ my $self = shift;
+ unless ( $self->{_consecutive_blank_lines} ) {
+ $self->write_blank_code_line();
+ }
+}
+
+sub write_blank_code_line {
+ my $self = shift;
+ my $rOpts = $self->{_rOpts};
+ return
+ if ( $self->{_consecutive_blank_lines} >=
+ $rOpts->{'maximum-consecutive-blank-lines'} );
+ $self->{_consecutive_blank_lines}++;
+ $self->{_consecutive_nonblank_lines} = 0;
+ $self->write_line("\n");
+}
+
+sub write_code_line {
+ my $self = shift;
+ my $a = shift;
+
+ if ( $a =~ /^\s*$/ ) {
+ my $rOpts = $self->{_rOpts};
+ return
+ if ( $self->{_consecutive_blank_lines} >=
+ $rOpts->{'maximum-consecutive-blank-lines'} );
+ $self->{_consecutive_blank_lines}++;
+ $self->{_consecutive_nonblank_lines} = 0;
+ }
+ else {
+ $self->{_consecutive_blank_lines} = 0;
+ $self->{_consecutive_nonblank_lines}++;
+ }
+ $self->write_line($a);
+}
+
+sub write_line {
+ my $self = shift;
+ my $a = shift;
+
+ # TODO: go through and see if the test is necessary here
+ if ( $a =~ /\n$/ ) { $self->{_output_line_number}++; }
+
+ $self->{_line_sink_object}->write_line($a);
+
+ # This calculation of excess line length ignores any internal tabs
+ my $rOpts = $self->{_rOpts};
+ my $exceed = length($a) - $rOpts->{'maximum-line-length'} - 1;
+ if ( $a =~ /^\t+/g ) {
+ $exceed += pos($a) * ( $rOpts->{'indent-columns'} - 1 );
+ }
+
+ # Note that we just incremented output line number to future value
+ # so we must subtract 1 for current line number
+ if ( length($a) > 1 + $self->{_max_output_line_length} ) {
+ $self->{_max_output_line_length} = length($a) - 1;
+ $self->{_max_output_line_length_at} = $self->{_output_line_number} - 1;
+ }
+
+ if ( $exceed > 0 ) {
+ my $output_line_number = $self->{_output_line_number};
+ $self->{_last_line_length_error} = $exceed;
+ $self->{_last_line_length_error_at} = $output_line_number - 1;
+ if ( $self->{_line_length_error_count} == 0 ) {
+ $self->{_first_line_length_error} = $exceed;
+ $self->{_first_line_length_error_at} = $output_line_number - 1;
+ }
+
+ if (
+ $self->{_last_line_length_error} > $self->{_max_line_length_error} )
+ {
+ $self->{_max_line_length_error} = $exceed;
+ $self->{_max_line_length_error_at} = $output_line_number - 1;
+ }
+
+ if ( $self->{_line_length_error_count} < MAX_NAG_MESSAGES ) {
+ $self->write_logfile_entry(
+ "Line length exceeded by $exceed characters\n");
+ }
+ $self->{_line_length_error_count}++;
+ }
+
+}
+
+sub report_line_length_errors {
+ my $self = shift;
+ my $rOpts = $self->{_rOpts};
+ my $line_length_error_count = $self->{_line_length_error_count};
+ if ( $line_length_error_count == 0 ) {
+ $self->write_logfile_entry(
+ "No lines exceeded $rOpts->{'maximum-line-length'} characters\n");
+ my $max_output_line_length = $self->{_max_output_line_length};
+ my $max_output_line_length_at = $self->{_max_output_line_length_at};
+ $self->write_logfile_entry(
+" Maximum output line length was $max_output_line_length at line $max_output_line_length_at\n"
+ );
+
+ }
+ else {
+
+ my $word = ( $line_length_error_count > 1 ) ? "s" : "";
+ $self->write_logfile_entry(
+"$line_length_error_count output line$word exceeded $rOpts->{'maximum-line-length'} characters:\n"
+ );
+
+ $word = ( $line_length_error_count > 1 ) ? "First" : "";
+ my $first_line_length_error = $self->{_first_line_length_error};
+ my $first_line_length_error_at = $self->{_first_line_length_error_at};
+ $self->write_logfile_entry(
+" $word at line $first_line_length_error_at by $first_line_length_error characters\n"
+ );
+
+ if ( $line_length_error_count > 1 ) {
+ my $max_line_length_error = $self->{_max_line_length_error};
+ my $max_line_length_error_at = $self->{_max_line_length_error_at};
+ my $last_line_length_error = $self->{_last_line_length_error};
+ my $last_line_length_error_at = $self->{_last_line_length_error_at};
+ $self->write_logfile_entry(
+" Maximum at line $max_line_length_error_at by $max_line_length_error characters\n"
+ );
+ $self->write_logfile_entry(
+" Last at line $last_line_length_error_at by $last_line_length_error characters\n"
+ );
+ }
+ }
+}
+
+#####################################################################
+#
+# The Perl::Tidy::Debugger class shows line tokenization
+#
+#####################################################################
+
+package Perl::Tidy::Debugger;
+
+sub new {
+
+ my ( $class, $filename ) = @_;
+
+ bless {
+ _debug_file => $filename,
+ _debug_file_opened => 0,
+ _fh => undef,
+ }, $class;
+}
+
+sub really_open_debug_file {
+
+ my $self = shift;
+ my $debug_file = $self->{_debug_file};
+ my $fh;
+ unless ( $fh = IO::File->new("> $debug_file") ) {
+ warn("can't open $debug_file: $!\n");
+ }
+ $self->{_debug_file_opened} = 1;
+ $self->{_fh} = $fh;
+ print $fh
+ "Use -dump-token-types (-dtt) to get a list of token type codes\n";
+}
+
+sub close_debug_file {
+
+ my $self = shift;
+ my $fh = $self->{_fh};
+ if ( $self->{_debug_file_opened} ) {
+
+ eval { $self->{_fh}->close() };
+ }
+}
+
+sub write_debug_entry {
+
+ # This is a debug dump routine which may be modified as necessary
+ # to dump tokens on a line-by-line basis. The output will be written
+ # to the .DEBUG file when the -D flag is entered.
+ my $self = shift;
+ my $line_of_tokens = shift;
+
+ my $input_line = $line_of_tokens->{_line_text};
+ my $rtoken_type = $line_of_tokens->{_rtoken_type};
+ my $rtokens = $line_of_tokens->{_rtokens};
+ my $rlevels = $line_of_tokens->{_rlevels};
+ my $rslevels = $line_of_tokens->{_rslevels};
+ my $rblock_type = $line_of_tokens->{_rblock_type};
+ my $input_line_number = $line_of_tokens->{_line_number};
+ my $line_type = $line_of_tokens->{_line_type};
+
+ my ( $j, $num );
+
+ my $token_str = "$input_line_number: ";
+ my $reconstructed_original = "$input_line_number: ";
+ my $block_str = "$input_line_number: ";
+
+ #$token_str .= "$line_type: ";
+ #$reconstructed_original .= "$line_type: ";
+
+ my $pattern = "";
+ my @next_char = ( '"', '"' );
+ my $i_next = 0;
+ unless ( $self->{_debug_file_opened} ) { $self->really_open_debug_file() }
+ my $fh = $self->{_fh};
+
+ for ( $j = 0 ; $j < @$rtoken_type ; $j++ ) {
+
+ # testing patterns
+ if ( $$rtoken_type[$j] eq 'k' ) {
+ $pattern .= $$rtokens[$j];
+ }
+ else {
+ $pattern .= $$rtoken_type[$j];
+ }
+ $reconstructed_original .= $$rtokens[$j];
+ $block_str .= "($$rblock_type[$j])";
+ $num = length( $$rtokens[$j] );
+ my $type_str = $$rtoken_type[$j];
+
+ # be sure there are no blank tokens (shouldn't happen)
+ # This can only happen if a programming error has been made
+ # because all valid tokens are non-blank
+ if ( $type_str eq ' ' ) {
+ print $fh "BLANK TOKEN on the next line\n";
+ $type_str = $next_char[$i_next];
+ $i_next = 1 - $i_next;
+ }
+
+ if ( length($type_str) == 1 ) {
+ $type_str = $type_str x $num;
+ }
+ $token_str .= $type_str;
+ }
+
+ # Write what you want here ...
+ # print $fh "$input_line\n";
+ # print $fh "$pattern\n";
+ print $fh "$reconstructed_original\n";
+ print $fh "$token_str\n";
+
+ #print $fh "$block_str\n";
+}
+
+#####################################################################
+#
+# The Perl::Tidy::LineBuffer class supplies a 'get_line()'
+# method for returning the next line to be parsed, as well as a
+# 'peek_ahead()' method
+#
+# The input parameter is an object with a 'get_line()' method
+# which returns the next line to be parsed
+#
+#####################################################################
+
+package Perl::Tidy::LineBuffer;
+
+sub new {
+
+ my $class = shift;
+ my $line_source_object = shift;
+
+ return bless {
+ _line_source_object => $line_source_object,
+ _rlookahead_buffer => [],
+ }, $class;
+}
+
+sub peek_ahead {
+ my $self = shift;
+ my $buffer_index = shift;
+ my $line = undef;
+ my $line_source_object = $self->{_line_source_object};
+ my $rlookahead_buffer = $self->{_rlookahead_buffer};
+ if ( $buffer_index < scalar(@$rlookahead_buffer) ) {
+ $line = $$rlookahead_buffer[$buffer_index];
+ }
+ else {
+ $line = $line_source_object->get_line();
+ push( @$rlookahead_buffer, $line );
+ }
+ return $line;
+}
+
+sub get_line {
+ my $self = shift;
+ my $line = undef;
+ my $line_source_object = $self->{_line_source_object};
+ my $rlookahead_buffer = $self->{_rlookahead_buffer};
+
+ if ( scalar(@$rlookahead_buffer) ) {
+ $line = shift @$rlookahead_buffer;
+ }
+ else {
+ $line = $line_source_object->get_line();
+ }
+ return $line;
+}
+
+########################################################################
+#
+# the Perl::Tidy::Tokenizer package is essentially a filter which
+# reads lines of perl source code from a source object and provides
+# corresponding tokenized lines through its get_line() method. Lines
+# flow from the source_object to the caller like this:
+#
+# source_object --> LineBuffer_object --> Tokenizer --> calling routine
+# get_line() get_line() get_line() line_of_tokens
+#
+# The source object can be any object with a get_line() method which
+# supplies one line (a character string) perl call.
+# The LineBuffer object is created by the Tokenizer.
+# The Tokenizer returns a reference to a data structure 'line_of_tokens'
+# containing one tokenized line for each call to its get_line() method.
+#
+# WARNING: This is not a real class yet. Only one tokenizer my be used.
+#
+########################################################################
+
+package Perl::Tidy::Tokenizer;
+
+BEGIN {
+
+ # Caution: these debug flags produce a lot of output
+ # They should all be 0 except when debugging small scripts
+
+ use constant TOKENIZER_DEBUG_FLAG_EXPECT => 0;
+ use constant TOKENIZER_DEBUG_FLAG_NSCAN => 0;
+ use constant TOKENIZER_DEBUG_FLAG_QUOTE => 0;
+ use constant TOKENIZER_DEBUG_FLAG_SCAN_ID => 0;
+ use constant TOKENIZER_DEBUG_FLAG_TOKENIZE => 0;
+
+ my $debug_warning = sub {
+ print "TOKENIZER_DEBUGGING with key $_[0]\n";
+ };
+
+ TOKENIZER_DEBUG_FLAG_EXPECT && $debug_warning->('EXPECT');
+ TOKENIZER_DEBUG_FLAG_NSCAN && $debug_warning->('NSCAN');
+ TOKENIZER_DEBUG_FLAG_QUOTE && $debug_warning->('QUOTE');
+ TOKENIZER_DEBUG_FLAG_SCAN_ID && $debug_warning->('SCAN_ID');
+ TOKENIZER_DEBUG_FLAG_TOKENIZE && $debug_warning->('TOKENIZE');
+
+}
+
+use Carp;
+
+# PACKAGE VARIABLES for for processing an entire FILE.
+use vars qw{
+ $tokenizer_self
+
+ $last_nonblank_token
+ $last_nonblank_type
+ $last_nonblank_block_type
+ $statement_type
+ $in_attribute_list
+ $current_package
+ $context
+
+ %is_constant
+ %is_user_function
+ %user_function_prototype
+ %is_block_function
+ %is_block_list_function
+ %saw_function_definition
+
+ $brace_depth
+ $paren_depth
+ $square_bracket_depth
+
+ @current_depth
+ @total_depth
+ $total_depth
+ @nesting_sequence_number
+ @current_sequence_number
+ @paren_type
+ @paren_semicolon_count
+ @paren_structural_type
+ @brace_type
+ @brace_structural_type
+ @brace_statement_type
+ @brace_context
+ @brace_package
+ @square_bracket_type
+ @square_bracket_structural_type
+ @depth_array
+ @nested_ternary_flag
+ @starting_line_of_current_depth
+};
+
+# GLOBAL CONSTANTS for routines in this package
+use vars qw{
+ %is_indirect_object_taker
+ %is_block_operator
+ %expecting_operator_token
+ %expecting_operator_types
+ %expecting_term_types
+ %expecting_term_token
+ %is_digraph
+ %is_file_test_operator
+ %is_trigraph
+ %is_valid_token_type
+ %is_keyword
+ %is_code_block_token
+ %really_want_term
+ @opening_brace_names
+ @closing_brace_names
+ %is_keyword_taking_list
+ %is_q_qq_qw_qx_qr_s_y_tr_m
+};
+
+# possible values of operator_expected()
+use constant TERM => -1;
+use constant UNKNOWN => 0;
+use constant OPERATOR => 1;
+
+# possible values of context
+use constant SCALAR_CONTEXT => -1;
+use constant UNKNOWN_CONTEXT => 0;
+use constant LIST_CONTEXT => 1;
+
+# Maximum number of little messages; probably need not be changed.
+use constant MAX_NAG_MESSAGES => 6;
+
+{
+
+ # methods to count instances
+ my $_count = 0;
+ sub get_count { $_count; }
+ sub _increment_count { ++$_count }
+ sub _decrement_count { --$_count }
+}
+
+sub DESTROY {
+ $_[0]->_decrement_count();
+}
+
+sub new {
+
+ my $class = shift;
+
+ # Note: 'tabs' and 'indent_columns' are temporary and should be
+ # removed asap
+ my %defaults = (
+ source_object => undef,
+ debugger_object => undef,
+ diagnostics_object => undef,
+ logger_object => undef,
+ starting_level => undef,
+ indent_columns => 4,
+ tabs => 0,
+ look_for_hash_bang => 0,
+ trim_qw => 1,
+ look_for_autoloader => 1,
+ look_for_selfloader => 1,
+ starting_line_number => 1,
+ );
+ my %args = ( %defaults, @_ );
+
+ # we are given an object with a get_line() method to supply source lines
+ my $source_object = $args{source_object};
+
+ # we create another object with a get_line() and peek_ahead() method
+ my $line_buffer_object = Perl::Tidy::LineBuffer->new($source_object);
+
+ # Tokenizer state data is as follows:
+ # _rhere_target_list reference to list of here-doc targets
+ # _here_doc_target the target string for a here document
+ # _here_quote_character the type of here-doc quoting (" ' ` or none)
+ # to determine if interpolation is done
+ # _quote_target character we seek if chasing a quote
+ # _line_start_quote line where we started looking for a long quote
+ # _in_here_doc flag indicating if we are in a here-doc
+ # _in_pod flag set if we are in pod documentation
+ # _in_error flag set if we saw severe error (binary in script)
+ # _in_data flag set if we are in __DATA__ section
+ # _in_end flag set if we are in __END__ section
+ # _in_format flag set if we are in a format description
+ # _in_attribute_list flag telling if we are looking for attributes
+ # _in_quote flag telling if we are chasing a quote
+ # _starting_level indentation level of first line
+ # _input_tabstr string denoting one indentation level of input file
+ # _know_input_tabstr flag indicating if we know _input_tabstr
+ # _line_buffer_object object with get_line() method to supply source code
+ # _diagnostics_object place to write debugging information
+ # _unexpected_error_count error count used to limit output
+ # _lower_case_labels_at line numbers where lower case labels seen
+ $tokenizer_self = {
+ _rhere_target_list => [],
+ _in_here_doc => 0,
+ _here_doc_target => "",
+ _here_quote_character => "",
+ _in_data => 0,
+ _in_end => 0,
+ _in_format => 0,
+ _in_error => 0,
+ _in_pod => 0,
+ _in_attribute_list => 0,
+ _in_quote => 0,
+ _quote_target => "",
+ _line_start_quote => -1,
+ _starting_level => $args{starting_level},
+ _know_starting_level => defined( $args{starting_level} ),
+ _tabs => $args{tabs},
+ _indent_columns => $args{indent_columns},
+ _look_for_hash_bang => $args{look_for_hash_bang},
+ _trim_qw => $args{trim_qw},
+ _input_tabstr => "",
+ _know_input_tabstr => -1,
+ _last_line_number => $args{starting_line_number} - 1,
+ _saw_perl_dash_P => 0,
+ _saw_perl_dash_w => 0,
+ _saw_use_strict => 0,
+ _saw_v_string => 0,
+ _look_for_autoloader => $args{look_for_autoloader},
+ _look_for_selfloader => $args{look_for_selfloader},
+ _saw_autoloader => 0,
+ _saw_selfloader => 0,
+ _saw_hash_bang => 0,
+ _saw_end => 0,
+ _saw_data => 0,
+ _saw_negative_indentation => 0,
+ _started_tokenizing => 0,
+ _line_buffer_object => $line_buffer_object,
+ _debugger_object => $args{debugger_object},
+ _diagnostics_object => $args{diagnostics_object},
+ _logger_object => $args{logger_object},
+ _unexpected_error_count => 0,
+ _started_looking_for_here_target_at => 0,
+ _nearly_matched_here_target_at => undef,
+ _line_text => "",
+ _rlower_case_labels_at => undef,
+ };
+
+ prepare_for_a_new_file();
+ find_starting_indentation_level();
+
+ bless $tokenizer_self, $class;
+
+ # This is not a full class yet, so die if an attempt is made to
+ # create more than one object.
+
+ if ( _increment_count() > 1 ) {
+ confess
+"Attempt to create more than 1 object in $class, which is not a true class yet\n";
+ }
+
+ return $tokenizer_self;
+
+}
+
+# interface to Perl::Tidy::Logger routines
+sub warning {
+ my $logger_object = $tokenizer_self->{_logger_object};
+ if ($logger_object) {
+ $logger_object->warning(@_);
+ }
+}
+
+sub complain {
+ my $logger_object = $tokenizer_self->{_logger_object};
+ if ($logger_object) {
+ $logger_object->complain(@_);
+ }
+}
+
+sub write_logfile_entry {
+ my $logger_object = $tokenizer_self->{_logger_object};
+ if ($logger_object) {
+ $logger_object->write_logfile_entry(@_);
+ }
+}
+
+sub interrupt_logfile {
+ my $logger_object = $tokenizer_self->{_logger_object};
+ if ($logger_object) {
+ $logger_object->interrupt_logfile();
+ }
+}
+
+sub resume_logfile {
+ my $logger_object = $tokenizer_self->{_logger_object};
+ if ($logger_object) {
+ $logger_object->resume_logfile();
+ }
+}
+
+sub increment_brace_error {
+ my $logger_object = $tokenizer_self->{_logger_object};
+ if ($logger_object) {
+ $logger_object->increment_brace_error();
+ }
+}
+
+sub report_definite_bug {
+ my $logger_object = $tokenizer_self->{_logger_object};
+ if ($logger_object) {
+ $logger_object->report_definite_bug();
+ }
+}
+
+sub brace_warning {
+ my $logger_object = $tokenizer_self->{_logger_object};
+ if ($logger_object) {
+ $logger_object->brace_warning(@_);
+ }
+}
+
+sub get_saw_brace_error {
+ my $logger_object = $tokenizer_self->{_logger_object};
+ if ($logger_object) {
+ $logger_object->get_saw_brace_error();
+ }
+ else {
+ 0;
+ }
+}
+
+# interface to Perl::Tidy::Diagnostics routines
+sub write_diagnostics {
+ if ( $tokenizer_self->{_diagnostics_object} ) {
+ $tokenizer_self->{_diagnostics_object}->write_diagnostics(@_);
+ }
+}
+
+sub report_tokenization_errors {
+
+ my $self = shift;
+
+ my $level = get_indentation_level();
+ if ( $level != $tokenizer_self->{_starting_level} ) {
+ warning("final indentation level: $level\n");
+ }
+
+ check_final_nesting_depths();
+
+ if ( $tokenizer_self->{_look_for_hash_bang}
+ && !$tokenizer_self->{_saw_hash_bang} )
+ {
+ warning(
+ "hit EOF without seeing hash-bang line; maybe don't need -x?\n");
+ }
+
+ if ( $tokenizer_self->{_in_format} ) {
+ warning("hit EOF while in format description\n");
+ }
+
+ if ( $tokenizer_self->{_in_pod} ) {
+
+ # Just write log entry if this is after __END__ or __DATA__
+ # because this happens to often, and it is not likely to be
+ # a parsing error.
+ if ( $tokenizer_self->{_saw_data} || $tokenizer_self->{_saw_end} ) {
+ write_logfile_entry(
+"hit eof while in pod documentation (no =cut seen)\n\tthis can cause trouble with some pod utilities\n"
+ );
+ }
+
+ else {
+ complain(
+"hit eof while in pod documentation (no =cut seen)\n\tthis can cause trouble with some pod utilities\n"
+ );
+ }
+
+ }
+
+ if ( $tokenizer_self->{_in_here_doc} ) {
+ my $here_doc_target = $tokenizer_self->{_here_doc_target};
+ my $started_looking_for_here_target_at =
+ $tokenizer_self->{_started_looking_for_here_target_at};
+ if ($here_doc_target) {
+ warning(
+"hit EOF in here document starting at line $started_looking_for_here_target_at with target: $here_doc_target\n"
+ );
+ }
+ else {
+ warning(
+"hit EOF in here document starting at line $started_looking_for_here_target_at with empty target string\n"
+ );
+ }
+ my $nearly_matched_here_target_at =
+ $tokenizer_self->{_nearly_matched_here_target_at};
+ if ($nearly_matched_here_target_at) {
+ warning(
+"NOTE: almost matched at input line $nearly_matched_here_target_at except for whitespace\n"
+ );
+ }
+ }
+
+ if ( $tokenizer_self->{_in_quote} ) {
+ my $line_start_quote = $tokenizer_self->{_line_start_quote};
+ my $quote_target = $tokenizer_self->{_quote_target};
+ my $what =
+ ( $tokenizer_self->{_in_attribute_list} )
+ ? "attribute list"
+ : "quote/pattern";
+ warning(
+"hit EOF seeking end of $what starting at line $line_start_quote ending in $quote_target\n"
+ );
+ }
+
+ unless ( $tokenizer_self->{_saw_perl_dash_w} ) {
+ if ( $] < 5.006 ) {
+ write_logfile_entry("Suggest including '-w parameter'\n");
+ }
+ else {
+ write_logfile_entry("Suggest including 'use warnings;'\n");
+ }
+ }
+
+ if ( $tokenizer_self->{_saw_perl_dash_P} ) {
+ write_logfile_entry("Use of -P parameter for defines is discouraged\n");
+ }
+
+ unless ( $tokenizer_self->{_saw_use_strict} ) {
+ write_logfile_entry("Suggest including 'use strict;'\n");
+ }
+
+ # it is suggested that lables have at least one upper case character
+ # for legibility and to avoid code breakage as new keywords are introduced
+ if ( $tokenizer_self->{_rlower_case_labels_at} ) {
+ my @lower_case_labels_at =
+ @{ $tokenizer_self->{_rlower_case_labels_at} };
+ write_logfile_entry(
+ "Suggest using upper case characters in label(s)\n");
+ local $" = ')(';
+ write_logfile_entry(" defined at line(s): (@lower_case_labels_at)\n");
+ }
+}
+
+sub report_v_string {
+
+ # warn if this version can't handle v-strings
+ my $tok = shift;
+ unless ( $tokenizer_self->{_saw_v_string} ) {
+ $tokenizer_self->{_saw_v_string} = $tokenizer_self->{_last_line_number};
+ }
+ if ( $] < 5.006 ) {
+ warning(
+"Found v-string '$tok' but v-strings are not implemented in your version of perl; see Camel 3 book ch 2\n"
+ );
+ }
+}
+
+sub get_input_line_number {
+ return $tokenizer_self->{_last_line_number};
+}
+
+# returns the next tokenized line
+sub get_line {
+
+ my $self = shift;
+
+ # USES GLOBAL VARIABLES: $tokenizer_self, $brace_depth,
+ # $square_bracket_depth, $paren_depth
+
+ my $input_line = $tokenizer_self->{_line_buffer_object}->get_line();
+ $tokenizer_self->{_line_text} = $input_line;
+
+ return undef unless ($input_line);
+
+ my $input_line_number = ++$tokenizer_self->{_last_line_number};
+
+ # Find and remove what characters terminate this line, including any
+ # control r
+ my $input_line_separator = "";
+ if ( chomp($input_line) ) { $input_line_separator = $/ }
+
+ # TODO: what other characters should be included here?
+ if ( $input_line =~ s/((\r|\035|\032)+)$// ) {
+ $input_line_separator = $2 . $input_line_separator;
+ }
+
+ # for backwards compatability we keep the line text terminated with
+ # a newline character
+ $input_line .= "\n";
+ $tokenizer_self->{_line_text} = $input_line; # update
+
+ # create a data structure describing this line which will be
+ # returned to the caller.
+
+ # _line_type codes are:
+ # SYSTEM - system-specific code before hash-bang line
+ # CODE - line of perl code (including comments)
+ # POD_START - line starting pod, such as '=head'
+ # POD - pod documentation text
+ # POD_END - last line of pod section, '=cut'
+ # HERE - text of here-document
+ # HERE_END - last line of here-doc (target word)
+ # FORMAT - format section
+ # FORMAT_END - last line of format section, '.'
+ # DATA_START - __DATA__ line
+ # DATA - unidentified text following __DATA__
+ # END_START - __END__ line
+ # END - unidentified text following __END__
+ # ERROR - we are in big trouble, probably not a perl script
+
+ # Other variables:
+ # _curly_brace_depth - depth of curly braces at start of line
+ # _square_bracket_depth - depth of square brackets at start of line
+ # _paren_depth - depth of parens at start of line
+ # _starting_in_quote - this line continues a multi-line quote
+ # (so don't trim leading blanks!)
+ # _ending_in_quote - this line ends in a multi-line quote
+ # (so don't trim trailing blanks!)
+ my $line_of_tokens = {
+ _line_type => 'EOF',
+ _line_text => $input_line,
+ _line_number => $input_line_number,
+ _rtoken_type => undef,
+ _rtokens => undef,
+ _rlevels => undef,
+ _rslevels => undef,
+ _rblock_type => undef,
+ _rcontainer_type => undef,
+ _rcontainer_environment => undef,
+ _rtype_sequence => undef,
+ _rnesting_tokens => undef,
+ _rci_levels => undef,
+ _rnesting_blocks => undef,
+ _python_indentation_level => -1, ## 0,
+ _starting_in_quote => 0, # to be set by subroutine
+ _ending_in_quote => 0,
+ _curly_brace_depth => $brace_depth,
+ _square_bracket_depth => $square_bracket_depth,
+ _paren_depth => $paren_depth,
+ _quote_character => '',
+ };
+
+ # must print line unchanged if we are in a here document
+ if ( $tokenizer_self->{_in_here_doc} ) {
+
+ $line_of_tokens->{_line_type} = 'HERE';
+ my $here_doc_target = $tokenizer_self->{_here_doc_target};
+ my $here_quote_character = $tokenizer_self->{_here_quote_character};
+ my $candidate_target = $input_line;
+ chomp $candidate_target;
+ if ( $candidate_target eq $here_doc_target ) {
+ $tokenizer_self->{_nearly_matched_here_target_at} = undef;
+ $line_of_tokens->{_line_type} = 'HERE_END';
+ write_logfile_entry("Exiting HERE document $here_doc_target\n");
+
+ my $rhere_target_list = $tokenizer_self->{_rhere_target_list};
+ if (@$rhere_target_list) { # there can be multiple here targets
+ ( $here_doc_target, $here_quote_character ) =
+ @{ shift @$rhere_target_list };
+ $tokenizer_self->{_here_doc_target} = $here_doc_target;
+ $tokenizer_self->{_here_quote_character} =
+ $here_quote_character;
+ write_logfile_entry(
+ "Entering HERE document $here_doc_target\n");
+ $tokenizer_self->{_nearly_matched_here_target_at} = undef;
+ $tokenizer_self->{_started_looking_for_here_target_at} =
+ $input_line_number;
+ }
+ else {
+ $tokenizer_self->{_in_here_doc} = 0;
+ $tokenizer_self->{_here_doc_target} = "";
+ $tokenizer_self->{_here_quote_character} = "";
+ }
+ }
+
+ # check for error of extra whitespace
+ # note for PERL6: leading whitespace is allowed
+ else {
+ $candidate_target =~ s/\s*$//;
+ $candidate_target =~ s/^\s*//;
+ if ( $candidate_target eq $here_doc_target ) {
+ $tokenizer_self->{_nearly_matched_here_target_at} =
+ $input_line_number;
+ }
+ }
+ return $line_of_tokens;
+ }
+
+ # must print line unchanged if we are in a format section
+ elsif ( $tokenizer_self->{_in_format} ) {
+
+ if ( $input_line =~ /^\.[\s#]*$/ ) {
+ write_logfile_entry("Exiting format section\n");
+ $tokenizer_self->{_in_format} = 0;
+ $line_of_tokens->{_line_type} = 'FORMAT_END';
+ }
+ else {
+ $line_of_tokens->{_line_type} = 'FORMAT';
+ }
+ return $line_of_tokens;
+ }
+
+ # must print line unchanged if we are in pod documentation
+ elsif ( $tokenizer_self->{_in_pod} ) {
+
+ $line_of_tokens->{_line_type} = 'POD';
+ if ( $input_line =~ /^=cut/ ) {
+ $line_of_tokens->{_line_type} = 'POD_END';
+ write_logfile_entry("Exiting POD section\n");
+ $tokenizer_self->{_in_pod} = 0;
+ }
+ if ( $input_line =~ /^\#\!.*perl\b/ ) {
+ warning(
+ "Hash-bang in pod can cause older versions of perl to fail! \n"
+ );
+ }
+
+ return $line_of_tokens;
+ }
+
+ # must print line unchanged if we have seen a severe error (i.e., we
+ # are seeing illegal tokens and connot continue. Syntax errors do
+ # not pass this route). Calling routine can decide what to do, but
+ # the default can be to just pass all lines as if they were after __END__
+ elsif ( $tokenizer_self->{_in_error} ) {
+ $line_of_tokens->{_line_type} = 'ERROR';
+ return $line_of_tokens;
+ }
+
+ # print line unchanged if we are __DATA__ section
+ elsif ( $tokenizer_self->{_in_data} ) {
+
+ # ...but look for POD
+ # Note that the _in_data and _in_end flags remain set
+ # so that we return to that state after seeing the
+ # end of a pod section
+ if ( $input_line =~ /^=(?!cut)/ ) {
+ $line_of_tokens->{_line_type} = 'POD_START';
+ write_logfile_entry("Entering POD section\n");
+ $tokenizer_self->{_in_pod} = 1;
+ return $line_of_tokens;
+ }
+ else {
+ $line_of_tokens->{_line_type} = 'DATA';
+ return $line_of_tokens;
+ }
+ }
+
+ # print line unchanged if we are in __END__ section
+ elsif ( $tokenizer_self->{_in_end} ) {
+
+ # ...but look for POD
+ # Note that the _in_data and _in_end flags remain set
+ # so that we return to that state after seeing the
+ # end of a pod section
+ if ( $input_line =~ /^=(?!cut)/ ) {
+ $line_of_tokens->{_line_type} = 'POD_START';
+ write_logfile_entry("Entering POD section\n");
+ $tokenizer_self->{_in_pod} = 1;
+ return $line_of_tokens;
+ }
+ else {
+ $line_of_tokens->{_line_type} = 'END';
+ return $line_of_tokens;
+ }
+ }
+
+ # check for a hash-bang line if we haven't seen one
+ if ( !$tokenizer_self->{_saw_hash_bang} ) {
+ if ( $input_line =~ /^\#\!.*perl\b/ ) {
+ $tokenizer_self->{_saw_hash_bang} = $input_line_number;
+
+ # check for -w and -P flags
+ if ( $input_line =~ /^\#\!.*perl\s.*-.*P/ ) {
+ $tokenizer_self->{_saw_perl_dash_P} = 1;
+ }
+
+ if ( $input_line =~ /^\#\!.*perl\s.*-.*w/ ) {
+ $tokenizer_self->{_saw_perl_dash_w} = 1;
+ }
+
+ if ( ( $input_line_number > 1 )
+ && ( !$tokenizer_self->{_look_for_hash_bang} ) )
+ {
+
+ # this is helpful for VMS systems; we may have accidentally
+ # tokenized some DCL commands
+ if ( $tokenizer_self->{_started_tokenizing} ) {
+ warning(
+"There seems to be a hash-bang after line 1; do you need to run with -x ?\n"
+ );
+ }
+ else {
+ complain("Useless hash-bang after line 1\n");
+ }
+ }
+
+ # Report the leading hash-bang as a system line
+ # This will prevent -dac from deleting it
+ else {
+ $line_of_tokens->{_line_type} = 'SYSTEM';
+ return $line_of_tokens;
+ }
+ }
+ }
+
+ # wait for a hash-bang before parsing if the user invoked us with -x
+ if ( $tokenizer_self->{_look_for_hash_bang}
+ && !$tokenizer_self->{_saw_hash_bang} )
+ {
+ $line_of_tokens->{_line_type} = 'SYSTEM';
+ return $line_of_tokens;
+ }
+
+ # a first line of the form ': #' will be marked as SYSTEM
+ # since lines of this form may be used by tcsh
+ if ( $input_line_number == 1 && $input_line =~ /^\s*\:\s*\#/ ) {
+ $line_of_tokens->{_line_type} = 'SYSTEM';
+ return $line_of_tokens;
+ }
+
+ # now we know that it is ok to tokenize the line...
+ # the line tokenizer will modify any of these private variables:
+ # _rhere_target_list
+ # _in_data
+ # _in_end
+ # _in_format
+ # _in_error
+ # _in_pod
+ # _in_quote
+ my $ending_in_quote_last = $tokenizer_self->{_in_quote};
+ tokenize_this_line($line_of_tokens);
+
+ # Now finish defining the return structure and return it
+ $line_of_tokens->{_ending_in_quote} = $tokenizer_self->{_in_quote};
+
+ # handle severe error (binary data in script)
+ if ( $tokenizer_self->{_in_error} ) {
+ $tokenizer_self->{_in_quote} = 0; # to avoid any more messages
+ warning("Giving up after error\n");
+ $line_of_tokens->{_line_type} = 'ERROR';
+ reset_indentation_level(0); # avoid error messages
+ return $line_of_tokens;
+ }
+
+ # handle start of pod documentation
+ if ( $tokenizer_self->{_in_pod} ) {
+
+ # This gets tricky..above a __DATA__ or __END__ section, perl
+ # accepts '=cut' as the start of pod section. But afterwards,
+ # only pod utilities see it and they may ignore an =cut without
+ # leading =head. In any case, this isn't good.
+ if ( $input_line =~ /^=cut\b/ ) {
+ if ( $tokenizer_self->{_saw_data} || $tokenizer_self->{_saw_end} ) {
+ complain("=cut while not in pod ignored\n");
+ $tokenizer_self->{_in_pod} = 0;
+ $line_of_tokens->{_line_type} = 'POD_END';
+ }
+ else {
+ $line_of_tokens->{_line_type} = 'POD_START';
+ complain(
+"=cut starts a pod section .. this can fool pod utilities.\n"
+ );
+ write_logfile_entry("Entering POD section\n");
+ }
+ }
+
+ else {
+ $line_of_tokens->{_line_type} = 'POD_START';
+ write_logfile_entry("Entering POD section\n");
+ }
+
+ return $line_of_tokens;
+ }
+
+ # update indentation levels for log messages
+ if ( $input_line !~ /^\s*$/ ) {
+ my $rlevels = $line_of_tokens->{_rlevels};
+ my $structural_indentation_level = $$rlevels[0];
+ my ( $python_indentation_level, $msg ) =
+ find_indentation_level( $input_line, $structural_indentation_level );
+ if ($msg) { write_logfile_entry("$msg") }
+ if ( $tokenizer_self->{_know_input_tabstr} == 1 ) {
+ $line_of_tokens->{_python_indentation_level} =
+ $python_indentation_level;
+ }
+ }
+
+ # see if this line contains here doc targets
+ my $rhere_target_list = $tokenizer_self->{_rhere_target_list};
+ if (@$rhere_target_list) {
+
+ my ( $here_doc_target, $here_quote_character ) =
+ @{ shift @$rhere_target_list };
+ $tokenizer_self->{_in_here_doc} = 1;
+ $tokenizer_self->{_here_doc_target} = $here_doc_target;
+ $tokenizer_self->{_here_quote_character} = $here_quote_character;
+ write_logfile_entry("Entering HERE document $here_doc_target\n");
+ $tokenizer_self->{_started_looking_for_here_target_at} =
+ $input_line_number;
+ }
+
+ # NOTE: __END__ and __DATA__ statements are written unformatted
+ # because they can theoretically contain additional characters
+ # which are not tokenized (and cannot be read with <DATA> either!).
+ if ( $tokenizer_self->{_in_data} ) {
+ $line_of_tokens->{_line_type} = 'DATA_START';
+ write_logfile_entry("Starting __DATA__ section\n");
+ $tokenizer_self->{_saw_data} = 1;
+
+ # keep parsing after __DATA__ if use SelfLoader was seen
+ if ( $tokenizer_self->{_saw_selfloader} ) {
+ $tokenizer_self->{_in_data} = 0;
+ write_logfile_entry(
+ "SelfLoader seen, continuing; -nlsl deactivates\n");
+ }
+
+ return $line_of_tokens;
+ }
+
+ elsif ( $tokenizer_self->{_in_end} ) {
+ $line_of_tokens->{_line_type} = 'END_START';
+ write_logfile_entry("Starting __END__ section\n");
+ $tokenizer_self->{_saw_end} = 1;
+
+ # keep parsing after __END__ if use AutoLoader was seen
+ if ( $tokenizer_self->{_saw_autoloader} ) {
+ $tokenizer_self->{_in_end} = 0;
+ write_logfile_entry(
+ "AutoLoader seen, continuing; -nlal deactivates\n");
+ }
+ return $line_of_tokens;
+ }
+
+ # now, finally, we know that this line is type 'CODE'
+ $line_of_tokens->{_line_type} = 'CODE';
+
+ # remember if we have seen any real code
+ if ( !$tokenizer_self->{_started_tokenizing}
+ && $input_line !~ /^\s*$/
+ && $input_line !~ /^\s*#/ )
+ {
+ $tokenizer_self->{_started_tokenizing} = 1;
+ }
+
+ if ( $tokenizer_self->{_debugger_object} ) {
+ $tokenizer_self->{_debugger_object}->write_debug_entry($line_of_tokens);
+ }
+
+ # Note: if keyword 'format' occurs in this line code, it is still CODE
+ # (keyword 'format' need not start a line)
+ if ( $tokenizer_self->{_in_format} ) {
+ write_logfile_entry("Entering format section\n");
+ }
+
+ if ( $tokenizer_self->{_in_quote}
+ and ( $tokenizer_self->{_line_start_quote} < 0 ) )
+ {
+
+ #if ( ( my $quote_target = get_quote_target() ) !~ /^\s*$/ ) {
+ if (
+ ( my $quote_target = $tokenizer_self->{_quote_target} ) !~ /^\s*$/ )
+ {
+ $tokenizer_self->{_line_start_quote} = $input_line_number;
+ write_logfile_entry(
+ "Start multi-line quote or pattern ending in $quote_target\n");
+ }
+ }
+ elsif ( ( $tokenizer_self->{_line_start_quote} >= 0 )
+ and !$tokenizer_self->{_in_quote} )
+ {
+ $tokenizer_self->{_line_start_quote} = -1;
+ write_logfile_entry("End of multi-line quote or pattern\n");
+ }
+
+ # we are returning a line of CODE
+ return $line_of_tokens;
+}
+
+sub find_starting_indentation_level {
+
+ # USES GLOBAL VARIABLES: $tokenizer_self
+ my $starting_level = 0;
+ my $know_input_tabstr = -1; # flag for find_indentation_level
+
+ # use value if given as parameter
+ if ( $tokenizer_self->{_know_starting_level} ) {
+ $starting_level = $tokenizer_self->{_starting_level};
+ }
+
+ # if we know there is a hash_bang line, the level must be zero
+ elsif ( $tokenizer_self->{_look_for_hash_bang} ) {
+ $tokenizer_self->{_know_starting_level} = 1;
+ }
+
+ # otherwise figure it out from the input file
+ else {
+ my $line;
+ my $i = 0;
+ my $structural_indentation_level = -1; # flag for find_indentation_level
+
+ my $msg = "";
+ while ( $line =
+ $tokenizer_self->{_line_buffer_object}->peek_ahead( $i++ ) )
+ {
+
+ # if first line is #! then assume starting level is zero
+ if ( $i == 1 && $line =~ /^\#\!/ ) {
+ $starting_level = 0;
+ last;
+ }
+ next if ( $line =~ /^\s*#/ ); # must not be comment
+ next if ( $line =~ /^\s*$/ ); # must not be blank
+ ( $starting_level, $msg ) =
+ find_indentation_level( $line, $structural_indentation_level );
+ if ($msg) { write_logfile_entry("$msg") }
+ last;
+ }
+ $msg = "Line $i implies starting-indentation-level = $starting_level\n";
+
+ if ( $starting_level > 0 ) {
+
+ my $input_tabstr = $tokenizer_self->{_input_tabstr};
+ if ( $input_tabstr eq "\t" ) {
+ $msg .= "by guessing input tabbing uses 1 tab per level\n";
+ }
+ else {
+ my $cols = length($input_tabstr);
+ $msg .=
+ "by guessing input tabbing uses $cols blanks per level\n";
+ }
+ }
+ write_logfile_entry("$msg");
+ }
+ $tokenizer_self->{_starting_level} = $starting_level;
+ reset_indentation_level($starting_level);
+}
+
+# Find indentation level given a input line. At the same time, try to
+# figure out the input tabbing scheme.
+#
+# There are two types of calls:
+#
+# Type 1: $structural_indentation_level < 0
+# In this case we have to guess $input_tabstr to figure out the level.
+#
+# Type 2: $structural_indentation_level >= 0
+# In this case the level of this line is known, and this routine can
+# update the tabbing string, if still unknown, to make the level correct.
+
+sub find_indentation_level {
+ my ( $line, $structural_indentation_level ) = @_;
+
+ # USES GLOBAL VARIABLES: $tokenizer_self
+ my $level = 0;
+ my $msg = "";
+
+ my $know_input_tabstr = $tokenizer_self->{_know_input_tabstr};
+ my $input_tabstr = $tokenizer_self->{_input_tabstr};
+
+ # find leading whitespace
+ my $leading_whitespace = ( $line =~ /^(\s*)/ ) ? $1 : "";
+
+ # make first guess at input tabbing scheme if necessary
+ if ( $know_input_tabstr < 0 ) {
+
+ $know_input_tabstr = 0;
+
+ if ( $tokenizer_self->{_tabs} ) {
+ $input_tabstr = "\t";
+ if ( length($leading_whitespace) > 0 ) {
+ if ( $leading_whitespace !~ /\t/ ) {
+
+ my $cols = $tokenizer_self->{_indent_columns};
+
+ if ( length($leading_whitespace) < $cols ) {
+ $cols = length($leading_whitespace);
+ }
+ $input_tabstr = " " x $cols;
+ }
+ }
+ }
+ else {
+ $input_tabstr = " " x $tokenizer_self->{_indent_columns};
+
+ if ( length($leading_whitespace) > 0 ) {
+ if ( $leading_whitespace =~ /^\t/ ) {
+ $input_tabstr = "\t";
+ }
+ }
+ }
+ $tokenizer_self->{_know_input_tabstr} = $know_input_tabstr;
+ $tokenizer_self->{_input_tabstr} = $input_tabstr;
+ }
+
+ # determine the input tabbing scheme if possible
+ if ( ( $know_input_tabstr == 0 )
+ && ( length($leading_whitespace) > 0 )
+ && ( $structural_indentation_level > 0 ) )
+ {
+ my $saved_input_tabstr = $input_tabstr;
+
+ # check for common case of one tab per indentation level
+ if ( $leading_whitespace eq "\t" x $structural_indentation_level ) {
+ if ( $leading_whitespace eq "\t" x $structural_indentation_level ) {
+ $input_tabstr = "\t";
+ $msg = "Guessing old indentation was tab character\n";
+ }
+ }
+
+ else {
+
+ # detab any tabs based on 8 blanks per tab
+ my $entabbed = "";
+ if ( $leading_whitespace =~ s/^\t+/ /g ) {
+ $entabbed = "entabbed";
+ }
+
+ # now compute tabbing from number of spaces
+ my $columns =
+ length($leading_whitespace) / $structural_indentation_level;
+ if ( $columns == int $columns ) {
+ $msg =
+ "Guessing old indentation was $columns $entabbed spaces\n";
+ }
+ else {
+ $columns = int $columns;
+ $msg =
+"old indentation is unclear, using $columns $entabbed spaces\n";
+ }
+ $input_tabstr = " " x $columns;
+ }
+ $know_input_tabstr = 1;
+ $tokenizer_self->{_know_input_tabstr} = $know_input_tabstr;
+ $tokenizer_self->{_input_tabstr} = $input_tabstr;
+
+ # see if mistakes were made
+ if ( ( $tokenizer_self->{_starting_level} > 0 )
+ && !$tokenizer_self->{_know_starting_level} )
+ {
+
+ if ( $input_tabstr ne $saved_input_tabstr ) {
+ complain(
+"I made a bad starting level guess; rerun with a value for -sil \n"
+ );
+ }
+ }
+ }
+
+ # use current guess at input tabbing to get input indentation level
+ #
+ # Patch to handle a common case of entabbed leading whitespace
+ # If the leading whitespace equals 4 spaces and we also have
+ # tabs, detab the input whitespace assuming 8 spaces per tab.
+ if ( length($input_tabstr) == 4 ) {
+ $leading_whitespace =~ s/^\t+/ /g;
+ }
+
+ if ( ( my $len_tab = length($input_tabstr) ) > 0 ) {
+ my $pos = 0;
+
+ while ( substr( $leading_whitespace, $pos, $len_tab ) eq $input_tabstr )
+ {
+ $pos += $len_tab;
+ $level++;
+ }
+ }
+ return ( $level, $msg );
+}
+
+# This is a currently unused debug routine
+sub dump_functions {
+
+ my $fh = *STDOUT;
+ my ( $pkg, $sub );
+ foreach $pkg ( keys %is_user_function ) {
+ print $fh "\nnon-constant subs in package $pkg\n";
+
+ foreach $sub ( keys %{ $is_user_function{$pkg} } ) {
+ my $msg = "";
+ if ( $is_block_list_function{$pkg}{$sub} ) {
+ $msg = 'block_list';
+ }
+
+ if ( $is_block_function{$pkg}{$sub} ) {
+ $msg = 'block';
+ }
+ print $fh "$sub $msg\n";
+ }
+ }
+
+ foreach $pkg ( keys %is_constant ) {
+ print $fh "\nconstants and constant subs in package $pkg\n";
+
+ foreach $sub ( keys %{ $is_constant{$pkg} } ) {
+ print $fh "$sub\n";
+ }
+ }
+}
+
+sub ones_count {
+
+ # count number of 1's in a string of 1's and 0's
+ # example: ones_count("010101010101") gives 6
+ return ( my $cis = $_[0] ) =~ tr/1/0/;
+}
+
+sub prepare_for_a_new_file {
+
+ # previous tokens needed to determine what to expect next
+ $last_nonblank_token = ';'; # the only possible starting state which
+ $last_nonblank_type = ';'; # will make a leading brace a code block
+ $last_nonblank_block_type = '';
+
+ # scalars for remembering statement types across multiple lines
+ $statement_type = ''; # '' or 'use' or 'sub..' or 'case..'
+ $in_attribute_list = 0;
+
+ # scalars for remembering where we are in the file
+ $current_package = "main";
+ $context = UNKNOWN_CONTEXT;
+
+ # hashes used to remember function information
+ %is_constant = (); # user-defined constants
+ %is_user_function = (); # user-defined functions
+ %user_function_prototype = (); # their prototypes
+ %is_block_function = ();
+ %is_block_list_function = ();
+ %saw_function_definition = ();
+
+ # variables used to track depths of various containers
+ # and report nesting errors
+ $paren_depth = 0;
+ $brace_depth = 0;
+ $square_bracket_depth = 0;
+ @current_depth[ 0 .. $#closing_brace_names ] =
+ (0) x scalar @closing_brace_names;
+ $total_depth = 0;
+ @total_depth = ();
+ @nesting_sequence_number[ 0 .. $#closing_brace_names ] =
+ ( 0 .. $#closing_brace_names );
+ @current_sequence_number = ();
+ $paren_type[$paren_depth] = '';
+ $paren_semicolon_count[$paren_depth] = 0;
+ $paren_structural_type[$brace_depth] = '';
+ $brace_type[$brace_depth] = ';'; # identify opening brace as code block
+ $brace_structural_type[$brace_depth] = '';
+ $brace_statement_type[$brace_depth] = "";
+ $brace_context[$brace_depth] = UNKNOWN_CONTEXT;
+ $brace_package[$paren_depth] = $current_package;
+ $square_bracket_type[$square_bracket_depth] = '';
+ $square_bracket_structural_type[$square_bracket_depth] = '';
+
+ initialize_tokenizer_state();
+}
+
+{ # begin tokenize_this_line
+
+ use constant BRACE => 0;
+ use constant SQUARE_BRACKET => 1;
+ use constant PAREN => 2;
+ use constant QUESTION_COLON => 3;
+
+ # TV1: scalars for processing one LINE.
+ # Re-initialized on each entry to sub tokenize_this_line.
+ my (
+ $block_type, $container_type, $expecting,
+ $i, $i_tok, $input_line,
+ $input_line_number, $last_nonblank_i, $max_token_index,
+ $next_tok, $next_type, $peeked_ahead,
+ $prototype, $rhere_target_list, $rtoken_map,
+ $rtoken_type, $rtokens, $tok,
+ $type, $type_sequence, $indent_flag,
+ );
+
+ # TV2: refs to ARRAYS for processing one LINE
+ # Re-initialized on each call.
+ my $routput_token_list = []; # stack of output token indexes
+ my $routput_token_type = []; # token types
+ my $routput_block_type = []; # types of code block
+ my $routput_container_type = []; # paren types, such as if, elsif, ..
+ my $routput_type_sequence = []; # nesting sequential number
+ my $routput_indent_flag = []; #
+
+ # TV3: SCALARS for quote variables. These are initialized with a
+ # subroutine call and continually updated as lines are processed.
+ my ( $in_quote, $quote_type, $quote_character, $quote_pos, $quote_depth,
+ $quoted_string_1, $quoted_string_2, $allowed_quote_modifiers, );
+
+ # TV4: SCALARS for multi-line identifiers and
+ # statements. These are initialized with a subroutine call
+ # and continually updated as lines are processed.
+ my ( $id_scan_state, $identifier, $want_paren, $indented_if_level );
+
+ # TV5: SCALARS for tracking indentation level.
+ # Initialized once and continually updated as lines are
+ # processed.
+ my (
+ $nesting_token_string, $nesting_type_string,
+ $nesting_block_string, $nesting_block_flag,
+ $nesting_list_string, $nesting_list_flag,
+ $ci_string_in_tokenizer, $continuation_string_in_tokenizer,
+ $in_statement_continuation, $level_in_tokenizer,
+ $slevel_in_tokenizer, $rslevel_stack,
+ );
+
+ # TV6: SCALARS for remembering several previous
+ # tokens. Initialized once and continually updated as
+ # lines are processed.
+ my (
+ $last_nonblank_container_type, $last_nonblank_type_sequence,
+ $last_last_nonblank_token, $last_last_nonblank_type,
+ $last_last_nonblank_block_type, $last_last_nonblank_container_type,
+ $last_last_nonblank_type_sequence, $last_nonblank_prototype,
+ );
+
+ # ----------------------------------------------------------------
+ # beginning of tokenizer variable access and manipulation routines
+ # ----------------------------------------------------------------
+
+ sub initialize_tokenizer_state {
+
+ # TV1: initialized on each call
+ # TV2: initialized on each call
+ # TV3:
+ $in_quote = 0;
+ $quote_type = 'Q';
+ $quote_character = "";
+ $quote_pos = 0;
+ $quote_depth = 0;
+ $quoted_string_1 = "";
+ $quoted_string_2 = "";
+ $allowed_quote_modifiers = "";
+
+ # TV4:
+ $id_scan_state = '';
+ $identifier = '';
+ $want_paren = "";
+ $indented_if_level = 0;
+
+ # TV5:
+ $nesting_token_string = "";
+ $nesting_type_string = "";
+ $nesting_block_string = '1'; # initially in a block
+ $nesting_block_flag = 1;
+ $nesting_list_string = '0'; # initially not in a list
+ $nesting_list_flag = 0; # initially not in a list
+ $ci_string_in_tokenizer = "";
+ $continuation_string_in_tokenizer = "0";
+ $in_statement_continuation = 0;
+ $level_in_tokenizer = 0;
+ $slevel_in_tokenizer = 0;
+ $rslevel_stack = [];
+
+ # TV6:
+ $last_nonblank_container_type = '';
+ $last_nonblank_type_sequence = '';
+ $last_last_nonblank_token = ';';
+ $last_last_nonblank_type = ';';
+ $last_last_nonblank_block_type = '';
+ $last_last_nonblank_container_type = '';
+ $last_last_nonblank_type_sequence = '';
+ $last_nonblank_prototype = "";
+ }
+
+ sub save_tokenizer_state {
+
+ my $rTV1 = [
+ $block_type, $container_type, $expecting,
+ $i, $i_tok, $input_line,
+ $input_line_number, $last_nonblank_i, $max_token_index,
+ $next_tok, $next_type, $peeked_ahead,
+ $prototype, $rhere_target_list, $rtoken_map,
+ $rtoken_type, $rtokens, $tok,
+ $type, $type_sequence, $indent_flag,
+ ];
+
+ my $rTV2 = [
+ $routput_token_list, $routput_token_type,
+ $routput_block_type, $routput_container_type,
+ $routput_type_sequence, $routput_indent_flag,
+ ];
+
+ my $rTV3 = [
+ $in_quote, $quote_type,
+ $quote_character, $quote_pos,
+ $quote_depth, $quoted_string_1,
+ $quoted_string_2, $allowed_quote_modifiers,
+ ];
+
+ my $rTV4 =
+ [ $id_scan_state, $identifier, $want_paren, $indented_if_level ];
+
+ my $rTV5 = [
+ $nesting_token_string, $nesting_type_string,
+ $nesting_block_string, $nesting_block_flag,
+ $nesting_list_string, $nesting_list_flag,
+ $ci_string_in_tokenizer, $continuation_string_in_tokenizer,
+ $in_statement_continuation, $level_in_tokenizer,
+ $slevel_in_tokenizer, $rslevel_stack,
+ ];
+
+ my $rTV6 = [
+ $last_nonblank_container_type,
+ $last_nonblank_type_sequence,
+ $last_last_nonblank_token,
+ $last_last_nonblank_type,
+ $last_last_nonblank_block_type,
+ $last_last_nonblank_container_type,
+ $last_last_nonblank_type_sequence,
+ $last_nonblank_prototype,
+ ];
+ return [ $rTV1, $rTV2, $rTV3, $rTV4, $rTV5, $rTV6 ];
+ }
+
+ sub restore_tokenizer_state {
+ my ($rstate) = @_;
+ my ( $rTV1, $rTV2, $rTV3, $rTV4, $rTV5, $rTV6 ) = @{$rstate};
+ (
+ $block_type, $container_type, $expecting,
+ $i, $i_tok, $input_line,
+ $input_line_number, $last_nonblank_i, $max_token_index,
+ $next_tok, $next_type, $peeked_ahead,
+ $prototype, $rhere_target_list, $rtoken_map,
+ $rtoken_type, $rtokens, $tok,
+ $type, $type_sequence, $indent_flag,
+ ) = @{$rTV1};
+
+ (
+ $routput_token_list, $routput_token_type,
+ $routput_block_type, $routput_container_type,
+ $routput_type_sequence, $routput_type_sequence,
+ ) = @{$rTV2};
+
+ (
+ $in_quote, $quote_type, $quote_character, $quote_pos, $quote_depth,
+ $quoted_string_1, $quoted_string_2, $allowed_quote_modifiers,
+ ) = @{$rTV3};
+
+ ( $id_scan_state, $identifier, $want_paren, $indented_if_level ) =
+ @{$rTV4};
+
+ (
+ $nesting_token_string, $nesting_type_string,
+ $nesting_block_string, $nesting_block_flag,
+ $nesting_list_string, $nesting_list_flag,
+ $ci_string_in_tokenizer, $continuation_string_in_tokenizer,
+ $in_statement_continuation, $level_in_tokenizer,
+ $slevel_in_tokenizer, $rslevel_stack,
+ ) = @{$rTV5};
+
+ (
+ $last_nonblank_container_type,
+ $last_nonblank_type_sequence,
+ $last_last_nonblank_token,
+ $last_last_nonblank_type,
+ $last_last_nonblank_block_type,
+ $last_last_nonblank_container_type,
+ $last_last_nonblank_type_sequence,
+ $last_nonblank_prototype,
+ ) = @{$rTV6};
+ }
+
+ sub get_indentation_level {
+
+ # patch to avoid reporting error if indented if is not terminated
+ if ($indented_if_level) { return $level_in_tokenizer - 1 }
+ return $level_in_tokenizer;
+ }
+
+ sub reset_indentation_level {
+ $level_in_tokenizer = $_[0];
+ $slevel_in_tokenizer = $_[0];
+ push @{$rslevel_stack}, $slevel_in_tokenizer;
+ }
+
+ sub peeked_ahead {
+ $peeked_ahead = defined( $_[0] ) ? $_[0] : $peeked_ahead;
+ }
+
+ # ------------------------------------------------------------
+ # end of tokenizer variable access and manipulation routines
+ # ------------------------------------------------------------
+
+ # ------------------------------------------------------------
+ # beginning of various scanner interface routines
+ # ------------------------------------------------------------
+ sub scan_replacement_text {
+
+ # check for here-docs in replacement text invoked by
+ # a substitution operator with executable modifier 'e'.
+ #
+ # given:
+ # $replacement_text
+ # return:
+ # $rht = reference to any here-doc targets
+ my ($replacement_text) = @_;
+
+ # quick check
+ return undef unless ( $replacement_text =~ /<</ );
+
+ write_logfile_entry("scanning replacement text for here-doc targets\n");
+
+ # save the logger object for error messages
+ my $logger_object = $tokenizer_self->{_logger_object};
+
+ # localize all package variables
+ local (
+ $tokenizer_self, $last_nonblank_token,
+ $last_nonblank_type, $last_nonblank_block_type,
+ $statement_type, $in_attribute_list,
+ $current_package, $context,
+ %is_constant, %is_user_function,
+ %user_function_prototype, %is_block_function,
+ %is_block_list_function, %saw_function_definition,
+ $brace_depth, $paren_depth,
+ $square_bracket_depth, @current_depth,
+ @total_depth, $total_depth,
+ @nesting_sequence_number, @current_sequence_number,
+ @paren_type, @paren_semicolon_count,
+ @paren_structural_type, @brace_type,
+ @brace_structural_type, @brace_statement_type,
+ @brace_context, @brace_package,
+ @square_bracket_type, @square_bracket_structural_type,
+ @depth_array, @starting_line_of_current_depth,
+ @nested_ternary_flag,
+ );
+
+ # save all lexical variables
+ my $rstate = save_tokenizer_state();
+ _decrement_count(); # avoid error check for multiple tokenizers
+
+ # make a new tokenizer
+ my $rOpts = {};
+ my $rpending_logfile_message;
+ my $source_object =
+ Perl::Tidy::LineSource->new( \$replacement_text, $rOpts,
+ $rpending_logfile_message );
+ my $tokenizer = Perl::Tidy::Tokenizer->new(
+ source_object => $source_object,
+ logger_object => $logger_object,
+ starting_line_number => $input_line_number,
+ );
+
+ # scan the replacement text
+ 1 while ( $tokenizer->get_line() );
+
+ # remove any here doc targets
+ my $rht = undef;
+ if ( $tokenizer_self->{_in_here_doc} ) {
+ $rht = [];
+ push @{$rht},
+ [
+ $tokenizer_self->{_here_doc_target},
+ $tokenizer_self->{_here_quote_character}
+ ];
+ if ( $tokenizer_self->{_rhere_target_list} ) {
+ push @{$rht}, @{ $tokenizer_self->{_rhere_target_list} };
+ $tokenizer_self->{_rhere_target_list} = undef;
+ }
+ $tokenizer_self->{_in_here_doc} = undef;
+ }
+
+ # now its safe to report errors
+ $tokenizer->report_tokenization_errors();
+
+ # restore all tokenizer lexical variables
+ restore_tokenizer_state($rstate);
+
+ # return the here doc targets
+ return $rht;
+ }
+
+ sub scan_bare_identifier {
+ ( $i, $tok, $type, $prototype ) =
+ scan_bare_identifier_do( $input_line, $i, $tok, $type, $prototype,
+ $rtoken_map, $max_token_index );
+ }
+
+ sub scan_identifier {
+ ( $i, $tok, $type, $id_scan_state, $identifier ) =
+ scan_identifier_do( $i, $id_scan_state, $identifier, $rtokens,
+ $max_token_index, $expecting );
+ }
+
+ sub scan_id {
+ ( $i, $tok, $type, $id_scan_state ) =
+ scan_id_do( $input_line, $i, $tok, $rtokens, $rtoken_map,
+ $id_scan_state, $max_token_index );
+ }
+
+ sub scan_number {
+ my $number;
+ ( $i, $type, $number ) =
+ scan_number_do( $input_line, $i, $rtoken_map, $type,
+ $max_token_index );
+ return $number;
+ }
+
+ # a sub to warn if token found where term expected
+ sub error_if_expecting_TERM {
+ if ( $expecting == TERM ) {
+ if ( $really_want_term{$last_nonblank_type} ) {
+ unexpected( $tok, "term", $i_tok, $last_nonblank_i, $rtoken_map,
+ $rtoken_type, $input_line );
+ 1;
+ }
+ }
+ }
+
+ # a sub to warn if token found where operator expected
+ sub error_if_expecting_OPERATOR {
+ if ( $expecting == OPERATOR ) {
+ my $thing = defined $_[0] ? $_[0] : $tok;
+ unexpected( $thing, "operator", $i_tok, $last_nonblank_i,
+ $rtoken_map, $rtoken_type, $input_line );
+ if ( $i_tok == 0 ) {
+ interrupt_logfile();
+ warning("Missing ';' above?\n");
+ resume_logfile();
+ }
+ 1;
+ }
+ }
+
+ # ------------------------------------------------------------
+ # end scanner interfaces
+ # ------------------------------------------------------------
+
+ my %is_for_foreach;
+ @_ = qw(for foreach);
+ @is_for_foreach{@_} = (1) x scalar(@_);
+
+ my %is_my_our;
+ @_ = qw(my our);
+ @is_my_our{@_} = (1) x scalar(@_);
+
+ # These keywords may introduce blocks after parenthesized expressions,
+ # in the form:
+ # keyword ( .... ) { BLOCK }
+ # patch for SWITCH/CASE: added 'switch' 'case' 'given' 'when'
+ my %is_blocktype_with_paren;
+ @_ = qw(if elsif unless while until for foreach switch case given when);
+ @is_blocktype_with_paren{@_} = (1) x scalar(@_);
+
+ # ------------------------------------------------------------
+ # begin hash of code for handling most token types
+ # ------------------------------------------------------------
+ my $tokenization_code = {
+
+ # no special code for these types yet, but syntax checks
+ # could be added
+
+## '!' => undef,
+## '!=' => undef,
+## '!~' => undef,
+## '%=' => undef,
+## '&&=' => undef,
+## '&=' => undef,
+## '+=' => undef,
+## '-=' => undef,
+## '..' => undef,
+## '..' => undef,
+## '...' => undef,
+## '.=' => undef,
+## '<<=' => undef,
+## '<=' => undef,
+## '<=>' => undef,
+## '<>' => undef,
+## '=' => undef,
+## '==' => undef,
+## '=~' => undef,
+## '>=' => undef,
+## '>>' => undef,
+## '>>=' => undef,
+## '\\' => undef,
+## '^=' => undef,
+## '|=' => undef,
+## '||=' => undef,
+## '//=' => undef,
+## '~' => undef,
+## '~~' => undef,
+## '!~~' => undef,
+
+ '>' => sub {
+ error_if_expecting_TERM()
+ if ( $expecting == TERM );
+ },
+ '|' => sub {
+ error_if_expecting_TERM()
+ if ( $expecting == TERM );
+ },
+ '$' => sub {
+
+ # start looking for a scalar
+ error_if_expecting_OPERATOR("Scalar")
+ if ( $expecting == OPERATOR );
+ scan_identifier();
+
+ if ( $identifier eq '$^W' ) {
+ $tokenizer_self->{_saw_perl_dash_w} = 1;
+ }
+
+ # Check for indentifier in indirect object slot
+ # (vorboard.pl, sort.t). Something like:
+ # /^(print|printf|sort|exec|system)$/
+ if (
+ $is_indirect_object_taker{$last_nonblank_token}
+
+ || ( ( $last_nonblank_token eq '(' )
+ && $is_indirect_object_taker{ $paren_type[$paren_depth] } )
+ || ( $last_nonblank_type =~ /^[Uw]$/ ) # possible object
+ )
+ {
+ $type = 'Z';
+ }
+ },
+ '(' => sub {
+
+ ++$paren_depth;
+ $paren_semicolon_count[$paren_depth] = 0;
+ if ($want_paren) {
+ $container_type = $want_paren;
+ $want_paren = "";
+ }
+ else {
+ $container_type = $last_nonblank_token;
+
+ # We can check for a syntax error here of unexpected '(',
+ # but this is going to get messy...
+ if (
+ $expecting == OPERATOR
+
+ # be sure this is not a method call of the form
+ # &method(...), $method->(..), &{method}(...),
+ # $ref[2](list) is ok & short for $ref[2]->(list)
+ # NOTE: at present, braces in something like &{ xxx }
+ # are not marked as a block, we might have a method call
+ && $last_nonblank_token !~ /^([\]\}\&]|\-\>)/
+
+ )
+ {
+
+ # ref: camel 3 p 703.
+ if ( $last_last_nonblank_token eq 'do' ) {
+ complain(
+"do SUBROUTINE is deprecated; consider & or -> notation\n"
+ );
+ }
+ else {
+
+ # if this is an empty list, (), then it is not an
+ # error; for example, we might have a constant pi and
+ # invoke it with pi() or just pi;
+ my ( $next_nonblank_token, $i_next ) =
+ find_next_nonblank_token( $i, $rtokens,
+ $max_token_index );
+ if ( $next_nonblank_token ne ')' ) {
+ my $hint;
+ error_if_expecting_OPERATOR('(');
+
+ if ( $last_nonblank_type eq 'C' ) {
+ $hint =
+ "$last_nonblank_token has a void prototype\n";
+ }
+ elsif ( $last_nonblank_type eq 'i' ) {
+ if ( $i_tok > 0
+ && $last_nonblank_token =~ /^\$/ )
+ {
+ $hint =
+"Do you mean '$last_nonblank_token->(' ?\n";
+ }
+ }
+ if ($hint) {
+ interrupt_logfile();
+ warning($hint);
+ resume_logfile();
+ }
+ } ## end if ( $next_nonblank_token...
+ } ## end else [ if ( $last_last_nonblank_token...
+ } ## end if ( $expecting == OPERATOR...
+ }
+ $paren_type[$paren_depth] = $container_type;
+ ( $type_sequence, $indent_flag ) =
+ increase_nesting_depth( PAREN, $$rtoken_map[$i_tok] );
+
+ # propagate types down through nested parens
+ # for example: the second paren in 'if ((' would be structural
+ # since the first is.
+
+ if ( $last_nonblank_token eq '(' ) {
+ $type = $last_nonblank_type;
+ }
+
+ # We exclude parens as structural after a ',' because it
+ # causes subtle problems with continuation indentation for
+ # something like this, where the first 'or' will not get
+ # indented.
+ #
+ # assert(
+ # __LINE__,
+ # ( not defined $check )
+ # or ref $check
+ # or $check eq "new"
+ # or $check eq "old",
+ # );
+ #
+ # Likewise, we exclude parens where a statement can start
+ # because of problems with continuation indentation, like
+ # these:
+ #
+ # ($firstline =~ /^#\!.*perl/)
+ # and (print $File::Find::name, "\n")
+ # and (return 1);
+ #
+ # (ref($usage_fref) =~ /CODE/)
+ # ? &$usage_fref
+ # : (&blast_usage, &blast_params, &blast_general_params);
+
+ else {
+ $type = '{';
+ }
+
+ if ( $last_nonblank_type eq ')' ) {
+ warning(
+ "Syntax error? found token '$last_nonblank_type' then '('\n"
+ );
+ }
+ $paren_structural_type[$paren_depth] = $type;
+
+ },
+ ')' => sub {
+ ( $type_sequence, $indent_flag ) =
+ decrease_nesting_depth( PAREN, $$rtoken_map[$i_tok] );
+
+ if ( $paren_structural_type[$paren_depth] eq '{' ) {
+ $type = '}';
+ }
+
+ $container_type = $paren_type[$paren_depth];
+
+ # /^(for|foreach)$/
+ if ( $is_for_foreach{ $paren_type[$paren_depth] } ) {
+ my $num_sc = $paren_semicolon_count[$paren_depth];
+ if ( $num_sc > 0 && $num_sc != 2 ) {
+ warning("Expected 2 ';' in 'for(;;)' but saw $num_sc\n");
+ }
+ }
+
+ if ( $paren_depth > 0 ) { $paren_depth-- }
+ },
+ ',' => sub {
+ if ( $last_nonblank_type eq ',' ) {
+ complain("Repeated ','s \n");
+ }
+
+ # patch for operator_expected: note if we are in the list (use.t)
+ if ( $statement_type eq 'use' ) { $statement_type = '_use' }
+## FIXME: need to move this elsewhere, perhaps check after a '('
+## elsif ($last_nonblank_token eq '(') {
+## warning("Leading ','s illegal in some versions of perl\n");
+## }
+ },
+ ';' => sub {
+ $context = UNKNOWN_CONTEXT;
+ $statement_type = '';
+
+ # /^(for|foreach)$/
+ if ( $is_for_foreach{ $paren_type[$paren_depth] } )
+ { # mark ; in for loop
+
+ # Be careful: we do not want a semicolon such as the
+ # following to be included:
+ #
+ # for (sort {strcoll($a,$b);} keys %investments) {
+
+ if ( $brace_depth == $depth_array[PAREN][BRACE][$paren_depth]
+ && $square_bracket_depth ==
+ $depth_array[PAREN][SQUARE_BRACKET][$paren_depth] )
+ {
+
+ $type = 'f';
+ $paren_semicolon_count[$paren_depth]++;
+ }
+ }
+
+ },
+ '"' => sub {
+ error_if_expecting_OPERATOR("String")
+ if ( $expecting == OPERATOR );
+ $in_quote = 1;
+ $type = 'Q';
+ $allowed_quote_modifiers = "";
+ },
+ "'" => sub {
+ error_if_expecting_OPERATOR("String")
+ if ( $expecting == OPERATOR );
+ $in_quote = 1;
+ $type = 'Q';
+ $allowed_quote_modifiers = "";
+ },
+ '`' => sub {
+ error_if_expecting_OPERATOR("String")
+ if ( $expecting == OPERATOR );
+ $in_quote = 1;
+ $type = 'Q';
+ $allowed_quote_modifiers = "";
+ },
+ '/' => sub {
+ my $is_pattern;
+
+ if ( $expecting == UNKNOWN ) { # indeterminte, must guess..
+ my $msg;
+ ( $is_pattern, $msg ) =
+ guess_if_pattern_or_division( $i, $rtokens, $rtoken_map,
+ $max_token_index );
+
+ if ($msg) {
+ write_diagnostics("DIVIDE:$msg\n");
+ write_logfile_entry($msg);
+ }
+ }
+ else { $is_pattern = ( $expecting == TERM ) }
+
+ if ($is_pattern) {
+ $in_quote = 1;
+ $type = 'Q';
+ $allowed_quote_modifiers = '[cgimosxp]';
+ }
+ else { # not a pattern; check for a /= token
+
+ if ( $$rtokens[ $i + 1 ] eq '=' ) { # form token /=
+ $i++;
+ $tok = '/=';
+ $type = $tok;
+ }
+
+ #DEBUG - collecting info on what tokens follow a divide
+ # for development of guessing algorithm
+ #if ( numerator_expected( $i, $rtokens, $max_token_index ) < 0 ) {
+ # #write_diagnostics( "DIVIDE? $input_line\n" );
+ #}
+ }
+ },
+ '{' => sub {
+
+ # if we just saw a ')', we will label this block with
+ # its type. We need to do this to allow sub
+ # code_block_type to determine if this brace starts a
+ # code block or anonymous hash. (The type of a paren
+ # pair is the preceding token, such as 'if', 'else',
+ # etc).
+ $container_type = "";
+
+ # ATTRS: for a '{' following an attribute list, reset
+ # things to look like we just saw the sub name
+ if ( $statement_type =~ /^sub/ ) {
+ $last_nonblank_token = $statement_type;
+ $last_nonblank_type = 'i';
+ $statement_type = "";
+ }
+
+ # patch for SWITCH/CASE: hide these keywords from an immediately
+ # following opening brace
+ elsif ( ( $statement_type eq 'case' || $statement_type eq 'when' )
+ && $statement_type eq $last_nonblank_token )
+ {
+ $last_nonblank_token = ";";
+ }
+
+ elsif ( $last_nonblank_token eq ')' ) {
+ $last_nonblank_token = $paren_type[ $paren_depth + 1 ];
+
+ # defensive move in case of a nesting error (pbug.t)
+ # in which this ')' had no previous '('
+ # this nesting error will have been caught
+ if ( !defined($last_nonblank_token) ) {
+ $last_nonblank_token = 'if';
+ }
+
+ # check for syntax error here;
+ unless ( $is_blocktype_with_paren{$last_nonblank_token} ) {
+ my $list = join( ' ', sort keys %is_blocktype_with_paren );
+ warning(
+ "syntax error at ') {', didn't see one of: $list\n");
+ }
+ }
+
+ # patch for paren-less for/foreach glitch, part 2.
+ # see note below under 'qw'
+ elsif ($last_nonblank_token eq 'qw'
+ && $is_for_foreach{$want_paren} )
+ {
+ $last_nonblank_token = $want_paren;
+ if ( $last_last_nonblank_token eq $want_paren ) {
+ warning(
+"syntax error at '$want_paren .. {' -- missing \$ loop variable\n"
+ );
+
+ }
+ $want_paren = "";
+ }
+
+ # now identify which of the three possible types of
+ # curly braces we have: hash index container, anonymous
+ # hash reference, or code block.
+
+ # non-structural (hash index) curly brace pair
+ # get marked 'L' and 'R'
+ if ( is_non_structural_brace() ) {
+ $type = 'L';
+
+ # patch for SWITCH/CASE:
+ # allow paren-less identifier after 'when'
+ # if the brace is preceded by a space
+ if ( $statement_type eq 'when'
+ && $last_nonblank_type eq 'i'
+ && $last_last_nonblank_type eq 'k'
+ && ( $i_tok == 0 || $rtoken_type->[ $i_tok - 1 ] eq 'b' ) )
+ {
+ $type = '{';
+ $block_type = $statement_type;
+ }
+ }
+
+ # code and anonymous hash have the same type, '{', but are
+ # distinguished by 'block_type',
+ # which will be blank for an anonymous hash
+ else {
+
+ $block_type = code_block_type( $i_tok, $rtokens, $rtoken_type,
+ $max_token_index );
+
+ # patch to promote bareword type to function taking block
+ if ( $block_type
+ && $last_nonblank_type eq 'w'
+ && $last_nonblank_i >= 0 )
+ {
+ if ( $routput_token_type->[$last_nonblank_i] eq 'w' ) {
+ $routput_token_type->[$last_nonblank_i] = 'G';
+ }
+ }
+
+ # patch for SWITCH/CASE: if we find a stray opening block brace
+ # where we might accept a 'case' or 'when' block, then take it
+ if ( $statement_type eq 'case'
+ || $statement_type eq 'when' )
+ {
+ if ( !$block_type || $block_type eq '}' ) {
+ $block_type = $statement_type;
+ }
+ }
+ }
+ $brace_type[ ++$brace_depth ] = $block_type;
+ $brace_package[$brace_depth] = $current_package;
+ ( $type_sequence, $indent_flag ) =
+ increase_nesting_depth( BRACE, $$rtoken_map[$i_tok] );
+ $brace_structural_type[$brace_depth] = $type;
+ $brace_context[$brace_depth] = $context;
+ $brace_statement_type[$brace_depth] = $statement_type;
+ },
+ '}' => sub {
+ $block_type = $brace_type[$brace_depth];
+ if ($block_type) { $statement_type = '' }
+ if ( defined( $brace_package[$brace_depth] ) ) {
+ $current_package = $brace_package[$brace_depth];
+ }
+
+ # can happen on brace error (caught elsewhere)
+ else {
+ }
+ ( $type_sequence, $indent_flag ) =
+ decrease_nesting_depth( BRACE, $$rtoken_map[$i_tok] );
+
+ if ( $brace_structural_type[$brace_depth] eq 'L' ) {
+ $type = 'R';
+ }
+
+ # propagate type information for 'do' and 'eval' blocks.
+ # This is necessary to enable us to know if an operator
+ # or term is expected next
+ if ( $is_block_operator{ $brace_type[$brace_depth] } ) {
+ $tok = $brace_type[$brace_depth];
+ }
+
+ $context = $brace_context[$brace_depth];
+ $statement_type = $brace_statement_type[$brace_depth];
+ if ( $brace_depth > 0 ) { $brace_depth--; }
+ },
+ '&' => sub { # maybe sub call? start looking
+
+ # We have to check for sub call unless we are sure we
+ # are expecting an operator. This example from s2p
+ # got mistaken as a q operator in an early version:
+ # print BODY &q(<<'EOT');
+ if ( $expecting != OPERATOR ) {
+ scan_identifier();
+ }
+ else {
+ }
+ },
+ '<' => sub { # angle operator or less than?
+
+ if ( $expecting != OPERATOR ) {
+ ( $i, $type ) =
+ find_angle_operator_termination( $input_line, $i, $rtoken_map,
+ $expecting, $max_token_index );
+
+ }
+ else {
+ }
+ },
+ '?' => sub { # ?: conditional or starting pattern?
+
+ my $is_pattern;
+
+ if ( $expecting == UNKNOWN ) {
+
+ my $msg;
+ ( $is_pattern, $msg ) =
+ guess_if_pattern_or_conditional( $i, $rtokens, $rtoken_map,
+ $max_token_index );
+
+ if ($msg) { write_logfile_entry($msg) }
+ }
+ else { $is_pattern = ( $expecting == TERM ) }
+
+ if ($is_pattern) {
+ $in_quote = 1;
+ $type = 'Q';
+ $allowed_quote_modifiers = '[cgimosxp]';
+ }
+ else {
+ ( $type_sequence, $indent_flag ) =
+ increase_nesting_depth( QUESTION_COLON,
+ $$rtoken_map[$i_tok] );
+ }
+ },
+ '*' => sub { # typeglob, or multiply?
+
+ if ( $expecting == TERM ) {
+ scan_identifier();
+ }
+ else {
+
+ if ( $$rtokens[ $i + 1 ] eq '=' ) {
+ $tok = '*=';
+ $type = $tok;
+ $i++;
+ }
+ elsif ( $$rtokens[ $i + 1 ] eq '*' ) {
+ $tok = '**';
+ $type = $tok;
+ $i++;
+ if ( $$rtokens[ $i + 1 ] eq '=' ) {
+ $tok = '**=';
+ $type = $tok;
+ $i++;
+ }
+ }
+ }
+ },
+ '.' => sub { # what kind of . ?
+
+ if ( $expecting != OPERATOR ) {
+ scan_number();
+ if ( $type eq '.' ) {
+ error_if_expecting_TERM()
+ if ( $expecting == TERM );
+ }
+ }
+ else {
+ }
+ },
+ ':' => sub {
+
+ # if this is the first nonblank character, call it a label
+ # since perl seems to just swallow it
+ if ( $input_line_number == 1 && $last_nonblank_i == -1 ) {
+ $type = 'J';
+ }
+
+ # ATTRS: check for a ':' which introduces an attribute list
+ # (this might eventually get its own token type)
+ elsif ( $statement_type =~ /^sub/ ) {
+ $type = 'A';
+ $in_attribute_list = 1;
+ }
+
+ # check for scalar attribute, such as
+ # my $foo : shared = 1;
+ elsif ($is_my_our{$statement_type}
+ && $current_depth[QUESTION_COLON] == 0 )
+ {
+ $type = 'A';
+ $in_attribute_list = 1;
+ }
+
+ # otherwise, it should be part of a ?/: operator
+ else {
+ ( $type_sequence, $indent_flag ) =
+ decrease_nesting_depth( QUESTION_COLON,
+ $$rtoken_map[$i_tok] );
+ if ( $last_nonblank_token eq '?' ) {
+ warning("Syntax error near ? :\n");
+ }
+ }
+ },
+ '+' => sub { # what kind of plus?
+
+ if ( $expecting == TERM ) {
+ my $number = scan_number();
+
+ # unary plus is safest assumption if not a number
+ if ( !defined($number) ) { $type = 'p'; }
+ }
+ elsif ( $expecting == OPERATOR ) {
+ }
+ else {
+ if ( $next_type eq 'w' ) { $type = 'p' }
+ }
+ },
+ '@' => sub {
+
+ error_if_expecting_OPERATOR("Array")
+ if ( $expecting == OPERATOR );
+ scan_identifier();
+ },
+ '%' => sub { # hash or modulo?
+
+ # first guess is hash if no following blank
+ if ( $expecting == UNKNOWN ) {
+ if ( $next_type ne 'b' ) { $expecting = TERM }
+ }
+ if ( $expecting == TERM ) {
+ scan_identifier();
+ }
+ },
+ '[' => sub {
+ $square_bracket_type[ ++$square_bracket_depth ] =
+ $last_nonblank_token;
+ ( $type_sequence, $indent_flag ) =
+ increase_nesting_depth( SQUARE_BRACKET, $$rtoken_map[$i_tok] );
+
+ # It may seem odd, but structural square brackets have
+ # type '{' and '}'. This simplifies the indentation logic.
+ if ( !is_non_structural_brace() ) {
+ $type = '{';
+ }
+ $square_bracket_structural_type[$square_bracket_depth] = $type;
+ },
+ ']' => sub {
+ ( $type_sequence, $indent_flag ) =
+ decrease_nesting_depth( SQUARE_BRACKET, $$rtoken_map[$i_tok] );
+
+ if ( $square_bracket_structural_type[$square_bracket_depth] eq '{' )
+ {
+ $type = '}';
+ }
+ if ( $square_bracket_depth > 0 ) { $square_bracket_depth--; }
+ },
+ '-' => sub { # what kind of minus?
+
+ if ( ( $expecting != OPERATOR )
+ && $is_file_test_operator{$next_tok} )
+ {
+ my ( $next_nonblank_token, $i_next ) =
+ find_next_nonblank_token( $i + 1, $rtokens,
+ $max_token_index );
+
+ # check for a quoted word like "-w=>xx";
+ # it is sufficient to just check for a following '='
+ if ( $next_nonblank_token eq '=' ) {
+ $type = 'm';
+ }
+ else {
+ $i++;
+ $tok .= $next_tok;
+ $type = 'F';
+ }
+ }
+ elsif ( $expecting == TERM ) {
+ my $number = scan_number();
+
+ # maybe part of bareword token? unary is safest
+ if ( !defined($number) ) { $type = 'm'; }
+
+ }
+ elsif ( $expecting == OPERATOR ) {
+ }
+ else {
+
+ if ( $next_type eq 'w' ) {
+ $type = 'm';
+ }
+ }
+ },
+
+ '^' => sub {
+
+ # check for special variables like ${^WARNING_BITS}
+ if ( $expecting == TERM ) {
+
+ # FIXME: this should work but will not catch errors
+ # because we also have to be sure that previous token is
+ # a type character ($,@,%).
+ if ( $last_nonblank_token eq '{'
+ && ( $next_tok =~ /^[A-Za-z_]/ ) )
+ {
+
+ if ( $next_tok eq 'W' ) {
+ $tokenizer_self->{_saw_perl_dash_w} = 1;
+ }
+ $tok = $tok . $next_tok;
+ $i = $i + 1;
+ $type = 'w';
+ }
+
+ else {
+ unless ( error_if_expecting_TERM() ) {
+
+ # Something like this is valid but strange:
+ # undef ^I;
+ complain("The '^' seems unusual here\n");
+ }
+ }
+ }
+ },
+
+ '::' => sub { # probably a sub call
+ scan_bare_identifier();
+ },
+ '<<' => sub { # maybe a here-doc?
+ return
+ unless ( $i < $max_token_index )
+ ; # here-doc not possible if end of line
+
+ if ( $expecting != OPERATOR ) {
+ my ( $found_target, $here_doc_target, $here_quote_character,
+ $saw_error );
+ (
+ $found_target, $here_doc_target, $here_quote_character, $i,
+ $saw_error
+ )
+ = find_here_doc( $expecting, $i, $rtokens, $rtoken_map,
+ $max_token_index );
+
+ if ($found_target) {
+ push @{$rhere_target_list},
+ [ $here_doc_target, $here_quote_character ];
+ $type = 'h';
+ if ( length($here_doc_target) > 80 ) {
+ my $truncated = substr( $here_doc_target, 0, 80 );
+ complain("Long here-target: '$truncated' ...\n");
+ }
+ elsif ( $here_doc_target !~ /^[A-Z_]\w+$/ ) {
+ complain(
+ "Unconventional here-target: '$here_doc_target'\n"
+ );
+ }
+ }
+ elsif ( $expecting == TERM ) {
+ unless ($saw_error) {
+
+ # shouldn't happen..
+ warning("Program bug; didn't find here doc target\n");
+ report_definite_bug();
+ }
+ }
+ }
+ else {
+ }
+ },
+ '->' => sub {
+
+ # if -> points to a bare word, we must scan for an identifier,
+ # otherwise something like ->y would look like the y operator
+ scan_identifier();
+ },
+
+ # type = 'pp' for pre-increment, '++' for post-increment
+ '++' => sub {
+ if ( $expecting == TERM ) { $type = 'pp' }
+ elsif ( $expecting == UNKNOWN ) {
+ my ( $next_nonblank_token, $i_next ) =
+ find_next_nonblank_token( $i, $rtokens, $max_token_index );
+ if ( $next_nonblank_token eq '$' ) { $type = 'pp' }
+ }
+ },
+
+ '=>' => sub {
+ if ( $last_nonblank_type eq $tok ) {
+ complain("Repeated '=>'s \n");
+ }
+
+ # patch for operator_expected: note if we are in the list (use.t)
+ # TODO: make version numbers a new token type
+ if ( $statement_type eq 'use' ) { $statement_type = '_use' }
+ },
+
+ # type = 'mm' for pre-decrement, '--' for post-decrement
+ '--' => sub {
+
+ if ( $expecting == TERM ) { $type = 'mm' }
+ elsif ( $expecting == UNKNOWN ) {
+ my ( $next_nonblank_token, $i_next ) =
+ find_next_nonblank_token( $i, $rtokens, $max_token_index );
+ if ( $next_nonblank_token eq '$' ) { $type = 'mm' }
+ }
+ },
+
+ '&&' => sub {
+ error_if_expecting_TERM()
+ if ( $expecting == TERM );
+ },
+
+ '||' => sub {
+ error_if_expecting_TERM()
+ if ( $expecting == TERM );
+ },
+
+ '//' => sub {
+ error_if_expecting_TERM()
+ if ( $expecting == TERM );
+ },
+ };
+
+ # ------------------------------------------------------------
+ # end hash of code for handling individual token types
+ # ------------------------------------------------------------
+
+ my %matching_start_token = ( '}' => '{', ']' => '[', ')' => '(' );
+
+ # These block types terminate statements and do not need a trailing
+ # semicolon
+ # patched for SWITCH/CASE:
+ my %is_zero_continuation_block_type;
+ @_ = qw( } { BEGIN END CHECK INIT AUTOLOAD DESTROY UNITCHECK continue ;
+ if elsif else unless while until for foreach switch case given when);
+ @is_zero_continuation_block_type{@_} = (1) x scalar(@_);
+
+ my %is_not_zero_continuation_block_type;
+ @_ = qw(sort grep map do eval);
+ @is_not_zero_continuation_block_type{@_} = (1) x scalar(@_);
+
+ my %is_logical_container;
+ @_ = qw(if elsif unless while and or err not && ! || for foreach);
+ @is_logical_container{@_} = (1) x scalar(@_);
+
+ my %is_binary_type;
+ @_ = qw(|| &&);
+ @is_binary_type{@_} = (1) x scalar(@_);
+
+ my %is_binary_keyword;
+ @_ = qw(and or err eq ne cmp);
+ @is_binary_keyword{@_} = (1) x scalar(@_);
+
+ # 'L' is token for opening { at hash key
+ my %is_opening_type;
+ @_ = qw" L { ( [ ";
+ @is_opening_type{@_} = (1) x scalar(@_);
+
+ # 'R' is token for closing } at hash key
+ my %is_closing_type;
+ @_ = qw" R } ) ] ";
+ @is_closing_type{@_} = (1) x scalar(@_);
+
+ my %is_redo_last_next_goto;
+ @_ = qw(redo last next goto);
+ @is_redo_last_next_goto{@_} = (1) x scalar(@_);
+
+ my %is_use_require;
+ @_ = qw(use require);
+ @is_use_require{@_} = (1) x scalar(@_);
+
+ my %is_sub_package;
+ @_ = qw(sub package);
+ @is_sub_package{@_} = (1) x scalar(@_);
+
+ # This hash holds the hash key in $tokenizer_self for these keywords:
+ my %is_format_END_DATA = (
+ 'format' => '_in_format',
+ '__END__' => '_in_end',
+ '__DATA__' => '_in_data',
+ );
+
+ # ref: camel 3 p 147,
+ # but perl may accept undocumented flags
+ # perl 5.10 adds 'p' (preserve)
+ my %quote_modifiers = (
+ 's' => '[cegimosxp]',
+ 'y' => '[cds]',
+ 'tr' => '[cds]',
+ 'm' => '[cgimosxp]',
+ 'qr' => '[imosxp]',
+ 'q' => "",
+ 'qq' => "",
+ 'qw' => "",
+ 'qx' => "",
+ );
+
+ # table showing how many quoted things to look for after quote operator..
+ # s, y, tr have 2 (pattern and replacement)
+ # others have 1 (pattern only)
+ my %quote_items = (
+ 's' => 2,
+ 'y' => 2,
+ 'tr' => 2,
+ 'm' => 1,
+ 'qr' => 1,
+ 'q' => 1,
+ 'qq' => 1,
+ 'qw' => 1,
+ 'qx' => 1,
+ );
+
+ sub tokenize_this_line {
+
+ # This routine breaks a line of perl code into tokens which are of use in
+ # indentation and reformatting. One of my goals has been to define tokens
+ # such that a newline may be inserted between any pair of tokens without
+ # changing or invalidating the program. This version comes close to this,
+ # although there are necessarily a few exceptions which must be caught by
+ # the formatter. Many of these involve the treatment of bare words.
+ #
+ # The tokens and their types are returned in arrays. See previous
+ # routine for their names.
+ #
+ # See also the array "valid_token_types" in the BEGIN section for an
+ # up-to-date list.
+ #
+ # To simplify things, token types are either a single character, or they
+ # are identical to the tokens themselves.
+ #
+ # As a debugging aid, the -D flag creates a file containing a side-by-side
+ # comparison of the input string and its tokenization for each line of a file.
+ # This is an invaluable debugging aid.
+ #
+ # In addition to tokens, and some associated quantities, the tokenizer
+ # also returns flags indication any special line types. These include
+ # quotes, here_docs, formats.
+ #
+ # -----------------------------------------------------------------------
+ #
+ # How to add NEW_TOKENS:
+ #
+ # New token types will undoubtedly be needed in the future both to keep up
+ # with changes in perl and to help adapt the tokenizer to other applications.
+ #
+ # Here are some notes on the minimal steps. I wrote these notes while
+ # adding the 'v' token type for v-strings, which are things like version
+ # numbers 5.6.0, and ip addresses, and will use that as an example. ( You
+ # can use your editor to search for the string "NEW_TOKENS" to find the
+ # appropriate sections to change):
+ #
+ # *. Try to talk somebody else into doing it! If not, ..
+ #
+ # *. Make a backup of your current version in case things don't work out!
+ #
+ # *. Think of a new, unused character for the token type, and add to
+ # the array @valid_token_types in the BEGIN section of this package.
+ # For example, I used 'v' for v-strings.
+ #
+ # *. Implement coding to recognize the $type of the token in this routine.
+ # This is the hardest part, and is best done by immitating or modifying
+ # some of the existing coding. For example, to recognize v-strings, I
+ # patched 'sub scan_bare_identifier' to recognize v-strings beginning with
+ # 'v' and 'sub scan_number' to recognize v-strings without the leading 'v'.
+ #
+ # *. Update sub operator_expected. This update is critically important but
+ # the coding is trivial. Look at the comments in that routine for help.
+ # For v-strings, which should behave like numbers, I just added 'v' to the
+ # regex used to handle numbers and strings (types 'n' and 'Q').
+ #
+ # *. Implement a 'bond strength' rule in sub set_bond_strengths in
+ # Perl::Tidy::Formatter for breaking lines around this token type. You can
+ # skip this step and take the default at first, then adjust later to get
+ # desired results. For adding type 'v', I looked at sub bond_strength and
+ # saw that number type 'n' was using default strengths, so I didn't do
+ # anything. I may tune it up someday if I don't like the way line
+ # breaks with v-strings look.
+ #
+ # *. Implement a 'whitespace' rule in sub set_white_space_flag in
+ # Perl::Tidy::Formatter. For adding type 'v', I looked at this routine
+ # and saw that type 'n' used spaces on both sides, so I just added 'v'
+ # to the array @spaces_both_sides.
+ #
+ # *. Update HtmlWriter package so that users can colorize the token as
+ # desired. This is quite easy; see comments identified by 'NEW_TOKENS' in
+ # that package. For v-strings, I initially chose to use a default color
+ # equal to the default for numbers, but it might be nice to change that
+ # eventually.
+ #
+ # *. Update comments in Perl::Tidy::Tokenizer::dump_token_types.
+ #
+ # *. Run lots and lots of debug tests. Start with special files designed
+ # to test the new token type. Run with the -D flag to create a .DEBUG
+ # file which shows the tokenization. When these work ok, test as many old
+ # scripts as possible. Start with all of the '.t' files in the 'test'
+ # directory of the distribution file. Compare .tdy output with previous
+ # version and updated version to see the differences. Then include as
+ # many more files as possible. My own technique has been to collect a huge
+ # number of perl scripts (thousands!) into one directory and run perltidy
+ # *, then run diff between the output of the previous version and the
+ # current version.
+ #
+ # *. For another example, search for the smartmatch operator '~~'
+ # with your editor to see where updates were made for it.
+ #
+ # -----------------------------------------------------------------------
+
+ my $line_of_tokens = shift;
+ my ($untrimmed_input_line) = $line_of_tokens->{_line_text};
+
+ # patch while coding change is underway
+ # make callers private data to allow access
+ # $tokenizer_self = $caller_tokenizer_self;
+
+ # extract line number for use in error messages
+ $input_line_number = $line_of_tokens->{_line_number};
+
+ # reinitialize for multi-line quote
+ $line_of_tokens->{_starting_in_quote} = $in_quote && $quote_type eq 'Q';
+
+ # check for pod documentation
+ if ( ( $untrimmed_input_line =~ /^=[A-Za-z_]/ ) ) {
+
+ # must not be in multi-line quote
+ # and must not be in an eqn
+ if ( !$in_quote and ( operator_expected( 'b', '=', 'b' ) == TERM ) )
+ {
+ $tokenizer_self->{_in_pod} = 1;
+ return;
+ }
+ }
+
+ $input_line = $untrimmed_input_line;
+
+ chomp $input_line;
+
+ # trim start of this line unless we are continuing a quoted line
+ # do not trim end because we might end in a quote (test: deken4.pl)
+ # Perl::Tidy::Formatter will delete needless trailing blanks
+ unless ( $in_quote && ( $quote_type eq 'Q' ) ) {
+ $input_line =~ s/^\s*//; # trim left end
+ }
+
+ # update the copy of the line for use in error messages
+ # This must be exactly what we give the pre_tokenizer
+ $tokenizer_self->{_line_text} = $input_line;
+
+ # re-initialize for the main loop
+ $routput_token_list = []; # stack of output token indexes
+ $routput_token_type = []; # token types
+ $routput_block_type = []; # types of code block
+ $routput_container_type = []; # paren types, such as if, elsif, ..
+ $routput_type_sequence = []; # nesting sequential number
+
+ $rhere_target_list = [];
+
+ $tok = $last_nonblank_token;
+ $type = $last_nonblank_type;
+ $prototype = $last_nonblank_prototype;
+ $last_nonblank_i = -1;
+ $block_type = $last_nonblank_block_type;
+ $container_type = $last_nonblank_container_type;
+ $type_sequence = $last_nonblank_type_sequence;
+ $indent_flag = 0;
+ $peeked_ahead = 0;
+
+ # tokenization is done in two stages..
+ # stage 1 is a very simple pre-tokenization
+ my $max_tokens_wanted = 0; # this signals pre_tokenize to get all tokens
+
+ # a little optimization for a full-line comment
+ if ( !$in_quote && ( $input_line =~ /^#/ ) ) {
+ $max_tokens_wanted = 1 # no use tokenizing a comment
+ }
+
+ # start by breaking the line into pre-tokens
+ ( $rtokens, $rtoken_map, $rtoken_type ) =
+ pre_tokenize( $input_line, $max_tokens_wanted );
+
+ $max_token_index = scalar(@$rtokens) - 1;
+ push( @$rtokens, ' ', ' ', ' ' ); # extra whitespace simplifies logic
+ push( @$rtoken_map, 0, 0, 0 ); # shouldn't be referenced
+ push( @$rtoken_type, 'b', 'b', 'b' );
+
+ # initialize for main loop
+ for $i ( 0 .. $max_token_index + 3 ) {
+ $routput_token_type->[$i] = "";
+ $routput_block_type->[$i] = "";
+ $routput_container_type->[$i] = "";
+ $routput_type_sequence->[$i] = "";
+ $routput_indent_flag->[$i] = 0;
+ }
+ $i = -1;
+ $i_tok = -1;
+
+ # ------------------------------------------------------------
+ # begin main tokenization loop
+ # ------------------------------------------------------------
+
+ # we are looking at each pre-token of one line and combining them
+ # into tokens
+ while ( ++$i <= $max_token_index ) {
+
+ if ($in_quote) { # continue looking for end of a quote
+ $type = $quote_type;
+
+ unless ( @{$routput_token_list} )
+ { # initialize if continuation line
+ push( @{$routput_token_list}, $i );
+ $routput_token_type->[$i] = $type;
+
+ }
+ $tok = $quote_character unless ( $quote_character =~ /^\s*$/ );
+
+ # scan for the end of the quote or pattern
+ (
+ $i, $in_quote, $quote_character, $quote_pos, $quote_depth,
+ $quoted_string_1, $quoted_string_2
+ )
+ = do_quote(
+ $i, $in_quote, $quote_character,
+ $quote_pos, $quote_depth, $quoted_string_1,
+ $quoted_string_2, $rtokens, $rtoken_map,
+ $max_token_index
+ );
+
+ # all done if we didn't find it
+ last if ($in_quote);
+
+ # save pattern and replacement text for rescanning
+ my $qs1 = $quoted_string_1;
+ my $qs2 = $quoted_string_2;
+
+ # re-initialize for next search
+ $quote_character = '';
+ $quote_pos = 0;
+ $quote_type = 'Q';
+ $quoted_string_1 = "";
+ $quoted_string_2 = "";
+ last if ( ++$i > $max_token_index );
+
+ # look for any modifiers
+ if ($allowed_quote_modifiers) {
+
+ # check for exact quote modifiers
+ if ( $$rtokens[$i] =~ /^[A-Za-z_]/ ) {
+ my $str = $$rtokens[$i];
+ my $saw_modifier_e;
+ while ( $str =~ /\G$allowed_quote_modifiers/gc ) {
+ my $pos = pos($str);
+ my $char = substr( $str, $pos - 1, 1 );
+ $saw_modifier_e ||= ( $char eq 'e' );
+ }
+
+ # For an 'e' quote modifier we must scan the replacement
+ # text for here-doc targets.
+ if ($saw_modifier_e) {
+
+ my $rht = scan_replacement_text($qs1);
+
+ # Change type from 'Q' to 'h' for quotes with
+ # here-doc targets so that the formatter (see sub
+ # print_line_of_tokens) will not make any line
+ # breaks after this point.
+ if ($rht) {
+ push @{$rhere_target_list}, @{$rht};
+ $type = 'h';
+ if ( $i_tok < 0 ) {
+ my $ilast = $routput_token_list->[-1];
+ $routput_token_type->[$ilast] = $type;
+ }
+ }
+ }
+
+ if ( defined( pos($str) ) ) {
+
+ # matched
+ if ( pos($str) == length($str) ) {
+ last if ( ++$i > $max_token_index );
+ }
+
+ # Looks like a joined quote modifier
+ # and keyword, maybe something like
+ # s/xxx/yyy/gefor @k=...
+ # Example is "galgen.pl". Would have to split
+ # the word and insert a new token in the
+ # pre-token list. This is so rare that I haven't
+ # done it. Will just issue a warning citation.
+
+ # This error might also be triggered if my quote
+ # modifier characters are incomplete
+ else {
+ warning(<<EOM);
+
+Partial match to quote modifier $allowed_quote_modifiers at word: '$str'
+Please put a space between quote modifiers and trailing keywords.
+EOM
+
+ # print "token $$rtokens[$i]\n";
+ # my $num = length($str) - pos($str);
+ # $$rtokens[$i]=substr($$rtokens[$i],pos($str),$num);
+ # print "continuing with new token $$rtokens[$i]\n";
+
+ # skipping past this token does least damage
+ last if ( ++$i > $max_token_index );
+ }
+ }
+ else {
+
+ # example file: rokicki4.pl
+ # This error might also be triggered if my quote
+ # modifier characters are incomplete
+ write_logfile_entry(
+"Note: found word $str at quote modifier location\n"
+ );
+ }
+ }
+
+ # re-initialize
+ $allowed_quote_modifiers = "";
+ }
+ }
+
+ unless ( $tok =~ /^\s*$/ ) {
+
+ # try to catch some common errors
+ if ( ( $type eq 'n' ) && ( $tok ne '0' ) ) {
+
+ if ( $last_nonblank_token eq 'eq' ) {
+ complain("Should 'eq' be '==' here ?\n");
+ }
+ elsif ( $last_nonblank_token eq 'ne' ) {
+ complain("Should 'ne' be '!=' here ?\n");
+ }
+ }
+
+ $last_last_nonblank_token = $last_nonblank_token;
+ $last_last_nonblank_type = $last_nonblank_type;
+ $last_last_nonblank_block_type = $last_nonblank_block_type;
+ $last_last_nonblank_container_type =
+ $last_nonblank_container_type;
+ $last_last_nonblank_type_sequence =
+ $last_nonblank_type_sequence;
+ $last_nonblank_token = $tok;
+ $last_nonblank_type = $type;
+ $last_nonblank_prototype = $prototype;
+ $last_nonblank_block_type = $block_type;
+ $last_nonblank_container_type = $container_type;
+ $last_nonblank_type_sequence = $type_sequence;
+ $last_nonblank_i = $i_tok;
+ }
+
+ # store previous token type
+ if ( $i_tok >= 0 ) {
+ $routput_token_type->[$i_tok] = $type;
+ $routput_block_type->[$i_tok] = $block_type;
+ $routput_container_type->[$i_tok] = $container_type;
+ $routput_type_sequence->[$i_tok] = $type_sequence;
+ $routput_indent_flag->[$i_tok] = $indent_flag;
+ }
+ my $pre_tok = $$rtokens[$i]; # get the next pre-token
+ my $pre_type = $$rtoken_type[$i]; # and type
+ $tok = $pre_tok;
+ $type = $pre_type; # to be modified as necessary
+ $block_type = ""; # blank for all tokens except code block braces
+ $container_type = ""; # blank for all tokens except some parens
+ $type_sequence = ""; # blank for all tokens except ?/:
+ $indent_flag = 0;
+ $prototype = ""; # blank for all tokens except user defined subs
+ $i_tok = $i;
+
+ # this pre-token will start an output token
+ push( @{$routput_token_list}, $i_tok );
+
+ # continue gathering identifier if necessary
+ # but do not start on blanks and comments
+ if ( $id_scan_state && $pre_type !~ /[b#]/ ) {
+
+ if ( $id_scan_state =~ /^(sub|package)/ ) {
+ scan_id();
+ }
+ else {
+ scan_identifier();
+ }
+
+ last if ($id_scan_state);
+ next if ( ( $i > 0 ) || $type );
+
+ # didn't find any token; start over
+ $type = $pre_type;
+ $tok = $pre_tok;
+ }
+
+ # handle whitespace tokens..
+ next if ( $type eq 'b' );
+ my $prev_tok = $i > 0 ? $$rtokens[ $i - 1 ] : ' ';
+ my $prev_type = $i > 0 ? $$rtoken_type[ $i - 1 ] : 'b';
+
+ # Build larger tokens where possible, since we are not in a quote.
+ #
+ # First try to assemble digraphs. The following tokens are
+ # excluded and handled specially:
+ # '/=' is excluded because the / might start a pattern.
+ # 'x=' is excluded since it might be $x=, with $ on previous line
+ # '**' and *= might be typeglobs of punctuation variables
+ # I have allowed tokens starting with <, such as <=,
+ # because I don't think these could be valid angle operators.
+ # test file: storrs4.pl
+ my $test_tok = $tok . $$rtokens[ $i + 1 ];
+ my $combine_ok = $is_digraph{$test_tok};
+
+ # check for special cases which cannot be combined
+ if ($combine_ok) {
+
+ # '//' must be defined_or operator if an operator is expected.
+ # TODO: Code for other ambiguous digraphs (/=, x=, **, *=)
+ # could be migrated here for clarity
+ if ( $test_tok eq '//' ) {
+ my $next_type = $$rtokens[ $i + 1 ];
+ my $expecting =
+ operator_expected( $prev_type, $tok, $next_type );
+ $combine_ok = 0 unless ( $expecting == OPERATOR );
+ }
+ }
+
+ if (
+ $combine_ok
+ && ( $test_tok ne '/=' ) # might be pattern
+ && ( $test_tok ne 'x=' ) # might be $x
+ && ( $test_tok ne '**' ) # typeglob?
+ && ( $test_tok ne '*=' ) # typeglob?
+ )
+ {
+ $tok = $test_tok;
+ $i++;
+
+ # Now try to assemble trigraphs. Note that all possible
+ # perl trigraphs can be constructed by appending a character
+ # to a digraph.
+ $test_tok = $tok . $$rtokens[ $i + 1 ];
+
+ if ( $is_trigraph{$test_tok} ) {
+ $tok = $test_tok;
+ $i++;
+ }
+ }
+
+ $type = $tok;
+ $next_tok = $$rtokens[ $i + 1 ];
+ $next_type = $$rtoken_type[ $i + 1 ];
+
+ TOKENIZER_DEBUG_FLAG_TOKENIZE && do {
+ local $" = ')(';
+ my @debug_list = (
+ $last_nonblank_token, $tok,
+ $next_tok, $brace_depth,
+ $brace_type[$brace_depth], $paren_depth,
+ $paren_type[$paren_depth]
+ );
+ print "TOKENIZE:(@debug_list)\n";
+ };
+
+ # turn off attribute list on first non-blank, non-bareword
+ if ( $pre_type ne 'w' ) { $in_attribute_list = 0 }
+
+ ###############################################################
+ # We have the next token, $tok.
+ # Now we have to examine this token and decide what it is
+ # and define its $type
+ #
+ # section 1: bare words
+ ###############################################################
+
+ if ( $pre_type eq 'w' ) {
+ $expecting = operator_expected( $prev_type, $tok, $next_type );
+ my ( $next_nonblank_token, $i_next ) =
+ find_next_nonblank_token( $i, $rtokens, $max_token_index );
+
+ # ATTRS: handle sub and variable attributes
+ if ($in_attribute_list) {
+
+ # treat bare word followed by open paren like qw(
+ if ( $next_nonblank_token eq '(' ) {
+ $in_quote = $quote_items{'q'};
+ $allowed_quote_modifiers = $quote_modifiers{'q'};
+ $type = 'q';
+ $quote_type = 'q';
+ next;
+ }
+
+ # handle bareword not followed by open paren
+ else {
+ $type = 'w';
+ next;
+ }
+ }
+
+ # quote a word followed by => operator
+ if ( $next_nonblank_token eq '=' ) {
+
+ if ( $$rtokens[ $i_next + 1 ] eq '>' ) {
+ if ( $is_constant{$current_package}{$tok} ) {
+ $type = 'C';
+ }
+ elsif ( $is_user_function{$current_package}{$tok} ) {
+ $type = 'U';
+ $prototype =
+ $user_function_prototype{$current_package}{$tok};
+ }
+ elsif ( $tok =~ /^v\d+$/ ) {
+ $type = 'v';
+ report_v_string($tok);
+ }
+ else { $type = 'w' }
+
+ next;
+ }
+ }
+
+ # quote a bare word within braces..like xxx->{s}; note that we
+ # must be sure this is not a structural brace, to avoid
+ # mistaking {s} in the following for a quoted bare word:
+ # for(@[){s}bla}BLA}
+ # Also treat q in something like var{-q} as a bare word, not qoute operator
+ ##if ( ( $last_nonblank_type eq 'L' )
+ ## && ( $next_nonblank_token eq '}' ) )
+ if (
+ $next_nonblank_token eq '}'
+ && (
+ $last_nonblank_type eq 'L'
+ || ( $last_nonblank_type eq 'm'
+ && $last_last_nonblank_type eq 'L' )
+ )
+ )
+ {
+ $type = 'w';
+ next;
+ }
+
+ # a bare word immediately followed by :: is not a keyword;
+ # use $tok_kw when testing for keywords to avoid a mistake
+ my $tok_kw = $tok;
+ if ( $$rtokens[ $i + 1 ] eq ':' && $$rtokens[ $i + 2 ] eq ':' )
+ {
+ $tok_kw .= '::';
+ }
+
+ # handle operator x (now we know it isn't $x=)
+ if ( ( $tok =~ /^x\d*$/ ) && ( $expecting == OPERATOR ) ) {
+ if ( $tok eq 'x' ) {
+
+ if ( $$rtokens[ $i + 1 ] eq '=' ) { # x=
+ $tok = 'x=';
+ $type = $tok;
+ $i++;
+ }
+ else {
+ $type = 'x';
+ }
+ }
+
+ # FIXME: Patch: mark something like x4 as an integer for now
+ # It gets fixed downstream. This is easier than
+ # splitting the pretoken.
+ else {
+ $type = 'n';
+ }
+ }
+
+ elsif ( ( $tok eq 'strict' )
+ and ( $last_nonblank_token eq 'use' ) )
+ {
+ $tokenizer_self->{_saw_use_strict} = 1;
+ scan_bare_identifier();
+ }
+
+ elsif ( ( $tok eq 'warnings' )
+ and ( $last_nonblank_token eq 'use' ) )
+ {
+ $tokenizer_self->{_saw_perl_dash_w} = 1;
+
+ # scan as identifier, so that we pick up something like:
+ # use warnings::register
+ scan_bare_identifier();
+ }
+
+ elsif (
+ $tok eq 'AutoLoader'
+ && $tokenizer_self->{_look_for_autoloader}
+ && (
+ $last_nonblank_token eq 'use'
+
+ # these regexes are from AutoSplit.pm, which we want
+ # to mimic
+ || $input_line =~ /^\s*(use|require)\s+AutoLoader\b/
+ || $input_line =~ /\bISA\s*=.*\bAutoLoader\b/
+ )
+ )
+ {
+ write_logfile_entry("AutoLoader seen, -nlal deactivates\n");
+ $tokenizer_self->{_saw_autoloader} = 1;
+ $tokenizer_self->{_look_for_autoloader} = 0;
+ scan_bare_identifier();
+ }
+
+ elsif (
+ $tok eq 'SelfLoader'
+ && $tokenizer_self->{_look_for_selfloader}
+ && ( $last_nonblank_token eq 'use'
+ || $input_line =~ /^\s*(use|require)\s+SelfLoader\b/
+ || $input_line =~ /\bISA\s*=.*\bSelfLoader\b/ )
+ )
+ {
+ write_logfile_entry("SelfLoader seen, -nlsl deactivates\n");
+ $tokenizer_self->{_saw_selfloader} = 1;
+ $tokenizer_self->{_look_for_selfloader} = 0;
+ scan_bare_identifier();
+ }
+
+ elsif ( ( $tok eq 'constant' )
+ and ( $last_nonblank_token eq 'use' ) )
+ {
+ scan_bare_identifier();
+ my ( $next_nonblank_token, $i_next ) =
+ find_next_nonblank_token( $i, $rtokens,
+ $max_token_index );
+
+ if ($next_nonblank_token) {
+
+ if ( $is_keyword{$next_nonblank_token} ) {
+ warning(
+"Attempting to define constant '$next_nonblank_token' which is a perl keyword\n"
+ );
+ }
+
+ # FIXME: could check for error in which next token is
+ # not a word (number, punctuation, ..)
+ else {
+ $is_constant{$current_package}
+ {$next_nonblank_token} = 1;
+ }
+ }
+ }
+
+ # various quote operators
+ elsif ( $is_q_qq_qw_qx_qr_s_y_tr_m{$tok} ) {
+ if ( $expecting == OPERATOR ) {
+
+ # patch for paren-less for/foreach glitch, part 1
+ # perl will accept this construct as valid:
+ #
+ # foreach my $key qw\Uno Due Tres Quadro\ {
+ # print "Set $key\n";
+ # }
+ unless ( $tok eq 'qw' && $is_for_foreach{$want_paren} )
+ {
+ error_if_expecting_OPERATOR();
+ }
+ }
+ $in_quote = $quote_items{$tok};
+ $allowed_quote_modifiers = $quote_modifiers{$tok};
+
+ # All quote types are 'Q' except possibly qw quotes.
+ # qw quotes are special in that they may generally be trimmed
+ # of leading and trailing whitespace. So they are given a
+ # separate type, 'q', unless requested otherwise.
+ $type =
+ ( $tok eq 'qw' && $tokenizer_self->{_trim_qw} )
+ ? 'q'
+ : 'Q';
+ $quote_type = $type;
+ }
+
+ # check for a statement label
+ elsif (
+ ( $next_nonblank_token eq ':' )
+ && ( $$rtokens[ $i_next + 1 ] ne ':' )
+ && ( $i_next <= $max_token_index ) # colon on same line
+ && label_ok()
+ )
+ {
+ if ( $tok !~ /[A-Z]/ ) {
+ push @{ $tokenizer_self->{_rlower_case_labels_at} },
+ $input_line_number;
+ }
+ $type = 'J';
+ $tok .= ':';
+ $i = $i_next;
+ next;
+ }
+
+ # 'sub' || 'package'
+ elsif ( $is_sub_package{$tok_kw} ) {
+ error_if_expecting_OPERATOR()
+ if ( $expecting == OPERATOR );
+ scan_id();
+ }
+
+ # Note on token types for format, __DATA__, __END__:
+ # It simplifies things to give these type ';', so that when we
+ # start rescanning we will be expecting a token of type TERM.
+ # We will switch to type 'k' before outputting the tokens.
+ elsif ( $is_format_END_DATA{$tok_kw} ) {
+ $type = ';'; # make tokenizer look for TERM next
+ $tokenizer_self->{ $is_format_END_DATA{$tok_kw} } = 1;
+ last;
+ }
+
+ elsif ( $is_keyword{$tok_kw} ) {
+ $type = 'k';
+
+ # Since for and foreach may not be followed immediately
+ # by an opening paren, we have to remember which keyword
+ # is associated with the next '('
+ if ( $is_for_foreach{$tok} ) {
+ if ( new_statement_ok() ) {
+ $want_paren = $tok;
+ }
+ }
+
+ # recognize 'use' statements, which are special
+ elsif ( $is_use_require{$tok} ) {
+ $statement_type = $tok;
+ error_if_expecting_OPERATOR()
+ if ( $expecting == OPERATOR );
+ }
+
+ # remember my and our to check for trailing ": shared"
+ elsif ( $is_my_our{$tok} ) {
+ $statement_type = $tok;
+ }
+
+ # Check for misplaced 'elsif' and 'else', but allow isolated
+ # else or elsif blocks to be formatted. This is indicated
+ # by a last noblank token of ';'
+ elsif ( $tok eq 'elsif' ) {
+ if ( $last_nonblank_token ne ';'
+ && $last_nonblank_block_type !~
+ /^(if|elsif|unless)$/ )
+ {
+ warning(
+"expecting '$tok' to follow one of 'if|elsif|unless'\n"
+ );
+ }
+ }
+ elsif ( $tok eq 'else' ) {
+
+ # patched for SWITCH/CASE
+ if ( $last_nonblank_token ne ';'
+ && $last_nonblank_block_type !~
+ /^(if|elsif|unless|case|when)$/ )
+ {
+ warning(
+"expecting '$tok' to follow one of 'if|elsif|unless|case|when'\n"
+ );
+ }
+ }
+ elsif ( $tok eq 'continue' ) {
+ if ( $last_nonblank_token ne ';'
+ && $last_nonblank_block_type !~
+ /(^(\{|\}|;|while|until|for|foreach)|:$)/ )
+ {
+
+ # note: ';' '{' and '}' in list above
+ # because continues can follow bare blocks;
+ # ':' is labeled block
+ #
+ ############################################
+ # NOTE: This check has been deactivated because
+ # continue has an alternative usage for given/when
+ # blocks in perl 5.10
+ ## warning("'$tok' should follow a block\n");
+ ############################################
+ }
+ }
+
+ # patch for SWITCH/CASE if 'case' and 'when are
+ # treated as keywords.
+ elsif ( $tok eq 'when' || $tok eq 'case' ) {
+ $statement_type = $tok; # next '{' is block
+ }
+
+ # indent trailing if/unless/while/until
+ # outdenting will be handled by later indentation loop
+ if ( $tok =~ /^(if|unless|while|until)$/
+ && $next_nonblank_token ne '(' )
+ {
+ $indent_flag = 1;
+ }
+ }
+
+ # check for inline label following
+ # /^(redo|last|next|goto)$/
+ elsif (( $last_nonblank_type eq 'k' )
+ && ( $is_redo_last_next_goto{$last_nonblank_token} ) )
+ {
+ $type = 'j';
+ next;
+ }
+
+ # something else --
+ else {
+
+ scan_bare_identifier();
+ if ( $type eq 'w' ) {
+
+ if ( $expecting == OPERATOR ) {
+
+ # don't complain about possible indirect object
+ # notation.
+ # For example:
+ # package main;
+ # sub new($) { ... }
+ # $b = new A::; # calls A::new
+ # $c = new A; # same thing but suspicious
+ # This will call A::new but we have a 'new' in
+ # main:: which looks like a constant.
+ #
+ if ( $last_nonblank_type eq 'C' ) {
+ if ( $tok !~ /::$/ ) {
+ complain(<<EOM);
+Expecting operator after '$last_nonblank_token' but found bare word '$tok'
+ Maybe indirectet object notation?
+EOM
+ }
+ }
+ else {
+ error_if_expecting_OPERATOR("bareword");
+ }
+ }
+
+ # mark bare words immediately followed by a paren as
+ # functions
+ $next_tok = $$rtokens[ $i + 1 ];
+ if ( $next_tok eq '(' ) {
+ $type = 'U';
+ }
+
+ # underscore after file test operator is file handle
+ if ( $tok eq '_' && $last_nonblank_type eq 'F' ) {
+ $type = 'Z';
+ }
+
+ # patch for SWITCH/CASE if 'case' and 'when are
+ # not treated as keywords:
+ if (
+ (
+ $tok eq 'case'
+ && $brace_type[$brace_depth] eq 'switch'
+ )
+ || ( $tok eq 'when'
+ && $brace_type[$brace_depth] eq 'given' )
+ )
+ {
+ $statement_type = $tok; # next '{' is block
+ $type = 'k'; # for keyword syntax coloring
+ }
+
+ # patch for SWITCH/CASE if switch and given not keywords
+ # Switch is not a perl 5 keyword, but we will gamble
+ # and mark switch followed by paren as a keyword. This
+ # is only necessary to get html syntax coloring nice,
+ # and does not commit this as being a switch/case.
+ if ( $next_nonblank_token eq '('
+ && ( $tok eq 'switch' || $tok eq 'given' ) )
+ {
+ $type = 'k'; # for keyword syntax coloring
+ }
+ }
+ }
+ }
+
+ ###############################################################
+ # section 2: strings of digits
+ ###############################################################
+ elsif ( $pre_type eq 'd' ) {
+ $expecting = operator_expected( $prev_type, $tok, $next_type );
+ error_if_expecting_OPERATOR("Number")
+ if ( $expecting == OPERATOR );
+ my $number = scan_number();
+ if ( !defined($number) ) {
+
+ # shouldn't happen - we should always get a number
+ warning("non-number beginning with digit--program bug\n");
+ report_definite_bug();
+ }
+ }
+
+ ###############################################################
+ # section 3: all other tokens
+ ###############################################################
+
+ else {
+ last if ( $tok eq '#' );
+ my $code = $tokenization_code->{$tok};
+ if ($code) {
+ $expecting =
+ operator_expected( $prev_type, $tok, $next_type );
+ $code->();
+ redo if $in_quote;
+ }
+ }
+ }
+
+ # -----------------------------
+ # end of main tokenization loop
+ # -----------------------------
+
+ if ( $i_tok >= 0 ) {
+ $routput_token_type->[$i_tok] = $type;
+ $routput_block_type->[$i_tok] = $block_type;
+ $routput_container_type->[$i_tok] = $container_type;
+ $routput_type_sequence->[$i_tok] = $type_sequence;
+ $routput_indent_flag->[$i_tok] = $indent_flag;
+ }
+
+ unless ( ( $type eq 'b' ) || ( $type eq '#' ) ) {
+ $last_last_nonblank_token = $last_nonblank_token;
+ $last_last_nonblank_type = $last_nonblank_type;
+ $last_last_nonblank_block_type = $last_nonblank_block_type;
+ $last_last_nonblank_container_type = $last_nonblank_container_type;
+ $last_last_nonblank_type_sequence = $last_nonblank_type_sequence;
+ $last_nonblank_token = $tok;
+ $last_nonblank_type = $type;
+ $last_nonblank_block_type = $block_type;
+ $last_nonblank_container_type = $container_type;
+ $last_nonblank_type_sequence = $type_sequence;
+ $last_nonblank_prototype = $prototype;
+ }
+
+ # reset indentation level if necessary at a sub or package
+ # in an attempt to recover from a nesting error
+ if ( $level_in_tokenizer < 0 ) {
+ if ( $input_line =~ /^\s*(sub|package)\s+(\w+)/ ) {
+ reset_indentation_level(0);
+ brace_warning("resetting level to 0 at $1 $2\n");
+ }
+ }
+
+ # all done tokenizing this line ...
+ # now prepare the final list of tokens and types
+
+ my @token_type = (); # stack of output token types
+ my @block_type = (); # stack of output code block types
+ my @container_type = (); # stack of output code container types
+ my @type_sequence = (); # stack of output type sequence numbers
+ my @tokens = (); # output tokens
+ my @levels = (); # structural brace levels of output tokens
+ my @slevels = (); # secondary nesting levels of output tokens
+ my @nesting_tokens = (); # string of tokens leading to this depth
+ my @nesting_types = (); # string of token types leading to this depth
+ my @nesting_blocks = (); # string of block types leading to this depth
+ my @nesting_lists = (); # string of list types leading to this depth
+ my @ci_string = (); # string needed to compute continuation indentation
+ my @container_environment = (); # BLOCK or LIST
+ my $container_environment = '';
+ my $im = -1; # previous $i value
+ my $num;
+ my $ci_string_sum = ones_count($ci_string_in_tokenizer);
+
+# Computing Token Indentation
+#
+# The final section of the tokenizer forms tokens and also computes
+# parameters needed to find indentation. It is much easier to do it
+# in the tokenizer than elsewhere. Here is a brief description of how
+# indentation is computed. Perl::Tidy computes indentation as the sum
+# of 2 terms:
+#
+# (1) structural indentation, such as if/else/elsif blocks
+# (2) continuation indentation, such as long parameter call lists.
+#
+# These are occasionally called primary and secondary indentation.
+#
+# Structural indentation is introduced by tokens of type '{', although
+# the actual tokens might be '{', '(', or '['. Structural indentation
+# is of two types: BLOCK and non-BLOCK. Default structural indentation
+# is 4 characters if the standard indentation scheme is used.
+#
+# Continuation indentation is introduced whenever a line at BLOCK level
+# is broken before its termination. Default continuation indentation
+# is 2 characters in the standard indentation scheme.
+#
+# Both types of indentation may be nested arbitrarily deep and
+# interlaced. The distinction between the two is somewhat arbitrary.
+#
+# For each token, we will define two variables which would apply if
+# the current statement were broken just before that token, so that
+# that token started a new line:
+#
+# $level = the structural indentation level,
+# $ci_level = the continuation indentation level
+#
+# The total indentation will be $level * (4 spaces) + $ci_level * (2 spaces),
+# assuming defaults. However, in some special cases it is customary
+# to modify $ci_level from this strict value.
+#
+# The total structural indentation is easy to compute by adding and
+# subtracting 1 from a saved value as types '{' and '}' are seen. The
+# running value of this variable is $level_in_tokenizer.
+#
+# The total continuation is much more difficult to compute, and requires
+# several variables. These veriables are:
+#
+# $ci_string_in_tokenizer = a string of 1's and 0's indicating, for
+# each indentation level, if there are intervening open secondary
+# structures just prior to that level.
+# $continuation_string_in_tokenizer = a string of 1's and 0's indicating
+# if the last token at that level is "continued", meaning that it
+# is not the first token of an expression.
+# $nesting_block_string = a string of 1's and 0's indicating, for each
+# indentation level, if the level is of type BLOCK or not.
+# $nesting_block_flag = the most recent 1 or 0 of $nesting_block_string
+# $nesting_list_string = a string of 1's and 0's indicating, for each
+# indentation level, if it is is appropriate for list formatting.
+# If so, continuation indentation is used to indent long list items.
+# $nesting_list_flag = the most recent 1 or 0 of $nesting_list_string
+# @{$rslevel_stack} = a stack of total nesting depths at each
+# structural indentation level, where "total nesting depth" means
+# the nesting depth that would occur if every nesting token -- '{', '[',
+# and '(' -- , regardless of context, is used to compute a nesting
+# depth.
+
+ #my $nesting_block_flag = ($nesting_block_string =~ /1$/);
+ #my $nesting_list_flag = ($nesting_list_string =~ /1$/);
+
+ my ( $ci_string_i, $level_i, $nesting_block_string_i,
+ $nesting_list_string_i, $nesting_token_string_i,
+ $nesting_type_string_i, );
+
+ foreach $i ( @{$routput_token_list} )
+ { # scan the list of pre-tokens indexes
+
+ # self-checking for valid token types
+ my $type = $routput_token_type->[$i];
+ my $forced_indentation_flag = $routput_indent_flag->[$i];
+
+ # See if we should undo the $forced_indentation_flag.
+ # Forced indentation after 'if', 'unless', 'while' and 'until'
+ # expressions without trailing parens is optional and doesn't
+ # always look good. It is usually okay for a trailing logical
+ # expression, but if the expression is a function call, code block,
+ # or some kind of list it puts in an unwanted extra indentation
+ # level which is hard to remove.
+ #
+ # Example where extra indentation looks ok:
+ # return 1
+ # if $det_a < 0 and $det_b > 0
+ # or $det_a > 0 and $det_b < 0;
+ #
+ # Example where extra indentation is not needed because
+ # the eval brace also provides indentation:
+ # print "not " if defined eval {
+ # reduce { die if $b > 2; $a + $b } 0, 1, 2, 3, 4;
+ # };
+ #
+ # The following rule works fairly well:
+ # Undo the flag if the end of this line, or start of the next
+ # line, is an opening container token or a comma.
+ # This almost always works, but if not after another pass it will
+ # be stable.
+ if ( $forced_indentation_flag && $type eq 'k' ) {
+ my $ixlast = -1;
+ my $ilast = $routput_token_list->[$ixlast];
+ my $toklast = $routput_token_type->[$ilast];
+ if ( $toklast eq '#' ) {
+ $ixlast--;
+ $ilast = $routput_token_list->[$ixlast];
+ $toklast = $routput_token_type->[$ilast];
+ }
+ if ( $toklast eq 'b' ) {
+ $ixlast--;
+ $ilast = $routput_token_list->[$ixlast];
+ $toklast = $routput_token_type->[$ilast];
+ }
+ if ( $toklast =~ /^[\{,]$/ ) {
+ $forced_indentation_flag = 0;
+ }
+ else {
+ ( $toklast, my $i_next ) =
+ find_next_nonblank_token( $max_token_index, $rtokens,
+ $max_token_index );
+ if ( $toklast =~ /^[\{,]$/ ) {
+ $forced_indentation_flag = 0;
+ }
+ }
+ }
+
+ # if we are already in an indented if, see if we should outdent
+ if ($indented_if_level) {
+
+ # don't try to nest trailing if's - shouldn't happen
+ if ( $type eq 'k' ) {
+ $forced_indentation_flag = 0;
+ }
+
+ # check for the normal case - outdenting at next ';'
+ elsif ( $type eq ';' ) {
+ if ( $level_in_tokenizer == $indented_if_level ) {
+ $forced_indentation_flag = -1;
+ $indented_if_level = 0;
+ }
+ }
+
+ # handle case of missing semicolon
+ elsif ( $type eq '}' ) {
+ if ( $level_in_tokenizer == $indented_if_level ) {
+ $indented_if_level = 0;
+
+ # TBD: This could be a subroutine call
+ $level_in_tokenizer--;
+ if ( @{$rslevel_stack} > 1 ) {
+ pop( @{$rslevel_stack} );
+ }
+ if ( length($nesting_block_string) > 1 )
+ { # true for valid script
+ chop $nesting_block_string;
+ chop $nesting_list_string;
+ }
+
+ }
+ }
+ }
+
+ my $tok = $$rtokens[$i]; # the token, but ONLY if same as pretoken
+ $level_i = $level_in_tokenizer;
+
+ # This can happen by running perltidy on non-scripts
+ # although it could also be bug introduced by programming change.
+ # Perl silently accepts a 032 (^Z) and takes it as the end
+ if ( !$is_valid_token_type{$type} ) {
+ my $val = ord($type);
+ warning(
+ "unexpected character decimal $val ($type) in script\n");
+ $tokenizer_self->{_in_error} = 1;
+ }
+
+ # ----------------------------------------------------------------
+ # TOKEN TYPE PATCHES
+ # output __END__, __DATA__, and format as type 'k' instead of ';'
+ # to make html colors correct, etc.
+ my $fix_type = $type;
+ if ( $type eq ';' && $tok =~ /\w/ ) { $fix_type = 'k' }
+
+ # output anonymous 'sub' as keyword
+ if ( $type eq 't' && $tok eq 'sub' ) { $fix_type = 'k' }
+
+ # -----------------------------------------------------------------
+
+ $nesting_token_string_i = $nesting_token_string;
+ $nesting_type_string_i = $nesting_type_string;
+ $nesting_block_string_i = $nesting_block_string;
+ $nesting_list_string_i = $nesting_list_string;
+
+ # set primary indentation levels based on structural braces
+ # Note: these are set so that the leading braces have a HIGHER
+ # level than their CONTENTS, which is convenient for indentation
+ # Also, define continuation indentation for each token.
+ if ( $type eq '{' || $type eq 'L' || $forced_indentation_flag > 0 )
+ {
+
+ # use environment before updating
+ $container_environment =
+ $nesting_block_flag ? 'BLOCK'
+ : $nesting_list_flag ? 'LIST'
+ : "";
+
+ # if the difference between total nesting levels is not 1,
+ # there are intervening non-structural nesting types between
+ # this '{' and the previous unclosed '{'
+ my $intervening_secondary_structure = 0;
+ if ( @{$rslevel_stack} ) {
+ $intervening_secondary_structure =
+ $slevel_in_tokenizer - $rslevel_stack->[-1];
+ }
+
+ # Continuation Indentation
+ #
+ # Having tried setting continuation indentation both in the formatter and
+ # in the tokenizer, I can say that setting it in the tokenizer is much,
+ # much easier. The formatter already has too much to do, and can't
+ # make decisions on line breaks without knowing what 'ci' will be at
+ # arbitrary locations.
+ #
+ # But a problem with setting the continuation indentation (ci) here
+ # in the tokenizer is that we do not know where line breaks will actually
+ # be. As a result, we don't know if we should propagate continuation
+ # indentation to higher levels of structure.
+ #
+ # For nesting of only structural indentation, we never need to do this.
+ # For example, in a long if statement, like this
+ #
+ # if ( !$output_block_type[$i]
+ # && ($in_statement_continuation) )
+ # { <--outdented
+ # do_something();
+ # }
+ #
+ # the second line has ci but we do normally give the lines within the BLOCK
+ # any ci. This would be true if we had blocks nested arbitrarily deeply.
+ #
+ # But consider something like this, where we have created a break after
+ # an opening paren on line 1, and the paren is not (currently) a
+ # structural indentation token:
+ #
+ # my $file = $menubar->Menubutton(
+ # qw/-text File -underline 0 -menuitems/ => [
+ # [
+ # Cascade => '~View',
+ # -menuitems => [
+ # ...
+ #
+ # The second line has ci, so it would seem reasonable to propagate it
+ # down, giving the third line 1 ci + 1 indentation. This suggests the
+ # following rule, which is currently used to propagating ci down: if there
+ # are any non-structural opening parens (or brackets, or braces), before
+ # an opening structural brace, then ci is propagated down, and otherwise
+ # not. The variable $intervening_secondary_structure contains this
+ # information for the current token, and the string
+ # "$ci_string_in_tokenizer" is a stack of previous values of this
+ # variable.
+
+ # save the current states
+ push( @{$rslevel_stack}, 1 + $slevel_in_tokenizer );
+ $level_in_tokenizer++;
+
+ if ($forced_indentation_flag) {
+
+ # break BEFORE '?' when there is forced indentation
+ if ( $type eq '?' ) { $level_i = $level_in_tokenizer; }
+ if ( $type eq 'k' ) {
+ $indented_if_level = $level_in_tokenizer;
+ }
+ }
+
+ if ( $routput_block_type->[$i] ) {
+ $nesting_block_flag = 1;
+ $nesting_block_string .= '1';
+ }
+ else {
+ $nesting_block_flag = 0;
+ $nesting_block_string .= '0';
+ }
+
+ # we will use continuation indentation within containers
+ # which are not blocks and not logical expressions
+ my $bit = 0;
+ if ( !$routput_block_type->[$i] ) {
+
+ # propagate flag down at nested open parens
+ if ( $routput_container_type->[$i] eq '(' ) {
+ $bit = 1 if $nesting_list_flag;
+ }
+
+ # use list continuation if not a logical grouping
+ # /^(if|elsif|unless|while|and|or|not|&&|!|\|\||for|foreach)$/
+ else {
+ $bit = 1
+ unless
+ $is_logical_container{ $routput_container_type->[$i]
+ };
+ }
+ }
+ $nesting_list_string .= $bit;
+ $nesting_list_flag = $bit;
+
+ $ci_string_in_tokenizer .=
+ ( $intervening_secondary_structure != 0 ) ? '1' : '0';
+ $ci_string_sum = ones_count($ci_string_in_tokenizer);
+ $continuation_string_in_tokenizer .=
+ ( $in_statement_continuation > 0 ) ? '1' : '0';
+
+ # Sometimes we want to give an opening brace continuation indentation,
+ # and sometimes not. For code blocks, we don't do it, so that the leading
+ # '{' gets outdented, like this:
+ #
+ # if ( !$output_block_type[$i]
+ # && ($in_statement_continuation) )
+ # { <--outdented
+ #
+ # For other types, we will give them continuation indentation. For example,
+ # here is how a list looks with the opening paren indented:
+ #
+ # @LoL =
+ # ( [ "fred", "barney" ], [ "george", "jane", "elroy" ],
+ # [ "homer", "marge", "bart" ], );
+ #
+ # This looks best when 'ci' is one-half of the indentation (i.e., 2 and 4)
+
+ my $total_ci = $ci_string_sum;
+ if (
+ !$routput_block_type->[$i] # patch: skip for BLOCK
+ && ($in_statement_continuation)
+ && !( $forced_indentation_flag && $type eq ':' )
+ )
+ {
+ $total_ci += $in_statement_continuation
+ unless ( $ci_string_in_tokenizer =~ /1$/ );
+ }
+
+ $ci_string_i = $total_ci;
+ $in_statement_continuation = 0;
+ }
+
+ elsif ($type eq '}'
+ || $type eq 'R'
+ || $forced_indentation_flag < 0 )
+ {
+
+ # only a nesting error in the script would prevent popping here
+ if ( @{$rslevel_stack} > 1 ) { pop( @{$rslevel_stack} ); }
+
+ $level_i = --$level_in_tokenizer;
+
+ # restore previous level values
+ if ( length($nesting_block_string) > 1 )
+ { # true for valid script
+ chop $nesting_block_string;
+ $nesting_block_flag = ( $nesting_block_string =~ /1$/ );
+ chop $nesting_list_string;
+ $nesting_list_flag = ( $nesting_list_string =~ /1$/ );
+
+ chop $ci_string_in_tokenizer;
+ $ci_string_sum = ones_count($ci_string_in_tokenizer);
+
+ $in_statement_continuation =
+ chop $continuation_string_in_tokenizer;
+
+ # zero continuation flag at terminal BLOCK '}' which
+ # ends a statement.
+ if ( $routput_block_type->[$i] ) {
+
+ # ...These include non-anonymous subs
+ # note: could be sub ::abc { or sub 'abc
+ if ( $routput_block_type->[$i] =~ m/^sub\s*/gc ) {
+
+ # note: older versions of perl require the /gc modifier
+ # here or else the \G does not work.
+ if ( $routput_block_type->[$i] =~ /\G('|::|\w)/gc )
+ {
+ $in_statement_continuation = 0;
+ }
+ }
+
+# ...and include all block types except user subs with
+# block prototypes and these: (sort|grep|map|do|eval)
+# /^(\}|\{|BEGIN|END|CHECK|INIT|AUTOLOAD|DESTROY|UNITCHECK|continue|;|if|elsif|else|unless|while|until|for|foreach)$/
+ elsif (
+ $is_zero_continuation_block_type{
+ $routput_block_type->[$i] } )
+ {
+ $in_statement_continuation = 0;
+ }
+
+ # ..but these are not terminal types:
+ # /^(sort|grep|map|do|eval)$/ )
+ elsif (
+ $is_not_zero_continuation_block_type{
+ $routput_block_type->[$i] } )
+ {
+ }
+
+ # ..and a block introduced by a label
+ # /^\w+\s*:$/gc ) {
+ elsif ( $routput_block_type->[$i] =~ /:$/ ) {
+ $in_statement_continuation = 0;
+ }
+
+ # user function with block prototype
+ else {
+ $in_statement_continuation = 0;
+ }
+ }
+
+ # If we are in a list, then
+ # we must set continuatoin indentation at the closing
+ # paren of something like this (paren after $check):
+ # assert(
+ # __LINE__,
+ # ( not defined $check )
+ # or ref $check
+ # or $check eq "new"
+ # or $check eq "old",
+ # );
+ elsif ( $tok eq ')' ) {
+ $in_statement_continuation = 1
+ if $routput_container_type->[$i] =~ /^[;,\{\}]$/;
+ }
+
+ elsif ( $tok eq ';' ) { $in_statement_continuation = 0 }
+ }
+
+ # use environment after updating
+ $container_environment =
+ $nesting_block_flag ? 'BLOCK'
+ : $nesting_list_flag ? 'LIST'
+ : "";
+ $ci_string_i = $ci_string_sum + $in_statement_continuation;
+ $nesting_block_string_i = $nesting_block_string;
+ $nesting_list_string_i = $nesting_list_string;
+ }
+
+ # not a structural indentation type..
+ else {
+
+ $container_environment =
+ $nesting_block_flag ? 'BLOCK'
+ : $nesting_list_flag ? 'LIST'
+ : "";
+
+ # zero the continuation indentation at certain tokens so
+ # that they will be at the same level as its container. For
+ # commas, this simplifies the -lp indentation logic, which
+ # counts commas. For ?: it makes them stand out.
+ if ($nesting_list_flag) {
+ if ( $type =~ /^[,\?\:]$/ ) {
+ $in_statement_continuation = 0;
+ }
+ }
+
+ # be sure binary operators get continuation indentation
+ if (
+ $container_environment
+ && ( $type eq 'k' && $is_binary_keyword{$tok}
+ || $is_binary_type{$type} )
+ )
+ {
+ $in_statement_continuation = 1;
+ }
+
+ # continuation indentation is sum of any open ci from previous
+ # levels plus the current level
+ $ci_string_i = $ci_string_sum + $in_statement_continuation;
+
+ # update continuation flag ...
+ # if this isn't a blank or comment..
+ if ( $type ne 'b' && $type ne '#' ) {
+
+ # and we are in a BLOCK
+ if ($nesting_block_flag) {
+
+ # the next token after a ';' and label starts a new stmt
+ if ( $type eq ';' || $type eq 'J' ) {
+ $in_statement_continuation = 0;
+ }
+
+ # otherwise, we are continuing the current statement
+ else {
+ $in_statement_continuation = 1;
+ }
+ }
+
+ # if we are not in a BLOCK..
+ else {
+
+ # do not use continuation indentation if not list
+ # environment (could be within if/elsif clause)
+ if ( !$nesting_list_flag ) {
+ $in_statement_continuation = 0;
+ }
+
+ # otherwise, the next token after a ',' starts a new term
+ elsif ( $type eq ',' ) {
+ $in_statement_continuation = 0;
+ }
+
+ # otherwise, we are continuing the current term
+ else {
+ $in_statement_continuation = 1;
+ }
+ }
+ }
+ }
+
+ if ( $level_in_tokenizer < 0 ) {
+ unless ( $tokenizer_self->{_saw_negative_indentation} ) {
+ $tokenizer_self->{_saw_negative_indentation} = 1;
+ warning("Starting negative indentation\n");
+ }
+ }
+
+ # set secondary nesting levels based on all continment token types
+ # Note: these are set so that the nesting depth is the depth
+ # of the PREVIOUS TOKEN, which is convenient for setting
+ # the stength of token bonds
+ my $slevel_i = $slevel_in_tokenizer;
+
+ # /^[L\{\(\[]$/
+ if ( $is_opening_type{$type} ) {
+ $slevel_in_tokenizer++;
+ $nesting_token_string .= $tok;
+ $nesting_type_string .= $type;
+ }
+
+ # /^[R\}\)\]]$/
+ elsif ( $is_closing_type{$type} ) {
+ $slevel_in_tokenizer--;
+ my $char = chop $nesting_token_string;
+
+ if ( $char ne $matching_start_token{$tok} ) {
+ $nesting_token_string .= $char . $tok;
+ $nesting_type_string .= $type;
+ }
+ else {
+ chop $nesting_type_string;
+ }
+ }
+
+ push( @block_type, $routput_block_type->[$i] );
+ push( @ci_string, $ci_string_i );
+ push( @container_environment, $container_environment );
+ push( @container_type, $routput_container_type->[$i] );
+ push( @levels, $level_i );
+ push( @nesting_tokens, $nesting_token_string_i );
+ push( @nesting_types, $nesting_type_string_i );
+ push( @slevels, $slevel_i );
+ push( @token_type, $fix_type );
+ push( @type_sequence, $routput_type_sequence->[$i] );
+ push( @nesting_blocks, $nesting_block_string );
+ push( @nesting_lists, $nesting_list_string );
+
+ # now form the previous token
+ if ( $im >= 0 ) {
+ $num =
+ $$rtoken_map[$i] - $$rtoken_map[$im]; # how many characters
+
+ if ( $num > 0 ) {
+ push( @tokens,
+ substr( $input_line, $$rtoken_map[$im], $num ) );
+ }
+ }
+ $im = $i;
+ }
+
+ $num = length($input_line) - $$rtoken_map[$im]; # make the last token
+ if ( $num > 0 ) {
+ push( @tokens, substr( $input_line, $$rtoken_map[$im], $num ) );
+ }
+
+ $tokenizer_self->{_in_attribute_list} = $in_attribute_list;
+ $tokenizer_self->{_in_quote} = $in_quote;
+ $tokenizer_self->{_quote_target} =
+ $in_quote ? matching_end_token($quote_character) : "";
+ $tokenizer_self->{_rhere_target_list} = $rhere_target_list;
+
+ $line_of_tokens->{_rtoken_type} = \@token_type;
+ $line_of_tokens->{_rtokens} = \@tokens;
+ $line_of_tokens->{_rblock_type} = \@block_type;
+ $line_of_tokens->{_rcontainer_type} = \@container_type;
+ $line_of_tokens->{_rcontainer_environment} = \@container_environment;
+ $line_of_tokens->{_rtype_sequence} = \@type_sequence;
+ $line_of_tokens->{_rlevels} = \@levels;
+ $line_of_tokens->{_rslevels} = \@slevels;
+ $line_of_tokens->{_rnesting_tokens} = \@nesting_tokens;
+ $line_of_tokens->{_rci_levels} = \@ci_string;
+ $line_of_tokens->{_rnesting_blocks} = \@nesting_blocks;
+
+ return;
+ }
+} # end tokenize_this_line
+
+#########i#############################################################
+# Tokenizer routines which assist in identifying token types
+#######################################################################
+
+sub operator_expected {
+
+ # Many perl symbols have two or more meanings. For example, '<<'
+ # can be a shift operator or a here-doc operator. The
+ # interpretation of these symbols depends on the current state of
+ # the tokenizer, which may either be expecting a term or an
+ # operator. For this example, a << would be a shift if an operator
+ # is expected, and a here-doc if a term is expected. This routine
+ # is called to make this decision for any current token. It returns
+ # one of three possible values:
+ #
+ # OPERATOR - operator expected (or at least, not a term)
+ # UNKNOWN - can't tell
+ # TERM - a term is expected (or at least, not an operator)
+ #
+ # The decision is based on what has been seen so far. This
+ # information is stored in the "$last_nonblank_type" and
+ # "$last_nonblank_token" variables. For example, if the
+ # $last_nonblank_type is '=~', then we are expecting a TERM, whereas
+ # if $last_nonblank_type is 'n' (numeric), we are expecting an
+ # OPERATOR.
+ #
+ # If a UNKNOWN is returned, the calling routine must guess. A major
+ # goal of this tokenizer is to minimize the possiblity of returning
+ # UNKNOWN, because a wrong guess can spoil the formatting of a
+ # script.
+ #
+ # adding NEW_TOKENS: it is critically important that this routine be
+ # updated to allow it to determine if an operator or term is to be
+ # expected after the new token. Doing this simply involves adding
+ # the new token character to one of the regexes in this routine or
+ # to one of the hash lists
+ # that it uses, which are initialized in the BEGIN section.
+ # USES GLOBAL VARIABLES: $last_nonblank_type, $last_nonblank_token,
+ # $statement_type
+
+ my ( $prev_type, $tok, $next_type ) = @_;
+
+ my $op_expected = UNKNOWN;
+
+#print "tok=$tok last type=$last_nonblank_type last tok=$last_nonblank_token\n";
+
+# Note: function prototype is available for token type 'U' for future
+# program development. It contains the leading and trailing parens,
+# and no blanks. It might be used to eliminate token type 'C', for
+# example (prototype = '()'). Thus:
+# if ($last_nonblank_type eq 'U') {
+# print "previous token=$last_nonblank_token type=$last_nonblank_type prototype=$last_nonblank_prototype\n";
+# }
+
+ # A possible filehandle (or object) requires some care...
+ if ( $last_nonblank_type eq 'Z' ) {
+
+ # angle.t
+ if ( $last_nonblank_token =~ /^[A-Za-z_]/ ) {
+ $op_expected = UNKNOWN;
+ }
+
+ # For possible file handle like "$a", Perl uses weird parsing rules.
+ # For example:
+ # print $a/2,"/hi"; - division
+ # print $a / 2,"/hi"; - division
+ # print $a/ 2,"/hi"; - division
+ # print $a /2,"/hi"; - pattern (and error)!
+ elsif ( ( $prev_type eq 'b' ) && ( $next_type ne 'b' ) ) {
+ $op_expected = TERM;
+ }
+
+ # Note when an operation is being done where a
+ # filehandle might be expected, since a change in whitespace
+ # could change the interpretation of the statement.
+ else {
+ if ( $tok =~ /^([x\/\+\-\*\%\&\.\?\<]|\>\>)$/ ) {
+ complain("operator in print statement not recommended\n");
+ $op_expected = OPERATOR;
+ }
+ }
+ }
+
+ # handle something after 'do' and 'eval'
+ elsif ( $is_block_operator{$last_nonblank_token} ) {
+
+ # something like $a = eval "expression";
+ # ^
+ if ( $last_nonblank_type eq 'k' ) {
+ $op_expected = TERM; # expression or list mode following keyword
+ }
+
+ # something like $a = do { BLOCK } / 2;
+ # ^
+ else {
+ $op_expected = OPERATOR; # block mode following }
+ }
+ }
+
+ # handle bare word..
+ elsif ( $last_nonblank_type eq 'w' ) {
+
+ # unfortunately, we can't tell what type of token to expect next
+ # after most bare words
+ $op_expected = UNKNOWN;
+ }
+
+ # operator, but not term possible after these types
+ # Note: moved ')' from type to token because parens in list context
+ # get marked as '{' '}' now. This is a minor glitch in the following:
+ # my %opts = (ref $_[0] eq 'HASH') ? %{shift()} : ();
+ #
+ elsif (( $last_nonblank_type =~ /^[\]RnviQh]$/ )
+ || ( $last_nonblank_token =~ /^(\)|\$|\-\>)/ ) )
+ {
+ $op_expected = OPERATOR;
+
+ # in a 'use' statement, numbers and v-strings are not true
+ # numbers, so to avoid incorrect error messages, we will
+ # mark them as unknown for now (use.t)
+ # TODO: it would be much nicer to create a new token V for VERSION
+ # number in a use statement. Then this could be a check on type V
+ # and related patches which change $statement_type for '=>'
+ # and ',' could be removed. Further, it would clean things up to
+ # scan the 'use' statement with a separate subroutine.
+ if ( ( $statement_type eq 'use' )
+ && ( $last_nonblank_type =~ /^[nv]$/ ) )
+ {
+ $op_expected = UNKNOWN;
+ }
+ }
+
+ # no operator after many keywords, such as "die", "warn", etc
+ elsif ( $expecting_term_token{$last_nonblank_token} ) {
+
+ # patch for dor.t (defined or).
+ # perl functions which may be unary operators
+ # TODO: This list is incomplete, and these should be put
+ # into a hash.
+ if ( $tok eq '/'
+ && $next_type eq '/'
+ && $last_nonblank_type eq 'k'
+ && $last_nonblank_token =~ /^eof|undef|shift|pop$/ )
+ {
+ $op_expected = OPERATOR;
+ }
+ else {
+ $op_expected = TERM;
+ }
+ }
+
+ # no operator after things like + - ** (i.e., other operators)
+ elsif ( $expecting_term_types{$last_nonblank_type} ) {
+ $op_expected = TERM;
+ }
+
+ # a few operators, like "time", have an empty prototype () and so
+ # take no parameters but produce a value to operate on
+ elsif ( $expecting_operator_token{$last_nonblank_token} ) {
+ $op_expected = OPERATOR;
+ }
+
+ # post-increment and decrement produce values to be operated on
+ elsif ( $expecting_operator_types{$last_nonblank_type} ) {
+ $op_expected = OPERATOR;
+ }
+
+ # no value to operate on after sub block
+ elsif ( $last_nonblank_token =~ /^sub\s/ ) { $op_expected = TERM; }
+
+ # a right brace here indicates the end of a simple block.
+ # all non-structural right braces have type 'R'
+ # all braces associated with block operator keywords have been given those
+ # keywords as "last_nonblank_token" and caught above.
+ # (This statement is order dependent, and must come after checking
+ # $last_nonblank_token).
+ elsif ( $last_nonblank_type eq '}' ) {
+
+ # patch for dor.t (defined or).
+ if ( $tok eq '/'
+ && $next_type eq '/'
+ && $last_nonblank_token eq ']' )
+ {
+ $op_expected = OPERATOR;
+ }
+ else {
+ $op_expected = TERM;
+ }
+ }
+
+ # something else..what did I forget?
+ else {
+
+ # collecting diagnostics on unknown operator types..see what was missed
+ $op_expected = UNKNOWN;
+ write_diagnostics(
+"OP: unknown after type=$last_nonblank_type token=$last_nonblank_token\n"
+ );
+ }
+
+ TOKENIZER_DEBUG_FLAG_EXPECT && do {
+ print
+"EXPECT: returns $op_expected for last type $last_nonblank_type token $last_nonblank_token\n";
+ };
+ return $op_expected;
+}
+
+sub new_statement_ok {
+
+ # return true if the current token can start a new statement
+ # USES GLOBAL VARIABLES: $last_nonblank_type
+
+ return label_ok() # a label would be ok here
+
+ || $last_nonblank_type eq 'J'; # or we follow a label
+
+}
+
+sub label_ok {
+
+ # Decide if a bare word followed by a colon here is a label
+ # USES GLOBAL VARIABLES: $last_nonblank_token, $last_nonblank_type,
+ # $brace_depth, @brace_type
+
+ # if it follows an opening or closing code block curly brace..
+ if ( ( $last_nonblank_token eq '{' || $last_nonblank_token eq '}' )
+ && $last_nonblank_type eq $last_nonblank_token )
+ {
+
+ # it is a label if and only if the curly encloses a code block
+ return $brace_type[$brace_depth];
+ }
+
+ # otherwise, it is a label if and only if it follows a ';'
+ # (real or fake)
+ else {
+ return ( $last_nonblank_type eq ';' );
+ }
+}
+
+sub code_block_type {
+
+ # Decide if this is a block of code, and its type.
+ # Must be called only when $type = $token = '{'
+ # The problem is to distinguish between the start of a block of code
+ # and the start of an anonymous hash reference
+ # Returns "" if not code block, otherwise returns 'last_nonblank_token'
+ # to indicate the type of code block. (For example, 'last_nonblank_token'
+ # might be 'if' for an if block, 'else' for an else block, etc).
+ # USES GLOBAL VARIABLES: $last_nonblank_token, $last_nonblank_type,
+ # $last_nonblank_block_type, $brace_depth, @brace_type
+
+ # handle case of multiple '{'s
+
+# print "BLOCK_TYPE EXAMINING: type=$last_nonblank_type tok=$last_nonblank_token\n";
+
+ my ( $i, $rtokens, $rtoken_type, $max_token_index ) = @_;
+ if ( $last_nonblank_token eq '{'
+ && $last_nonblank_type eq $last_nonblank_token )
+ {
+
+ # opening brace where a statement may appear is probably
+ # a code block but might be and anonymous hash reference
+ if ( $brace_type[$brace_depth] ) {
+ return decide_if_code_block( $i, $rtokens, $rtoken_type,
+ $max_token_index );
+ }
+
+ # cannot start a code block within an anonymous hash
+ else {
+ return "";
+ }
+ }
+
+ elsif ( $last_nonblank_token eq ';' ) {
+
+ # an opening brace where a statement may appear is probably
+ # a code block but might be and anonymous hash reference
+ return decide_if_code_block( $i, $rtokens, $rtoken_type,
+ $max_token_index );
+ }
+
+ # handle case of '}{'
+ elsif ($last_nonblank_token eq '}'
+ && $last_nonblank_type eq $last_nonblank_token )
+ {
+
+ # a } { situation ...
+ # could be hash reference after code block..(blktype1.t)
+ if ($last_nonblank_block_type) {
+ return decide_if_code_block( $i, $rtokens, $rtoken_type,
+ $max_token_index );
+ }
+
+ # must be a block if it follows a closing hash reference
+ else {
+ return $last_nonblank_token;
+ }
+ }
+
+ # NOTE: braces after type characters start code blocks, but for
+ # simplicity these are not identified as such. See also
+ # sub is_non_structural_brace.
+ # elsif ( $last_nonblank_type eq 't' ) {
+ # return $last_nonblank_token;
+ # }
+
+ # brace after label:
+ elsif ( $last_nonblank_type eq 'J' ) {
+ return $last_nonblank_token;
+ }
+
+# otherwise, look at previous token. This must be a code block if
+# it follows any of these:
+# /^(BEGIN|END|CHECK|INIT|AUTOLOAD|DESTROY|UNITCHECK|continue|if|elsif|else|unless|do|while|until|eval|for|foreach|map|grep|sort)$/
+ elsif ( $is_code_block_token{$last_nonblank_token} ) {
+ return $last_nonblank_token;
+ }
+
+ # or a sub definition
+ elsif ( ( $last_nonblank_type eq 'i' || $last_nonblank_type eq 't' )
+ && $last_nonblank_token =~ /^sub\b/ )
+ {
+ return $last_nonblank_token;
+ }
+
+ # user-defined subs with block parameters (like grep/map/eval)
+ elsif ( $last_nonblank_type eq 'G' ) {
+ return $last_nonblank_token;
+ }
+
+ # check bareword
+ elsif ( $last_nonblank_type eq 'w' ) {
+ return decide_if_code_block( $i, $rtokens, $rtoken_type,
+ $max_token_index );
+ }
+
+ # anything else must be anonymous hash reference
+ else {
+ return "";
+ }
+}
+
+sub decide_if_code_block {
+
+ # USES GLOBAL VARIABLES: $last_nonblank_token
+ my ( $i, $rtokens, $rtoken_type, $max_token_index ) = @_;
+ my ( $next_nonblank_token, $i_next ) =
+ find_next_nonblank_token( $i, $rtokens, $max_token_index );
+
+ # we are at a '{' where a statement may appear.
+ # We must decide if this brace starts an anonymous hash or a code
+ # block.
+ # return "" if anonymous hash, and $last_nonblank_token otherwise
+
+ # initialize to be code BLOCK
+ my $code_block_type = $last_nonblank_token;
+
+ # Check for the common case of an empty anonymous hash reference:
+ # Maybe something like sub { { } }
+ if ( $next_nonblank_token eq '}' ) {
+ $code_block_type = "";
+ }
+
+ else {
+
+ # To guess if this '{' is an anonymous hash reference, look ahead
+ # and test as follows:
+ #
+ # it is a hash reference if next come:
+ # - a string or digit followed by a comma or =>
+ # - bareword followed by =>
+ # otherwise it is a code block
+ #
+ # Examples of anonymous hash ref:
+ # {'aa',};
+ # {1,2}
+ #
+ # Examples of code blocks:
+ # {1; print "hello\n", 1;}
+ # {$a,1};
+
+ # We are only going to look ahead one more (nonblank/comment) line.
+ # Strange formatting could cause a bad guess, but that's unlikely.
+ my @pre_types = @$rtoken_type[ $i + 1 .. $max_token_index ];
+ my @pre_tokens = @$rtokens[ $i + 1 .. $max_token_index ];
+ my ( $rpre_tokens, $rpre_types ) =
+ peek_ahead_for_n_nonblank_pre_tokens(20); # 20 is arbitrary but
+ # generous, and prevents
+ # wasting lots of
+ # time in mangled files
+ if ( defined($rpre_types) && @$rpre_types ) {
+ push @pre_types, @$rpre_types;
+ push @pre_tokens, @$rpre_tokens;
+ }
+
+ # put a sentinal token to simplify stopping the search
+ push @pre_types, '}';
+
+ my $jbeg = 0;
+ $jbeg = 1 if $pre_types[0] eq 'b';
+
+ # first look for one of these
+ # - bareword
+ # - bareword with leading -
+ # - digit
+ # - quoted string
+ my $j = $jbeg;
+ if ( $pre_types[$j] =~ /^[\'\"]/ ) {
+
+ # find the closing quote; don't worry about escapes
+ my $quote_mark = $pre_types[$j];
+ for ( my $k = $j + 1 ; $k < $#pre_types ; $k++ ) {
+ if ( $pre_types[$k] eq $quote_mark ) {
+ $j = $k + 1;
+ my $next = $pre_types[$j];
+ last;
+ }
+ }
+ }
+ elsif ( $pre_types[$j] eq 'd' ) {
+ $j++;
+ }
+ elsif ( $pre_types[$j] eq 'w' ) {
+ unless ( $is_keyword{ $pre_tokens[$j] } ) {
+ $j++;
+ }
+ }
+ elsif ( $pre_types[$j] eq '-' && $pre_types[ ++$j ] eq 'w' ) {
+ $j++;
+ }
+ if ( $j > $jbeg ) {
+
+ $j++ if $pre_types[$j] eq 'b';
+
+ # it's a hash ref if a comma or => follow next
+ if ( $pre_types[$j] eq ','
+ || ( $pre_types[$j] eq '=' && $pre_types[ ++$j ] eq '>' ) )
+ {
+ $code_block_type = "";
+ }
+ }
+ }
+
+ return $code_block_type;
+}
+
+sub unexpected {
+
+ # report unexpected token type and show where it is
+ # USES GLOBAL VARIABLES: $tokenizer_self
+ my ( $found, $expecting, $i_tok, $last_nonblank_i, $rpretoken_map,
+ $rpretoken_type, $input_line )
+ = @_;
+
+ if ( ++$tokenizer_self->{_unexpected_error_count} <= MAX_NAG_MESSAGES ) {
+ my $msg = "found $found where $expecting expected";
+ my $pos = $$rpretoken_map[$i_tok];
+ interrupt_logfile();
+ my $input_line_number = $tokenizer_self->{_last_line_number};
+ my ( $offset, $numbered_line, $underline ) =
+ make_numbered_line( $input_line_number, $input_line, $pos );
+ $underline = write_on_underline( $underline, $pos - $offset, '^' );
+
+ my $trailer = "";
+ if ( ( $i_tok > 0 ) && ( $last_nonblank_i >= 0 ) ) {
+ my $pos_prev = $$rpretoken_map[$last_nonblank_i];
+ my $num;
+ if ( $$rpretoken_type[ $i_tok - 1 ] eq 'b' ) {
+ $num = $$rpretoken_map[ $i_tok - 1 ] - $pos_prev;
+ }
+ else {
+ $num = $pos - $pos_prev;
+ }
+ if ( $num > 40 ) { $num = 40; $pos_prev = $pos - 40; }
+
+ $underline =
+ write_on_underline( $underline, $pos_prev - $offset, '-' x $num );
+ $trailer = " (previous token underlined)";
+ }
+ warning( $numbered_line . "\n" );
+ warning( $underline . "\n" );
+ warning( $msg . $trailer . "\n" );
+ resume_logfile();
+ }
+}
+
+sub is_non_structural_brace {
+
+ # Decide if a brace or bracket is structural or non-structural
+ # by looking at the previous token and type
+ # USES GLOBAL VARIABLES: $last_nonblank_type, $last_nonblank_token
+
+ # EXPERIMENTAL: Mark slices as structural; idea was to improve formatting.
+ # Tentatively deactivated because it caused the wrong operator expectation
+ # for this code:
+ # $user = @vars[1] / 100;
+ # Must update sub operator_expected before re-implementing.
+ # if ( $last_nonblank_type eq 'i' && $last_nonblank_token =~ /^@/ ) {
+ # return 0;
+ # }
+
+ # NOTE: braces after type characters start code blocks, but for
+ # simplicity these are not identified as such. See also
+ # sub code_block_type
+ # if ($last_nonblank_type eq 't') {return 0}
+
+ # otherwise, it is non-structural if it is decorated
+ # by type information.
+ # For example, the '{' here is non-structural: ${xxx}
+ (
+ $last_nonblank_token =~ /^([\$\@\*\&\%\)]|->|::)/
+
+ # or if we follow a hash or array closing curly brace or bracket
+ # For example, the second '{' in this is non-structural: $a{'x'}{'y'}
+ # because the first '}' would have been given type 'R'
+ || $last_nonblank_type =~ /^([R\]])$/
+ );
+}
+
+#########i#############################################################
+# Tokenizer routines for tracking container nesting depths
+#######################################################################
+
+# The following routines keep track of nesting depths of the nesting
+# types, ( [ { and ?. This is necessary for determining the indentation
+# level, and also for debugging programs. Not only do they keep track of
+# nesting depths of the individual brace types, but they check that each
+# of the other brace types is balanced within matching pairs. For
+# example, if the program sees this sequence:
+#
+# { ( ( ) }
+#
+# then it can determine that there is an extra left paren somewhere
+# between the { and the }. And so on with every other possible
+# combination of outer and inner brace types. For another
+# example:
+#
+# ( [ ..... ] ] )
+#
+# which has an extra ] within the parens.
+#
+# The brace types have indexes 0 .. 3 which are indexes into
+# the matrices.
+#
+# The pair ? : are treated as just another nesting type, with ? acting
+# as the opening brace and : acting as the closing brace.
+#
+# The matrix
+#
+# $depth_array[$a][$b][ $current_depth[$a] ] = $current_depth[$b];
+#
+# saves the nesting depth of brace type $b (where $b is either of the other
+# nesting types) when brace type $a enters a new depth. When this depth
+# decreases, a check is made that the current depth of brace types $b is
+# unchanged, or otherwise there must have been an error. This can
+# be very useful for localizing errors, particularly when perl runs to
+# the end of a large file (such as this one) and announces that there
+# is a problem somewhere.
+#
+# A numerical sequence number is maintained for every nesting type,
+# so that each matching pair can be uniquely identified in a simple
+# way.
+
+sub increase_nesting_depth {
+ my ( $aa, $pos ) = @_;
+
+ # USES GLOBAL VARIABLES: $tokenizer_self, @current_depth,
+ # @current_sequence_number, @depth_array, @starting_line_of_current_depth
+ my $bb;
+ $current_depth[$aa]++;
+ $total_depth++;
+ $total_depth[$aa][ $current_depth[$aa] ] = $total_depth;
+ my $input_line_number = $tokenizer_self->{_last_line_number};
+ my $input_line = $tokenizer_self->{_line_text};
+
+ # Sequence numbers increment by number of items. This keeps
+ # a unique set of numbers but still allows the relative location
+ # of any type to be determined.
+ $nesting_sequence_number[$aa] += scalar(@closing_brace_names);
+ my $seqno = $nesting_sequence_number[$aa];
+ $current_sequence_number[$aa][ $current_depth[$aa] ] = $seqno;
+
+ $starting_line_of_current_depth[$aa][ $current_depth[$aa] ] =
+ [ $input_line_number, $input_line, $pos ];
+
+ for $bb ( 0 .. $#closing_brace_names ) {
+ next if ( $bb == $aa );
+ $depth_array[$aa][$bb][ $current_depth[$aa] ] = $current_depth[$bb];
+ }
+
+ # set a flag for indenting a nested ternary statement
+ my $indent = 0;
+ if ( $aa == QUESTION_COLON ) {
+ $nested_ternary_flag[ $current_depth[$aa] ] = 0;
+ if ( $current_depth[$aa] > 1 ) {
+ if ( $nested_ternary_flag[ $current_depth[$aa] - 1 ] == 0 ) {
+ my $pdepth = $total_depth[$aa][ $current_depth[$aa] - 1 ];
+ if ( $pdepth == $total_depth - 1 ) {
+ $indent = 1;
+ $nested_ternary_flag[ $current_depth[$aa] - 1 ] = -1;
+ }
+ }
+ }
+ }
+ return ( $seqno, $indent );
+}
+
+sub decrease_nesting_depth {
+
+ my ( $aa, $pos ) = @_;
+
+ # USES GLOBAL VARIABLES: $tokenizer_self, @current_depth,
+ # @current_sequence_number, @depth_array, @starting_line_of_current_depth
+ my $bb;
+ my $seqno = 0;
+ my $input_line_number = $tokenizer_self->{_last_line_number};
+ my $input_line = $tokenizer_self->{_line_text};
+
+ my $outdent = 0;
+ $total_depth--;
+ if ( $current_depth[$aa] > 0 ) {
+
+ # set a flag for un-indenting after seeing a nested ternary statement
+ $seqno = $current_sequence_number[$aa][ $current_depth[$aa] ];
+ if ( $aa == QUESTION_COLON ) {
+ $outdent = $nested_ternary_flag[ $current_depth[$aa] ];
+ }
+
+ # check that any brace types $bb contained within are balanced
+ for $bb ( 0 .. $#closing_brace_names ) {
+ next if ( $bb == $aa );
+
+ unless ( $depth_array[$aa][$bb][ $current_depth[$aa] ] ==
+ $current_depth[$bb] )
+ {
+ my $diff =
+ $current_depth[$bb] -
+ $depth_array[$aa][$bb][ $current_depth[$aa] ];
+
+ # don't whine too many times
+ my $saw_brace_error = get_saw_brace_error();
+ if (
+ $saw_brace_error <= MAX_NAG_MESSAGES
+
+ # if too many closing types have occured, we probably
+ # already caught this error
+ && ( ( $diff > 0 ) || ( $saw_brace_error <= 0 ) )
+ )
+ {
+ interrupt_logfile();
+ my $rsl =
+ $starting_line_of_current_depth[$aa]
+ [ $current_depth[$aa] ];
+ my $sl = $$rsl[0];
+ my $rel = [ $input_line_number, $input_line, $pos ];
+ my $el = $$rel[0];
+ my ($ess);
+
+ if ( $diff == 1 || $diff == -1 ) {
+ $ess = '';
+ }
+ else {
+ $ess = 's';
+ }
+ my $bname =
+ ( $diff > 0 )
+ ? $opening_brace_names[$bb]
+ : $closing_brace_names[$bb];
+ write_error_indicator_pair( @$rsl, '^' );
+ my $msg = <<"EOM";
+Found $diff extra $bname$ess between $opening_brace_names[$aa] on line $sl and $closing_brace_names[$aa] on line $el
+EOM
+
+ if ( $diff > 0 ) {
+ my $rml =
+ $starting_line_of_current_depth[$bb]
+ [ $current_depth[$bb] ];
+ my $ml = $$rml[0];
+ $msg .=
+" The most recent un-matched $bname is on line $ml\n";
+ write_error_indicator_pair( @$rml, '^' );
+ }
+ write_error_indicator_pair( @$rel, '^' );
+ warning($msg);
+ resume_logfile();
+ }
+ increment_brace_error();
+ }
+ }
+ $current_depth[$aa]--;
+ }
+ else {
+
+ my $saw_brace_error = get_saw_brace_error();
+ if ( $saw_brace_error <= MAX_NAG_MESSAGES ) {
+ my $msg = <<"EOM";
+There is no previous $opening_brace_names[$aa] to match a $closing_brace_names[$aa] on line $input_line_number
+EOM
+ indicate_error( $msg, $input_line_number, $input_line, $pos, '^' );
+ }
+ increment_brace_error();
+ }
+ return ( $seqno, $outdent );
+}
+
+sub check_final_nesting_depths {
+ my ($aa);
+
+ # USES GLOBAL VARIABLES: @current_depth, @starting_line_of_current_depth
+
+ for $aa ( 0 .. $#closing_brace_names ) {
+
+ if ( $current_depth[$aa] ) {
+ my $rsl =
+ $starting_line_of_current_depth[$aa][ $current_depth[$aa] ];
+ my $sl = $$rsl[0];
+ my $msg = <<"EOM";
+Final nesting depth of $opening_brace_names[$aa]s is $current_depth[$aa]
+The most recent un-matched $opening_brace_names[$aa] is on line $sl
+EOM
+ indicate_error( $msg, @$rsl, '^' );
+ increment_brace_error();
+ }
+ }
+}
+
+#########i#############################################################
+# Tokenizer routines for looking ahead in input stream
+#######################################################################
+
+sub peek_ahead_for_n_nonblank_pre_tokens {
+
+ # returns next n pretokens if they exist
+ # returns undef's if hits eof without seeing any pretokens
+ # USES GLOBAL VARIABLES: $tokenizer_self
+ my $max_pretokens = shift;
+ my $line;
+ my $i = 0;
+ my ( $rpre_tokens, $rmap, $rpre_types );
+
+ while ( $line = $tokenizer_self->{_line_buffer_object}->peek_ahead( $i++ ) )
+ {
+ $line =~ s/^\s*//; # trim leading blanks
+ next if ( length($line) <= 0 ); # skip blank
+ next if ( $line =~ /^#/ ); # skip comment
+ ( $rpre_tokens, $rmap, $rpre_types ) =
+ pre_tokenize( $line, $max_pretokens );
+ last;
+ }
+ return ( $rpre_tokens, $rpre_types );
+}
+
+# look ahead for next non-blank, non-comment line of code
+sub peek_ahead_for_nonblank_token {
+
+ # USES GLOBAL VARIABLES: $tokenizer_self
+ my ( $rtokens, $max_token_index ) = @_;
+ my $line;
+ my $i = 0;
+
+ while ( $line = $tokenizer_self->{_line_buffer_object}->peek_ahead( $i++ ) )
+ {
+ $line =~ s/^\s*//; # trim leading blanks
+ next if ( length($line) <= 0 ); # skip blank
+ next if ( $line =~ /^#/ ); # skip comment
+ my ( $rtok, $rmap, $rtype ) =
+ pre_tokenize( $line, 2 ); # only need 2 pre-tokens
+ my $j = $max_token_index + 1;
+ my $tok;
+
+ foreach $tok (@$rtok) {
+ last if ( $tok =~ "\n" );
+ $$rtokens[ ++$j ] = $tok;
+ }
+ last;
+ }
+ return $rtokens;
+}
+
+#########i#############################################################
+# Tokenizer guessing routines for ambiguous situations
+#######################################################################
+
+sub guess_if_pattern_or_conditional {
+
+ # this routine is called when we have encountered a ? following an
+ # unknown bareword, and we must decide if it starts a pattern or not
+ # input parameters:
+ # $i - token index of the ? starting possible pattern
+ # output parameters:
+ # $is_pattern = 0 if probably not pattern, =1 if probably a pattern
+ # msg = a warning or diagnostic message
+ # USES GLOBAL VARIABLES: $last_nonblank_token
+ my ( $i, $rtokens, $rtoken_map, $max_token_index ) = @_;
+ my $is_pattern = 0;
+ my $msg = "guessing that ? after $last_nonblank_token starts a ";
+
+ if ( $i >= $max_token_index ) {
+ $msg .= "conditional (no end to pattern found on the line)\n";
+ }
+ else {
+ my $ibeg = $i;
+ $i = $ibeg + 1;
+ my $next_token = $$rtokens[$i]; # first token after ?
+
+ # look for a possible ending ? on this line..
+ my $in_quote = 1;
+ my $quote_depth = 0;
+ my $quote_character = '';
+ my $quote_pos = 0;
+ my $quoted_string;
+ (
+ $i, $in_quote, $quote_character, $quote_pos, $quote_depth,
+ $quoted_string
+ )
+ = follow_quoted_string( $ibeg, $in_quote, $rtokens, $quote_character,
+ $quote_pos, $quote_depth, $max_token_index );
+
+ if ($in_quote) {
+
+ # we didn't find an ending ? on this line,
+ # so we bias towards conditional
+ $is_pattern = 0;
+ $msg .= "conditional (no ending ? on this line)\n";
+
+ # we found an ending ?, so we bias towards a pattern
+ }
+ else {
+
+ if ( pattern_expected( $i, $rtokens, $max_token_index ) >= 0 ) {
+ $is_pattern = 1;
+ $msg .= "pattern (found ending ? and pattern expected)\n";
+ }
+ else {
+ $msg .= "pattern (uncertain, but found ending ?)\n";
+ }
+ }
+ }
+ return ( $is_pattern, $msg );
+}
+
+sub guess_if_pattern_or_division {
+
+ # this routine is called when we have encountered a / following an
+ # unknown bareword, and we must decide if it starts a pattern or is a
+ # division
+ # input parameters:
+ # $i - token index of the / starting possible pattern
+ # output parameters:
+ # $is_pattern = 0 if probably division, =1 if probably a pattern
+ # msg = a warning or diagnostic message
+ # USES GLOBAL VARIABLES: $last_nonblank_token
+ my ( $i, $rtokens, $rtoken_map, $max_token_index ) = @_;
+ my $is_pattern = 0;
+ my $msg = "guessing that / after $last_nonblank_token starts a ";
+
+ if ( $i >= $max_token_index ) {
+ "division (no end to pattern found on the line)\n";
+ }
+ else {
+ my $ibeg = $i;
+ my $divide_expected =
+ numerator_expected( $i, $rtokens, $max_token_index );
+ $i = $ibeg + 1;
+ my $next_token = $$rtokens[$i]; # first token after slash
+
+ # look for a possible ending / on this line..
+ my $in_quote = 1;
+ my $quote_depth = 0;
+ my $quote_character = '';
+ my $quote_pos = 0;
+ my $quoted_string;
+ (
+ $i, $in_quote, $quote_character, $quote_pos, $quote_depth,
+ $quoted_string
+ )
+ = follow_quoted_string( $ibeg, $in_quote, $rtokens, $quote_character,
+ $quote_pos, $quote_depth, $max_token_index );
+
+ if ($in_quote) {
+
+ # we didn't find an ending / on this line,
+ # so we bias towards division
+ if ( $divide_expected >= 0 ) {
+ $is_pattern = 0;
+ $msg .= "division (no ending / on this line)\n";
+ }
+ else {
+ $msg = "multi-line pattern (division not possible)\n";
+ $is_pattern = 1;
+ }
+
+ }
+
+ # we found an ending /, so we bias towards a pattern
+ else {
+
+ if ( pattern_expected( $i, $rtokens, $max_token_index ) >= 0 ) {
+
+ if ( $divide_expected >= 0 ) {
+
+ if ( $i - $ibeg > 60 ) {
+ $msg .= "division (matching / too distant)\n";
+ $is_pattern = 0;
+ }
+ else {
+ $msg .= "pattern (but division possible too)\n";
+ $is_pattern = 1;
+ }
+ }
+ else {
+ $is_pattern = 1;
+ $msg .= "pattern (division not possible)\n";
+ }
+ }
+ else {
+
+ if ( $divide_expected >= 0 ) {
+ $is_pattern = 0;
+ $msg .= "division (pattern not possible)\n";
+ }
+ else {
+ $is_pattern = 1;
+ $msg .=
+ "pattern (uncertain, but division would not work here)\n";
+ }
+ }
+ }
+ }
+ return ( $is_pattern, $msg );
+}
+
+# try to resolve here-doc vs. shift by looking ahead for
+# non-code or the end token (currently only looks for end token)
+# returns 1 if it is probably a here doc, 0 if not
+sub guess_if_here_doc {
+
+ # This is how many lines we will search for a target as part of the
+ # guessing strategy. It is a constant because there is probably
+ # little reason to change it.
+ # USES GLOBAL VARIABLES: $tokenizer_self, $current_package
+ # %is_constant,
+ use constant HERE_DOC_WINDOW => 40;
+
+ my $next_token = shift;
+ my $here_doc_expected = 0;
+ my $line;
+ my $k = 0;
+ my $msg = "checking <<";
+
+ while ( $line = $tokenizer_self->{_line_buffer_object}->peek_ahead( $k++ ) )
+ {
+ chomp $line;
+
+ if ( $line =~ /^$next_token$/ ) {
+ $msg .= " -- found target $next_token ahead $k lines\n";
+ $here_doc_expected = 1; # got it
+ last;
+ }
+ last if ( $k >= HERE_DOC_WINDOW );
+ }
+
+ unless ($here_doc_expected) {
+
+ if ( !defined($line) ) {
+ $here_doc_expected = -1; # hit eof without seeing target
+ $msg .= " -- must be shift; target $next_token not in file\n";
+
+ }
+ else { # still unsure..taking a wild guess
+
+ if ( !$is_constant{$current_package}{$next_token} ) {
+ $here_doc_expected = 1;
+ $msg .=
+ " -- guessing it's a here-doc ($next_token not a constant)\n";
+ }
+ else {
+ $msg .=
+ " -- guessing it's a shift ($next_token is a constant)\n";
+ }
+ }
+ }
+ write_logfile_entry($msg);
+ return $here_doc_expected;
+}
+
+#########i#############################################################
+# Tokenizer Routines for scanning identifiers and related items
+#######################################################################
+
+sub scan_bare_identifier_do {
+
+ # this routine is called to scan a token starting with an alphanumeric
+ # variable or package separator, :: or '.
+ # USES GLOBAL VARIABLES: $current_package, $last_nonblank_token,
+ # $last_nonblank_type,@paren_type, $paren_depth
+
+ my ( $input_line, $i, $tok, $type, $prototype, $rtoken_map,
+ $max_token_index )
+ = @_;
+ my $i_begin = $i;
+ my $package = undef;
+
+ my $i_beg = $i;
+
+ # we have to back up one pretoken at a :: since each : is one pretoken
+ if ( $tok eq '::' ) { $i_beg-- }
+ if ( $tok eq '->' ) { $i_beg-- }
+ my $pos_beg = $$rtoken_map[$i_beg];
+ pos($input_line) = $pos_beg;
+
+ # Examples:
+ # A::B::C
+ # A::
+ # ::A
+ # A'B
+ if ( $input_line =~ m/\G\s*((?:\w*(?:'|::)))*(?:(?:->)?(\w+))?/gc ) {
+
+ my $pos = pos($input_line);
+ my $numc = $pos - $pos_beg;
+ $tok = substr( $input_line, $pos_beg, $numc );
+
+ # type 'w' includes anything without leading type info
+ # ($,%,@,*) including something like abc::def::ghi
+ $type = 'w';
+
+ my $sub_name = "";
+ if ( defined($2) ) { $sub_name = $2; }
+ if ( defined($1) ) {
+ $package = $1;
+
+ # patch: don't allow isolated package name which just ends
+ # in the old style package separator (single quote). Example:
+ # use CGI':all';
+ if ( !($sub_name) && substr( $package, -1, 1 ) eq '\'' ) {
+ $pos--;
+ }
+
+ $package =~ s/\'/::/g;
+ if ( $package =~ /^\:/ ) { $package = 'main' . $package }
+ $package =~ s/::$//;
+ }
+ else {
+ $package = $current_package;
+
+ if ( $is_keyword{$tok} ) {
+ $type = 'k';
+ }
+ }
+
+ # if it is a bareword..
+ if ( $type eq 'w' ) {
+
+ # check for v-string with leading 'v' type character
+ # (This seems to have presidence over filehandle, type 'Y')
+ if ( $tok =~ /^v\d[_\d]*$/ ) {
+
+ # we only have the first part - something like 'v101' -
+ # look for more
+ if ( $input_line =~ m/\G(\.\d[_\d]*)+/gc ) {
+ $pos = pos($input_line);
+ $numc = $pos - $pos_beg;
+ $tok = substr( $input_line, $pos_beg, $numc );
+ }
+ $type = 'v';
+
+ # warn if this version can't handle v-strings
+ report_v_string($tok);
+ }
+
+ elsif ( $is_constant{$package}{$sub_name} ) {
+ $type = 'C';
+ }
+
+ # bareword after sort has implied empty prototype; for example:
+ # @sorted = sort numerically ( 53, 29, 11, 32, 7 );
+ # This has priority over whatever the user has specified.
+ elsif ($last_nonblank_token eq 'sort'
+ && $last_nonblank_type eq 'k' )
+ {
+ $type = 'Z';
+ }
+
+ # Note: strangely, perl does not seem to really let you create
+ # functions which act like eval and do, in the sense that eval
+ # and do may have operators following the final }, but any operators
+ # that you create with prototype (&) apparently do not allow
+ # trailing operators, only terms. This seems strange.
+ # If this ever changes, here is the update
+ # to make perltidy behave accordingly:
+
+ # elsif ( $is_block_function{$package}{$tok} ) {
+ # $tok='eval'; # patch to do braces like eval - doesn't work
+ # $type = 'k';
+ #}
+ # FIXME: This could become a separate type to allow for different
+ # future behavior:
+ elsif ( $is_block_function{$package}{$sub_name} ) {
+ $type = 'G';
+ }
+
+ elsif ( $is_block_list_function{$package}{$sub_name} ) {
+ $type = 'G';
+ }
+ elsif ( $is_user_function{$package}{$sub_name} ) {
+ $type = 'U';
+ $prototype = $user_function_prototype{$package}{$sub_name};
+ }
+
+ # check for indirect object
+ elsif (
+
+ # added 2001-03-27: must not be followed immediately by '('
+ # see fhandle.t
+ ( $input_line !~ m/\G\(/gc )
+
+ # and
+ && (
+
+ # preceded by keyword like 'print', 'printf' and friends
+ $is_indirect_object_taker{$last_nonblank_token}
+
+ # or preceded by something like 'print(' or 'printf('
+ || (
+ ( $last_nonblank_token eq '(' )
+ && $is_indirect_object_taker{ $paren_type[$paren_depth]
+ }
+
+ )
+ )
+ )
+ {
+
+ # may not be indirect object unless followed by a space
+ if ( $input_line =~ m/\G\s+/gc ) {
+ $type = 'Y';
+
+ # Abandon Hope ...
+ # Perl's indirect object notation is a very bad
+ # thing and can cause subtle bugs, especially for
+ # beginning programmers. And I haven't even been
+ # able to figure out a sane warning scheme which
+ # doesn't get in the way of good scripts.
+
+ # Complain if a filehandle has any lower case
+ # letters. This is suggested good practice.
+ # Use 'sub_name' because something like
+ # main::MYHANDLE is ok for filehandle
+ if ( $sub_name =~ /[a-z]/ ) {
+
+ # could be bug caused by older perltidy if
+ # followed by '('
+ if ( $input_line =~ m/\G\s*\(/gc ) {
+ complain(
+"Caution: unknown word '$tok' in indirect object slot\n"
+ );
+ }
+ }
+ }
+
+ # bareword not followed by a space -- may not be filehandle
+ # (may be function call defined in a 'use' statement)
+ else {
+ $type = 'Z';
+ }
+ }
+ }
+
+ # Now we must convert back from character position
+ # to pre_token index.
+ # I don't think an error flag can occur here ..but who knows
+ my $error;
+ ( $i, $error ) =
+ inverse_pretoken_map( $i, $pos, $rtoken_map, $max_token_index );
+ if ($error) {
+ warning("scan_bare_identifier: Possibly invalid tokenization\n");
+ }
+ }
+
+ # no match but line not blank - could be syntax error
+ # perl will take '::' alone without complaint
+ else {
+ $type = 'w';
+
+ # change this warning to log message if it becomes annoying
+ warning("didn't find identifier after leading ::\n");
+ }
+ return ( $i, $tok, $type, $prototype );
+}
+
+sub scan_id_do {
+
+# This is the new scanner and will eventually replace scan_identifier.
+# Only type 'sub' and 'package' are implemented.
+# Token types $ * % @ & -> are not yet implemented.
+#
+# Scan identifier following a type token.
+# The type of call depends on $id_scan_state: $id_scan_state = ''
+# for starting call, in which case $tok must be the token defining
+# the type.
+#
+# If the type token is the last nonblank token on the line, a value
+# of $id_scan_state = $tok is returned, indicating that further
+# calls must be made to get the identifier. If the type token is
+# not the last nonblank token on the line, the identifier is
+# scanned and handled and a value of '' is returned.
+# USES GLOBAL VARIABLES: $current_package, $last_nonblank_token, $in_attribute_list,
+# $statement_type, $tokenizer_self
+
+ my ( $input_line, $i, $tok, $rtokens, $rtoken_map, $id_scan_state,
+ $max_token_index )
+ = @_;
+ my $type = '';
+ my ( $i_beg, $pos_beg );
+
+ #print "NSCAN:entering i=$i, tok=$tok, type=$type, state=$id_scan_state\n";
+ #my ($a,$b,$c) = caller;
+ #print "NSCAN: scan_id called with tok=$tok $a $b $c\n";
+
+ # on re-entry, start scanning at first token on the line
+ if ($id_scan_state) {
+ $i_beg = $i;
+ $type = '';
+ }
+
+ # on initial entry, start scanning just after type token
+ else {
+ $i_beg = $i + 1;
+ $id_scan_state = $tok;
+ $type = 't';
+ }
+
+ # find $i_beg = index of next nonblank token,
+ # and handle empty lines
+ my $blank_line = 0;
+ my $next_nonblank_token = $$rtokens[$i_beg];
+ if ( $i_beg > $max_token_index ) {
+ $blank_line = 1;
+ }
+ else {
+
+ # only a '#' immediately after a '$' is not a comment
+ if ( $next_nonblank_token eq '#' ) {
+ unless ( $tok eq '$' ) {
+ $blank_line = 1;
+ }
+ }
+
+ if ( $next_nonblank_token =~ /^\s/ ) {
+ ( $next_nonblank_token, $i_beg ) =
+ find_next_nonblank_token_on_this_line( $i_beg, $rtokens,
+ $max_token_index );
+ if ( $next_nonblank_token =~ /(^#|^\s*$)/ ) {
+ $blank_line = 1;
+ }
+ }
+ }
+
+ # handle non-blank line; identifier, if any, must follow
+ unless ($blank_line) {
+
+ if ( $id_scan_state eq 'sub' ) {
+ ( $i, $tok, $type, $id_scan_state ) = do_scan_sub(
+ $input_line, $i, $i_beg,
+ $tok, $type, $rtokens,
+ $rtoken_map, $id_scan_state, $max_token_index
+ );
+ }
+
+ elsif ( $id_scan_state eq 'package' ) {
+ ( $i, $tok, $type ) =
+ do_scan_package( $input_line, $i, $i_beg, $tok, $type, $rtokens,
+ $rtoken_map, $max_token_index );
+ $id_scan_state = '';
+ }
+
+ else {
+ warning("invalid token in scan_id: $tok\n");
+ $id_scan_state = '';
+ }
+ }
+
+ if ( $id_scan_state && ( !defined($type) || !$type ) ) {
+
+ # shouldn't happen:
+ warning(
+"Program bug in scan_id: undefined type but scan_state=$id_scan_state\n"
+ );
+ report_definite_bug();
+ }
+
+ TOKENIZER_DEBUG_FLAG_NSCAN && do {
+ print
+ "NSCAN: returns i=$i, tok=$tok, type=$type, state=$id_scan_state\n";
+ };
+ return ( $i, $tok, $type, $id_scan_state );
+}
+
+sub check_prototype {
+ my ( $proto, $package, $subname ) = @_;
+ return unless ( defined($package) && defined($subname) );
+ if ( defined($proto) ) {
+ $proto =~ s/^\s*\(\s*//;
+ $proto =~ s/\s*\)$//;
+ if ($proto) {
+ $is_user_function{$package}{$subname} = 1;
+ $user_function_prototype{$package}{$subname} = "($proto)";
+
+ # prototypes containing '&' must be treated specially..
+ if ( $proto =~ /\&/ ) {
+
+ # right curly braces of prototypes ending in
+ # '&' may be followed by an operator
+ if ( $proto =~ /\&$/ ) {
+ $is_block_function{$package}{$subname} = 1;
+ }
+
+ # right curly braces of prototypes NOT ending in
+ # '&' may NOT be followed by an operator
+ elsif ( $proto !~ /\&$/ ) {
+ $is_block_list_function{$package}{$subname} = 1;
+ }
+ }
+ }
+ else {
+ $is_constant{$package}{$subname} = 1;
+ }
+ }
+ else {
+ $is_user_function{$package}{$subname} = 1;
+ }
+}
+
+sub do_scan_package {
+
+ # do_scan_package parses a package name
+ # it is called with $i_beg equal to the index of the first nonblank
+ # token following a 'package' token.
+ # USES GLOBAL VARIABLES: $current_package,
+
+ my ( $input_line, $i, $i_beg, $tok, $type, $rtokens, $rtoken_map,
+ $max_token_index )
+ = @_;
+ my $package = undef;
+ my $pos_beg = $$rtoken_map[$i_beg];
+ pos($input_line) = $pos_beg;
+
+ # handle non-blank line; package name, if any, must follow
+ if ( $input_line =~ m/\G\s*((?:\w*(?:'|::))*\w+)/gc ) {
+ $package = $1;
+ $package = ( defined($1) && $1 ) ? $1 : 'main';
+ $package =~ s/\'/::/g;
+ if ( $package =~ /^\:/ ) { $package = 'main' . $package }
+ $package =~ s/::$//;
+ my $pos = pos($input_line);
+ my $numc = $pos - $pos_beg;
+ $tok = 'package ' . substr( $input_line, $pos_beg, $numc );
+ $type = 'i';
+
+ # Now we must convert back from character position
+ # to pre_token index.
+ # I don't think an error flag can occur here ..but ?
+ my $error;
+ ( $i, $error ) =
+ inverse_pretoken_map( $i, $pos, $rtoken_map, $max_token_index );
+ if ($error) { warning("Possibly invalid package\n") }
+ $current_package = $package;
+
+ # check for error
+ my ( $next_nonblank_token, $i_next ) =
+ find_next_nonblank_token( $i, $rtokens, $max_token_index );
+ if ( $next_nonblank_token !~ /^[;\}]$/ ) {
+ warning(
+ "Unexpected '$next_nonblank_token' after package name '$tok'\n"
+ );
+ }
+ }
+
+ # no match but line not blank --
+ # could be a label with name package, like package: , for example.
+ else {
+ $type = 'k';
+ }
+
+ return ( $i, $tok, $type );
+}
+
+sub scan_identifier_do {
+
+ # This routine assembles tokens into identifiers. It maintains a
+ # scan state, id_scan_state. It updates id_scan_state based upon
+ # current id_scan_state and token, and returns an updated
+ # id_scan_state and the next index after the identifier.
+ # USES GLOBAL VARIABLES: $context, $last_nonblank_token,
+ # $last_nonblank_type
+
+ my ( $i, $id_scan_state, $identifier, $rtokens, $max_token_index,
+ $expecting )
+ = @_;
+ my $i_begin = $i;
+ my $type = '';
+ my $tok_begin = $$rtokens[$i_begin];
+ if ( $tok_begin eq ':' ) { $tok_begin = '::' }
+ my $id_scan_state_begin = $id_scan_state;
+ my $identifier_begin = $identifier;
+ my $tok = $tok_begin;
+ my $message = "";
+
+ # these flags will be used to help figure out the type:
+ my $saw_alpha = ( $tok =~ /^[A-Za-z_]/ );
+ my $saw_type;
+
+ # allow old package separator (') except in 'use' statement
+ my $allow_tick = ( $last_nonblank_token ne 'use' );
+
+ # get started by defining a type and a state if necessary
+ unless ($id_scan_state) {
+ $context = UNKNOWN_CONTEXT;
+
+ # fixup for digraph
+ if ( $tok eq '>' ) {
+ $tok = '->';
+ $tok_begin = $tok;
+ }
+ $identifier = $tok;
+
+ if ( $tok eq '$' || $tok eq '*' ) {
+ $id_scan_state = '$';
+ $context = SCALAR_CONTEXT;
+ }
+ elsif ( $tok eq '%' || $tok eq '@' ) {
+ $id_scan_state = '$';
+ $context = LIST_CONTEXT;
+ }
+ elsif ( $tok eq '&' ) {
+ $id_scan_state = '&';
+ }
+ elsif ( $tok eq 'sub' or $tok eq 'package' ) {
+ $saw_alpha = 0; # 'sub' is considered type info here
+ $id_scan_state = '$';
+ $identifier .= ' '; # need a space to separate sub from sub name
+ }
+ elsif ( $tok eq '::' ) {
+ $id_scan_state = 'A';
+ }
+ elsif ( $tok =~ /^[A-Za-z_]/ ) {
+ $id_scan_state = ':';
+ }
+ elsif ( $tok eq '->' ) {
+ $id_scan_state = '$';
+ }
+ else {
+
+ # shouldn't happen
+ my ( $a, $b, $c ) = caller;
+ warning("Program Bug: scan_identifier given bad token = $tok \n");
+ warning(" called from sub $a line: $c\n");
+ report_definite_bug();
+ }
+ $saw_type = !$saw_alpha;
+ }
+ else {
+ $i--;
+ $saw_type = ( $tok =~ /([\$\%\@\*\&])/ );
+ }
+
+ # now loop to gather the identifier
+ my $i_save = $i;
+
+ while ( $i < $max_token_index ) {
+ $i_save = $i unless ( $tok =~ /^\s*$/ );
+ $tok = $$rtokens[ ++$i ];
+
+ if ( ( $tok eq ':' ) && ( $$rtokens[ $i + 1 ] eq ':' ) ) {
+ $tok = '::';
+ $i++;
+ }
+
+ if ( $id_scan_state eq '$' ) { # starting variable name
+
+ if ( $tok eq '$' ) {
+
+ $identifier .= $tok;
+
+ # we've got a punctuation variable if end of line (punct.t)
+ if ( $i == $max_token_index ) {
+ $type = 'i';
+ $id_scan_state = '';
+ last;
+ }
+ }
+ elsif ( $tok =~ /^[A-Za-z_]/ ) { # alphanumeric ..
+ $saw_alpha = 1;
+ $id_scan_state = ':'; # now need ::
+ $identifier .= $tok;
+ }
+ elsif ( $tok eq "'" && $allow_tick ) { # alphanumeric ..
+ $saw_alpha = 1;
+ $id_scan_state = ':'; # now need ::
+ $identifier .= $tok;
+
+ # Perl will accept leading digits in identifiers,
+ # although they may not always produce useful results.
+ # Something like $main::0 is ok. But this also works:
+ #
+ # sub howdy::123::bubba{ print "bubba $54321!\n" }
+ # howdy::123::bubba();
+ #
+ }
+ elsif ( $tok =~ /^[0-9]/ ) { # numeric
+ $saw_alpha = 1;
+ $id_scan_state = ':'; # now need ::
+ $identifier .= $tok;
+ }
+ elsif ( $tok eq '::' ) {
+ $id_scan_state = 'A';
+ $identifier .= $tok;
+ }
+ elsif ( ( $tok eq '#' ) && ( $identifier eq '$' ) ) { # $#array
+ $identifier .= $tok; # keep same state, a $ could follow
+ }
+ elsif ( $tok eq '{' ) {
+
+ # check for something like ${#} or ${©}
+ if ( $identifier eq '$'
+ && $i + 2 <= $max_token_index
+ && $$rtokens[ $i + 2 ] eq '}'
+ && $$rtokens[ $i + 1 ] !~ /[\s\w]/ )
+ {
+ my $next2 = $$rtokens[ $i + 2 ];
+ my $next1 = $$rtokens[ $i + 1 ];
+ $identifier .= $tok . $next1 . $next2;
+ $i += 2;
+ $id_scan_state = '';
+ last;
+ }
+
+ # skip something like ${xxx} or ->{
+ $id_scan_state = '';
+
+ # if this is the first token of a line, any tokens for this
+ # identifier have already been accumulated
+ if ( $identifier eq '$' || $i == 0 ) { $identifier = ''; }
+ $i = $i_save;
+ last;
+ }
+
+ # space ok after leading $ % * & @
+ elsif ( $tok =~ /^\s*$/ ) {
+
+ if ( $identifier =~ /^[\$\%\*\&\@]/ ) {
+
+ if ( length($identifier) > 1 ) {
+ $id_scan_state = '';
+ $i = $i_save;
+ $type = 'i'; # probably punctuation variable
+ last;
+ }
+ else {
+
+ # spaces after $'s are common, and space after @
+ # is harmless, so only complain about space
+ # after other type characters. Space after $ and
+ # @ will be removed in formatting. Report space
+ # after % and * because they might indicate a
+ # parsing error. In other words '% ' might be a
+ # modulo operator. Delete this warning if it
+ # gets annoying.
+ if ( $identifier !~ /^[\@\$]$/ ) {
+ $message =
+ "Space in identifier, following $identifier\n";
+ }
+ }
+ }
+
+ # else:
+ # space after '->' is ok
+ }
+ elsif ( $tok eq '^' ) {
+
+ # check for some special variables like $^W
+ if ( $identifier =~ /^[\$\*\@\%]$/ ) {
+ $identifier .= $tok;
+ $id_scan_state = 'A';
+
+ # Perl accepts '$^]' or '@^]', but
+ # there must not be a space before the ']'.
+ my $next1 = $$rtokens[ $i + 1 ];
+ if ( $next1 eq ']' ) {
+ $i++;
+ $identifier .= $next1;
+ $id_scan_state = "";
+ last;
+ }
+ }
+ else {
+ $id_scan_state = '';
+ }
+ }
+ else { # something else
+
+ # check for various punctuation variables
+ if ( $identifier =~ /^[\$\*\@\%]$/ ) {
+ $identifier .= $tok;
+ }
+
+ elsif ( $identifier eq '$#' ) {
+
+ if ( $tok eq '{' ) { $type = 'i'; $i = $i_save }
+
+ # perl seems to allow just these: $#: $#- $#+
+ elsif ( $tok =~ /^[\:\-\+]$/ ) {
+ $type = 'i';
+ $identifier .= $tok;
+ }
+ else {
+ $i = $i_save;
+ write_logfile_entry( 'Use of $# is deprecated' . "\n" );
+ }
+ }
+ elsif ( $identifier eq '$$' ) {
+
+ # perl does not allow references to punctuation
+ # variables without braces. For example, this
+ # won't work:
+ # $:=\4;
+ # $a = $$:;
+ # You would have to use
+ # $a = ${$:};
+
+ $i = $i_save;
+ if ( $tok eq '{' ) { $type = 't' }
+ else { $type = 'i' }
+ }
+ elsif ( $identifier eq '->' ) {
+ $i = $i_save;
+ }
+ else {
+ $i = $i_save;
+ if ( length($identifier) == 1 ) { $identifier = ''; }
+ }
+ $id_scan_state = '';
+ last;
+ }
+ }
+ elsif ( $id_scan_state eq '&' ) { # starting sub call?
+
+ if ( $tok =~ /^[\$A-Za-z_]/ ) { # alphanumeric ..
+ $id_scan_state = ':'; # now need ::
+ $saw_alpha = 1;
+ $identifier .= $tok;
+ }
+ elsif ( $tok eq "'" && $allow_tick ) { # alphanumeric ..
+ $id_scan_state = ':'; # now need ::
+ $saw_alpha = 1;
+ $identifier .= $tok;
+ }
+ elsif ( $tok =~ /^[0-9]/ ) { # numeric..see comments above
+ $id_scan_state = ':'; # now need ::
+ $saw_alpha = 1;
+ $identifier .= $tok;
+ }
+ elsif ( $tok =~ /^\s*$/ ) { # allow space
+ }
+ elsif ( $tok eq '::' ) { # leading ::
+ $id_scan_state = 'A'; # accept alpha next
+ $identifier .= $tok;
+ }
+ elsif ( $tok eq '{' ) {
+ if ( $identifier eq '&' || $i == 0 ) { $identifier = ''; }
+ $i = $i_save;
+ $id_scan_state = '';
+ last;
+ }
+ else {
+
+ # punctuation variable?
+ # testfile: cunningham4.pl
+ #
+ # We have to be careful here. If we are in an unknown state,
+ # we will reject the punctuation variable. In the following
+ # example the '&' is a binary opeator but we are in an unknown
+ # state because there is no sigil on 'Prima', so we don't
+ # know what it is. But it is a bad guess that
+ # '&~' is a punction variable.
+ # $self->{text}->{colorMap}->[
+ # Prima::PodView::COLOR_CODE_FOREGROUND
+ # & ~tb::COLOR_INDEX ] =
+ # $sec->{ColorCode}
+ if ( $identifier eq '&' && $expecting ) {
+ $identifier .= $tok;
+ }
+ else {
+ $identifier = '';
+ $i = $i_save;
+ $type = '&';
+ }
+ $id_scan_state = '';
+ last;
+ }
+ }
+ elsif ( $id_scan_state eq 'A' ) { # looking for alpha (after ::)
+
+ if ( $tok =~ /^[A-Za-z_]/ ) { # found it
+ $identifier .= $tok;
+ $id_scan_state = ':'; # now need ::
+ $saw_alpha = 1;
+ }
+ elsif ( $tok eq "'" && $allow_tick ) {
+ $identifier .= $tok;
+ $id_scan_state = ':'; # now need ::
+ $saw_alpha = 1;
+ }
+ elsif ( $tok =~ /^[0-9]/ ) { # numeric..see comments above
+ $identifier .= $tok;
+ $id_scan_state = ':'; # now need ::
+ $saw_alpha = 1;
+ }
+ elsif ( ( $identifier =~ /^sub / ) && ( $tok =~ /^\s*$/ ) ) {
+ $id_scan_state = '(';
+ $identifier .= $tok;
+ }
+ elsif ( ( $identifier =~ /^sub / ) && ( $tok eq '(' ) ) {
+ $id_scan_state = ')';
+ $identifier .= $tok;
+ }
+ else {
+ $id_scan_state = '';
+ $i = $i_save;
+ last;
+ }
+ }
+ elsif ( $id_scan_state eq ':' ) { # looking for :: after alpha
+
+ if ( $tok eq '::' ) { # got it
+ $identifier .= $tok;
+ $id_scan_state = 'A'; # now require alpha
+ }
+ elsif ( $tok =~ /^[A-Za-z_]/ ) { # more alphanumeric is ok here
+ $identifier .= $tok;
+ $id_scan_state = ':'; # now need ::
+ $saw_alpha = 1;
+ }
+ elsif ( $tok =~ /^[0-9]/ ) { # numeric..see comments above
+ $identifier .= $tok;
+ $id_scan_state = ':'; # now need ::
+ $saw_alpha = 1;
+ }
+ elsif ( $tok eq "'" && $allow_tick ) { # tick
+
+ if ( $is_keyword{$identifier} ) {
+ $id_scan_state = ''; # that's all
+ $i = $i_save;
+ }
+ else {
+ $identifier .= $tok;
+ }
+ }
+ elsif ( ( $identifier =~ /^sub / ) && ( $tok =~ /^\s*$/ ) ) {
+ $id_scan_state = '(';
+ $identifier .= $tok;
+ }
+ elsif ( ( $identifier =~ /^sub / ) && ( $tok eq '(' ) ) {
+ $id_scan_state = ')';
+ $identifier .= $tok;
+ }
+ else {
+ $id_scan_state = ''; # that's all
+ $i = $i_save;
+ last;
+ }
+ }
+ elsif ( $id_scan_state eq '(' ) { # looking for ( of prototype
+
+ if ( $tok eq '(' ) { # got it
+ $identifier .= $tok;
+ $id_scan_state = ')'; # now find the end of it
+ }
+ elsif ( $tok =~ /^\s*$/ ) { # blank - keep going
+ $identifier .= $tok;
+ }
+ else {
+ $id_scan_state = ''; # that's all - no prototype
+ $i = $i_save;
+ last;
+ }
+ }
+ elsif ( $id_scan_state eq ')' ) { # looking for ) to end
+
+ if ( $tok eq ')' ) { # got it
+ $identifier .= $tok;
+ $id_scan_state = ''; # all done
+ last;
+ }
+ elsif ( $tok =~ /^[\s\$\%\\\*\@\&\;]/ ) {
+ $identifier .= $tok;
+ }
+ else { # probable error in script, but keep going
+ warning("Unexpected '$tok' while seeking end of prototype\n");
+ $identifier .= $tok;
+ }
+ }
+ else { # can get here due to error in initialization
+ $id_scan_state = '';
+ $i = $i_save;
+ last;
+ }
+ }
+
+ if ( $id_scan_state eq ')' ) {
+ warning("Hit end of line while seeking ) to end prototype\n");
+ }
+
+ # once we enter the actual identifier, it may not extend beyond
+ # the end of the current line
+ if ( $id_scan_state =~ /^[A\:\(\)]/ ) {
+ $id_scan_state = '';
+ }
+ if ( $i < 0 ) { $i = 0 }
+
+ unless ($type) {
+
+ if ($saw_type) {
+
+ if ($saw_alpha) {
+ if ( $identifier =~ /^->/ && $last_nonblank_type eq 'w' ) {
+ $type = 'w';
+ }
+ else { $type = 'i' }
+ }
+ elsif ( $identifier eq '->' ) {
+ $type = '->';
+ }
+ elsif (
+ ( length($identifier) > 1 )
+
+ # In something like '@$=' we have an identifier '@$'
+ # In something like '$${' we have type '$$' (and only
+ # part of an identifier)
+ && !( $identifier =~ /\$$/ && $tok eq '{' )
+ && ( $identifier !~ /^(sub |package )$/ )
+ )
+ {
+ $type = 'i';
+ }
+ else { $type = 't' }
+ }
+ elsif ($saw_alpha) {
+
+ # type 'w' includes anything without leading type info
+ # ($,%,@,*) including something like abc::def::ghi
+ $type = 'w';
+ }
+ else {
+ $type = '';
+ } # this can happen on a restart
+ }
+
+ if ($identifier) {
+ $tok = $identifier;
+ if ($message) { write_logfile_entry($message) }
+ }
+ else {
+ $tok = $tok_begin;
+ $i = $i_begin;
+ }
+
+ TOKENIZER_DEBUG_FLAG_SCAN_ID && do {
+ my ( $a, $b, $c ) = caller;
+ print
+"SCANID: called from $a $b $c with tok, i, state, identifier =$tok_begin, $i_begin, $id_scan_state_begin, $identifier_begin\n";
+ print
+"SCANID: returned with tok, i, state, identifier =$tok, $i, $id_scan_state, $identifier\n";
+ };
+ return ( $i, $tok, $type, $id_scan_state, $identifier );
+}
+
+{
+
+ # saved package and subnames in case prototype is on separate line
+ my ( $package_saved, $subname_saved );
+
+ sub do_scan_sub {
+
+ # do_scan_sub parses a sub name and prototype
+ # it is called with $i_beg equal to the index of the first nonblank
+ # token following a 'sub' token.
+
+ # TODO: add future error checks to be sure we have a valid
+ # sub name. For example, 'sub &doit' is wrong. Also, be sure
+ # a name is given if and only if a non-anonymous sub is
+ # appropriate.
+ # USES GLOBAL VARS: $current_package, $last_nonblank_token,
+ # $in_attribute_list, %saw_function_definition,
+ # $statement_type
+
+ my (
+ $input_line, $i, $i_beg,
+ $tok, $type, $rtokens,
+ $rtoken_map, $id_scan_state, $max_token_index
+ ) = @_;
+ $id_scan_state = ""; # normally we get everything in one call
+ my $subname = undef;
+ my $package = undef;
+ my $proto = undef;
+ my $attrs = undef;
+ my $match;
+
+ my $pos_beg = $$rtoken_map[$i_beg];
+ pos($input_line) = $pos_beg;
+
+ # sub NAME PROTO ATTRS
+ if (
+ $input_line =~ m/\G\s*
+ ((?:\w*(?:'|::))*) # package - something that ends in :: or '
+ (\w+) # NAME - required
+ (\s*\([^){]*\))? # PROTO - something in parens
+ (\s*:)? # ATTRS - leading : of attribute list
+ /gcx
+ )
+ {
+ $match = 1;
+ $subname = $2;
+ $proto = $3;
+ $attrs = $4;
+
+ $package = ( defined($1) && $1 ) ? $1 : $current_package;
+ $package =~ s/\'/::/g;
+ if ( $package =~ /^\:/ ) { $package = 'main' . $package }
+ $package =~ s/::$//;
+ my $pos = pos($input_line);
+ my $numc = $pos - $pos_beg;
+ $tok = 'sub ' . substr( $input_line, $pos_beg, $numc );
+ $type = 'i';
+ }
+
+ # Look for prototype/attributes not preceded on this line by subname;
+ # This might be an anonymous sub with attributes,
+ # or a prototype on a separate line from its sub name
+ elsif (
+ $input_line =~ m/\G(\s*\([^){]*\))? # PROTO
+ (\s*:)? # ATTRS leading ':'
+ /gcx
+ && ( $1 || $2 )
+ )
+ {
+ $match = 1;
+ $proto = $1;
+ $attrs = $2;
+
+ # Handle prototype on separate line from subname
+ if ($subname_saved) {
+ $package = $package_saved;
+ $subname = $subname_saved;
+ $tok = $last_nonblank_token;
+ }
+ $type = 'i';
+ }
+
+ if ($match) {
+
+ # ATTRS: if there are attributes, back up and let the ':' be
+ # found later by the scanner.
+ my $pos = pos($input_line);
+ if ($attrs) {
+ $pos -= length($attrs);
+ }
+
+ my $next_nonblank_token = $tok;
+
+ # catch case of line with leading ATTR ':' after anonymous sub
+ if ( $pos == $pos_beg && $tok eq ':' ) {
+ $type = 'A';
+ $in_attribute_list = 1;
+ }
+
+ # We must convert back from character position
+ # to pre_token index.
+ else {
+
+ # I don't think an error flag can occur here ..but ?
+ my $error;
+ ( $i, $error ) = inverse_pretoken_map( $i, $pos, $rtoken_map,
+ $max_token_index );
+ if ($error) { warning("Possibly invalid sub\n") }
+
+ # check for multiple definitions of a sub
+ ( $next_nonblank_token, my $i_next ) =
+ find_next_nonblank_token_on_this_line( $i, $rtokens,
+ $max_token_index );
+ }
+
+ if ( $next_nonblank_token =~ /^(\s*|#)$/ )
+ { # skip blank or side comment
+ my ( $rpre_tokens, $rpre_types ) =
+ peek_ahead_for_n_nonblank_pre_tokens(1);
+ if ( defined($rpre_tokens) && @$rpre_tokens ) {
+ $next_nonblank_token = $rpre_tokens->[0];
+ }
+ else {
+ $next_nonblank_token = '}';
+ }
+ }
+ $package_saved = "";
+ $subname_saved = "";
+ if ( $next_nonblank_token eq '{' ) {
+ if ($subname) {
+
+ # Check for multiple definitions of a sub, but
+ # it is ok to have multiple sub BEGIN, etc,
+ # so we do not complain if name is all caps
+ if ( $saw_function_definition{$package}{$subname}
+ && $subname !~ /^[A-Z]+$/ )
+ {
+ my $lno = $saw_function_definition{$package}{$subname};
+ warning(
+"already saw definition of 'sub $subname' in package '$package' at line $lno\n"
+ );
+ }
+ $saw_function_definition{$package}{$subname} =
+ $tokenizer_self->{_last_line_number};
+ }
+ }
+ elsif ( $next_nonblank_token eq ';' ) {
+ }
+ elsif ( $next_nonblank_token eq '}' ) {
+ }
+
+ # ATTRS - if an attribute list follows, remember the name
+ # of the sub so the next opening brace can be labeled.
+ # Setting 'statement_type' causes any ':'s to introduce
+ # attributes.
+ elsif ( $next_nonblank_token eq ':' ) {
+ $statement_type = $tok;
+ }
+
+ # see if PROTO follows on another line:
+ elsif ( $next_nonblank_token eq '(' ) {
+ if ( $attrs || $proto ) {
+ warning(
+"unexpected '(' after definition or declaration of sub '$subname'\n"
+ );
+ }
+ else {
+ $id_scan_state = 'sub'; # we must come back to get proto
+ $statement_type = $tok;
+ $package_saved = $package;
+ $subname_saved = $subname;
+ }
+ }
+ elsif ($next_nonblank_token) { # EOF technically ok
+ warning(
+"expecting ':' or ';' or '{' after definition or declaration of sub '$subname' but saw '$next_nonblank_token'\n"
+ );
+ }
+ check_prototype( $proto, $package, $subname );
+ }
+
+ # no match but line not blank
+ else {
+ }
+ return ( $i, $tok, $type, $id_scan_state );
+ }
+}
+
+#########i###############################################################
+# Tokenizer utility routines which may use CONSTANTS but no other GLOBALS
+#########################################################################
+
+sub find_next_nonblank_token {
+ my ( $i, $rtokens, $max_token_index ) = @_;
+
+ if ( $i >= $max_token_index ) {
+ if ( !peeked_ahead() ) {
+ peeked_ahead(1);
+ $rtokens =
+ peek_ahead_for_nonblank_token( $rtokens, $max_token_index );
+ }
+ }
+ my $next_nonblank_token = $$rtokens[ ++$i ];
+
+ if ( $next_nonblank_token =~ /^\s*$/ ) {
+ $next_nonblank_token = $$rtokens[ ++$i ];
+ }
+ return ( $next_nonblank_token, $i );
+}
+
+sub numerator_expected {
+
+ # this is a filter for a possible numerator, in support of guessing
+ # for the / pattern delimiter token.
+ # returns -
+ # 1 - yes
+ # 0 - can't tell
+ # -1 - no
+ # Note: I am using the convention that variables ending in
+ # _expected have these 3 possible values.
+ my ( $i, $rtokens, $max_token_index ) = @_;
+ my $next_token = $$rtokens[ $i + 1 ];
+ if ( $next_token eq '=' ) { $i++; } # handle /=
+ my ( $next_nonblank_token, $i_next ) =
+ find_next_nonblank_token( $i, $rtokens, $max_token_index );
+
+ if ( $next_nonblank_token =~ /(\(|\$|\w|\.|\@)/ ) {
+ 1;
+ }
+ else {
+
+ if ( $next_nonblank_token =~ /^\s*$/ ) {
+ 0;
+ }
+ else {
+ -1;
+ }
+ }
+}
+
+sub pattern_expected {
+
+ # This is the start of a filter for a possible pattern.
+ # It looks at the token after a possbible pattern and tries to
+ # determine if that token could end a pattern.
+ # returns -
+ # 1 - yes
+ # 0 - can't tell
+ # -1 - no
+ my ( $i, $rtokens, $max_token_index ) = @_;
+ my $next_token = $$rtokens[ $i + 1 ];
+ if ( $next_token =~ /^[cgimosxp]/ ) { $i++; } # skip possible modifier
+ my ( $next_nonblank_token, $i_next ) =
+ find_next_nonblank_token( $i, $rtokens, $max_token_index );
+
+ # list of tokens which may follow a pattern
+ # (can probably be expanded)
+ if ( $next_nonblank_token =~ /(\)|\}|\;|\&\&|\|\||and|or|while|if|unless)/ )
+ {
+ 1;
+ }
+ else {
+
+ if ( $next_nonblank_token =~ /^\s*$/ ) {
+ 0;
+ }
+ else {
+ -1;
+ }
+ }
+}
+
+sub find_next_nonblank_token_on_this_line {
+ my ( $i, $rtokens, $max_token_index ) = @_;
+ my $next_nonblank_token;
+
+ if ( $i < $max_token_index ) {
+ $next_nonblank_token = $$rtokens[ ++$i ];
+
+ if ( $next_nonblank_token =~ /^\s*$/ ) {
+
+ if ( $i < $max_token_index ) {
+ $next_nonblank_token = $$rtokens[ ++$i ];
+ }
+ }
+ }
+ else {
+ $next_nonblank_token = "";
+ }
+ return ( $next_nonblank_token, $i );
+}
+
+sub find_angle_operator_termination {
+
+ # We are looking at a '<' and want to know if it is an angle operator.
+ # We are to return:
+ # $i = pretoken index of ending '>' if found, current $i otherwise
+ # $type = 'Q' if found, '>' otherwise
+ my ( $input_line, $i_beg, $rtoken_map, $expecting, $max_token_index ) = @_;
+ my $i = $i_beg;
+ my $type = '<';
+ pos($input_line) = 1 + $$rtoken_map[$i];
+
+ my $filter;
+
+ # we just have to find the next '>' if a term is expected
+ if ( $expecting == TERM ) { $filter = '[\>]' }
+
+ # we have to guess if we don't know what is expected
+ elsif ( $expecting == UNKNOWN ) { $filter = '[\>\;\=\#\|\<]' }
+
+ # shouldn't happen - we shouldn't be here if operator is expected
+ else { warning("Program Bug in find_angle_operator_termination\n") }
+
+ # To illustrate what we might be looking at, in case we are
+ # guessing, here are some examples of valid angle operators
+ # (or file globs):
+ # <tmp_imp/*>
+ # <FH>
+ # <$fh>
+ # <*.c *.h>
+ # <_>
+ # <jskdfjskdfj* op/* jskdjfjkosvk*> ( glob.t)
+ # <${PREFIX}*img*.$IMAGE_TYPE>
+ # <img*.$IMAGE_TYPE>
+ # <Timg*.$IMAGE_TYPE>
+ # <$LATEX2HTMLVERSIONS${dd}html[1-9].[0-9].pl>
+ #
+ # Here are some examples of lines which do not have angle operators:
+ # return undef unless $self->[2]++ < $#{$self->[1]};
+ # < 2 || @$t >
+ #
+ # the following line from dlister.pl caused trouble:
+ # print'~'x79,"\n",$D<1024?"0.$D":$D>>10,"K, $C files\n\n\n";
+ #
+ # If the '<' starts an angle operator, it must end on this line and
+ # it must not have certain characters like ';' and '=' in it. I use
+ # this to limit the testing. This filter should be improved if
+ # possible.
+
+ if ( $input_line =~ /($filter)/g ) {
+
+ if ( $1 eq '>' ) {
+
+ # We MAY have found an angle operator termination if we get
+ # here, but we need to do more to be sure we haven't been
+ # fooled.
+ my $pos = pos($input_line);
+
+ my $pos_beg = $$rtoken_map[$i];
+ my $str = substr( $input_line, $pos_beg, ( $pos - $pos_beg ) );
+
+ # Reject if the closing '>' follows a '-' as in:
+ # if ( VERSION < 5.009 && $op-> name eq 'aassign' ) { }
+ if ( $expecting eq UNKNOWN ) {
+ my $check = substr( $input_line, $pos - 2, 1 );
+ if ( $check eq '-' ) {
+ return ( $i, $type );
+ }
+ }
+
+ ######################################debug#####
+ #write_diagnostics( "ANGLE? :$str\n");
+ #print "ANGLE: found $1 at pos=$pos str=$str check=$check\n";
+ ######################################debug#####
+ $type = 'Q';
+ my $error;
+ ( $i, $error ) =
+ inverse_pretoken_map( $i, $pos, $rtoken_map, $max_token_index );
+
+ # It may be possible that a quote ends midway in a pretoken.
+ # If this happens, it may be necessary to split the pretoken.
+ if ($error) {
+ warning(
+ "Possible tokinization error..please check this line\n");
+ report_possible_bug();
+ }
+
+ # Now let's see where we stand....
+ # OK if math op not possible
+ if ( $expecting == TERM ) {
+ }
+
+ # OK if there are no more than 2 pre-tokens inside
+ # (not possible to write 2 token math between < and >)
+ # This catches most common cases
+ elsif ( $i <= $i_beg + 3 ) {
+ write_diagnostics("ANGLE(1 or 2 tokens): $str\n");
+ }
+
+ # Not sure..
+ else {
+
+ # Let's try a Brace Test: any braces inside must balance
+ my $br = 0;
+ while ( $str =~ /\{/g ) { $br++ }
+ while ( $str =~ /\}/g ) { $br-- }
+ my $sb = 0;
+ while ( $str =~ /\[/g ) { $sb++ }
+ while ( $str =~ /\]/g ) { $sb-- }
+ my $pr = 0;
+ while ( $str =~ /\(/g ) { $pr++ }
+ while ( $str =~ /\)/g ) { $pr-- }
+
+ # if braces do not balance - not angle operator
+ if ( $br || $sb || $pr ) {
+ $i = $i_beg;
+ $type = '<';
+ write_diagnostics(
+ "NOT ANGLE (BRACE={$br ($pr [$sb ):$str\n");
+ }
+
+ # we should keep doing more checks here...to be continued
+ # Tentatively accepting this as a valid angle operator.
+ # There are lots more things that can be checked.
+ else {
+ write_diagnostics(
+ "ANGLE-Guessing yes: $str expecting=$expecting\n");
+ write_logfile_entry("Guessing angle operator here: $str\n");
+ }
+ }
+ }
+
+ # didn't find ending >
+ else {
+ if ( $expecting == TERM ) {
+ warning("No ending > for angle operator\n");
+ }
+ }
+ }
+ return ( $i, $type );
+}
+
+sub scan_number_do {
+
+ # scan a number in any of the formats that Perl accepts
+ # Underbars (_) are allowed in decimal numbers.
+ # input parameters -
+ # $input_line - the string to scan
+ # $i - pre_token index to start scanning
+ # $rtoken_map - reference to the pre_token map giving starting
+ # character position in $input_line of token $i
+ # output parameters -
+ # $i - last pre_token index of the number just scanned
+ # number - the number (characters); or undef if not a number
+
+ my ( $input_line, $i, $rtoken_map, $input_type, $max_token_index ) = @_;
+ my $pos_beg = $$rtoken_map[$i];
+ my $pos;
+ my $i_begin = $i;
+ my $number = undef;
+ my $type = $input_type;
+
+ my $first_char = substr( $input_line, $pos_beg, 1 );
+
+ # Look for bad starting characters; Shouldn't happen..
+ if ( $first_char !~ /[\d\.\+\-Ee]/ ) {
+ warning("Program bug - scan_number given character $first_char\n");
+ report_definite_bug();
+ return ( $i, $type, $number );
+ }
+
+ # handle v-string without leading 'v' character ('Two Dot' rule)
+ # (vstring.t)
+ # TODO: v-strings may contain underscores
+ pos($input_line) = $pos_beg;
+ if ( $input_line =~ /\G((\d+)?\.\d+(\.\d+)+)/g ) {
+ $pos = pos($input_line);
+ my $numc = $pos - $pos_beg;
+ $number = substr( $input_line, $pos_beg, $numc );
+ $type = 'v';
+ report_v_string($number);
+ }
+
+ # handle octal, hex, binary
+ if ( !defined($number) ) {
+ pos($input_line) = $pos_beg;
+ if ( $input_line =~ /\G[+-]?0((x[0-9a-fA-F_]+)|([0-7_]+)|(b[01_]+))/g )
+ {
+ $pos = pos($input_line);
+ my $numc = $pos - $pos_beg;
+ $number = substr( $input_line, $pos_beg, $numc );
+ $type = 'n';
+ }
+ }
+
+ # handle decimal
+ if ( !defined($number) ) {
+ pos($input_line) = $pos_beg;
+
+ if ( $input_line =~ /\G([+-]?[\d_]*(\.[\d_]*)?([Ee][+-]?(\d+))?)/g ) {
+ $pos = pos($input_line);
+
+ # watch out for things like 0..40 which would give 0. by this;
+ if ( ( substr( $input_line, $pos - 1, 1 ) eq '.' )
+ && ( substr( $input_line, $pos, 1 ) eq '.' ) )
+ {
+ $pos--;
+ }
+ my $numc = $pos - $pos_beg;
+ $number = substr( $input_line, $pos_beg, $numc );
+ $type = 'n';
+ }
+ }
+
+ # filter out non-numbers like e + - . e2 .e3 +e6
+ # the rule: at least one digit, and any 'e' must be preceded by a digit
+ if (
+ $number !~ /\d/ # no digits
+ || ( $number =~ /^(.*)[eE]/
+ && $1 !~ /\d/ ) # or no digits before the 'e'
+ )
+ {
+ $number = undef;
+ $type = $input_type;
+ return ( $i, $type, $number );
+ }
+
+ # Found a number; now we must convert back from character position
+ # to pre_token index. An error here implies user syntax error.
+ # An example would be an invalid octal number like '009'.
+ my $error;
+ ( $i, $error ) =
+ inverse_pretoken_map( $i, $pos, $rtoken_map, $max_token_index );
+ if ($error) { warning("Possibly invalid number\n") }
+
+ return ( $i, $type, $number );
+}
+
+sub inverse_pretoken_map {
+
+ # Starting with the current pre_token index $i, scan forward until
+ # finding the index of the next pre_token whose position is $pos.
+ my ( $i, $pos, $rtoken_map, $max_token_index ) = @_;
+ my $error = 0;
+
+ while ( ++$i <= $max_token_index ) {
+
+ if ( $pos <= $$rtoken_map[$i] ) {
+
+ # Let the calling routine handle errors in which we do not
+ # land on a pre-token boundary. It can happen by running
+ # perltidy on some non-perl scripts, for example.
+ if ( $pos < $$rtoken_map[$i] ) { $error = 1 }
+ $i--;
+ last;
+ }
+ }
+ return ( $i, $error );
+}
+
+sub find_here_doc {
+
+ # find the target of a here document, if any
+ # input parameters:
+ # $i - token index of the second < of <<
+ # ($i must be less than the last token index if this is called)
+ # output parameters:
+ # $found_target = 0 didn't find target; =1 found target
+ # HERE_TARGET - the target string (may be empty string)
+ # $i - unchanged if not here doc,
+ # or index of the last token of the here target
+ # $saw_error - flag noting unbalanced quote on here target
+ my ( $expecting, $i, $rtokens, $rtoken_map, $max_token_index ) = @_;
+ my $ibeg = $i;
+ my $found_target = 0;
+ my $here_doc_target = '';
+ my $here_quote_character = '';
+ my $saw_error = 0;
+ my ( $next_nonblank_token, $i_next_nonblank, $next_token );
+ $next_token = $$rtokens[ $i + 1 ];
+
+ # perl allows a backslash before the target string (heredoc.t)
+ my $backslash = 0;
+ if ( $next_token eq '\\' ) {
+ $backslash = 1;
+ $next_token = $$rtokens[ $i + 2 ];
+ }
+
+ ( $next_nonblank_token, $i_next_nonblank ) =
+ find_next_nonblank_token_on_this_line( $i, $rtokens, $max_token_index );
+
+ if ( $next_nonblank_token =~ /[\'\"\`]/ ) {
+
+ my $in_quote = 1;
+ my $quote_depth = 0;
+ my $quote_pos = 0;
+ my $quoted_string;
+
+ (
+ $i, $in_quote, $here_quote_character, $quote_pos, $quote_depth,
+ $quoted_string
+ )
+ = follow_quoted_string( $i_next_nonblank, $in_quote, $rtokens,
+ $here_quote_character, $quote_pos, $quote_depth, $max_token_index );
+
+ if ($in_quote) { # didn't find end of quote, so no target found
+ $i = $ibeg;
+ if ( $expecting == TERM ) {
+ warning(
+"Did not find here-doc string terminator ($here_quote_character) before end of line \n"
+ );
+ $saw_error = 1;
+ }
+ }
+ else { # found ending quote
+ my $j;
+ $found_target = 1;
+
+ my $tokj;
+ for ( $j = $i_next_nonblank + 1 ; $j < $i ; $j++ ) {
+ $tokj = $$rtokens[$j];
+
+ # we have to remove any backslash before the quote character
+ # so that the here-doc-target exactly matches this string
+ next
+ if ( $tokj eq "\\"
+ && $j < $i - 1
+ && $$rtokens[ $j + 1 ] eq $here_quote_character );
+ $here_doc_target .= $tokj;
+ }
+ }
+ }
+
+ elsif ( ( $next_token =~ /^\s*$/ ) and ( $expecting == TERM ) ) {
+ $found_target = 1;
+ write_logfile_entry(
+ "found blank here-target after <<; suggest using \"\"\n");
+ $i = $ibeg;
+ }
+ elsif ( $next_token =~ /^\w/ ) { # simple bareword or integer after <<
+
+ my $here_doc_expected;
+ if ( $expecting == UNKNOWN ) {
+ $here_doc_expected = guess_if_here_doc($next_token);
+ }
+ else {
+ $here_doc_expected = 1;
+ }
+
+ if ($here_doc_expected) {
+ $found_target = 1;
+ $here_doc_target = $next_token;
+ $i = $ibeg + 1;
+ }
+
+ }
+ else {
+
+ if ( $expecting == TERM ) {
+ $found_target = 1;
+ write_logfile_entry("Note: bare here-doc operator <<\n");
+ }
+ else {
+ $i = $ibeg;
+ }
+ }
+
+ # patch to neglect any prepended backslash
+ if ( $found_target && $backslash ) { $i++ }
+
+ return ( $found_target, $here_doc_target, $here_quote_character, $i,
+ $saw_error );
+}
+
+sub do_quote {
+
+ # follow (or continue following) quoted string(s)
+ # $in_quote return code:
+ # 0 - ok, found end
+ # 1 - still must find end of quote whose target is $quote_character
+ # 2 - still looking for end of first of two quotes
+ #
+ # Returns updated strings:
+ # $quoted_string_1 = quoted string seen while in_quote=1
+ # $quoted_string_2 = quoted string seen while in_quote=2
+ my (
+ $i, $in_quote, $quote_character,
+ $quote_pos, $quote_depth, $quoted_string_1,
+ $quoted_string_2, $rtokens, $rtoken_map,
+ $max_token_index
+ ) = @_;
+
+ my $in_quote_starting = $in_quote;
+
+ my $quoted_string;
+ if ( $in_quote == 2 ) { # two quotes/quoted_string_1s to follow
+ my $ibeg = $i;
+ (
+ $i, $in_quote, $quote_character, $quote_pos, $quote_depth,
+ $quoted_string
+ )
+ = follow_quoted_string( $i, $in_quote, $rtokens, $quote_character,
+ $quote_pos, $quote_depth, $max_token_index );
+ $quoted_string_2 .= $quoted_string;
+ if ( $in_quote == 1 ) {
+ if ( $quote_character =~ /[\{\[\<\(]/ ) { $i++; }
+ $quote_character = '';
+ }
+ else {
+ $quoted_string_2 .= "\n";
+ }
+ }
+
+ if ( $in_quote == 1 ) { # one (more) quote to follow
+ my $ibeg = $i;
+ (
+ $i, $in_quote, $quote_character, $quote_pos, $quote_depth,
+ $quoted_string
+ )
+ = follow_quoted_string( $ibeg, $in_quote, $rtokens, $quote_character,
+ $quote_pos, $quote_depth, $max_token_index );
+ $quoted_string_1 .= $quoted_string;
+ if ( $in_quote == 1 ) {
+ $quoted_string_1 .= "\n";
+ }
+ }
+ return ( $i, $in_quote, $quote_character, $quote_pos, $quote_depth,
+ $quoted_string_1, $quoted_string_2 );
+}
+
+sub follow_quoted_string {
+
+ # scan for a specific token, skipping escaped characters
+ # if the quote character is blank, use the first non-blank character
+ # input parameters:
+ # $rtokens = reference to the array of tokens
+ # $i = the token index of the first character to search
+ # $in_quote = number of quoted strings being followed
+ # $beginning_tok = the starting quote character
+ # $quote_pos = index to check next for alphanumeric delimiter
+ # output parameters:
+ # $i = the token index of the ending quote character
+ # $in_quote = decremented if found end, unchanged if not
+ # $beginning_tok = the starting quote character
+ # $quote_pos = index to check next for alphanumeric delimiter
+ # $quote_depth = nesting depth, since delimiters '{ ( [ <' can be nested.
+ # $quoted_string = the text of the quote (without quotation tokens)
+ my ( $i_beg, $in_quote, $rtokens, $beginning_tok, $quote_pos, $quote_depth,
+ $max_token_index )
+ = @_;
+ my ( $tok, $end_tok );
+ my $i = $i_beg - 1;
+ my $quoted_string = "";
+
+ TOKENIZER_DEBUG_FLAG_QUOTE && do {
+ print
+"QUOTE entering with quote_pos = $quote_pos i=$i beginning_tok =$beginning_tok\n";
+ };
+
+ # get the corresponding end token
+ if ( $beginning_tok !~ /^\s*$/ ) {
+ $end_tok = matching_end_token($beginning_tok);
+ }
+
+ # a blank token means we must find and use the first non-blank one
+ else {
+ my $allow_quote_comments = ( $i < 0 ) ? 1 : 0; # i<0 means we saw a <cr>
+
+ while ( $i < $max_token_index ) {
+ $tok = $$rtokens[ ++$i ];
+
+ if ( $tok !~ /^\s*$/ ) {
+
+ if ( ( $tok eq '#' ) && ($allow_quote_comments) ) {
+ $i = $max_token_index;
+ }
+ else {
+
+ if ( length($tok) > 1 ) {
+ if ( $quote_pos <= 0 ) { $quote_pos = 1 }
+ $beginning_tok = substr( $tok, $quote_pos - 1, 1 );
+ }
+ else {
+ $beginning_tok = $tok;
+ $quote_pos = 0;
+ }
+ $end_tok = matching_end_token($beginning_tok);
+ $quote_depth = 1;
+ last;
+ }
+ }
+ else {
+ $allow_quote_comments = 1;
+ }
+ }
+ }
+
+ # There are two different loops which search for the ending quote
+ # character. In the rare case of an alphanumeric quote delimiter, we
+ # have to look through alphanumeric tokens character-by-character, since
+ # the pre-tokenization process combines multiple alphanumeric
+ # characters, whereas for a non-alphanumeric delimiter, only tokens of
+ # length 1 can match.
+
+ ###################################################################
+ # Case 1 (rare): loop for case of alphanumeric quote delimiter..
+ # "quote_pos" is the position the current word to begin searching
+ ###################################################################
+ if ( $beginning_tok =~ /\w/ ) {
+
+ # Note this because it is not recommended practice except
+ # for obfuscated perl contests
+ if ( $in_quote == 1 ) {
+ write_logfile_entry(
+ "Note: alphanumeric quote delimiter ($beginning_tok) \n");
+ }
+
+ while ( $i < $max_token_index ) {
+
+ if ( $quote_pos == 0 || ( $i < 0 ) ) {
+ $tok = $$rtokens[ ++$i ];
+
+ if ( $tok eq '\\' ) {
+
+ # retain backslash unless it hides the end token
+ $quoted_string .= $tok
+ unless $$rtokens[ $i + 1 ] eq $end_tok;
+ $quote_pos++;
+ last if ( $i >= $max_token_index );
+ $tok = $$rtokens[ ++$i ];
+ }
+ }
+ my $old_pos = $quote_pos;
+
+ unless ( defined($tok) && defined($end_tok) && defined($quote_pos) )
+ {
+
+ }
+ $quote_pos = 1 + index( $tok, $end_tok, $quote_pos );
+
+ if ( $quote_pos > 0 ) {
+
+ $quoted_string .=
+ substr( $tok, $old_pos, $quote_pos - $old_pos - 1 );
+
+ $quote_depth--;
+
+ if ( $quote_depth == 0 ) {
+ $in_quote--;
+ last;
+ }
+ }
+ else {
+ $quoted_string .= substr( $tok, $old_pos );
+ }
+ }
+ }
+
+ ########################################################################
+ # Case 2 (normal): loop for case of a non-alphanumeric quote delimiter..
+ ########################################################################
+ else {
+
+ while ( $i < $max_token_index ) {
+ $tok = $$rtokens[ ++$i ];
+
+ if ( $tok eq $end_tok ) {
+ $quote_depth--;
+
+ if ( $quote_depth == 0 ) {
+ $in_quote--;
+ last;
+ }
+ }
+ elsif ( $tok eq $beginning_tok ) {
+ $quote_depth++;
+ }
+ elsif ( $tok eq '\\' ) {
+
+ # retain backslash unless it hides the beginning or end token
+ $tok = $$rtokens[ ++$i ];
+ $quoted_string .= '\\'
+ unless ( $tok eq $end_tok || $tok eq $beginning_tok );
+ }
+ $quoted_string .= $tok;
+ }
+ }
+ if ( $i > $max_token_index ) { $i = $max_token_index }
+ return ( $i, $in_quote, $beginning_tok, $quote_pos, $quote_depth,
+ $quoted_string );
+}
+
+sub indicate_error {
+ my ( $msg, $line_number, $input_line, $pos, $carrat ) = @_;
+ interrupt_logfile();
+ warning($msg);
+ write_error_indicator_pair( $line_number, $input_line, $pos, $carrat );
+ resume_logfile();
+}
+
+sub write_error_indicator_pair {
+ my ( $line_number, $input_line, $pos, $carrat ) = @_;
+ my ( $offset, $numbered_line, $underline ) =
+ make_numbered_line( $line_number, $input_line, $pos );
+ $underline = write_on_underline( $underline, $pos - $offset, $carrat );
+ warning( $numbered_line . "\n" );
+ $underline =~ s/\s*$//;
+ warning( $underline . "\n" );
+}
+
+sub make_numbered_line {
+
+ # Given an input line, its line number, and a character position of
+ # interest, create a string not longer than 80 characters of the form
+ # $lineno: sub_string
+ # such that the sub_string of $str contains the position of interest
+ #
+ # Here is an example of what we want, in this case we add trailing
+ # '...' because the line is long.
+ #
+ # 2: (One of QAML 2.0's authors is a member of the World Wide Web Con ...
+ #
+ # Here is another example, this time in which we used leading '...'
+ # because of excessive length:
+ #
+ # 2: ... er of the World Wide Web Consortium's
+ #
+ # input parameters are:
+ # $lineno = line number
+ # $str = the text of the line
+ # $pos = position of interest (the error) : 0 = first character
+ #
+ # We return :
+ # - $offset = an offset which corrects the position in case we only
+ # display part of a line, such that $pos-$offset is the effective
+ # position from the start of the displayed line.
+ # - $numbered_line = the numbered line as above,
+ # - $underline = a blank 'underline' which is all spaces with the same
+ # number of characters as the numbered line.
+
+ my ( $lineno, $str, $pos ) = @_;
+ my $offset = ( $pos < 60 ) ? 0 : $pos - 40;
+ my $excess = length($str) - $offset - 68;
+ my $numc = ( $excess > 0 ) ? 68 : undef;
+
+ if ( defined($numc) ) {
+ if ( $offset == 0 ) {
+ $str = substr( $str, $offset, $numc - 4 ) . " ...";
+ }
+ else {
+ $str = "... " . substr( $str, $offset + 4, $numc - 4 ) . " ...";
+ }
+ }
+ else {
+
+ if ( $offset == 0 ) {
+ }
+ else {
+ $str = "... " . substr( $str, $offset + 4 );
+ }
+ }
+
+ my $numbered_line = sprintf( "%d: ", $lineno );
+ $offset -= length($numbered_line);
+ $numbered_line .= $str;
+ my $underline = " " x length($numbered_line);
+ return ( $offset, $numbered_line, $underline );
+}
+
+sub write_on_underline {
+
+ # The "underline" is a string that shows where an error is; it starts
+ # out as a string of blanks with the same length as the numbered line of
+ # code above it, and we have to add marking to show where an error is.
+ # In the example below, we want to write the string '--^' just below
+ # the line of bad code:
+ #
+ # 2: (One of QAML 2.0's authors is a member of the World Wide Web Con ...
+ # ---^
+ # We are given the current underline string, plus a position and a
+ # string to write on it.
+ #
+ # In the above example, there will be 2 calls to do this:
+ # First call: $pos=19, pos_chr=^
+ # Second call: $pos=16, pos_chr=---
+ #
+ # This is a trivial thing to do with substr, but there is some
+ # checking to do.
+
+ my ( $underline, $pos, $pos_chr ) = @_;
+
+ # check for error..shouldn't happen
+ unless ( ( $pos >= 0 ) && ( $pos <= length($underline) ) ) {
+ return $underline;
+ }
+ my $excess = length($pos_chr) + $pos - length($underline);
+ if ( $excess > 0 ) {
+ $pos_chr = substr( $pos_chr, 0, length($pos_chr) - $excess );
+ }
+ substr( $underline, $pos, length($pos_chr) ) = $pos_chr;
+ return ($underline);
+}
+
+sub pre_tokenize {
+
+ # Break a string, $str, into a sequence of preliminary tokens. We
+ # are interested in these types of tokens:
+ # words (type='w'), example: 'max_tokens_wanted'
+ # digits (type = 'd'), example: '0755'
+ # whitespace (type = 'b'), example: ' '
+ # any other single character (i.e. punct; type = the character itself).
+ # We cannot do better than this yet because we might be in a quoted
+ # string or pattern. Caller sets $max_tokens_wanted to 0 to get all
+ # tokens.
+ my ( $str, $max_tokens_wanted ) = @_;
+
+ # we return references to these 3 arrays:
+ my @tokens = (); # array of the tokens themselves
+ my @token_map = (0); # string position of start of each token
+ my @type = (); # 'b'=whitespace, 'd'=digits, 'w'=alpha, or punct
+
+ do {
+
+ # whitespace
+ if ( $str =~ /\G(\s+)/gc ) { push @type, 'b'; }
+
+ # numbers
+ # note that this must come before words!
+ elsif ( $str =~ /\G(\d+)/gc ) { push @type, 'd'; }
+
+ # words
+ elsif ( $str =~ /\G(\w+)/gc ) { push @type, 'w'; }
+
+ # single-character punctuation
+ elsif ( $str =~ /\G(\W)/gc ) { push @type, $1; }
+
+ # that's all..
+ else {
+ return ( \@tokens, \@token_map, \@type );
+ }
+
+ push @tokens, $1;
+ push @token_map, pos($str);
+
+ } while ( --$max_tokens_wanted != 0 );
+
+ return ( \@tokens, \@token_map, \@type );
+}
+
+sub show_tokens {
+
+ # this is an old debug routine
+ my ( $rtokens, $rtoken_map ) = @_;
+ my $num = scalar(@$rtokens);
+ my $i;
+
+ for ( $i = 0 ; $i < $num ; $i++ ) {
+ my $len = length( $$rtokens[$i] );
+ print "$i:$len:$$rtoken_map[$i]:$$rtokens[$i]:\n";
+ }
+}
+
+sub matching_end_token {
+
+ # find closing character for a pattern
+ my $beginning_token = shift;
+
+ if ( $beginning_token eq '{' ) {
+ '}';
+ }
+ elsif ( $beginning_token eq '[' ) {
+ ']';
+ }
+ elsif ( $beginning_token eq '<' ) {
+ '>';
+ }
+ elsif ( $beginning_token eq '(' ) {
+ ')';
+ }
+ else {
+ $beginning_token;
+ }
+}
+
+sub dump_token_types {
+ my $class = shift;
+ my $fh = shift;
+
+ # This should be the latest list of token types in use
+ # adding NEW_TOKENS: add a comment here
+ print $fh <<'END_OF_LIST';
+
+Here is a list of the token types currently used for lines of type 'CODE'.
+For the following tokens, the "type" of a token is just the token itself.
+
+.. :: << >> ** && .. || // -> => += -= .= %= &= |= ^= *= <>
+( ) <= >= == =~ !~ != ++ -- /= x=
+... **= <<= >>= &&= ||= //= <=>
+, + - / * | % ! x ~ = \ ? : . < > ^ &
+
+The following additional token types are defined:
+
+ type meaning
+ b blank (white space)
+ { indent: opening structural curly brace or square bracket or paren
+ (code block, anonymous hash reference, or anonymous array reference)
+ } outdent: right structural curly brace or square bracket or paren
+ [ left non-structural square bracket (enclosing an array index)
+ ] right non-structural square bracket
+ ( left non-structural paren (all but a list right of an =)
+ ) right non-structural parena
+ L left non-structural curly brace (enclosing a key)
+ R right non-structural curly brace
+ ; terminal semicolon
+ f indicates a semicolon in a "for" statement
+ h here_doc operator <<
+ # a comment
+ Q indicates a quote or pattern
+ q indicates a qw quote block
+ k a perl keyword
+ C user-defined constant or constant function (with void prototype = ())
+ U user-defined function taking parameters
+ G user-defined function taking block parameter (like grep/map/eval)
+ M (unused, but reserved for subroutine definition name)
+ P (unused, but -html uses it to label pod text)
+ t type indicater such as %,$,@,*,&,sub
+ w bare word (perhaps a subroutine call)
+ i identifier of some type (with leading %, $, @, *, &, sub, -> )
+ n a number
+ v a v-string
+ F a file test operator (like -e)
+ Y File handle
+ Z identifier in indirect object slot: may be file handle, object
+ J LABEL: code block label
+ j LABEL after next, last, redo, goto
+ p unary +
+ m unary -
+ pp pre-increment operator ++
+ mm pre-decrement operator --
+ A : used as attribute separator
+
+ Here are the '_line_type' codes used internally:
+ SYSTEM - system-specific code before hash-bang line
+ CODE - line of perl code (including comments)
+ POD_START - line starting pod, such as '=head'
+ POD - pod documentation text
+ POD_END - last line of pod section, '=cut'
+ HERE - text of here-document
+ HERE_END - last line of here-doc (target word)
+ FORMAT - format section
+ FORMAT_END - last line of format section, '.'
+ DATA_START - __DATA__ line
+ DATA - unidentified text following __DATA__
+ END_START - __END__ line
+ END - unidentified text following __END__
+ ERROR - we are in big trouble, probably not a perl script
+END_OF_LIST
+}
+
+BEGIN {
+
+ # These names are used in error messages
+ @opening_brace_names = qw# '{' '[' '(' '?' #;
+ @closing_brace_names = qw# '}' ']' ')' ':' #;
+
+ my @digraphs = qw(
+ .. :: << >> ** && .. || // -> => += -= .= %= &= |= ^= *= <>
+ <= >= == =~ !~ != ++ -- /= x= ~~
+ );
+ @is_digraph{@digraphs} = (1) x scalar(@digraphs);
+
+ my @trigraphs = qw( ... **= <<= >>= &&= ||= //= <=> !~~ );
+ @is_trigraph{@trigraphs} = (1) x scalar(@trigraphs);
+
+ # make a hash of all valid token types for self-checking the tokenizer
+ # (adding NEW_TOKENS : select a new character and add to this list)
+ my @valid_token_types = qw#
+ A b C G L R f h Q k t w i q n p m F pp mm U j J Y Z v
+ { } ( ) [ ] ; + - / * | % ! x ~ = \ ? : . < > ^ &
+ #;
+ push( @valid_token_types, @digraphs );
+ push( @valid_token_types, @trigraphs );
+ push( @valid_token_types, '#' );
+ push( @valid_token_types, ',' );
+ @is_valid_token_type{@valid_token_types} = (1) x scalar(@valid_token_types);
+
+ # a list of file test letters, as in -e (Table 3-4 of 'camel 3')
+ my @file_test_operators =
+ qw( A B C M O R S T W X b c d e f g k l o p r s t u w x z);
+ @is_file_test_operator{@file_test_operators} =
+ (1) x scalar(@file_test_operators);
+
+ # these functions have prototypes of the form (&), so when they are
+ # followed by a block, that block MAY BE followed by an operator.
+ @_ = qw( do eval );
+ @is_block_operator{@_} = (1) x scalar(@_);
+
+ # these functions allow an identifier in the indirect object slot
+ @_ = qw( print printf sort exec system say);
+ @is_indirect_object_taker{@_} = (1) x scalar(@_);
+
+ # These tokens may precede a code block
+ # patched for SWITCH/CASE
+ @_ =
+ qw( BEGIN END CHECK INIT AUTOLOAD DESTROY UNITCHECK continue if elsif else
+ unless do while until eval for foreach map grep sort
+ switch case given when);
+ @is_code_block_token{@_} = (1) x scalar(@_);
+
+ # I'll build the list of keywords incrementally
+ my @Keywords = ();
+
+ # keywords and tokens after which a value or pattern is expected,
+ # but not an operator. In other words, these should consume terms
+ # to their right, or at least they are not expected to be followed
+ # immediately by operators.
+ my @value_requestor = qw(
+ AUTOLOAD
+ BEGIN
+ CHECK
+ DESTROY
+ END
+ EQ
+ GE
+ GT
+ INIT
+ LE
+ LT
+ NE
+ UNITCHECK
+ abs
+ accept
+ alarm
+ and
+ atan2
+ bind
+ binmode
+ bless
+ break
+ caller
+ chdir
+ chmod
+ chomp
+ chop
+ chown
+ chr
+ chroot
+ close
+ closedir
+ cmp
+ connect
+ continue
+ cos
+ crypt
+ dbmclose
+ dbmopen
+ defined
+ delete
+ die
+ dump
+ each
+ else
+ elsif
+ eof
+ eq
+ exec
+ exists
+ exit
+ exp
+ fcntl
+ fileno
+ flock
+ for
+ foreach
+ formline
+ ge
+ getc
+ getgrgid
+ getgrnam
+ gethostbyaddr
+ gethostbyname
+ getnetbyaddr
+ getnetbyname
+ getpeername
+ getpgrp
+ getpriority
+ getprotobyname
+ getprotobynumber
+ getpwnam
+ getpwuid
+ getservbyname
+ getservbyport
+ getsockname
+ getsockopt
+ glob
+ gmtime
+ goto
+ grep
+ gt
+ hex
+ if
+ index
+ int
+ ioctl
+ join
+ keys
+ kill
+ last
+ lc
+ lcfirst
+ le
+ length
+ link
+ listen
+ local
+ localtime
+ lock
+ log
+ lstat
+ lt
+ map
+ mkdir
+ msgctl
+ msgget
+ msgrcv
+ msgsnd
+ my
+ ne
+ next
+ no
+ not
+ oct
+ open
+ opendir
+ or
+ ord
+ our
+ pack
+ pipe
+ pop
+ pos
+ print
+ printf
+ prototype
+ push
+ quotemeta
+ rand
+ read
+ readdir
+ readlink
+ readline
+ readpipe
+ recv
+ redo
+ ref
+ rename
+ require
+ reset
+ return
+ reverse
+ rewinddir
+ rindex
+ rmdir
+ scalar
+ seek
+ seekdir
+ select
+ semctl
+ semget
+ semop
+ send
+ sethostent
+ setnetent
+ setpgrp
+ setpriority
+ setprotoent
+ setservent
+ setsockopt
+ shift
+ shmctl
+ shmget
+ shmread
+ shmwrite
+ shutdown
+ sin
+ sleep
+ socket
+ socketpair
+ sort
+ splice
+ split
+ sprintf
+ sqrt
+ srand
+ stat
+ study
+ substr
+ symlink
+ syscall
+ sysopen
+ sysread
+ sysseek
+ system
+ syswrite
+ tell
+ telldir
+ tie
+ tied
+ truncate
+ uc
+ ucfirst
+ umask
+ undef
+ unless
+ unlink
+ unpack
+ unshift
+ untie
+ until
+ use
+ utime
+ values
+ vec
+ waitpid
+ warn
+ while
+ write
+ xor
+
+ switch
+ case
+ given
+ when
+ err
+ say
+ );
+
+ # patched above for SWITCH/CASE given/when err say
+ # 'err' is a fairly safe addition.
+ # TODO: 'default' still needed if appropriate
+ # 'use feature' seen, but perltidy works ok without it.
+ # Concerned that 'default' could break code.
+ push( @Keywords, @value_requestor );
+
+ # These are treated the same but are not keywords:
+ my @extra_vr = qw(
+ constant
+ vars
+ );
+ push( @value_requestor, @extra_vr );
+
+ @expecting_term_token{@value_requestor} = (1) x scalar(@value_requestor);
+
+ # this list contains keywords which do not look for arguments,
+ # so that they might be followed by an operator, or at least
+ # not a term.
+ my @operator_requestor = qw(
+ endgrent
+ endhostent
+ endnetent
+ endprotoent
+ endpwent
+ endservent
+ fork
+ getgrent
+ gethostent
+ getlogin
+ getnetent
+ getppid
+ getprotoent
+ getpwent
+ getservent
+ setgrent
+ setpwent
+ time
+ times
+ wait
+ wantarray
+ );
+
+ push( @Keywords, @operator_requestor );
+
+ # These are treated the same but are not considered keywords:
+ my @extra_or = qw(
+ STDERR
+ STDIN
+ STDOUT
+ );
+
+ push( @operator_requestor, @extra_or );
+
+ @expecting_operator_token{@operator_requestor} =
+ (1) x scalar(@operator_requestor);
+
+ # these token TYPES expect trailing operator but not a term
+ # note: ++ and -- are post-increment and decrement, 'C' = constant
+ my @operator_requestor_types = qw( ++ -- C <> q );
+ @expecting_operator_types{@operator_requestor_types} =
+ (1) x scalar(@operator_requestor_types);
+
+ # these token TYPES consume values (terms)
+ # note: pp and mm are pre-increment and decrement
+ # f=semicolon in for, F=file test operator
+ my @value_requestor_type = qw#
+ L { ( [ ~ !~ =~ ; . .. ... A : && ! || // = + - x
+ **= += -= .= /= *= %= x= &= |= ^= <<= >>= &&= ||= //=
+ <= >= == != => \ > < % * / ? & | ** <=> ~~ !~~
+ f F pp mm Y p m U J G j >> << ^ t
+ #;
+ push( @value_requestor_type, ',' )
+ ; # (perl doesn't like a ',' in a qw block)
+ @expecting_term_types{@value_requestor_type} =
+ (1) x scalar(@value_requestor_type);
+
+ # Note: the following valid token types are not assigned here to
+ # hashes requesting to be followed by values or terms, but are
+ # instead currently hard-coded into sub operator_expected:
+ # ) -> :: Q R Z ] b h i k n v w } #
+
+ # For simple syntax checking, it is nice to have a list of operators which
+ # will really be unhappy if not followed by a term. This includes most
+ # of the above...
+ %really_want_term = %expecting_term_types;
+
+ # with these exceptions...
+ delete $really_want_term{'U'}; # user sub, depends on prototype
+ delete $really_want_term{'F'}; # file test works on $_ if no following term
+ delete $really_want_term{'Y'}; # indirect object, too risky to check syntax;
+ # let perl do it
+
+ @_ = qw(q qq qw qx qr s y tr m);
+ @is_q_qq_qw_qx_qr_s_y_tr_m{@_} = (1) x scalar(@_);
+
+ # These keywords are handled specially in the tokenizer code:
+ my @special_keywords = qw(
+ do
+ eval
+ format
+ m
+ package
+ q
+ qq
+ qr
+ qw
+ qx
+ s
+ sub
+ tr
+ y
+ );
+ push( @Keywords, @special_keywords );
+
+ # Keywords after which list formatting may be used
+ # WARNING: do not include |map|grep|eval or perl may die on
+ # syntax errors (map1.t).
+ my @keyword_taking_list = qw(
+ and
+ chmod
+ chomp
+ chop
+ chown
+ dbmopen
+ die
+ elsif
+ exec
+ fcntl
+ for
+ foreach
+ formline
+ getsockopt
+ if
+ index
+ ioctl
+ join
+ kill
+ local
+ msgctl
+ msgrcv
+ msgsnd
+ my
+ open
+ or
+ our
+ pack
+ print
+ printf
+ push
+ read
+ readpipe
+ recv
+ return
+ reverse
+ rindex
+ seek
+ select
+ semctl
+ semget
+ send
+ setpriority
+ setsockopt
+ shmctl
+ shmget
+ shmread
+ shmwrite
+ socket
+ socketpair
+ sort
+ splice
+ split
+ sprintf
+ substr
+ syscall
+ sysopen
+ sysread
+ sysseek
+ system
+ syswrite
+ tie
+ unless
+ unlink
+ unpack
+ unshift
+ until
+ vec
+ warn
+ while
+ );
+ @is_keyword_taking_list{@keyword_taking_list} =
+ (1) x scalar(@keyword_taking_list);
+
+ # These are not used in any way yet
+ # my @unused_keywords = qw(
+ # CORE
+ # __FILE__
+ # __LINE__
+ # __PACKAGE__
+ # );
+
+ # The list of keywords was extracted from function 'keyword' in
+ # perl file toke.c version 5.005.03, using this utility, plus a
+ # little editing: (file getkwd.pl):
+ # while (<>) { while (/\"(.*)\"/g) { print "$1\n"; } }
+ # Add 'get' prefix where necessary, then split into the above lists.
+ # This list should be updated as necessary.
+ # The list should not contain these special variables:
+ # ARGV DATA ENV SIG STDERR STDIN STDOUT
+ # __DATA__ __END__
+
+ @is_keyword{@Keywords} = (1) x scalar(@Keywords);
+}
+1;
+package main;
+
+
+my $arg_string = undef;
+
+# give Macs a chance to provide command line parameters
+if ($^O =~ /Mac/) {
+ $arg_string =
+ MacPerl::Ask( 'Please enter @ARGV (-h for help)',
+ defined $ARGV[0] ? "\"$ARGV[0]\"" : "" );
+}
+
+Perl::Tidy::perltidy(argv => $arg_string);
+
diff --git a/managementnode/tools/perltidy/runperltidy b/managementnode/tools/perltidy/runperltidy
new file mode 100755
index 0000000..613a4ef
--- /dev/null
+++ b/managementnode/tools/perltidy/runperltidy
@@ -0,0 +1,14 @@
+#!/bin/bash
+
+# Run perltidy
+find ../../ -regex '.*lib/VCL.*\.p[lm]$\|.*bin/vcld$\|.*bin/.*\.p[lm]$' \
+ -exec echo --------------------------- \; \
+ -exec echo Processing {}... \; \
+ -exec perl -I ../../lib ./perltidy -pro=./.perltidyrc -b {} \; \
+
+# Clear out old log and bak directories
+rm -f ./log/*
+rm -f ./bak/*
+
+find ../../ -regex '.*lib/VCL.*\.LOG\|.*bin/.*\.LOG' -exec mv {} ./log \;
+find ../../ -regex '.*lib/VCL.*\.bak\|.*bin/.*\.bak' -exec mv {} ./bak \;
diff --git a/managementnode/tools/setpass.vbs b/managementnode/tools/setpass.vbs
new file mode 100755
index 0000000..9c86f66
--- /dev/null
+++ b/managementnode/tools/setpass.vbs
@@ -0,0 +1,153 @@
+Dim strUsername
+Dim strPassword
+
+' Check arguments
+If WScript.Arguments.Count = 2 Then
+ strUsername = WScript.Arguments.Item(0)
+ strPassword = WScript.Arguments.Item(1)
+Else
+ WScript.Echo "Usage: setpass.vbs <user_name> <password>"
+ WScript.Quit
+End If
+
+
+SetPassword
+
+WScript.Echo "Successfully set password for user: " & strUsername
+WScript.quit 0
+
+'----------------------------------------------------------------------------
+Function UserExists
+ WScript.Echo "Checking if user exists: " & strUsername
+
+ on error resume next
+ Set objUser = GetObject("WinNT://./" & strUsername)
+
+ If IsObject(objUser) Then
+ WScript.Echo "OK: User already exists"
+ UserExists = 1
+ Else
+ WScript.Echo "OK: User does not exist"
+ UserExists = 0
+ End If
+End Function
+
+'----------------------------------------------------------------------------
+Sub CreateUser
+ WScript.Echo "Creating user account: " & strUsername
+
+ Set objComputer = GetObject("WinNT://.")
+ on error resume next
+
+ Set objUser = objComputer.Create("user", strUsername)
+ If (CheckError <> 0) Then
+ WScript.Echo "ERROR: user account could not be created, user object could not be obtained"
+ Quit
+ End If
+
+ objUser.Put "Description", "VCL user account"
+
+ objUser.SetInfo
+ If (CheckError <> 0) Then
+ WScript.Echo "ERROR: user account could not be created, unable to set info"
+ Quit
+ End If
+
+ WScript.Echo "SUCCESS: User account was created"
+End Sub
+
+'----------------------------------------------------------------------------
+Sub DeleteUser
+ WScript.Echo "Deleting user " & strUsername
+
+ on error resume next
+
+ Set objComputer = GetObject("WinNT://.")
+
+
+ If (CheckError <> 0) Then
+ WScript.Echo "ERROR: user object could not be deleted, computer object could not be obtained"
+ Quit
+ End If
+
+ objComputer.Delete "user", strUsername
+ If (CheckError <> 0) Then
+ WScript.Echo "ERROR: user object could not be deleted"
+ Quit
+ End If
+
+ WScript.Echo "SUCCESS: User account was deleted"
+End Sub
+
+'----------------------------------------------------------------------------
+Sub SetPassword
+ WScript.Echo "Setting password for " & strUsername
+
+ on error resume next
+
+ Set objUser = GetObject("WinNT://./" & strUsername)
+ If (CheckError <> 0) Then
+ WScript.Echo "ERROR: unable to get user object before setting password"
+ Quit
+ End If
+
+ objUser.SetPassword strPassword
+ If (CheckError <> 0) Then
+ WScript.Echo "ERROR: unable to set password"
+ Quit
+ End If
+
+ WScript.Echo "SUCCESS: Password was set"
+End Sub
+
+
+'----------------------------------------------------------------------------
+Sub AddUserToGroup(strGroup)
+ WScript.Echo "Adding " & strUsername & " to group: " & strGroup
+
+ on error resume next
+
+ set objGroup = GetObject("WinNT://./" & strGroup)
+ If (CheckError <> 0) Then
+ WScript.Echo "ERROR: unable to get group object before adding user"
+ Quit
+ End If
+
+ objGroup.Add "WinNT://" & strUsername
+ If (Err.Number = "-2147023518") Then
+ WScript.Echo "OK: " & strUsername & " is already a member of " & strGroup
+ ElseIf (CheckError <> 0) Then
+ WScript.Echo "ERROR: unable to add user to group"
+ Quit
+ Else
+ WScript.Echo "SUCCESS: " & strUsername & " added to " & strGroup
+ End If
+End Sub
+
+'----------------------------------------------------------------------------
+Function CheckError
+ If (Err.number <> 0) Then
+ DisplayErrorInfo
+ Err.clear
+ CheckError = 1
+ Else
+ CheckError = 0
+ End If
+end Function
+
+'----------------------------------------------------------------------------
+Sub DisplayErrorInfo
+ WScript.Echo "Error: : " & Err
+ WScript.Echo "Error (hex) : &H" & Hex(Err)
+ WScript.Echo "Source : " & Err.Source
+ WScript.Echo "Description : " & Err.Description
+ Err.Clear
+End Sub
+
+'----------------------------------------------------------------------------
+Sub Quit
+ WScript.Echo "Script exiting after error"
+ WScript.Quit 1
+End Sub
+
+'----------------------------------------------------------------------------
\ No newline at end of file
diff --git a/managementnode/tools/xcat_postscripts/addhttpdiptables b/managementnode/tools/xcat_postscripts/addhttpdiptables
new file mode 100755
index 0000000..9aa6f55
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/addhttpdiptables
@@ -0,0 +1,24 @@
+#!/bin/ksh
+
+logger -t xcat "Install: setup iptables"
+cp /etc/sysconfig/iptables /etc/sysconfig/iptables.ORIG
+echo "# Firewall configuration written by redhat-config-securitylevel" > /etc/sysconfig/iptables
+echo "# Manual customization of this file is not recommended." >> /etc/sysconfig/iptables
+echo "*filter" >> /etc/sysconfig/iptables
+echo ":INPUT ACCEPT [0:0]" >> /etc/sysconfig/iptables
+echo ":FORWARD ACCEPT [0:0]" >> /etc/sysconfig/iptables
+echo ":OUTPUT ACCEPT [0:0]" >> /etc/sysconfig/iptables
+echo ":RH-Firewall-1-INPUT - [0:0]" >> /etc/sysconfig/iptables
+echo "-A INPUT -j RH-Firewall-1-INPUT" >> /etc/sysconfig/iptables
+echo "-A FORWARD -j RH-Firewall-1-INPUT" >> /etc/sysconfig/iptables
+echo "-A RH-Firewall-1-INPUT -i lo -j ACCEPT" >> /etc/sysconfig/iptables
+echo "-A RH-Firewall-1-INPUT -i eth0 -j ACCEPT" >> /etc/sysconfig/iptables
+echo "-A RH-Firewall-1-INPUT -p icmp --icmp-type any -j ACCEPT" >> /etc/sysconfig/iptables
+echo "-A RH-Firewall-1-INPUT -p 50 -j ACCEPT" >> /etc/sysconfig/iptables
+echo "-A RH-Firewall-1-INPUT -p 51 -j ACCEPT" >> /etc/sysconfig/iptables
+echo "-A RH-Firewall-1-INPUT -m state --state ESTABLISHED,RELATED -j ACCEPT" >> /etc/sysconfig/iptables
+echo "-A RH-Firewall-1-INPUT -m state --state NEW -m tcp -p tcp --dport 22 -j ACCEPT" >> /etc/sysconfig/iptables
+echo "-A RH-Firewall-1-INPUT -m state --state NEW -m tcp -p tcp --dport 80 -j ACCEPT" >> /etc/sysconfig/iptables
+echo "-A RH-Firewall-1-INPUT -m state --state NEW -m tcp -p tcp --dport 8080 -j ACCEPT" >> /etc/sysconfig/iptables
+echo "-A RH-Firewall-1-INPUT -j REJECT --reject-with icmp-host-prohibited" >> /etc/sysconfig/iptables
+echo "COMMIT" >> /etc/sysconfig/iptables
diff --git a/managementnode/tools/xcat_postscripts/checksmp b/managementnode/tools/xcat_postscripts/checksmp
new file mode 100755
index 0000000..ccf073b
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/checksmp
@@ -0,0 +1,22 @@
+#!/bin/ksh
+
+logger -t xcat "Install: setup check what type of kernel should be used (SMP or UP) after first boot"
+echo "
+if [ -f /etc/sysconfig/CheckCPU ]; then
+ if [ \`grep processor /proc/cpuinfo | wc -l\` -le 1 ]
+ then
+ logger -t xcat \"PostInstall: it's a UP machine, grub.conf needs to be changed\"
+ cd /boot/grub/
+ mv -f grub.conf grub.conf.ORIG
+ sed -e \"s/default=0/default=1/\" grub.conf.ORIG > grub.conf
+ rm -f /etc/sysconfig/CheckCPU
+ shutdown -r -t 3 now
+ else
+ logger -t xcat \"PostInstall: it's a SMP machine, nothing needs to be done\"
+ fi
+ rm -f /etc/sysconfig/CheckCPU
+fi
+" >>/etc/rc.d/rc.local
+
+echo "CHECKCPU=YES" > /etc/sysconfig/CheckCPU
+
diff --git a/managementnode/tools/xcat_postscripts/checkswap b/managementnode/tools/xcat_postscripts/checkswap
new file mode 100755
index 0000000..0b2401e
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/checkswap
@@ -0,0 +1,33 @@
+#!/bin/ksh
+#egan@us.ibm.com
+#(C)IBM Corp
+#
+
+# make rc.local to check swap configuration and adjust it accordingly to the HDD type
+echo "" >> /etc/rc.local
+echo "
+# fix swap partitons in fstab if neccessary
+DISK=\$(basename \`/sbin/findfs LABEL=/\`)
+DISK=\$(echo \$DISK | sed -e 's/[0-9]*\$//')
+
+cp -f /etc/fstab /etc/fstab.ORIG
+cp -f /etc/fstab /etc/fstab.tmp
+for j in \$(cat /etc/fstab.ORIG | grep swap | awk '{print \$1}')
+do
+ #check if partition has a label
+ if [ \`echo \$j | grep \"LABEL\"\` ]
+ then
+ partname=\$(echo \$j | awk -F- '{print \$2}')
+ else
+ partname=\$(basename \$j)
+ fi
+ partnamenew=\${partname/#???/\$DISK}
+ sed -e \"s/\$partname/\$partnamenew/\" /etc/fstab.tmp > /etc/fstab
+ cp -f /etc/fstab /etc/fstab.tmp
+done
+mv -f /etc/fstab.tmp /etc/fstab
+/sbin/swapon -a
+" >> /etc/rc.local
+
+exit 0
+
diff --git a/managementnode/tools/xcat_postscripts/correctresolv-conf b/managementnode/tools/xcat_postscripts/correctresolv-conf
new file mode 100755
index 0000000..4a173c0
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/correctresolv-conf
@@ -0,0 +1,5 @@
+#!/bin/ksh
+
+logger -t xcat "Install: updating resolv.conf"
+echo "search your.domain
+nameserver your name server" > /etc/resolv.conf
diff --git a/managementnode/tools/xcat_postscripts/defaultshell-tcsh b/managementnode/tools/xcat_postscripts/defaultshell-tcsh
new file mode 100755
index 0000000..1bb9807
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/defaultshell-tcsh
@@ -0,0 +1,11 @@
+#!/bin/ksh
+
+logger -t xcat "Install: defaultshell-tcsh"
+mv /etc/default/useradd /etc/default/useradd.ORIG
+echo "# useradd defaults file" >> /etc/default/useradd
+echo "GROUP=100" >> /etc/default/useradd
+echo "HOME=/home" >> /etc/default/useradd
+echo "INACTIVE=-1" >> /etc/default/useradd
+echo "EXPIRE=" >> /etc/default/useradd
+echo "SHELL=/bin/tcsh" >> /etc/default/useradd
+echo "SKEL=/etc/skel" >> /etc/default/useradd
diff --git a/managementnode/tools/xcat_postscripts/disipv6 b/managementnode/tools/xcat_postscripts/disipv6
new file mode 100755
index 0000000..a94192c
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/disipv6
@@ -0,0 +1,5 @@
+#!/bin/ksh
+
+echo "alias net-pf-10 off" >> /etc/modprobe.conf
+echo "alias ipv6 off" >> /etc/modprobe.conf
+
diff --git a/managementnode/tools/xcat_postscripts/eths4dhcp b/managementnode/tools/xcat_postscripts/eths4dhcp
new file mode 100755
index 0000000..c97faa6
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/eths4dhcp
@@ -0,0 +1,207 @@
+#!/bin/ksh
+#egan@us.ibm.com
+#(C)IBM Corp
+#
+
+if [ -z "$XCATROOT" ]
+then
+ if [ -r /etc/sysconfig/xcat ]
+ then
+ . /etc/sysconfig/xcat
+ else
+ if [ -r /etc/rc.config ]
+ then
+ . /etc/rc.config
+ fi
+ fi
+fi
+
+if [ -z "$XCATROOT" ]
+then
+ if [ -r "$(dirname $0)/../lib/xcatroot" ]
+ then
+ . $(dirname $0)/../lib/xcatroot
+ fi
+fi
+
+if [ -z "$XCATROOT" ]
+then
+ echo "$(basename $0): env XCATROOT not defined!" >&2
+ exit 1
+fi
+
+if [ ! -d "$XCATROOT" ]
+then
+ echo "$(basename $0): XCATROOT $XCATROOT does not exist!" >&2
+ exit 1
+fi
+
+. $XCATROOT/lib/functions
+
+function setupnic {
+ NIC=$1
+ ETHNIC=eth$1
+ RESNAME=$(whatismyres2 $NODE)
+ PRINIC=$(tabdb $NODERESTAB $RESNAME $noderes_prinic)
+
+ if IP=$(
+ host $NODE-eth$NIC | \
+ head -1 | \
+ awk '{ if (/has address/) {print $NF} else exit 1}'
+ )
+ then
+ :
+ else
+ if IP=$(
+ host $NODE | \
+ head -1 | \
+ awk '{ if (/has address/) {print $NF} else exit 1}'
+ )
+ then
+ if [ "$ETHNIC" != "$PRINIC" ]
+ then
+ IP=""
+ fi
+ else
+ IP=""
+ fi
+ fi
+
+ if [ -n "$IP" ]
+ then
+ NM=$(whatsmynet $IP | awk '{print $2}')
+
+ GW=""
+ if GW=$(whatsmynet $IP | awk '{print $3}')
+ then
+ if [ "$GW" = "NA" ]
+ then
+ GW=""
+ fi
+ else
+ GW=""
+ fi
+ fi
+
+ if [ -n "$IP" -a -n "$NM" ]
+ then
+ NW=$(ipcalc.ksh --network $IP $NM | awk -F= '{print $2}')
+ BC=$(ipcalc.ksh --broadcast $IP $NM | awk -F= '{print $2}')
+ fi
+
+ if [ "$PRINIC" = "eth$NIC" ]
+ then
+ GATEWAY=$GW
+ fi
+
+ case $OSVER in
+ sles[89]|suse8*|suse9*|suse10|ul*)
+ if [ -n "$GATEWAY" ]
+ then
+ echo "default $GATEWAY - $PRINIC" >/etc/sysconfig/network/routes
+ fi
+ cd /etc/sysconfig/network
+ perl -pi -e 's/^FIREWALL="yes"/FIREWALL="no"/' /etc/sysconfig/network/config
+ ;;
+ rh*)
+ if [ -n "$GATEWAY" ]
+ then
+ perl -pi -e 's/^GATEWAYDEV=.*\n//' /etc/sysconfig/network
+ perl -pi -e 's/^GATEWAY=.*\n//' /etc/sysconfig/network
+# echo "GATEWAYDEV=$PRINIC" >>/etc/sysconfig/network
+# echo "GATEWAY=$GATEWAY" >>/etc/sysconfig/network
+ fi
+ cd /etc/sysconfig/network-scripts
+ ;;
+ esac
+
+ if [ -r ifcfg-eth$NIC ]
+ then
+ cp ifcfg-eth$NIC ../ifcfg-eth$NIC.ORIG
+ fi
+ >ifcfg-eth$NIC
+
+ if [ -n "$IP" -a -n "$NM" ]
+ then
+ echo "DEVICE=eth$NIC" >>ifcfg-eth$NIC
+ echo "BOOTPROTO=dhcp" >>ifcfg-eth$NIC
+ echo "STARTMODE=onboot" >>ifcfg-eth$NIC
+ echo "ONBOOT=yes" >>ifcfg-eth$NIC
+ echo "USERCTL=no" >>ifcfg-eth$NIC
+# echo "IPADDR=$IP" >>ifcfg-eth$NIC
+# echo "BROADCAST=$BC" >>ifcfg-eth$NIC
+# echo "NETMASK=$NM" >>ifcfg-eth$NIC
+ else
+ echo "DEVICE=eth$NIC" >>ifcfg-eth$NIC
+ echo "BOOTPROTO=dhcp" >>ifcfg-eth$NIC
+ echo "STARTMODE=onboot" >>ifcfg-eth$NIC
+ echo "ONBOOT=yes" >>ifcfg-eth$NIC
+ fi
+}
+
+mv -f /etc/hosts /etc/hosts.hardeths
+
+nic=0
+PCITABLE=$XCATROOT/install/postscripts/data/pcitable.net
+
+MOD=""
+for i in $(lspci -n | sed 's/Class//' | perl -pi -e 's/^\d{4}://' | awk '{print $1 ":" $3}')
+do
+ PCI=$(echo $i | awk -F: '{print $1 ":" $2}')
+ VID="0x$(echo $i | awk -F: '{print $3}')"
+ DID="0x$(echo $i | awk -F: '{print $4}')"
+ if egrep "^$VID $DID" $PCITABLE >/dev/null
+ then
+ TYPE=$(
+ lspci | \
+ perl -pi -e 's/^\d{4}://' | \
+ grep "^$PCI " | \
+ awk '{print $2}' | \
+ tr '[A-Z]' '[a-z]'
+ )
+ DESC=$(
+ lspci | \
+ perl -pi -e 's/^\d{4}://' | \
+ grep "^$PCI " | \
+ awk -F: '{print $3}' | \
+ sed 's/^ *//'
+ )
+ MOD=$(
+ egrep "^$VID $DID" $PCITABLE | \
+ head -1 | \
+ awk '{print $3}' | \
+ tr -d '"'
+ )
+ case "$TYPE" in
+ ethernet|network)
+ echo "Found ($MOD) $DESC"
+ if egrep "^alias eth$nic $MOD\b" /etc/modules.conf >/dev/null 2>&1
+ then
+ :
+ else
+ echo "#added by xCAT hardeths" >>/etc/modules.conf
+ echo "alias eth$nic $MOD" >>/etc/modules.conf
+ fi
+ if egrep "^alias eth$nic $MOD\b" /etc/modprobe.conf >/dev/null 2>&1
+ then
+ :
+ else
+ echo "#added by xCAT hardeths" >>/etc/modprobe.conf
+ echo "alias eth$nic $MOD" >>/etc/modprobe.conf
+ fi
+ ;;
+ *)
+ continue
+ ;;
+ esac
+
+ logger -t xcat "Install: found eth$nic as $MOD"
+ setupnic $nic
+ nic=$(($nic + 1))
+ fi
+done
+
+mv -f /etc/hosts.hardeths /etc/hosts
+
+exit 0
+
diff --git a/managementnode/tools/xcat_postscripts/gpfs31 b/managementnode/tools/xcat_postscripts/gpfs31
new file mode 100755
index 0000000..a5e6bcf
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/gpfs31
@@ -0,0 +1,59 @@
+#!/bin/ksh
+#vallard@us.ibm.com
+#(C)IBM Corp
+#
+set -x
+MMSDRFS=mmsdrfs
+ARCH=$(uname -i)
+KERN=$(uname -r)
+
+if [ -d /post/gpfs31 ]
+then
+ cd /post/gpfs31
+else
+ exit
+fi
+
+# copy config
+if [ -n "$MMSDRFS" ]
+then
+ if [ -r "$MMSDRFS" ]
+ then
+ mkdir -p /var/mmfs/gen 2>&1 | logger
+ chmod 755 /var/mmfs /var/mmfs/gen 2>&1 | logger
+ cp -f $MMSDRFS /var/mmfs/gen/mmsdrfs 2>&1 | logger
+ fi
+fi
+
+echo $ARCH | perl -pi -e "if(/^i.86$/) {exit 0} else {exit 1}"
+if [ "$?" = "0" ]
+then
+ ARCH=x86
+fi
+
+# install rpms
+if [ -d /post/gpfs31/$ARCH/base ]
+then
+ cd /post/gpfs31/$ARCH/base
+ rpm -ivh gpfs*.rpm 2>&1 | logger
+else
+ echo "/post/gpfs31/$ARCH/base does not exist"
+ exit
+fi
+
+if [ -d /post/gpfs31/$ARCH/update ]
+then
+ cd /post/gpfs31/$ARCH/update
+ rpm -Uvh gpfs*.rpm 2>&1 | logger
+fi
+
+# copy portability layer
+cd ../bin
+cp * /usr/lpp/mmfs/bin/
+
+# copy profile stuff:
+cd ../..
+cp gpfs.sh gpfs.csh /etc/profile.d
+
+
+exit 0
diff --git a/managementnode/tools/xcat_postscripts/hosts4dhcp b/managementnode/tools/xcat_postscripts/hosts4dhcp
new file mode 100755
index 0000000..eaf26ee
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/hosts4dhcp
@@ -0,0 +1,53 @@
+#!/bin/ksh
+#egan@us.ibm.com
+#(C)IBM Corp
+#
+
+. $XCATROOT/lib/functions
+
+logger -t xcat "Install: setting up /etc/hosts"
+
+RESNAME=$(whatismyres2 $NODE)
+ETH=$(tabdb $NODERESTAB $RESNAME $noderes_prinic)
+
+if [ -z "$ETH" ]
+then
+ ETH=eth0
+fi
+
+IP=$(host $NODE | head -1 | awk '{print $NF}')
+HOSTNAME=$NODE
+MIP=$(host $MASTER | head -1 | awk '{print $NF}')
+
+mv -f /etc/hosts /etc/hosts.ORIG
+
+case $OSVER in
+ sles[89]|suse8*|suse9*|suse10|ul*)
+ echo "127.0.0.1 localhost" >/etc/hosts
+ echo >>/etc/hosts
+ perl -pi -e 's/CHECK_ETC_HOSTS=.*/CHECK_ETC_HOSTS="no"/' /etc/sysconfig/suseconfig
+ perl -pi -e 's/BEAUTIFY_ETC_HOSTS=.*/BEAUTIFY_ETC_HOSTS="no"/' /etc/sysconfig/suseconfig
+ ;;
+ rh*)
+ echo "127.0.0.1 localhost" >/etc/hosts
+ echo >>/etc/hosts
+ ;;
+esac
+
+#if [ -n "$IP" ]
+#then
+# echo "$IP $HOSTNAME $HOSTNAME.$DOMAIN" >>/etc/hosts
+#fi
+
+#if [ -n "$MIP" ]
+#then
+# echo "$MIP $MASTER $MASTER.$DOMAIN" >>/etc/hosts
+#fi
+
+if [ -r /etc/hosts.x ]
+then
+ cat /etc/hosts.x >>/etc/hosts
+fi
+
+exit 0
+
diff --git a/managementnode/tools/xcat_postscripts/makesshgkh b/managementnode/tools/xcat_postscripts/makesshgkh
new file mode 100755
index 0000000..dc90820
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/makesshgkh
@@ -0,0 +1,27 @@
+#!/bin/ksh
+#egan@us.ibm.com
+#(C)IBM Corp
+#
+
+. $XCATROOT/lib/functions
+
+echo "$RSHC" | grep "ssh" >/dev/null 2>&1
+if [ "$?" = "0" ]
+then
+ logger -t xcat "Install: Running makesshgkh on the server"
+
+ service sshd start
+ ssh $MASTER $XCATROOT/sbin/makesshgkh $NODE
+ service sshd stop
+fi
+
+if [[ $(ls /root/.ssh/ | grep ORIG | wc -l) != "0" ]]
+then
+ rm -f /root/.ssh/*ORIG
+else
+ rm -f /root/.ssh/id_rsa
+ rm -f /root/.ssh/id_rsa.pub
+ rm -f /root/.ssh/config
+fi
+
+exit 0
diff --git a/managementnode/tools/xcat_postscripts/mysyncdirs b/managementnode/tools/xcat_postscripts/mysyncdirs
new file mode 100755
index 0000000..5d5c314
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/mysyncdirs
@@ -0,0 +1,49 @@
+#!/bin/ksh
+#egan@us.ibm.com
+#(C)IBM Corp
+#
+
+. $XCATROOT/lib/functions
+
+RESNAME=$(whatismyres2 $NODE)
+
+if [ "$RESNAME" = "$NODE" ]
+then
+ RESNAME=""
+fi
+
+NODETYPE=$(tabdb $NODETYPETAB $NODE 3)
+
+GROUPS="$(
+ egrep "^$NODE( | |$)" $NODELISTTAB | \
+ head -1 | \
+ awk '{print $2}' | \
+ tr ',' ' '
+)"
+
+#for i in $OSVER/$ARCH $OSVER/noarch $ARCH $NODETYPE $RESNAME $GROUPS $NODE $*
+for i in $OSVER/$ARCH $OSVER/noarch $ARCH $NODETYPE $GROUPS $NODE $*
+do
+ newi=$(echo $i | tr '/' '-')
+ if [ -d /post/sync/$i ]
+ then
+ logger -t xcat "Install: copying /post/sync/$i to /"
+ if cd /post/sync/$i
+ then
+ pwd | logger -t xcat
+ for j in $(find . -type f -print)
+ do
+ if [ -r /$j ]
+ then
+ cp -f /$j /${j}.${newi}.ORIG 2>&1 | logger -t xcat
+ fi
+ done
+ cp -fR * /
+# find . -print | cpio -dump / 2>&1 | logger -t xcat
+# sleep 5
+ fi
+ else
+ logger -t xcat "Install: not syncing from $i"
+ fi
+done
+
diff --git a/managementnode/tools/xcat_postscripts/name4dhcp b/managementnode/tools/xcat_postscripts/name4dhcp
new file mode 100755
index 0000000..7a548bd
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/name4dhcp
@@ -0,0 +1,27 @@
+#!/bin/ksh
+#egan@us.ibm.com
+#(C)IBM Corp
+#
+
+. $XCATROOT/lib/functions
+
+logger -t xcat "Install: setting up hostname"
+
+HOSTNAME=$NODE
+
+case $OSVER in
+ sles[89]|suse8*|suse9*|suse10|ul*)
+ cp -f /etc/HOSTNAME /etc/HOSTNAME.ORIG
+ echo "$HOSTNAME" >/etc/HOSTNAME
+ ;;
+ rh*)
+ cp -f /etc/sysconfig/network /etc/sysconfig/network.ORIG
+ perl -pi -e 's/^NETWORKING=.*\n//' /etc/sysconfig/network
+ perl -pi -e 's/^HOSTNAME=.*\n//' /etc/sysconfig/network
+ echo "NETWORKING=yes" >>/etc/sysconfig/network
+# echo "HOSTNAME=$HOSTNAME" >>/etc/sysconfig/network
+ ;;
+esac
+
+exit 0
+
diff --git a/managementnode/tools/xcat_postscripts/openafs b/managementnode/tools/xcat_postscripts/openafs
new file mode 100755
index 0000000..0e0bdfc
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/openafs
@@ -0,0 +1,63 @@
+#!/bin/ksh
+#vallard@us.ibm.com
+#(C)IBM Corp
+#
+ARCH=$(uname -i)
+KERN=$(uname -r)
+
+NODEPS=""
+for i in $*
+do
+ case "$i" in
+ nodeps)
+ NODEPS="--nodeps"
+ ;;
+ esac
+done
+
+
+echo $ARCH | perl -pi -e "if(/^i.86$/) {exit 0} else {exit 1}"
+if [ "$?" = "0" ]
+then
+ ARCH=x86
+fi
+
+# install RPMs with --nodeps option
+if [ -d /post/openafs/$OSVER/$ARCH/ ]
+then
+ logger -t xcat "Install: OpenAFS RPMs"
+ cd /post/openafs/$OSVER/$ARCH/
+ rpm -iv --nodeps *.rpm 2>&1 | logger -t xcat
+else
+ echo "/post/openafs/$OSVER/$ARCH/ does not exist"
+ exit
+fi
+
+exit 0
+
+# install rpms based on type of kernel (UP vs. SMP)
+#if [ -z `echo $KERN | grep "smp"` ]
+if [ `grep processor /proc/cpuinfo | wc -l` -le 1 ]
+then
+ if [ -d /post/openafs/$OSVER/$ARCH/up ]
+ then
+ logger -t xcat "Install: OpenAFS RPMs for UP kernel ($KERN)"
+ cd /post/openafs/$OSVER/$ARCH/up
+ rpm -ivh $NODEPS *.rpm 2>&1 | logger -t xcat
+ else
+ echo "/post/openafs/$OSVER/$ARCH/up does not exist"
+ exit
+ fi
+else
+ if [ -d /post/openafs/$OSVER/$ARCH/smp ]
+ then
+i logger -t xcat "Install: OpenAFS RPMs for SMP kernel ($KERN)"
+ cd /post/openafs/$OSVER/$ARCH/smp
+ rpm -ivh $NODEPS *.rpm 2>&1 | logger -t xcat
+ else
+ echo "/post/openafs/$OSVER/$ARCH/smp does not exist"
+ exit
+ fi
+fi
+
+exit 0
diff --git a/managementnode/tools/xcat_postscripts/otherrpms b/managementnode/tools/xcat_postscripts/otherrpms
new file mode 100755
index 0000000..537b697
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/otherrpms
@@ -0,0 +1,117 @@
+#!/bin/ksh
+#egan@us.ibm.com
+#(C)IBM Corp
+#
+# Updates must be located in $INSTALLDIR/post/otherrpms/$OSVER/$ARCH
+#
+# ARCH for x86 is special and may be i386 - i686.
+#
+# noarch is also applied.
+#
+
+NODEPS=""
+FORCE=""
+for i in $*
+do
+ case "$i" in
+ nodeps)
+ NODEPS="--nodeps"
+ ;;
+ force)
+ FORCE="--force"
+ ;;
+ esac
+done
+
+logger -t xcat "Install: other RPMs"
+
+echo $ARCH | perl -pi -e "if(/^i.86$/) {exit 0} else {exit 1}"
+if [ "$?" = "0" ]
+then
+ ARCH=x86
+fi
+
+set -A UPDATEDIR
+integer c=-1
+
+if [ -d "/post/otherrpms/$OSVER/$ARCH" ]
+then
+ c=c+1
+ UPDATEDIR[$c]=/post/otherrpms/$OSVER/$ARCH
+fi
+
+if [ "$ARCH" = "x86" ]
+then
+ for i in 6 5 4 3
+ do
+ if [ -d /post/otherrpms/$OSVER/i${i}86 ]
+ then
+ c=c+1
+ UPDATEDIR[$c]=/post/otherrpms/$OSVER/i${i}86
+ fi
+ done
+fi
+
+if [ -d "/post/otherrpms/$OSVER/noarch" ]
+then
+ c=c+1
+ UPDATEDIR[$c]=/post/otherrpms/$OSVER/noarch
+fi
+
+if ((c < 0))
+then
+ logger -t xcat "Install: No otherrpm dir, exiting other RPMs"
+ exit
+fi
+
+RPMLIST=""
+integer d=-1
+for i in ${UPDATEDIR[*]}
+do
+ d=d+1
+ ls $i/*.rpm >/dev/null 2>&1
+ if [ "$?" != "0" ]
+ then
+ continue
+ fi
+ for j in $i/*.rpm
+ do
+ if ((d > 0))
+ then
+ integer e=$d-1
+ GOTIT=0
+ for k in $(seq 0 $e)
+ do
+ RPM=$(basename $j)
+ RPMNAME=$(echo $RPM | perl -pi -e 's/\.[^\.]+?\.rpm//')
+ if [ -r ${UPDATEDIR[$k]}/$RPMNAME.*.rpm ]
+ then
+ GOTIT=1
+ echo "Already got $j as $(ls ${UPDATEDIR[$k]}/$RPMNAME.*.rpm)"
+ break
+ fi
+ done
+ if [ "$GOTIT" = "0" ]
+ then
+ RPMLIST="$RPMLIST $j"
+ fi
+ else
+ RPMLIST="$RPMLIST $j"
+ fi
+ done
+done
+
+RPMLIST=$(echo $RPMLIST | sed 's/^ *//')
+
+if [ -z "$RPMLIST" ]
+then
+ logger -t xcat "Install: otherrpm dirs ${UPDATEDIR[*]} empty, exiting other RPMs"
+ exit
+fi
+
+logger -t xcat "Install: Installing RPMs from ${UPDATEDIR[*]}"
+
+rpm -iv $FORCE $NODEPS $RPMLIST 2>&1 | logger -t xcat
+
+exit 0
+
diff --git a/managementnode/tools/xcat_postscripts/otherrpms-lamp b/managementnode/tools/xcat_postscripts/otherrpms-lamp
new file mode 100755
index 0000000..77e0833
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/otherrpms-lamp
@@ -0,0 +1,119 @@
+#!/bin/ksh
+#egan@us.ibm.com
+#(C)IBM Corp
+#
+# Updates must be located in $INSTALLDIR/post/otherrpms/$OSVER/$ARCH
+#
+# ARCH for x86 is special and may be i386 - i686.
+#
+# noarch is also applied.
+#
+
+NODEPS=""
+for i in $*
+do
+ case "$i" in
+ nodeps)
+ NODEPS="--nodeps"
+ ;;
+ esac
+done
+
+logger -t xcat "Install: other RPMs"
+
+echo $ARCH | perl -pi -e "if(/^i.86$/) {exit 0} else {exit 1}"
+if [ "$?" = "0" ]
+then
+ ARCH=x86
+fi
+
+set -A UPDATEDIR
+integer c=-1
+
+if [ -d "/post/otherrpms/$OSVER/$ARCH" ]
+then
+ c=c+1
+ UPDATEDIR[$c]=/post/otherrpms/$OSVER/$ARCH
+fi
+
+if [ "$ARCH" = "x86" ]
+then
+ for i in 6 5 4 3
+ do
+ if [ -d /post/otherrpms/$OSVER/i${i}86 ]
+ then
+ c=c+1
+ UPDATEDIR[$c]=/post/otherrpms/$OSVER/i${i}86
+ fi
+ done
+fi
+
+if [ -d "/post/otherrpms/$OSVER/noarch" ]
+then
+ c=c+1
+ UPDATEDIR[$c]=/post/otherrpms/$OSVER/noarch
+fi
+
+if ((c < 0))
+then
+ logger -t xcat "Install: No otherrpm dir, exiting other RPMs"
+ exit
+fi
+
+if [ -d "/post/otherrpms/$OSVER/$ARCH/lamp" ]
+then
+ c=c+1
+ UPDATEDIR[$c]=/post/otherrpms/$OSVER/$ARCH/lamp
+fi
+
+RPMLIST=""
+integer d=-1
+for i in ${UPDATEDIR[*]}
+do
+ d=d+1
+ ls $i/*.rpm >/dev/null 2>&1
+ if [ "$?" != "0" ]
+ then
+ continue
+ fi
+ for j in $i/*.rpm
+ do
+ if ((d > 0))
+ then
+ integer e=$d-1
+ GOTIT=0
+ for k in $(seq 0 $e)
+ do
+ RPM=$(basename $j)
+ RPMNAME=$(echo $RPM | perl -pi -e 's/\.[^\.]+?\.rpm//')
+ if [ -r ${UPDATEDIR[$k]}/$RPMNAME.*.rpm ]
+ then
+ GOTIT=1
+ echo "Already got $j as $(ls ${UPDATEDIR[$k]}/$RPMNAME.*.rpm)"
+ break
+ fi
+ done
+ if [ "$GOTIT" = "0" ]
+ then
+ RPMLIST="$RPMLIST $j"
+ fi
+ else
+ RPMLIST="$RPMLIST $j"
+ fi
+ done
+done
+
+RPMLIST=$(echo $RPMLIST | sed 's/^ *//')
+
+if [ -z "$RPMLIST" ]
+then
+ logger -t xcat "Install: otherrpm dirs ${UPDATEDIR[*]} empty, exiting other RPMs"
+ exit
+fi
+
+logger -t xcat "Install: Installing RPMs from ${UPDATEDIR[*]}"
+
+rpm -iv $NODEPS $RPMLIST 2>&1 | logger -t xcat
+
+exit 0
+
diff --git a/managementnode/tools/xcat_postscripts/private.hardeths b/managementnode/tools/xcat_postscripts/private.hardeths
new file mode 100755
index 0000000..2697d0b
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/private.hardeths
@@ -0,0 +1,107 @@
+#!/bin/ksh
+#egan@us.ibm.com
+#(C)IBM Corp
+#
+
+if [ -z "$XCATROOT" ]
+then
+ if [ -r /etc/sysconfig/xcat ]
+ then
+ . /etc/sysconfig/xcat
+ else
+ if [ -r /etc/rc.config ]
+ then
+ . /etc/rc.config
+ fi
+ fi
+fi
+
+if [ -z "$XCATROOT" ]
+then
+ if [ -r "$(dirname $0)/../lib/xcatroot" ]
+ then
+ . $(dirname $0)/../lib/xcatroot
+ fi
+fi
+
+if [ -z "$XCATROOT" ]
+then
+ echo "$(basename $0): env XCATROOT not defined!" >&2
+ exit 1
+fi
+
+if [ ! -d "$XCATROOT" ]
+then
+ echo "$(basename $0): XCATROOT $XCATROOT does not exist!" >&2
+ exit 1
+fi
+
+. $XCATROOT/lib/functions
+
+#
+# Hardcode eth0
+#
+logger -t xcat "Install: setting up eth0"
+IP0=$(ifconfig eth0 | grep inet | awk '{print $2}' | awk -F: '{print $2}')
+BC0=$(ifconfig eth0 | grep inet | awk '{print $3}' | awk -F: '{print $2}')
+SM0=$(ifconfig eth0 | grep inet | awk '{print $4}' | awk -F: '{print $2}')
+cd /etc/sysconfig/network-scripts
+cp ifcfg-eth0 ../ORIG.ifcfg-eth0
+echo "DEVICE=eth0
+BOOTPROTO=none
+ONBOOT=yes
+USERCTL=no
+IPADDR=$IP0
+BROADCAST=$BC0
+NETMASK=$SM0" >ifcfg-eth0
+
+#mv /etc/resolv.conf /etc/resolv.conf.ORIG
+#echo "search $DNSDOMAIN" >/etc/resolv.conf
+#for i in $(echo $NAMESERVERS | tr ',' ' ')
+#do
+# echo "nameserver $i"
+#done >>/etc/resolv.conf
+
+HOSTNAME=$(host $IP0 2>/dev/null | awk '{print $5}' | awk -F. '{print $1}')
+cp /etc/sysconfig/network /etc/sysconfig/network.ORIG
+echo "NETWORKING=yes
+HOSTNAME=$HOSTNAME
+GATEWAYDEV=eth1
+GATEWAY=X.X.X.X" >/etc/sysconfig/network
+
+if [ "$NISDOMAIN" != "NA" ]
+then
+ echo "NISDOMAIN=$NISDOMAIN" >>/etc/sysconfig/network
+fi
+
+#
+# Setup eth1
+#
+logger -t xcat "Install: setting up eth1"
+IP1=$(ifconfig eth0 | grep inet | awk '{print $2}' | awk -F: '{print $2}' | awk -F. '{print $1.$2.$3.$4}')
+BC1=X.X.X.X
+SM1=255.255.255.0
+cd /etc/sysconfig/network-scripts
+cp ifcfg-eth1 ../ORIG.ifcfg-eth1
+echo "DEVICE=eth1
+BOOTPROTO=none
+ONBOOT=yes
+USERCTL=no
+IPADDR=$IP1
+BROADCAST=$BC1
+NETMASK=$SM1" >ifcfg-eth1
+
+chmod 755 ifcfg-eth*
+
+#
+# Setup hosts
+#
+echo "Install: setting up /etc/hosts"
+echo "127.0.0.1 localhost
+
+$IP0 $HOSTNAME $HOSTNAME.$DOMAIN
+$MIP $MASTER $MASTER.$DOMAIN" >/etc/hosts
+
+exit 0
+
+
diff --git a/managementnode/tools/xcat_postscripts/remoteshell-dblssh b/managementnode/tools/xcat_postscripts/remoteshell-dblssh
new file mode 100755
index 0000000..87f6b50
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/remoteshell-dblssh
@@ -0,0 +1,74 @@
+#!/bin/ksh
+#egan@us.ibm.com
+#(C)IBM Corp
+#
+
+. $XCATROOT/lib/functions
+
+echo "$RSHC" | grep "rsh" >/dev/null 2>&1
+if [ "$?" = "0" ]
+then
+ if [ -r /etc/xinetd.d/rsh ]
+ then
+ logger -t xcat "Install: enable rsh"
+ perl -pi -e 's/^(\tdisable[^=]*=) yes/$1 no/' /etc/xinetd.d/rsh
+ perl -pi -e 's/^(\tdisable[^=]*=) yes/$1 no/' /etc/xinetd.d/rlogin
+ logger -t xcat "Install: setup root .rhosts"
+ cd /root
+ echo "$MASTER" >.rhosts
+ echo "$MASTER.$DOMAIN" >>.rhosts
+ chmod 600 .rhosts
+ fi
+ echo "rsh" >>/etc/securetty
+ echo "rlogin" >>/etc/securetty
+fi
+
+
+MIP=$(nametoip $MASTER)
+IP0=$(ifconfig eth0 | grep inet | awk '{print $2}' | awk -F: '{print $2}')
+IP1=$(ifconfig eth0 | grep inet | awk '{print $2}' | awk -F: '{print \$2}')
+
+TABFILE="$XCATROOT/etc/hpcaddr.tab"
+SHORTHOSTNAME=$(echo $HOSTNAME | awk -F. '{print $1}')
+IP05=$(tabdb $TABFILE $SHORTHOSTNAME 1)
+
+echo "$RSHC" | grep "ssh" >/dev/null 2>&1
+if [ "$?" = "0" ]
+then
+ if [ -r /etc/ssh/sshd_config ]
+ then
+ logger -t xcat "Install: setup /etc/ssh/sshd_config"
+ cp /etc/ssh/sshd_config /etc/ssh/sshd_config.ORIG
+ perl -pi -e 's/^X11Forwarding .*$/X11Forwarding yes/' /etc/ssh/sshd_config
+ perl -pi -e 's/^KeyRegenerationInterval .*$/KeyRegenerationInterval 0/' /etc/ssh/sshd_config
+ perl -pi -e 's/(.*MaxStartups.*)/#\1/' /etc/ssh/sshd_config
+ echo "MaxStartups 1024" >>/etc/ssh/sshd_config
+# echo "PasswordAuthentication no" >>/etc/ssh/sshd_config
+# setup second sshd (external)
+ cp /etc/ssh/sshd_config /etc/ssh/external_sshd_config
+ echo "ListenAddress $IP0" >>/etc/ssh/sshd_config
+ echo "ListenAddress $IP05" >>/etc/ssh/sshd_config
+# echo "AllowUsers root@$MIP" >>/etc/ssh/sshd_config
+ echo "AllowUsers root" >>/etc/ssh/sshd_config
+
+ logger -t xcat "Install: setup /etc/ssh/external_sshd_config"
+ echo "PidFile /var/run/ext_sshd.pid" >>/etc/ssh/external_sshd_config
+ echo "ListenAddress $IP1" >>/etc/ssh/external_sshd_config
+ echo "PermitRootLogin no" >>/etc/ssh/external_sshd_config
+ echo "Banner /etc/banner" >>/etc/ssh/external_sshd_config
+
+ fi
+
+ if [ -d /post/.ssh ]
+ then
+ logger -t xcat "Install: setup root .ssh"
+ cd /post/.ssh
+ mkdir -p /root/.ssh
+ cp -f * /root/.ssh
+ chmod 700 /root/.ssh
+ chmod 600 /root/.ssh/*
+ fi
+fi
+
+exit 0
+
diff --git a/managementnode/tools/xcat_postscripts/remoteshell-dblssh-dhcp b/managementnode/tools/xcat_postscripts/remoteshell-dblssh-dhcp
new file mode 100755
index 0000000..ddad2ae
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/remoteshell-dblssh-dhcp
@@ -0,0 +1,94 @@
+#!/bin/ksh
+#egan@us.ibm.com
+#(C)IBM Corp
+#
+
+. $XCATROOT/lib/functions
+
+echo "$RSHC" | grep "rsh" >/dev/null 2>&1
+if [ "$?" = "0" ]
+then
+ if [ -r /etc/xinetd.d/rsh ]
+ then
+ logger -t xcat "Install: enable rsh"
+ perl -pi -e 's/^(\tdisable[^=]*=) yes/$1 no/' /etc/xinetd.d/rsh
+ perl -pi -e 's/^(\tdisable[^=]*=) yes/$1 no/' /etc/xinetd.d/rlogin
+ logger -t xcat "Install: setup root .rhosts"
+ cd /root
+ echo "$MASTER" >.rhosts
+ echo "$MASTER.$DOMAIN" >>.rhosts
+ chmod 600 .rhosts
+ fi
+ echo "rsh" >>/etc/securetty
+ echo "rlogin" >>/etc/securetty
+fi
+
+
+MIP=$(nametoip $MASTER)
+
+echo "$RSHC" | grep "ssh" >/dev/null 2>&1
+if [ "$?" = "0" ]
+then
+ if [ -r /etc/ssh/sshd_config ]
+ then
+ logger -t xcat "Install: setup /etc/ssh/sshd_config"
+ cp /etc/ssh/sshd_config /etc/ssh/sshd_config.ORIG
+ perl -pi -e 's/^X11Forwarding .*$/X11Forwarding yes/' /etc/ssh/sshd_config
+ perl -pi -e 's/^KeyRegenerationInterval .*$/KeyRegenerationInterval 0/' /etc/ssh/sshd_config
+ perl -pi -e 's/(.*MaxStartups.*)/#\1/' /etc/ssh/sshd_config
+ echo "MaxStartups 1024" >>/etc/ssh/sshd_config
+# echo "PasswordAuthentication no" >>/etc/ssh/sshd_config
+# setup second sshd (external)
+ cp /etc/ssh/sshd_config /etc/ssh/external_sshd_config
+ echo "AllowUsers root@$MIP" >>/etc/ssh/sshd_config
+
+ logger -t xcat "Install: setup /etc/ssh/external_sshd_config"
+ echo "PidFile /var/run/ext_sshd.pid" >>/etc/ssh/external_sshd_config
+ echo "PermitRootLogin no" >>/etc/ssh/external_sshd_config
+ echo "Banner /etc/banner" >>/etc/ssh/external_sshd_config
+
+ fi
+
+ if [ -d /post/.ssh ]
+ then
+ logger -t xcat "Install: setup root .ssh"
+ cd /post/.ssh
+ mkdir -p /root/.ssh
+ cp -f * /root/.ssh
+ chmod 700 /root/.ssh
+ chmod 600 /root/.ssh/*
+ fi
+
+case $OSVER in
+ rhfc[45]*)
+ newline="\\n"
+ ;;
+ rh*)
+ newline="\\\\n"
+ ;;
+esac
+
+
+# make rc.local to change "ListenAddress" in sshd's configs accordingly to network interfaces values
+echo "" >> /etc/rc.local
+echo "
+IP0=\$(ifconfig eth0 | grep 'inet addr' | awk '{print \$2}' | awk -F: '{print \$2}')
+IP1=\$(ifconfig eth1 | grep 'inet addr' | awk '{print \$2}' | awk -F: '{print \$2}')
+perl -pi -e 's/^AllowUsers .*//' /etc/ssh/sshd_config
+perl -pi -e 's/^ListenAddress .*//' /etc/ssh/sshd_config
+perl -pi -e 's/^ListenAddress .*//' /etc/ssh/external_sshd_config
+echo \"AllowUsers root\" >> /etc/ssh/sshd_config
+echo \"ListenAddress \$IP0\" >> /etc/ssh/sshd_config
+echo \"ListenAddress \$IP1\" >> /etc/ssh/external_sshd_config
+/etc/rc.d/init.d/ext_sshd stop
+/etc/rc.d/init.d/sshd stop
+sleep 2
+/etc/rc.d/init.d/sshd start
+/etc/rc.d/init.d/ext_sshd start
+
+" >> /etc/rc.local
+
+fi
+
+exit 0
+
diff --git a/managementnode/tools/xcat_postscripts/remoteshell-dblssh-dhcp-new b/managementnode/tools/xcat_postscripts/remoteshell-dblssh-dhcp-new
new file mode 100755
index 0000000..55855f4
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/remoteshell-dblssh-dhcp-new
@@ -0,0 +1,103 @@
+#!/bin/ksh
+#egan@us.ibm.com
+#(C)IBM Corp
+#
+
+. $XCATROOT/lib/functions
+
+echo "$RSHC" | grep "rsh" >/dev/null 2>&1
+if [ "$?" = "0" ]
+then
+ if [ -r /etc/xinetd.d/rsh ]
+ then
+ logger -t xcat "Install: enable rsh"
+ perl -pi -e 's/^(\tdisable[^=]*=) yes/$1 no/' /etc/xinetd.d/rsh
+ perl -pi -e 's/^(\tdisable[^=]*=) yes/$1 no/' /etc/xinetd.d/rlogin
+ logger -t xcat "Install: setup root .rhosts"
+ cd /root
+ echo "$MASTER" >.rhosts
+ echo "$MASTER.$DOMAIN" >>.rhosts
+ chmod 600 .rhosts
+ fi
+ echo "rsh" >>/etc/securetty
+ echo "rlogin" >>/etc/securetty
+fi
+
+
+MIP=$(nametoip $MASTER)
+
+echo "$RSHC" | grep "ssh" >/dev/null 2>&1
+if [ "$?" = "0" ]
+then
+ if [ -r /etc/ssh/sshd_config ]
+ then
+ logger -t xcat "Install: setup /etc/ssh/sshd_config"
+ cp /etc/ssh/sshd_config /etc/ssh/sshd_config.ORIG
+ perl -pi -e 's/^X11Forwarding .*$/X11Forwarding yes/' /etc/ssh/sshd_config
+ perl -pi -e 's/^KeyRegenerationInterval .*$/KeyRegenerationInterval 0/' /etc/ssh/sshd_config
+ perl -pi -e 's/(.*MaxStartups.*)/#\1/' /etc/ssh/sshd_config
+ echo "MaxStartups 1024" >>/etc/ssh/sshd_config
+# echo "PasswordAuthentication no" >>/etc/ssh/sshd_config
+# setup second sshd (external)
+ cp /etc/ssh/sshd_config /etc/ssh/external_sshd_config
+ echo "AllowUsers root@$MIP" >>/etc/ssh/sshd_config
+
+ logger -t xcat "Install: setup /etc/ssh/external_sshd_config"
+ echo "PidFile /var/run/ext_sshd.pid" >>/etc/ssh/external_sshd_config
+ echo "PermitRootLogin no" >>/etc/ssh/external_sshd_config
+ echo "Banner /etc/banner" >>/etc/ssh/external_sshd_config
+
+ fi
+
+ if [ -d /post/.ssh ]
+ then
+ logger -t xcat "Install: setup root .ssh"
+ cd /post/.ssh
+ mkdir -p /root/.ssh
+ cp -f * /root/.ssh
+ chmod 700 /root/.ssh
+ chmod 600 /root/.ssh/*
+ fi
+
+case $OSVER in
+ rhfc[45]*)
+ newline="\\n"
+ ;;
+ rh*)
+ newline="\\\\n"
+ ;;
+esac
+
+
+# make rc.local to change "ListenAddress" in sshd's configs accordingly to network interfaces values
+echo "" >> /etc/rc.local
+echo "
+IP0=\$(ifconfig eth0 | grep inet | awk '{print \$2}' | awk -F: '{print \$2}')
+IP1=\$(ifconfig eth1 | grep inet | awk '{print \$2}' | awk -F: '{print \$2}')
+perl -pi -e 's/^AllowUsers .*$newline//' /etc/ssh/sshd_config
+perl -pi -e 's/^ListenAddress .*$newline//' /etc/ssh/sshd_config
+perl -pi -e 's/^ListenAddress .*$newline//' /etc/ssh/external_sshd_config
+echo \"AllowUsers root@\$MYMASTER\" >> /etc/ssh/sshd_config
+echo \"ListenAddress \$IP0\" >> /etc/ssh/sshd_config
+echo \"ListenAddress \$IP1\" >> /etc/ssh/external_sshd_config
+/etc/rc.d/init.d/ext_sshd stop
+/etc/rc.d/init.d/sshd stop
+sleep 2
+if [ -f /etc/sysconfig/FirstBoot ]; then
+ ssh-keygen -q -t rsa1 -f /etc/ssh/ssh_host_key -N \"\"
+ ssh-keygen -q -t rsa -f /etc/ssh/ssh_host_rsa_key -N \"\"
+ ssh-keygen -q -t dsa -f /etc/ssh/ssh_host_dsa_key -N \"\"
+fi
+/etc/rc.d/init.d/sshd start
+/etc/rc.d/init.d/ext_sshd start
+
+rm -f /etc/sysconfig/FirstBoot
+
+" >> /etc/rc.local
+
+fi
+
+#echo "FIRSTBOOT=YES" > /etc/sysconfig/FirstBoot
+
+exit 0
+
diff --git a/managementnode/tools/xcat_postscripts/remoteshell-dblssh-dhcp-test b/managementnode/tools/xcat_postscripts/remoteshell-dblssh-dhcp-test
new file mode 100755
index 0000000..a17cdd9
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/remoteshell-dblssh-dhcp-test
@@ -0,0 +1,82 @@
+#!/bin/ksh
+#egan@us.ibm.com
+#(C)IBM Corp
+#
+
+. $XCATROOT/lib/functions
+
+echo "$RSHC" | grep "rsh" >/dev/null 2>&1
+if [ "$?" = "0" ]
+then
+ if [ -r /etc/xinetd.d/rsh ]
+ then
+ logger -t xcat "Install: enable rsh"
+ perl -pi -e 's/^(\tdisable[^=]*=) yes/$1 no/' /etc/xinetd.d/rsh
+ perl -pi -e 's/^(\tdisable[^=]*=) yes/$1 no/' /etc/xinetd.d/rlogin
+ logger -t xcat "Install: setup root .rhosts"
+ cd /root
+ echo "$MASTER" >.rhosts
+ echo "$MASTER.$DOMAIN" >>.rhosts
+ chmod 600 .rhosts
+ fi
+ echo "rsh" >>/etc/securetty
+ echo "rlogin" >>/etc/securetty
+fi
+
+
+MIP=$(nametoip $MASTER)
+
+echo "$RSHC" | grep "ssh" >/dev/null 2>&1
+if [ "$?" = "0" ]
+then
+ if [ -r /etc/ssh/sshd_config ]
+ then
+ logger -t xcat "Install: setup /etc/ssh/sshd_config"
+ cp /etc/ssh/sshd_config /etc/ssh/sshd_config.ORIG
+ perl -pi -e 's/^X11Forwarding .*$/X11Forwarding yes/' /etc/ssh/sshd_config
+ perl -pi -e 's/^KeyRegenerationInterval .*$/KeyRegenerationInterval 0/' /etc/ssh/sshd_config
+ perl -pi -e 's/(.*MaxStartups.*)/#\1/' /etc/ssh/sshd_config
+ echo "MaxStartups 1024" >>/etc/ssh/sshd_config
+# echo "PasswordAuthentication no" >>/etc/ssh/sshd_config
+# setup second sshd (external)
+ cp /etc/ssh/sshd_config /etc/ssh/external_sshd_config
+ echo "AllowUsers root@$MIP" >>/etc/ssh/sshd_config
+
+ logger -t xcat "Install: setup /etc/ssh/external_sshd_config"
+ echo "PidFile /var/run/ext_sshd.pid" >>/etc/ssh/external_sshd_config
+ echo "PermitRootLogin no" >>/etc/ssh/external_sshd_config
+ echo "Banner /etc/banner" >>/etc/ssh/external_sshd_config
+
+ fi
+
+ if [ -d /post/.ssh ]
+ then
+ logger -t xcat "Install: setup root .ssh"
+ cd /post/.ssh
+ mkdir -p /root/.ssh
+ cp -f * /root/.ssh
+ chmod 700 /root/.ssh
+ chmod 600 /root/.ssh/*
+ fi
+# make rc.local to change "ListenAddress" in sshd's configs accordingly to network interfaces values
+echo "" >> /etc/rc.local
+echo "
+IP0=\$(ifconfig eth0 | grep inet | awk '{print \$2}' | awk -F: '{print \$2}')
+IP1=\$(ifconfig eth1 | grep inet | awk '{print \$2}' | awk -F: '{print \$2}')
+perl -pi -e 's/^AllowUsers .*\\n//' /etc/ssh/sshd_config
+perl -pi -e 's/^ListenAddress .*\\n//' /etc/ssh/sshd_config
+perl -pi -e 's/^ListenAddress .*\\n//' /etc/ssh/external_sshd_config
+echo \"AllowUsers root@\$MYMASTER\" >> /etc/ssh/sshd_config
+echo \"ListenAddress \$IP0\" >> /etc/ssh/sshd_config
+echo \"ListenAddress \$IP1\" >> /etc/ssh/external_sshd_config
+/etc/rc.d/init.d/sshd stop
+/etc/rc.d/init.d/ext_sshd stop
+/etc/rc.d/init.d/sshd start
+/etc/rc.d/init.d/ext_sshd start
+
+" >> /etc/rc.local
+
+fi
+
+exit 0
+
diff --git a/managementnode/tools/xcat_postscripts/remoteshell-dblssh-dhcp.bak b/managementnode/tools/xcat_postscripts/remoteshell-dblssh-dhcp.bak
new file mode 100755
index 0000000..22f51f4
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/remoteshell-dblssh-dhcp.bak
@@ -0,0 +1,82 @@
+#!/bin/ksh
+#egan@us.ibm.com
+#(C)IBM Corp
+#
+
+. $XCATROOT/lib/functions
+
+echo "$RSHC" | grep "rsh" >/dev/null 2>&1
+if [ "$?" = "0" ]
+then
+ if [ -r /etc/xinetd.d/rsh ]
+ then
+ logger -t xcat "Install: enable rsh"
+ perl -pi -e 's/^(\tdisable[^=]*=) yes/$1 no/' /etc/xinetd.d/rsh
+ perl -pi -e 's/^(\tdisable[^=]*=) yes/$1 no/' /etc/xinetd.d/rlogin
+ logger -t xcat "Install: setup root .rhosts"
+ cd /root
+ echo "$MASTER" >.rhosts
+ echo "$MASTER.$DOMAIN" >>.rhosts
+ chmod 600 .rhosts
+ fi
+ echo "rsh" >>/etc/securetty
+ echo "rlogin" >>/etc/securetty
+fi
+
+
+MIP=$(nametoip $MASTER)
+
+echo "$RSHC" | grep "ssh" >/dev/null 2>&1
+if [ "$?" = "0" ]
+then
+ if [ -r /etc/ssh/sshd_config ]
+ then
+ logger -t xcat "Install: setup /etc/ssh/sshd_config"
+ cp /etc/ssh/sshd_config /etc/ssh/sshd_config.ORIG
+ perl -pi -e 's/^X11Forwarding .*$/X11Forwarding yes/' /etc/ssh/sshd_config
+ perl -pi -e 's/^KeyRegenerationInterval .*$/KeyRegenerationInterval 0/' /etc/ssh/sshd_config
+ perl -pi -e 's/(.*MaxStartups.*)/#\1/' /etc/ssh/sshd_config
+ echo "MaxStartups 1024" >>/etc/ssh/sshd_config
+# echo "PasswordAuthentication no" >>/etc/ssh/sshd_config
+# setup second sshd (external)
+ cp /etc/ssh/sshd_config /etc/ssh/external_sshd_config
+ echo "AllowUsers root@$MIP" >>/etc/ssh/sshd_config
+
+ logger -t xcat "Install: setup /etc/ssh/external_sshd_config"
+ echo "PidFile /var/run/ext_sshd.pid" >>/etc/ssh/external_sshd_config
+ echo "PermitRootLogin no" >>/etc/ssh/external_sshd_config
+ echo "Banner /etc/banner" >>/etc/ssh/external_sshd_config
+
+ fi
+
+ if [ -d /post/.ssh ]
+ then
+ logger -t xcat "Install: setup root .ssh"
+ cd /post/.ssh
+ mkdir -p /root/.ssh
+ cp -f * /root/.ssh
+ chmod 700 /root/.ssh
+ chmod 600 /root/.ssh/*
+ fi
+# make rc.local to change "ListenAddress" in sshd's configs accordingly to network interfaces values
+echo "" >> /etc/rc.local
+echo "
+IP0=\$(ifconfig eth0 | grep inet | awk '{print \$2}' | awk -F: '{print \$2}')
+IP1=\$(ifconfig eth1 | grep inet | awk '{print \$2}' | awk -F: '{print \$2}')
+perl -pi -e 's/^AllowUsers .*\\\n//' /etc/ssh/sshd_config
+perl -pi -e 's/^ListenAddress .*\\\n//' /etc/ssh/sshd_config
+perl -pi -e 's/^ListenAddress .*\\\n//' /etc/ssh/external_sshd_config
+echo \"AllowUsers root@\$MYMASTER\" >> /etc/ssh/sshd_config
+echo \"ListenAddress \$IP0\" >> /etc/ssh/sshd_config
+echo \"ListenAddress \$IP1\" >> /etc/ssh/external_sshd_config
+/etc/rc.d/init.d/sshd stop
+/etc/rc.d/init.d/ext_sshd stop
+/etc/rc.d/init.d/sshd start
+/etc/rc.d/init.d/ext_sshd start
+
+" >> /etc/rc.local
+
+fi
+
+exit 0
+
diff --git a/managementnode/tools/xcat_postscripts/remoteshell-dblssh-dhcp.bak2 b/managementnode/tools/xcat_postscripts/remoteshell-dblssh-dhcp.bak2
new file mode 100755
index 0000000..a987d86
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/remoteshell-dblssh-dhcp.bak2
@@ -0,0 +1,94 @@
+#!/bin/ksh
+#egan@us.ibm.com
+#(C)IBM Corp
+#
+
+. $XCATROOT/lib/functions
+
+echo "$RSHC" | grep "rsh" >/dev/null 2>&1
+if [ "$?" = "0" ]
+then
+ if [ -r /etc/xinetd.d/rsh ]
+ then
+ logger -t xcat "Install: enable rsh"
+ perl -pi -e 's/^(\tdisable[^=]*=) yes/$1 no/' /etc/xinetd.d/rsh
+ perl -pi -e 's/^(\tdisable[^=]*=) yes/$1 no/' /etc/xinetd.d/rlogin
+ logger -t xcat "Install: setup root .rhosts"
+ cd /root
+ echo "$MASTER" >.rhosts
+ echo "$MASTER.$DOMAIN" >>.rhosts
+ chmod 600 .rhosts
+ fi
+ echo "rsh" >>/etc/securetty
+ echo "rlogin" >>/etc/securetty
+fi
+
+
+MIP=$(nametoip $MASTER)
+
+echo "$RSHC" | grep "ssh" >/dev/null 2>&1
+if [ "$?" = "0" ]
+then
+ if [ -r /etc/ssh/sshd_config ]
+ then
+ logger -t xcat "Install: setup /etc/ssh/sshd_config"
+ cp /etc/ssh/sshd_config /etc/ssh/sshd_config.ORIG
+ perl -pi -e 's/^X11Forwarding .*$/X11Forwarding yes/' /etc/ssh/sshd_config
+ perl -pi -e 's/^KeyRegenerationInterval .*$/KeyRegenerationInterval 0/' /etc/ssh/sshd_config
+ perl -pi -e 's/(.*MaxStartups.*)/#\1/' /etc/ssh/sshd_config
+ echo "MaxStartups 1024" >>/etc/ssh/sshd_config
+# echo "PasswordAuthentication no" >>/etc/ssh/sshd_config
+# setup second sshd (external)
+ cp /etc/ssh/sshd_config /etc/ssh/external_sshd_config
+ echo "AllowUsers root@$MIP" >>/etc/ssh/sshd_config
+
+ logger -t xcat "Install: setup /etc/ssh/external_sshd_config"
+ echo "PidFile /var/run/ext_sshd.pid" >>/etc/ssh/external_sshd_config
+ echo "PermitRootLogin no" >>/etc/ssh/external_sshd_config
+ echo "Banner /etc/banner" >>/etc/ssh/external_sshd_config
+
+ fi
+
+ if [ -d /post/.ssh ]
+ then
+ logger -t xcat "Install: setup root .ssh"
+ cd /post/.ssh
+ mkdir -p /root/.ssh
+ cp -f * /root/.ssh
+ chmod 700 /root/.ssh
+ chmod 600 /root/.ssh/*
+ fi
+
+case $OSVER in
+ rhfc[45]*)
+ newline="\\n"
+ ;;
+ rh*)
+ newline="\\\\n"
+ ;;
+esac
+
+
+# make rc.local to change "ListenAddress" in sshd's configs accordingly to network interfaces values
+echo "" >> /etc/rc.local
+echo "
+IP0=\$(ifconfig eth0 | grep inet | awk '{print \$2}' | awk -F: '{print \$2}')
+IP1=\$(ifconfig eth1 | grep inet | awk '{print \$2}' | awk -F: '{print \$2}')
+perl -pi -e 's/^AllowUsers .*$newline//' /etc/ssh/sshd_config
+perl -pi -e 's/^ListenAddress .*$newline//' /etc/ssh/sshd_config
+perl -pi -e 's/^ListenAddress .*$newline//' /etc/ssh/external_sshd_config
+echo \"AllowUsers root@\$MYMASTER\" >> /etc/ssh/sshd_config
+echo \"ListenAddress \$IP0\" >> /etc/ssh/sshd_config
+echo \"ListenAddress \$IP1\" >> /etc/ssh/external_sshd_config
+/etc/rc.d/init.d/sshd stop
+/etc/rc.d/init.d/ext_sshd stop
+sleep 2
+/etc/rc.d/init.d/sshd start
+/etc/rc.d/init.d/ext_sshd start
+
+" >> /etc/rc.local
+
+fi
+
+exit 0
+
diff --git a/managementnode/tools/xcat_postscripts/remoteshell-dblssh-dhcp.bak3 b/managementnode/tools/xcat_postscripts/remoteshell-dblssh-dhcp.bak3
new file mode 100755
index 0000000..a2c71f6
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/remoteshell-dblssh-dhcp.bak3
@@ -0,0 +1,94 @@
+#!/bin/ksh
+#egan@us.ibm.com
+#(C)IBM Corp
+#
+
+. $XCATROOT/lib/functions
+
+echo "$RSHC" | grep "rsh" >/dev/null 2>&1
+if [ "$?" = "0" ]
+then
+ if [ -r /etc/xinetd.d/rsh ]
+ then
+ logger -t xcat "Install: enable rsh"
+ perl -pi -e 's/^(\tdisable[^=]*=) yes/$1 no/' /etc/xinetd.d/rsh
+ perl -pi -e 's/^(\tdisable[^=]*=) yes/$1 no/' /etc/xinetd.d/rlogin
+ logger -t xcat "Install: setup root .rhosts"
+ cd /root
+ echo "$MASTER" >.rhosts
+ echo "$MASTER.$DOMAIN" >>.rhosts
+ chmod 600 .rhosts
+ fi
+ echo "rsh" >>/etc/securetty
+ echo "rlogin" >>/etc/securetty
+fi
+
+
+MIP=$(nametoip $MASTER)
+
+echo "$RSHC" | grep "ssh" >/dev/null 2>&1
+if [ "$?" = "0" ]
+then
+ if [ -r /etc/ssh/sshd_config ]
+ then
+ logger -t xcat "Install: setup /etc/ssh/sshd_config"
+ cp /etc/ssh/sshd_config /etc/ssh/sshd_config.ORIG
+ perl -pi -e 's/^X11Forwarding .*$/X11Forwarding yes/' /etc/ssh/sshd_config
+ perl -pi -e 's/^KeyRegenerationInterval .*$/KeyRegenerationInterval 0/' /etc/ssh/sshd_config
+ perl -pi -e 's/(.*MaxStartups.*)/#\1/' /etc/ssh/sshd_config
+ echo "MaxStartups 1024" >>/etc/ssh/sshd_config
+# echo "PasswordAuthentication no" >>/etc/ssh/sshd_config
+# setup second sshd (external)
+ cp /etc/ssh/sshd_config /etc/ssh/external_sshd_config
+ echo "AllowUsers root@$MIP" >>/etc/ssh/sshd_config
+
+ logger -t xcat "Install: setup /etc/ssh/external_sshd_config"
+ echo "PidFile /var/run/ext_sshd.pid" >>/etc/ssh/external_sshd_config
+ echo "PermitRootLogin no" >>/etc/ssh/external_sshd_config
+ echo "Banner /etc/banner" >>/etc/ssh/external_sshd_config
+
+ fi
+
+ if [ -d /post/.ssh ]
+ then
+ logger -t xcat "Install: setup root .ssh"
+ cd /post/.ssh
+ mkdir -p /root/.ssh
+ cp -f * /root/.ssh
+ chmod 700 /root/.ssh
+ chmod 600 /root/.ssh/*
+ fi
+
+case $OSVER in
+ rhfc[45]*)
+ newline="\\n"
+ ;;
+ rh*)
+ newline="\\\\n"
+ ;;
+esac
+
+
+# make rc.local to change "ListenAddress" in sshd's configs accordingly to network interfaces values
+echo "" >> /etc/rc.local
+echo "
+IP0=\$(ifconfig eth0 | grep 'inet addr' | awk '{print \$2}' | awk -F: '{print \$2}')
+IP1=\$(ifconfig eth1 | grep 'inet addr' | awk '{print \$2}' | awk -F: '{print \$2}')
+perl -pi -e 's/^AllowUsers .*$newline//' /etc/ssh/sshd_config
+perl -pi -e 's/^ListenAddress .*$newline//' /etc/ssh/sshd_config
+perl -pi -e 's/^ListenAddress .*$newline//' /etc/ssh/external_sshd_config
+echo \"AllowUsers root@\$MYMASTER\" >> /etc/ssh/sshd_config
+echo \"ListenAddress \$IP0\" >> /etc/ssh/sshd_config
+echo \"ListenAddress \$IP1\" >> /etc/ssh/external_sshd_config
+/etc/rc.d/init.d/ext_sshd stop
+/etc/rc.d/init.d/sshd stop
+sleep 2
+/etc/rc.d/init.d/sshd start
+/etc/rc.d/init.d/ext_sshd start
+
+" >> /etc/rc.local
+
+fi
+
+exit 0
+
diff --git a/managementnode/tools/xcat_postscripts/setupESX b/managementnode/tools/xcat_postscripts/setupESX
new file mode 100755
index 0000000..f546496
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/setupESX
@@ -0,0 +1,6 @@
+#!/bin/ksh
+
+logger -t xcat "Install: configuring vmware ESX"
+
+logger -t xcat "Config ESX: enable firewall ntpClient"
+esxcfg-firewall --enableService ntpClient
diff --git a/managementnode/tools/xcat_postscripts/setupafs b/managementnode/tools/xcat_postscripts/setupafs
new file mode 100755
index 0000000..7ebf604
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/setupafs
@@ -0,0 +1,5 @@
+#!/bin/ksh
+
+logger -t xcat "Install: configuring afs"
+perl -pi -e 's/pam_krb5.so/pam_krb5afs.so/' /etc/pam.d/system-auth
+perl -pi -e 's/(OPTIONS=.*)/OPTIONS="\$MEDIUM -nosettime"/' /etc/sysconfig/afs
diff --git a/managementnode/tools/xcat_postscripts/setupafs64 b/managementnode/tools/xcat_postscripts/setupafs64
new file mode 100755
index 0000000..2e81135
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/setupafs64
@@ -0,0 +1,5 @@
+#!/bin/ksh
+
+logger -t xcat "Install: configuring afs"
+perl -pi -e 's/pam_krb5.so/pam_krb5afs.so/' /etc/pam.d/system-auth
+perl -pi -e 's/(OPTIONS=.*)/OPTIONS="\$MEDIUM -nosettime"/' /etc/sysconfig/openafs
diff --git a/managementnode/tools/xcat_postscripts/setupgpfs b/managementnode/tools/xcat_postscripts/setupgpfs
new file mode 100755
index 0000000..3e003d9
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/setupgpfs
@@ -0,0 +1,26 @@
+#!/bin/ksh
+
+logger -t xcat "Install: setup GPFS on node"
+
+echo "
+
+SHORTHOSTNAME=\$(echo \$HOSTNAME | awk -F. '{print \$1}')
+
+if [ -n \"\`ssh storage009 mmlscluster | grep -w \$SHORTHOSTNAME\`\" ]; then
+ scp storage009:/var/mmfs/gen/mmsdrfs /var/mmfs/gen/
+fi
+
+if [ -n \"\`ssh storage011 mmlscluster | grep -w \$SHORTHOSTNAME\`\" ]; then
+ scp storage011:/var/mmfs/gen/mmsdrfs /var/mmfs/gen/
+fi
+
+if [ -n \"\`ssh storage016 mmlscluster | grep -w \$SHORTHOSTNAME\`\" ]; then
+ scp storage016:/var/mmfs/gen/mmsdrfs /var/mmfs/gen/
+fi
+
+sleep 5
+
+/usr/lpp/mmfs/bin/mmstartup
+
+" >>/etc/rc.d/rc.local
+
diff --git a/managementnode/tools/xcat_postscripts/setupntp b/managementnode/tools/xcat_postscripts/setupntp
new file mode 100755
index 0000000..ebeee9f
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/setupntp
@@ -0,0 +1,11 @@
+#!/bin/ksh
+#egan@us.ibm.com
+#(C)IBM Corp
+#
+
+logger -t xcat "Install: Setup NTP"
+
+mkdir -p /etc/ntp
+chown ntp /etc/ntp
+
+# /etc/ntp.conf will be copied from "sync" directory
diff --git a/managementnode/tools/xcat_postscripts/setupservices-dblssh b/managementnode/tools/xcat_postscripts/setupservices-dblssh
new file mode 100755
index 0000000..a59e574
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/setupservices-dblssh
@@ -0,0 +1,44 @@
+#!/bin/ksh
+#egan@us.ibm.com
+#(C)IBM Corp
+#
+
+logger -t xcat "Install: Setup services for $OSVER"
+case "$OSVER" in
+ rh*)
+ chkconfig --del apmd
+ chkconfig --del gpm
+ chkconfig --del kudzu
+ chkconfig --del lpd
+ chkconfig --del pcmcia
+ chkconfig --del linuxconf
+ chkconfig --del sendmail
+ chkconfig --del xfs
+ chkconfig --del httpd
+ chkconfig --del identd
+ chkconfig --del isdn
+ chkconfig --del pppoe
+ chkconfig --del wine
+ chkconfig --del iscsi
+ chkconfig --del ip6tables
+ chkconfig --del ipchains
+ chkconfig --del rhnsd
+ chkconfig --del rawdevices
+ chkconfig --del cups
+ chkconfig --del hpoj
+ chkconfig --del mdmonitor
+ chkconfig --del mdmpd
+ chkconfig --del bluetooth
+ chkconfig sgi_fam off
+ chkconfig --level 345 ntpd on
+ chkconfig --level 345 sshd on
+ chkconfig --level 345 ext_sshd on
+ chkconfig --level 345 snmpd on
+ chkconfig --level 345 autofs on
+ ;;
+ sles[89]|suse8*|suse9*)
+ chkconfig -a nfs
+ chkconfig -a xntpd
+ ;;
+esac
+
diff --git a/managementnode/tools/xcat_postscripts/setupsudoers b/managementnode/tools/xcat_postscripts/setupsudoers
new file mode 100755
index 0000000..41f7c9a
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/setupsudoers
@@ -0,0 +1,6 @@
+#!/bin/ksh
+
+logger -t xcat "Install: setup sudoers"
+cp /etc/sudoers /etc/sudoers.ORIG
+echo "%ncsu ALL = NOPASSWD: /sbin/iptables" >> /etc/sudoers
+echo "%ncsu ALL = NOPASSWD: /etc/rc.d/init.d/iptables" >> /etc/sudoers
diff --git a/managementnode/tools/xcat_postscripts/setupsudoersFULL b/managementnode/tools/xcat_postscripts/setupsudoersFULL
new file mode 100755
index 0000000..5d978c7
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/setupsudoersFULL
@@ -0,0 +1,5 @@
+#!/bin/ksh
+
+logger -t xcat "Install: setup sudoers"
+cp /etc/sudoers /etc/sudoers.ORIG
+echo "%ncsu ALL = NOPASSWD: ALL" >> /etc/sudoers
diff --git a/managementnode/tools/xcat_postscripts/setupusers b/managementnode/tools/xcat_postscripts/setupusers
new file mode 100755
index 0000000..381ce97
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/setupusers
@@ -0,0 +1,5 @@
+#!/bin/ksh
+
+logger -t xcat "Install: adding user(s)"
+groupadd -g 91 staff
+groupadd ncsu
diff --git a/managementnode/tools/xcat_postscripts/setupusers-ncsu b/managementnode/tools/xcat_postscripts/setupusers-ncsu
new file mode 100755
index 0000000..f98c4d7
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/setupusers-ncsu
@@ -0,0 +1,4 @@
+#!/bin/ksh
+
+logger -t xcat "Install: adding user(s)"
+groupadd ncsu
diff --git a/managementnode/tools/xcat_postscripts/syncdirs b/managementnode/tools/xcat_postscripts/syncdirs
new file mode 100755
index 0000000..4da5a05
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/syncdirs
@@ -0,0 +1,61 @@
+#!/bin/ksh
+#egan@us.ibm.com
+#(C)IBM Corp
+#
+
+. $XCATROOT/lib/functions
+
+#OTHER_DIR=$1
+
+#if [ -n "OTHER_DIR" ]
+#then
+# OTHERS=$OTHER_DIR
+#fi
+
+
+RESNAME=$(whatismyres2 $NODE)
+
+if [ "$RESNAME" = "$NODE" ]
+then
+ RESNAME=""
+fi
+
+NODETYPE=$(tabdb $NODETYPETAB $NODE 3)
+
+GROUPS="$(
+ egrep "^$NODE( | |$)" $NODELISTTAB | \
+ head -1 | \
+ awk '{print $2}' | \
+ tr ',' ' '
+)"
+
+echo $ARCH | perl -pi -e "if(/^i.86$/) {exit 0} else {exit 1}"
+if [ "$?" = "0" ]
+then
+ ARCH=x86
+fi
+
+#for i in $OSVER/$ARCH $OSVER/noarch $ARCH $NODETYPE $RESNAME $GROUPS $NODE $*
+for i in $OSVER/$ARCH $OSVER/noarch $ARCH $NODETYPE $GROUPS $NODE $*
+do
+ newi=$(echo $i | tr '/' '-')
+ if [ -d /post/sync/$i ]
+ then
+ logger -t xcat "Install: copying /post/sync/$i to /"
+ if cd /post/sync/$i
+ then
+ pwd | logger -t xcat
+ for j in $(find . -type f -print)
+ do
+ if [ -r /$j ]
+ then
+ cp -f /$j /${j}.${newi}.ORIG 2>&1 | logger -t xcat
+ fi
+ done
+ find . -print | cpio -dump / 2>&1 | logger -t xcat
+ fi
+ else
+ logger -t xcat "Install: not syncing from $i"
+ fi
+done
+
diff --git a/managementnode/tools/xcat_postscripts/syslog b/managementnode/tools/xcat_postscripts/syslog
new file mode 100755
index 0000000..2e0e5f7
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/syslog
@@ -0,0 +1,127 @@
+#!/bin/ksh
+#egan@us.ibm.com
+#(C)IBM Corp
+#
+
+. $XCATROOT/lib/functions
+
+HARD_SYSLOG=$1
+
+if [ -n "$HARD_SYSLOG" ]
+then
+ MASTER=$HARD_SYSLOG
+fi
+
+if [ -e /etc/syslog.conf ]
+then
+ mv -f /etc/syslog.conf /etc/syslog.conf.ORIG
+ echo "*.* @$(getent hosts $MASTER | awk '{print $1}')" >/etc/syslog.conf
+ cp -f /etc/syslog.conf.ORIG /etc/syslog.conf.HPC
+ echo "*.warn @$(getent hosts $MASTER | awk '{print $1}')" >>/etc/syslog.conf.HPC
+
+ case $OSVER in
+ sles[89]|suse8*|suse9*|suse10|ul*)
+ if grep 'SYSLOGD_PARAMS="-m0' /etc/sysconfig/syslog >/dev/null 2>&1
+ then
+ :
+ else
+ perl -pi -e 's/SYSLOGD_PARAMS="/SYSLOGD_PARAMS="-m0 /' /etc/sysconfig/syslog
+ fi
+ /etc/init.d/syslog restart
+ ;;
+ rh*)
+ /etc/rc.d/init.d/syslog start
+ ;;
+ esac
+
+ logger -t xcat "Install: syslog setup"
+
+ case $OSVER in
+ rhfc[45]*)
+ dhclientpath="/var/lib/dhclient/dhclient-eth0.leases"
+ ;;
+ rh5*)
+ dhclientpath="/var/lib/dhclient/dhclient-eth0.leases"
+ ;;
+ rh*)
+ dhclientpath="/var/lib/dhcp/dhclient-eth0.leases"
+ ;;
+ esac
+
+ # prepare to adjust syslog.conf to report to correct head-node in case of imaging
+ echo "" >> /etc/rc.local
+ echo "
+ if [ -r $dhclientpath ]
+ then
+ cp -f /etc/syslog.conf.ORIG /etc/syslog.conf
+ for i in \$(cat $dhclientpath | grep \"dhcp-server-identifier\" | awk '{print \$3}' | awk -F\\; '{print \$1}')
+ do
+ MYMASTER=\$i
+ done
+ echo \"*.* @\$MYMASTER\" >> /etc/syslog.conf
+ else
+ mv -f /etc/syslog.conf.HPC /etc/syslog.conf
+ fi
+ /etc/rc.d/init.d/syslog restart
+
+ " >> /etc/rc.local
+elif [ -e /etc/rsyslog.conf ]
+then
+logger -t xcat "Install: rsyslog setup"
+cp -f /etc/rsyslog.conf /etc/rsyslog.conf.ORIG
+echo "*.* @$(getent hosts $MASTER | awk '{print $1}')" >>/etc/rsyslog.conf
+cp -f /etc/rsyslog.conf.ORIG /etc/rsyslog.conf.HPC
+echo "*.warn @$(getent hosts $MASTER | awk '{print $1}')" >>/etc/rsyslog.conf.HPC
+
+case $OSVER in
+ sles[89]|suse8*|suse9*|suse10|ul*)
+ if grep 'SYSLOGD_PARAMS="-m0' /etc/sysconfig/rsyslog >/dev/null 2>&1
+ then
+ :
+ else
+ perl -pi -e 's/SYSLOGD_PARAMS="/SYSLOGD_PARAMS="-m0 /' /etc/sysconfig/rsyslog
+ fi
+ /etc/init.d/rsyslog restart
+ ;;
+ rh*)
+ /etc/rc.d/init.d/rsyslog restart
+ ;;
+esac
+
+
+case $OSVER in
+ rhfc[9]*)
+ dhclientpath="/var/run/dhclient-eth0.lease"
+ ;;
+ rhfc[45]*)
+ dhclientpath="/var/lib/dhclient/dhclient-eth0.leases"
+ ;;
+ rh*)
+ dhclientpath="/var/lib/dhcp/dhclient-eth0.leases"
+ ;;
+esac
+
+# prepare to adjust syslog.conf to report to correct head-node in case of imaging
+echo "" >> /etc/rc.local
+echo "
+if [ -r $dhclientpath ]
+then
+ cp -f /etc/rsyslog.conf.ORIG /etc/rsyslog.conf
+ for i in \$(cat $dhclientpath | grep \"dhcp-server-identifier\" | awk '{print \$3}' | awk -F\\; '{print \$1}')
+ do
+ MYMASTER=\$i
+ done
+ echo \"*.* @\$MYMASTER\" >> /etc/rsyslog.conf
+else
+ mv -f /etc/rsyslog.conf.HPC /etc/rsyslog.conf
+fi
+/etc/init.d/rsyslog restart
+
+" >> /etc/rc.local
+
+else
+ echo "syslog or rsyslog conf not found"
+fi
+
+exit 0
+
diff --git a/managementnode/tools/xcat_postscripts/syslog-test b/managementnode/tools/xcat_postscripts/syslog-test
new file mode 100755
index 0000000..abf4c78
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/syslog-test
@@ -0,0 +1,58 @@
+#!/bin/ksh
+#egan@us.ibm.com
+#(C)IBM Corp
+#
+
+. $XCATROOT/lib/functions
+
+HARD_SYSLOG=$1
+
+if [ -n "$HARD_SYSLOG" ]
+then
+ MASTER=$HARD_SYSLOG
+fi
+
+mv -f /etc/syslog.conf /etc/syslog.conf.ORIG
+echo "*.* @$(getent hosts $MASTER | awk '{print $1}')" >/etc/syslog.conf
+
+case $OSVER in
+ sles[89]|suse8*|suse9*|suse10|ul*)
+ if grep 'SYSLOGD_PARAMS="-m0' /etc/sysconfig/syslog >/dev/null 2>&1
+ then
+ :
+ else
+ perl -pi -e 's/SYSLOGD_PARAMS="/SYSLOGD_PARAMS="-m0 /' /etc/sysconfig/syslog
+ fi
+ /etc/init.d/syslog restart
+ ;;
+ rh*)
+ /etc/rc.d/init.d/syslog start
+ ;;
+esac
+
+logger -t xcat "Install: syslog setup"
+
+case $OSVER in
+ rhfc*)
+ dhclientpath="/var/lib/dhclient/dhclient-eth0.leases"
+ ;;
+ rh*)
+ dhclientpath="/var/lib/dhcp/dhclient-eth0.leases"
+ ;;
+esac
+
+# prepare to adjust syslog.conf to report to correct head-node in case of imaging
+echo "" >> /etc/rc.local
+echo "
+cp -f /etc/syslog.conf.ORIG /etc/syslog.conf
+for i in \$(cat $dhclientpath | grep \"dhcp-server-identifier\" | awk '{print \$3}' | awk -F\\; '{print \$1}')
+do
+ MYMASTER=\$i
+done
+echo \"*.warn @\$MYMASTER\" >> /etc/syslog.conf
+/etc/rc.d/init.d/syslog restart
+
+" >> /etc/rc.local
+
+exit 0
+
diff --git a/managementnode/tools/xcat_postscripts/syslog.ver1 b/managementnode/tools/xcat_postscripts/syslog.ver1
new file mode 100755
index 0000000..a5d8bc5
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/syslog.ver1
@@ -0,0 +1,49 @@
+#!/bin/ksh
+#egan@us.ibm.com
+#(C)IBM Corp
+#
+
+. $XCATROOT/lib/functions
+
+HARD_SYSLOG=$1
+
+if [ -n "$HARD_SYSLOG" ]
+then
+ MASTER=$HARD_SYSLOG
+fi
+
+mv -f /etc/syslog.conf /etc/syslog.conf.ORIG
+echo "*.* @$(getent hosts $MASTER | awk '{print $1}')" >/etc/syslog.conf
+
+case $OSVER in
+ sles[89]|suse8*|suse9*|suse10|ul*)
+ if grep 'SYSLOGD_PARAMS="-m0' /etc/sysconfig/syslog >/dev/null 2>&1
+ then
+ :
+ else
+ perl -pi -e 's/SYSLOGD_PARAMS="/SYSLOGD_PARAMS="-m0 /' /etc/sysconfig/syslog
+ fi
+ /etc/init.d/syslog restart
+ ;;
+ rh*)
+ /etc/rc.d/init.d/syslog start
+ ;;
+esac
+
+logger -t xcat "Install: syslog setup"
+
+# prepare to adjust syslog.conf to report to correct head-node in case of imaging
+echo "" >> /etc/rc.local
+echo "
+cp -f /etc/syslog.conf.ORIG /etc/syslog.conf
+for i in \$(cat /var/lib/dhcp/dhclient-eth0.leases | grep \"dhcp-server-identifier\" | awk '{print \$3}' | awk -F\\; '{print \$1}')
+do
+ MYMASTER=\$i
+done
+echo \"*.warn @\$MYMASTER\" >> /etc/syslog.conf
+/etc/rc.d/init.d/syslog restart
+
+" >> /etc/rc.local
+
+exit 0
+
diff --git a/managementnode/tools/xcat_postscripts/syslog_ORIG b/managementnode/tools/xcat_postscripts/syslog_ORIG
new file mode 100755
index 0000000..8d63023
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/syslog_ORIG
@@ -0,0 +1,65 @@
+#!/bin/ksh
+#egan@us.ibm.com
+#(C)IBM Corp
+#
+
+. $XCATROOT/lib/functions
+
+HARD_SYSLOG=$1
+
+if [ -n "$HARD_SYSLOG" ]
+then
+ MASTER=$HARD_SYSLOG
+fi
+
+mv -f /etc/syslog.conf /etc/syslog.conf.ORIG
+echo "*.* @$(getent hosts $MASTER | awk '{print $1}')" >/etc/syslog.conf
+cp -f /etc/syslog.conf.ORIG /etc/syslog.conf.HPC
+echo "*.warn @$(getent hosts $MASTER | awk '{print $1}')" >>/etc/syslog.conf.HPC
+
+case $OSVER in
+ sles[89]|suse8*|suse9*|suse10|ul*)
+ if grep 'SYSLOGD_PARAMS="-m0' /etc/sysconfig/syslog >/dev/null 2>&1
+ then
+ :
+ else
+ perl -pi -e 's/SYSLOGD_PARAMS="/SYSLOGD_PARAMS="-m0 /' /etc/sysconfig/syslog
+ fi
+ /etc/init.d/syslog restart
+ ;;
+ rh*)
+ /etc/rc.d/init.d/syslog start
+ ;;
+esac
+
+logger -t xcat "Install: syslog setup"
+
+case $OSVER in
+ rhfc[45]*)
+ dhclientpath="/var/lib/dhclient/dhclient-eth0.leases"
+ ;;
+ rh*)
+ dhclientpath="/var/lib/dhcp/dhclient-eth0.leases"
+ ;;
+esac
+
+# prepare to adjust syslog.conf to report to correct head-node in case of imaging
+echo "" >> /etc/rc.local
+echo "
+if [ -x $dhclientpath ]
+then
+ cp -f /etc/syslog.conf.ORIG /etc/syslog.conf
+ for i in \$(cat $dhclientpath | grep \"dhcp-server-identifier\" | awk '{print \$3}' | awk -F\\; '{print \$1}')
+ do
+ MYMASTER=\$i
+ done
+ echo \"*.warn @\$MYMASTER\" >> /etc/syslog.conf
+else
+ mv -f /etc/syslog.conf.HPC /etc/syslog.conf
+fi
+/etc/rc.d/init.d/syslog restart
+
+" >> /etc/rc.local
+
+exit 0
+
diff --git a/managementnode/tools/xcat_postscripts/syslog_new b/managementnode/tools/xcat_postscripts/syslog_new
new file mode 100755
index 0000000..6d183af
--- /dev/null
+++ b/managementnode/tools/xcat_postscripts/syslog_new
@@ -0,0 +1,124 @@
+#!/bin/ksh
+#egan@us.ibm.com
+#(C)IBM Corp
+#
+
+. $XCATROOT/lib/functions
+
+HARD_SYSLOG=$1
+
+if [ -n "$HARD_SYSLOG" ]
+then
+ MASTER=$HARD_SYSLOG
+fi
+
+if [ -e /etc/syslog.conf ]
+then
+ mv -f /etc/syslog.conf /etc/syslog.conf.ORIG
+ echo "*.* @$(getent hosts $MASTER | awk '{print $1}')" >/etc/syslog.conf
+ cp -f /etc/syslog.conf.ORIG /etc/syslog.conf.HPC
+ echo "*.warn @$(getent hosts $MASTER | awk '{print $1}')" >>/etc/syslog.conf.HPC
+
+ case $OSVER in
+ sles[89]|suse8*|suse9*|suse10|ul*)
+ if grep 'SYSLOGD_PARAMS="-m0' /etc/sysconfig/syslog >/dev/null 2>&1
+ then
+ :
+ else
+ perl -pi -e 's/SYSLOGD_PARAMS="/SYSLOGD_PARAMS="-m0 /' /etc/sysconfig/syslog
+ fi
+ /etc/init.d/syslog restart
+ ;;
+ rh*)
+ /etc/rc.d/init.d/syslog start
+ ;;
+ esac
+
+ logger -t xcat "Install: syslog setup"
+
+ case $OSVER in
+ rhfc[45]*)
+ dhclientpath="/var/lib/dhclient/dhclient-eth0.leases"
+ ;;
+ rh*)
+ dhclientpath="/var/lib/dhcp/dhclient-eth0.leases"
+ ;;
+ esac
+
+ # prepare to adjust syslog.conf to report to correct head-node in case of imaging
+ echo "" >> /etc/rc.local
+ echo "
+ if [ -x $dhclientpath ]
+ then
+ cp -f /etc/syslog.conf.ORIG /etc/syslog.conf
+ for i in \$(cat $dhclientpath | grep \"dhcp-server-identifier\" | awk '{print \$3}' | awk -F\\; '{print \$1}')
+ do
+ MYMASTER=\$i
+ done
+ echo \"*.warn @\$MYMASTER\" >> /etc/syslog.conf
+ else
+ mv -f /etc/syslog.conf.HPC /etc/syslog.conf
+ fi
+ /etc/rc.d/init.d/syslog restart
+
+ " >> /etc/rc.local
+elif [ -e /etc/rsyslog.conf ]
+then
+logger -t xcat "Install: rsyslog setup"
+cp -f /etc/rsyslog.conf /etc/rsyslog.conf.ORIG
+echo "*.* @$(getent hosts $MASTER | awk '{print $1}')" >>/etc/rsyslog.conf
+cp -f /etc/rsyslog.conf.ORIG /etc/rsyslog.conf.HPC
+echo "*.warn @$(getent hosts $MASTER | awk '{print $1}')" >>/etc/rsyslog.conf.HPC
+
+case $OSVER in
+ sles[89]|suse8*|suse9*|suse10|ul*)
+ if grep 'SYSLOGD_PARAMS="-m0' /etc/sysconfig/rsyslog >/dev/null 2>&1
+ then
+ :
+ else
+ perl -pi -e 's/SYSLOGD_PARAMS="/SYSLOGD_PARAMS="-m0 /' /etc/sysconfig/rsyslog
+ fi
+ /etc/init.d/rsyslog restart
+ ;;
+ rh*)
+ /etc/rc.d/init.d/rsyslog restart
+ ;;
+esac
+
+
+case $OSVER in
+ rhfc[9]*)
+ dhclientpath="/var/run/dhclient-eth0.lease"
+ ;;
+ rhfc[45]*)
+ dhclientpath="/var/lib/dhclient/dhclient-eth0.leases"
+ ;;
+ rh*)
+ dhclientpath="/var/lib/dhcp/dhclient-eth0.leases"
+ ;;
+esac
+
+# prepare to adjust syslog.conf to report to correct head-node in case of imaging
+echo "" >> /etc/rc.local
+echo "
+if [ -x $dhclientpath ]
+then
+ cp -f /etc/rsyslog.conf.ORIG /etc/rsyslog.conf
+ for i in \$(cat $dhclientpath | grep \"dhcp-server-identifier\" | awk '{print \$3}' | awk -F\\; '{print \$1}')
+ do
+ MYMASTER=\$i
+ done
+ echo \"*.* @\$MYMASTER\" >> /etc/rsyslog.conf
+else
+ mv -f /etc/rsyslog.conf.HPC /etc/rsyslog.conf
+fi
+/etc/init.d/rsyslog restart
+
+" >> /etc/rc.local
+
+else
+ echo "syslog or rsyslog conf not found"
+fi
+
+exit 0
+
diff --git a/managementnode/vbs_scripts/VCL/VCLcleanup.cmd b/managementnode/vbs_scripts/VCL/VCLcleanup.cmd
new file mode 100755
index 0000000..6a73be1
--- /dev/null
+++ b/managementnode/vbs_scripts/VCL/VCLcleanup.cmd
@@ -0,0 +1,6 @@
+@echo off
+
+del %SystemRoot%\system32\GroupPolicy\User\Scripts\Logon\VCLprepare.cmd
+del "C:\Documents and Settings\Default User\Desktop\Windows Media Player.lnk"
+del "C:\Documents and Settings\root\Desktop\Windows Media Player.lnk"
+
diff --git a/managementnode/vbs_scripts/VCL/VCLprepare.cmd b/managementnode/vbs_scripts/VCL/VCLprepare.cmd
new file mode 100755
index 0000000..dae3d81
--- /dev/null
+++ b/managementnode/vbs_scripts/VCL/VCLprepare.cmd
@@ -0,0 +1,17 @@
+@echo off
+
+cd %APPDATA%/vcl
+
+%SystemRoot%\system32\cscript.exe unsetautologon.vbs
+
+%SystemRoot%\system32\cscript.exe updatecygwin.vbs
+
+%SystemRoot%\system32\cmd.exe /c setfw.bat
+
+%SystemRoot%\system32\cmd.exe /c setsyslog.bat
+
+copy VCLcleanup.cmd C:\WINDOWS\system32\GroupPolicy\User\Scripts\Logoff\
+
+%SystemRoot%\system32\eventcreate.exe /T INFORMATION /L APPLICATION /SO VCLprepare.cmd /ID 555 /D "%COMPUTERNAME% is READY."
+
+%SystemRoot%\system32\logoff.exe
diff --git a/managementnode/vbs_scripts/VCL/VCLrcboot.cmd b/managementnode/vbs_scripts/VCL/VCLrcboot.cmd
new file mode 100755
index 0000000..458a5d6
--- /dev/null
+++ b/managementnode/vbs_scripts/VCL/VCLrcboot.cmd
@@ -0,0 +1,17 @@
+@echo off
+
+copy "C:\Documents and Settings\root\Application Data\VCL\VCLprepare.cmd" C:\WINDOWS\system32\GroupPolicy\User\Scripts\Logon\
+
+del C:\WINDOWS\system32\GroupPolicy\User\Scripts\Logoff\VCLcleanup.cmd
+
+cd %APPDATA%/vcl
+
+%SystemRoot%\system32\cmd.exe /c C:\WINDOWS\regedit.exe /s nodyndns.reg
+
+%SystemRoot%\system32\cmd.exe /c wsname.exe /N:$DNS /MCN
+
+%SystemRoot%\system32\cmd.exe /c C:\WINDOWS\system32\ping.exe 1.1.1.1 %-n 1 -w 5000 > NUL
+
+%SystemRoot%\system32\cmd.exe /c newsid.exe /a /d 6
+
+del C:\WINDOWS\system32\GroupPolicy\User\Scripts\Logon\VCLrcboot.cmd
diff --git a/managementnode/vbs_scripts/VCL/VCLstartimage.vbs b/managementnode/vbs_scripts/VCL/VCLstartimage.vbs
new file mode 100755
index 0000000..15f700d
--- /dev/null
+++ b/managementnode/vbs_scripts/VCL/VCLstartimage.vbs
@@ -0,0 +1,42 @@
+On Error Resume Next
+
+Set oWshShell = CreateObject("WScript.Shell")
+Set oWshEnvironment = oWshShell.Environment("Process")
+Set oFileSystem = CreateObject("Scripting.FileSystemObject")
+Set WshNetwork = WScript.CreateObject("WScript.Network")
+sTempDir = oWshEnvironment("TEMP")
+Dim oExec
+Dim GuiAnswer
+strComputer = "."
+
+'copy VCLrcboot.cmd to Logon
+oFileSystem.CopyFile "C:/cygwin/home/root/VCLrcboot.vbs", "C:\WINDOWS\system32\GroupPolicy\User\Scripts\Logon\",true
+WScript.Echo "copied VCLrcboot"
+
+'set autologin
+' setup DefaultUserName as root
+oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\DefaultUserName", "root"
+
+' setup DefaultPassword
+oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\DefaultPassword", "cl0udy"
+
+' Turn on auto-login
+oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon", "1"
+
+WScript.Echo "set autologin for root account"
+
+'shutdown
+Set objWMIService = GetObject("winmgmts:" _
+ & "{impersonationLevel=impersonate,(Shutdown)}!\\" & MyName & "\root\cimv2")
+Set colOperatingSystems = objWMIService.ExecQuery _
+ ("Select * from Win32_OperatingSystem")
+For Each objOperatingSystem in colOperatingSystems
+ intreturn = ObjOperatingSystem.Win32Shutdown(5)
+ if intreturn = 0 Then
+ WScript.echo "createimage shutdown"
+ Else
+ Wscript.echo "shutdown failed error code " & intreturn
+ End If
+Next
+
+WScript.Quit
diff --git a/managementnode/vbs_scripts/VCL/auto_create_image_new.vbs b/managementnode/vbs_scripts/VCL/auto_create_image_new.vbs
new file mode 100755
index 0000000..a73e81d
--- /dev/null
+++ b/managementnode/vbs_scripts/VCL/auto_create_image_new.vbs
@@ -0,0 +1,97 @@
+On Error Resume Next
+
+Set oWshShell = CreateObject("WScript.Shell")
+Set oWshEnvironment = oWshShell.Environment("Process")
+Set oFileSystem = CreateObject("Scripting.FileSystemObject")
+Set WshNetwork = WScript.CreateObject("WScript.Network")
+sTempDir = oWshEnvironment("TEMP")
+sAppDataDir = oWshEnvironment("APPDATA")
+Dim oExec
+Dim GuiAnswer
+strComputer = "."
+MyName = lcase(WshNetwork.ComputerName)
+
+Const ForAppending = 8
+
+
+' clean up %TEMP% directory from .log files
+oWshShell.Run "cmd.exe /C del /Q " & sTempDir & "\*.log", 0, TRUE
+
+' open log file to record all actions taken
+set objFSO = CreateObject("Scripting.FileSystemObject")
+Set objTextFile = objFSO.OpenTextFile _
+ (sTempDir & "\VCLprepare.log", ForAppending, True)
+objTextFile.WriteLine("========================================================================")
+objTextFile.WriteLine(Now & " : auto_create_image.vbs : script started")
+
+objTextFile.WriteLine(Now & " : auto_create_image.vbs : cleaned up " & sTempDir & " directory from .log files")
+
+
+' check that WAN network interface is enabled, if not - enable it
+''WScript.Echo "Enabling WAN interface..."
+''objTextFile.WriteLine(Now & " : auto_create_image.vbs : Enable WAN interface")
+''oWshShell.Run "cscript.exe " & sTempDir & "\vcl\enWAN.vbs", 0, TRUE
+''WScript.Echo "Done!"
+''objTextFile.WriteLine(Now & " : auto_create_image.vbs : WAN interface enabled")
+
+
+' setup to run prepare_for_image.vbs script after reboot
+'objTextFile.WriteLine(Now & " : auto_create_image.vbs : setup RunOnce 'auto_prepare_for_image.vbs' after reboot")
+'oWshShell.RegWrite "HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce\step0", "cmd.exe /c cscript.exe " & sTempDir & "\vcl\auto_prepare_for_image.vbs"
+
+'check = oWshShell.RegRead("HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce\step0")
+'objTextFile.WriteLine(Now & " : CHECK (RunOnce registry entry): " & check)
+
+' enable AutoLogon after reboot
+'objTextFile.WriteLine(Now & " : auto_create_image.vbs : enable Auto-Logon after reboot")
+'oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon", "1"
+'oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\DefaultUserName", "root"
+
+'check = oWshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon")
+'objTextFile.WriteLine(Now & " : CHECK (AutoAdminLogon registry entry): " & check & " (should be 1)")
+
+
+' disable pagefile
+objTextFile.WriteLine(Now & " : auto_create_image.vbs : disable page file")
+strCommand = "reg.exe add " & Chr(34) & _
+ "HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Memory Management" & Chr(34) &_
+ " /v PagingFiles /d " & Chr(34) & "" & Chr(34) & " /t REG_MULTI_SZ /f"
+Set oExec = oWshShell.Exec(strcommand)
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
+''strCommand = sTempDir & "\vcl\movefile.exe " & Chr(34) & "c:\pagefile.sys" & Chr(34) & " " & Chr(34) & Chr(34)
+strCommand = sAppDataDir & "\vcl\movefile.exe " & Chr(34) & "c:\pagefile.sys" & Chr(34) & " " & Chr(34) & Chr(34)
+Set oExec = oWshShell.Exec(strcommand)
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
+
+
+'check = oWshShell.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Memory Management\PagingFiles")
+'objTextFile.WriteLine(Now & " : CHECK (PagingFiles registry entry): '" & check(0) & "' (should be empty)")
+
+
+objTextFile.WriteLine(Now & " : auto_create_image.vbs : script finished, rebooting computer")
+objTextFile.WriteLine("========================================================================")
+'close log file handler
+objTextFile.Close
+
+
+'reboot computer to make changes effective
+
+Set objWMIService = GetObject("winmgmts:" _
+ & "{impersonationLevel=impersonate,(Shutdown)}!\\" & MyName & "\root\cimv2")
+Set colOperatingSystems = objWMIService.ExecQuery _
+ ("Select * from Win32_OperatingSystem")
+For Each objOperatingSystem in colOperatingSystems
+ intreturn = ObjOperatingSystem.Win32Shutdown(6)
+ if intreturn = 0 Then
+ WScript.echo "createimage reboot"
+ Else
+ Wscript.echo "reboot failed error code " & intreturn
+ End If
+Next
+
+WScript.Quit
+
diff --git a/managementnode/vbs_scripts/VCL/enablepagefile.vbs b/managementnode/vbs_scripts/VCL/enablepagefile.vbs
new file mode 100755
index 0000000..c37b746
--- /dev/null
+++ b/managementnode/vbs_scripts/VCL/enablepagefile.vbs
@@ -0,0 +1,11 @@
+On Error Resume Next
+Set oWshShell = CreateObject("WScript.Shell")
+
+' turn back on pagefile
+strCommand = "reg.exe add " & Chr(34) & _
+ "HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Memory Management" & Chr(34) &_
+ " /v PagingFiles /d " & Chr(34) & "c:\pagefile.sys 0 0" & Chr(34) & " /t REG_MULTI_SZ /f"
+Set oExec = oWshShell.Exec(strcommand)
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
diff --git a/managementnode/vbs_scripts/VCL/networkinfo.bat b/managementnode/vbs_scripts/VCL/networkinfo.bat
new file mode 100755
index 0000000..21c6d8c
--- /dev/null
+++ b/managementnode/vbs_scripts/VCL/networkinfo.bat
@@ -0,0 +1,115 @@
+@echo off
+
+FOR /f "skip=1 tokens=2,15 " %%a in ('IPCONFIG') do (
+ if %%a==Address. (
+ SET FIRST_IP=%%b
+ GOTO CONTINUE
+ )
+)
+
+:CONTINUE
+
+FOR /f "skip=10 tokens=2,15 " %%a in ('IPCONFIG') do (
+ if %%a==Address. (
+ SET SECOND_IP=%%b
+ )
+)
+
+REM echo FIRST_IP = %FIRST_IP%
+REM echo SECOND_IP = %SECOND_IP%
+
+FOR /f "skip=1 tokens=1,2* " %%a in ('IPCONFIG') do (
+ if %%b==adapter (
+ SET FIRST_NAME=%%c
+ GOTO CONTINUE2
+ )
+)
+
+:CONTINUE2
+
+FOR /f "skip=10 tokens=1,2* " %%a in ('IPCONFIG') do (
+ if %%b==adapter (
+ SET SECOND_NAME=%%c
+ )
+)
+
+FOR /f "tokens=1 delims=:" %%a in ('echo %FIRST_NAME%') do (
+ SET FIRST_NAME=%%a
+)
+
+FOR /f "tokens=1 delims=:" %%a in ('echo %SECOND_NAME%') do (
+ SET SECOND_NAME=%%a
+)
+
+FOR /f "skip=1 tokens=2,13 " %%a in ('IPCONFIG') do (
+ if %%a==Gateway (
+ SET FIRST_GW=%%b
+ GOTO CONTINUE3
+ )
+)
+
+:CONTINUE3
+
+FOR /f "skip=10 tokens=2,13 " %%a in ('IPCONFIG') do (
+ if %%a==Gateway (
+ SET SECOND_GW=%%b
+ )
+)
+
+REM echo FIRST_IP = %FIRST_IP%
+REM echo FIRST_NAME = %FIRST_NAME%
+REM echo SECOND_IP = %SECOND_IP%
+REM echo SECOND_NAME = %SECOND_NAME%
+
+FOR /f "tokens=1,5 delims=. " %%a in ('echo %FIRST_IP%%SECOND_IP%') do (
+ if %%a==10 (
+ if %%b==152 (
+ SET INTERNAL_IP=%FIRST_IP%
+ SET INTERNAL_NAME=%FIRST_NAME%
+ SET INTERNAL_GW=%FIRST_GW%
+ SET EXTERNAL_IP=%SECOND_IP%
+ SET EXTERNAL_NAME=%SECOND_NAME%
+ SET EXTERNAL_GW=%SECOND_GW%
+ ) else (
+ SET INTERNAL_IP=%FIRST_IP%
+ SET INTERNAL_NAME=%FIRST_NAME%
+ SET INTERNAL_GW=%FIRST_GW%
+ SET EXTERNAL_IP=NA
+ SET EXTERNAL_NAME=NA
+ SET EXTERNAL_GW=NA
+ )
+ ) else (
+ if %%a==152 (
+ if %%b==10 (
+ SET EXTERNAL_IP=%FIRST_IP%
+ SET EXTERNAL_NAME=%FIRST_NAME%
+ SET EXTERNAL_GW=%FIRST_GW%
+ SET INTERNAL_IP=%SECOND_IP%
+ SET INTERNAL_NAME=%SECOND_NAME%
+ SET INTERNAL_GW=%SECOND_GW%
+ ) else (
+ SET EXTERNAL_IP=%FIRST_IP%
+ SET EXTERNAL_NAME=%FIRST_NAME%
+ SET EXTERNAL_GW=%FIRST_GW%
+ SET INTERNAL_IP=NA
+ SET INTERNAL_NAME=NA
+ SET INTERNAL_GW=NA
+ )
+ ) else (
+ SET INTERNAL_IP=NA
+ SET INTERNAL_NAME=NA
+ SET INTERNAL_GW=NA
+ SET EXTERNAL_IP=NA
+ SET EXTERNAL_NAME=NA
+ SET EXTERNAL_GW=NA
+ )
+ )
+)
+
+REM echo INTERNAL_IP = %INTERNAL_IP%
+REM echo INTERNAL_NAME = %INTERNAL_NAME%
+REM echo INTERNAL_GW = %INTERNAL_GW%
+
+REM echo EXTERNAL_IP = %EXTERNAL_IP%
+REM echo EXTERNAL_NAME = %EXTERNAL_NAME%
+REM echo EXTERNAL_GW = %EXTERNAL_GW%
diff --git a/managementnode/vbs_scripts/VCL/networkinfosetfw.vbs b/managementnode/vbs_scripts/VCL/networkinfosetfw.vbs
new file mode 100755
index 0000000..60b9e35
--- /dev/null
+++ b/managementnode/vbs_scripts/VCL/networkinfosetfw.vbs
@@ -0,0 +1,120 @@
+On Error Resume Next
+
+Dim objWMIService, objItem, objService
+Dim colListOfServices, strComputer, strService, intSleep
+Dim colNicConfigs,colNicAdapter,strDescription,strMAC
+Dim strIPAddresses,strGWAddress
+
+strComputer = "."
+
+Set objWMIService = GetObject("winmgmts:" _
+ & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
+Set colNicConfigs = objWMIService.ExecQuery _
+ ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
+Set colNicAdapter = objWMIService.ExecQuery _
+ ("SELECT * FROM Win32_NetworkAdapter")
+
+For Each objNicConfig In colNicConfigs
+ strDescription = objNicConfig.Description
+ strMAC = objNicConfig.MACAddress
+ If InStr(strDescription, "Broadcom") Then
+ strIPAddresses = ""
+ If Not IsNull(objNicConfig.IPAddress) Then
+ For Each strIPAddress In objNicConfig.IPAddress
+ If Not strIPAddress = "" Then
+ strIPAddresses = strIPAddresses & strIPAddress
+ End If
+ Next
+ End If
+ strGWAddresses = ""
+ If Not IsNull(objNicConfig.DefaultIPGateway) Then
+ For Each strGWAddress In objNicConfig.DefaultIPGateway
+ If Not strGWAddress = "" Then
+ strGWAddresses = strGWAddresses & strGWAddress
+ End If
+ Next
+ End If
+
+
+' WScript.Echo "IP Address : " & strIPAddresses & VbCrLf & _
+' "MAC Address : " & strMAC & VbCrLf & _
+' "GW Address : " & strGWAddresses
+ For Each objNicAdapter In colNicAdapter
+ If strMAC = objNicAdapter.MACAddress Then
+ strNetConnectionID = objNicAdapter.NetConnectionID
+ If Not strNetConnectionID = "" Then
+ 'WScript.Echo "Name: " & strNetConnectionID & VbCrLf
+ If Left(strIPAddresses,3) = "10." Then
+ INTERNAL_IP = strIPAddresses
+ INTERNAL_NAME = strNetConnectionID
+ INTERNAL_GW = strGWAddresses
+ End If
+
+ If Left(strIPAddresses,4) = "152." Then
+ EXTERNAL_IP = strIPAddresses
+ EXTERNAL_NAME = strNetConnectionID
+ EXTERNAL_GW = strGWAddresses
+ End If
+ End If
+ End If
+ Next
+
+
+ Else
+ strIPAddresses = ""
+ strGWAddresses = ""
+ End If
+
+Next
+
+
+
+'WScript.Echo "INTERNAL_IP = " & INTERNAL_IP
+'WScript.Echo "INTERNAL_NAME = " & INTERNAL_NAME
+'WScript.Echo "INTERNAL_GW = " & INTERNAL_GW
+
+'WScript.Echo "EXTERNAL_IP = " & EXTERNAL_IP
+'WScript.Echo "EXTERNAL_NAME = " & EXTERNAL_NAME
+'WScript.Echo "EXTERNAL_GW = " & EXTERNAL_GW
+
+Set oWshShell = CreateObject("WScript.Shell")
+
+Dim strCMD1,routeCMD,strCMD2,strCMD3
+
+strCMD1 = "netsh firewall set icmpsetting type = 8 mode = enable interface = " & Chr(34) & INTERNAL_NAME & Chr(34)
+'oWshShell.run "%SystemRoot%\system32\route.exe -f -p ADD 0.0.0.0 MASK 0.0.0.0 EXTERNAL_GW METRIC 2",,true
+routeCMD = "route.exe -f -p ADD 0.0.0.0 MASK 0.0.0.0 " & EXTERNAL_GW & " METRIC 2"
+'WScript.Echo "setting route" & routeCMD
+oWshShell.run routeCMD,,true
+'WScript.Echo "setting icmpsetting " & strCMD1
+oWshShell.run strCMD1,,true
+strCMD2 = "netsh firewall set portopening protocol = TCP port = 3389 mode = disable interface = " & Chr(34) & EXTERNAL_NAME & Chr(34)
+'WScript.Echo "closing 3389 " & strCMD2
+oWshShell.run strCMD2,,true
+strCMD3 = "netsh firewall set portopening protocol = TCP port = 22 name = SSHD mode = enable interface = " & Chr(34) & INTERNAL_NAME & Chr(34)
+'WScript.Echo "opening 22 " & strCMD3
+oWshShell.run strCMD3,,true
+
+objWMIService=""
+' update syslog - stop and restart service
+
+strComputer = "."
+intSleep = 1500
+
+'On Error Resume Next
+' NB strService is case sensitive.
+strService = " 'ntsyslog' "
+Set objWMIService = GetObject("winmgmts:" _
+& "{impersonationLevel=impersonate}!\\" _
+& strComputer & "\root\cimv2")
+Set colListOfServices = objWMIService.ExecQuery _
+("Select * from Win32_Service Where Name ="_
+& strService & " ")
+For Each objService in colListOfServices
+objService.StopService()
+WSCript.Sleep intSleep
+oWshShell.run """reg add HKLM\SOFTWARE\SaberNet /v syslog /d INTERNAL_GW /f""",,true
+objService.StartService()
+Next
+'WScript.Echo "Your "& strService & " service has Started"
+WScript.Quit
diff --git a/managementnode/vbs_scripts/VCL/setfw.bat b/managementnode/vbs_scripts/VCL/setfw.bat
new file mode 100755
index 0000000..447fd75
--- /dev/null
+++ b/managementnode/vbs_scripts/VCL/setfw.bat
@@ -0,0 +1,17 @@
+@echo off
+
+ipconfig /renew
+
+ping 1.1.1.1 -n 1 -w 10000 > NUL
+
+call "%APPDATA%\VCL\networkinfo.bat"
+
+%SystemRoot%\system32\route.exe -p ADD 0.0.0.0 MASK 0.0.0.0 %EXTERNAL_GW% %METRIC 2
+
+netsh firewall set icmpsetting type = 8 mode = enable interface = "%INTERNAL_NAME%"
+
+netsh firewall set portopening protocol = TCP port = 3389 mode = enable scope = custom addresses = %INTERNAL_GW%
+
+netsh firewall set portopening protocol = TCP port = 3389 mode = disable interface = "%EXTERNAL_NAME%"
+
+netsh firewall set portopening protocol = TCP port = 22 name = SSHD mode = enable interface = "%INTERNAL_NAME%"
diff --git a/managementnode/vbs_scripts/VCL/setsyslog.bat b/managementnode/vbs_scripts/VCL/setsyslog.bat
new file mode 100755
index 0000000..4b675ac
--- /dev/null
+++ b/managementnode/vbs_scripts/VCL/setsyslog.bat
@@ -0,0 +1,37 @@
+@echo off
+
+call "%APPDATA%\VCL\networkinfo.bat"
+
+sc stop ntsyslog
+
+:WAIT
+FOR /f "skip=1 tokens=1,4 " %%a in ('sc query ntsyslog') do (
+ if %%a==STATE (
+ if %%b==STOPPED (
+ GOTO CONTINUE
+ ) else (
+ ping 1.1.1.1 -n 1 -w 1000 > NUL
+ GOTO WAIT
+ )
+ )
+)
+
+:CONTINUE
+
+reg add HKLM\SOFTWARE\SaberNet /v Syslog /d %INTERNAL_GW% /f
+
+sc start ntsyslog
+
+:WAIT2
+FOR /f "skip=1 tokens=1,4 " %%a in ('sc query ntsyslog') do (
+ if %%a==STATE (
+ if %%b==RUNNING (
+ GOTO END
+ ) else (
+ ping 1.1.1.1 -n 1 -w 1000 > NUL
+ GOTO WAIT2
+ )
+ )
+)
+
+:END
\ No newline at end of file
diff --git a/managementnode/vbs_scripts/VCL/unsetautologon.vbs b/managementnode/vbs_scripts/VCL/unsetautologon.vbs
new file mode 100755
index 0000000..03c8a98
--- /dev/null
+++ b/managementnode/vbs_scripts/VCL/unsetautologon.vbs
@@ -0,0 +1,8 @@
+On Error Resume Next
+
+Set oWshShell = CreateObject("WScript.Shell")
+
+' Turn off auto-login
+oWshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoAdminLogon", "0"
+
+WScript.Quit
diff --git a/managementnode/vbs_scripts/VCL/updatecygwin.vbs b/managementnode/vbs_scripts/VCL/updatecygwin.vbs
new file mode 100755
index 0000000..24c6305
--- /dev/null
+++ b/managementnode/vbs_scripts/VCL/updatecygwin.vbs
@@ -0,0 +1,33 @@
+Set oWshShell = CreateObject("WScript.Shell")
+
+' create new "passwd" and "group" files for cygwin, because SID was changed
+oWshShell.Run "cmd.exe /C del " & "c:\cygwin\etc\group", 0, TRUE
+WScript.Sleep 1000
+oWshShell.Run "cmd.exe /C del " & "c:\cygwin\etc\passwd", 0, TRUE
+WScript.Sleep 1000
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\mkgroup.exe -l" & " > c:\cygwin\etc\group", 0, TRUE
+WScript.Sleep 1000
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\mkpasswd.exe -l" & " > c:\cygwin\etc\passwd", 0, TRUE
+WScript.Sleep 1000
+
+' restore ownership of files
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\chown.exe root:None /etc/ssh*", 0, TRUE
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\chown.exe -R root:None /home/", 0, TRUE
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\chown.exe root:None /var/empty", 0, TRUE
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\chown.exe root:None /var/log/sshd.log", 0, TRUE
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\chown.exe root:None /var/log/lastlog", 0, TRUE
+WScript.Sleep 1000
+
+' regenerate ssh keys
+' first delete old ones
+oWshShell.Run "cmd.exe /C del " & "c:\cygwin\etc\ssh_host_*", 0, TRUE
+
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\ssh-keygen.exe -q -t rsa1 -f /etc/ssh_host_key -N " & Chr(34) & Chr(34), 0, TRUE
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\ssh-keygen.exe -q -t rsa -f /etc/ssh_host_rsa_key -N " & Chr(34) & Chr(34), 0, TRUE
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\ssh-keygen.exe -q -t dsa -f /etc/ssh_host_dsa_key -N " & Chr(34) & Chr(34), 0, TRUE
+
+' start SSH Daemon
+oWshShell.Run "cmd.exe /C " & "c:\cygwin\bin\cygrunsrv.exe -S sshd", 0, TRUE
+'WScript.Sleep 1000
+
+WScript.Quit
diff --git a/managementnode/vbs_scripts/add_user.vbs b/managementnode/vbs_scripts/add_user.vbs
new file mode 100755
index 0000000..1acd9f5
--- /dev/null
+++ b/managementnode/vbs_scripts/add_user.vbs
@@ -0,0 +1,35 @@
+Dim UserAccount
+Dim UserPasswd
+
+If WScript.Arguments.Count = 2 Then
+ UserAccount = WScript.Arguments.Item(0)
+ UserPasswd = WScript.Arguments.Item(1)
+Else
+ WScript.Echo "Usage: add_user.vbs <user_name> <user_passwd>"
+ WScript.Quit
+End If
+
+strComputer = "."
+Set colAccounts = GetObject("WinNT://" & strComputer & "")
+Set objUser = colAccounts.Create("user", UserAccount)
+objUser.SetPassword UserPasswd
+objUser.SetInfo
+
+Set net = WScript.CreateObject("WScript.Network")
+local = net.ComputerName
+set group = GetObject("WinNT://"& local &"/Administrators")
+set group1 = GetObject("WinNT://"& local &"/Remote Desktop Users")
+on error resume next
+group.Add "WinNT://"& UserAccount &""
+group1.Add "WinNT://"& UserAccount &""
+CheckError
+
+sub CheckError
+ if not err.number=0 then
+ WScript.Echo err.Number
+ vbCritical err.clear
+' else WScript.Echo "Done!"
+ end if
+end sub
+
+WScript.sleep 1000
\ No newline at end of file
diff --git a/managementnode/vbs_scripts/auto_create_image.vbs b/managementnode/vbs_scripts/auto_create_image.vbs
new file mode 100755
index 0000000..056ce46
--- /dev/null
+++ b/managementnode/vbs_scripts/auto_create_image.vbs
@@ -0,0 +1,66 @@
+On Error Resume Next
+
+Set oWshShell = CreateObject("WScript.Shell")
+Set oWshEnvironment = oWshShell.Environment("Process")
+Set oFileSystem = CreateObject("Scripting.FileSystemObject")
+Set WshNetwork = WScript.CreateObject("WScript.Network")
+sTempDir = oWshEnvironment("TEMP")
+sAppDataDir = oWshEnvironment("APPDATA")
+Dim oExec
+Dim GuiAnswer
+strComputer = "."
+MyName = lcase(WshNetwork.ComputerName)
+
+Const ForAppending = 8
+
+
+' clean up %TEMP% directory from .log files
+oWshShell.Run "cmd.exe /C del /Q " & sTempDir & "\*.log", 0, TRUE
+
+' open log file to record all actions taken
+set objFSO = CreateObject("Scripting.FileSystemObject")
+Set objTextFile = objFSO.OpenTextFile _
+ (sTempDir & "\VCLprepare.log", ForAppending, True)
+objTextFile.WriteLine("========================================================================")
+objTextFile.WriteLine(Now & " : auto_create_image.vbs : script started")
+
+objTextFile.WriteLine(Now & " : auto_create_image.vbs : cleaned up " & sTempDir & " directory from .log files")
+
+
+' disable pagefile
+objTextFile.WriteLine(Now & " : auto_create_image.vbs : disable page file")
+strCommand = "reg.exe add " & Chr(34) & _
+ "HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Memory Management" & Chr(34) &_
+ " /v PagingFiles /d " & Chr(34) & "" & Chr(34) & " /t REG_MULTI_SZ /f"
+Set oExec = oWshShell.Exec(strcommand)
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
+strCommand = sAppDataDir & "\vcl\movefile.exe " & Chr(34) & "c:\pagefile.sys" & Chr(34) & " " & Chr(34) & Chr(34)
+Set oExec = oWshShell.Exec(strcommand)
+Do While oExec.Status = 0
+ WScript.Sleep 100
+Loop
+
+objTextFile.WriteLine(Now & " : auto_create_image.vbs : script finished, rebooting computer")
+objTextFile.WriteLine("========================================================================")
+'close log file handler
+objTextFile.Close
+
+'reboot computer to make changes effective
+
+Set objWMIService = GetObject("winmgmts:" _
+ & "{impersonationLevel=impersonate,(Shutdown)}!\\" & MyName & "\root\cimv2")
+Set colOperatingSystems = objWMIService.ExecQuery _
+ ("Select * from Win32_OperatingSystem")
+For Each objOperatingSystem in colOperatingSystems
+ intreturn = ObjOperatingSystem.Win32Shutdown(6)
+ if intreturn = 0 Then
+ WScript.echo "createimage reboot"
+ Else
+ Wscript.echo "reboot failed error code " & intreturn
+ End If
+Next
+
+WScript.Quit
+
diff --git a/managementnode/vbs_scripts/del_user.vbs b/managementnode/vbs_scripts/del_user.vbs
new file mode 100755
index 0000000..50f54f3
--- /dev/null
+++ b/managementnode/vbs_scripts/del_user.vbs
@@ -0,0 +1,14 @@
+Dim UserAccount
+
+If WScript.Arguments.Count = 1 Then
+ UserAccount = WScript.Arguments.Item(0)
+Else
+ WScript.Echo "Usage: del_user.vbs <user_name>"
+ WScript.Quit
+End If
+
+strComputer = "."
+Set objComputer = GetObject("WinNT://" & strComputer & ",computer")
+objComputer.Delete "user", UserAccount
+
+WScript.sleep 1000
\ No newline at end of file
diff --git a/managementnode/vbs_scripts/list_users.vbs b/managementnode/vbs_scripts/list_users.vbs
new file mode 100755
index 0000000..de0a39a
--- /dev/null
+++ b/managementnode/vbs_scripts/list_users.vbs
@@ -0,0 +1,7 @@
+Set objNetwork = CreateObject("Wscript.Network")
+strComputer = objNetwork.ComputerName
+Set colAccounts = GetObject("WinNT://" & strComputer & "")
+colAccounts.Filter = Array("user")
+For Each objUser In colAccounts
+ Wscript.Echo objUser.Name
+Next
\ No newline at end of file
diff --git a/mysql/vcl.sql b/mysql/vcl.sql
new file mode 100644
index 0000000..692cba3
--- /dev/null
+++ b/mysql/vcl.sql
@@ -0,0 +1,1720 @@
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+-- phpMyAdmin SQL Dump
+-- version 2.10.1
+-- http://www.phpmyadmin.net
+--
+-- Host: mysql.eos.ncsu.edu:3306
+-- Generation Time: Apr 08, 2008 at 03:26 PM
+-- Server version: 5.0.45
+-- PHP Version: 5.2.0
+
+SET SQL_MODE="NO_AUTO_VALUE_ON_ZERO";
+
+--
+-- Database: `vcl`
+--
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `adminlevel`
+--
+
+CREATE TABLE IF NOT EXISTS `adminlevel` (
+ `id` tinyint(3) unsigned NOT NULL auto_increment,
+ `name` varchar(10) NOT NULL default '',
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `name` (`name`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=4 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `affiliation`
+--
+
+CREATE TABLE IF NOT EXISTS `affiliation` (
+ `id` mediumint(8) unsigned NOT NULL auto_increment,
+ `name` varchar(40) NOT NULL,
+ `dataUpdateText` text NOT NULL,
+ `sitewwwaddress` varchar(56) default NULL,
+ `helpaddress` varchar(32) default NULL,
+ PRIMARY KEY (`id`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=2 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `blockComputers`
+--
+
+CREATE TABLE IF NOT EXISTS `blockComputers` (
+ `blockTimeid` mediumint(8) unsigned NOT NULL default '0',
+ `computerid` smallint(5) unsigned NOT NULL default '0',
+ PRIMARY KEY (`blockTimeid`,`computerid`),
+ KEY `computerid` (`computerid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `blockRequest`
+--
+
+CREATE TABLE IF NOT EXISTS `blockRequest` (
+ `id` mediumint(8) unsigned NOT NULL auto_increment,
+ `name` varchar(80) NOT NULL,
+ `imageid` smallint(5) unsigned NOT NULL,
+ `numMachines` tinyint(3) unsigned NOT NULL,
+ `groupid` smallint(5) unsigned NOT NULL,
+ `repeating` enum('weekly','monthly','list') NOT NULL default 'weekly',
+ `ownerid` mediumint(8) unsigned NOT NULL,
+ `admingroupid` mediumint(8) unsigned NOT NULL,
+ `managementnodeid` smallint(5) unsigned NOT NULL,
+ `expireTime` datetime NOT NULL,
+ `processing` tinyint(1) unsigned NOT NULL,
+ PRIMARY KEY (`id`),
+ KEY `imageid` (`imageid`),
+ KEY `groupid` (`groupid`),
+ KEY `ownerid` (`ownerid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=1 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `blockTimes`
+--
+
+CREATE TABLE IF NOT EXISTS `blockTimes` (
+ `id` mediumint(8) unsigned NOT NULL auto_increment,
+ `blockRequestid` mediumint(8) unsigned NOT NULL,
+ `start` datetime NOT NULL,
+ `end` datetime NOT NULL,
+ `processed` tinyint(1) unsigned NOT NULL default '0',
+ PRIMARY KEY (`id`),
+ KEY `start` (`start`),
+ KEY `end` (`end`),
+ KEY `blockRequestid` (`blockRequestid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=1 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `blockWebDate`
+--
+
+CREATE TABLE IF NOT EXISTS `blockWebDate` (
+ `blockRequestid` mediumint(8) unsigned NOT NULL,
+ `start` date NOT NULL,
+ `end` date NOT NULL,
+ `days` tinyint(3) unsigned default NULL,
+ `weeknum` tinyint(1) unsigned default NULL,
+ KEY `blockRequestid` (`blockRequestid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `blockWebTime`
+--
+
+CREATE TABLE IF NOT EXISTS `blockWebTime` (
+ `blockRequestid` mediumint(8) unsigned NOT NULL,
+ `starthour` tinyint(2) unsigned NOT NULL,
+ `startminute` tinyint(2) unsigned NOT NULL,
+ `startmeridian` enum('am','pm') NOT NULL,
+ `endhour` tinyint(2) unsigned NOT NULL,
+ `endminute` tinyint(2) unsigned NOT NULL,
+ `endmeridian` enum('am','pm') NOT NULL,
+ `order` tinyint(3) unsigned NOT NULL,
+ KEY `blockRequestid` (`blockRequestid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `changelog`
+--
+
+CREATE TABLE IF NOT EXISTS `changelog` (
+ `id` int(10) unsigned NOT NULL auto_increment,
+ `logid` int(10) unsigned NOT NULL default '0',
+ `start` datetime default NULL,
+ `end` datetime default NULL,
+ `computerid` smallint(5) unsigned default NULL,
+ `remoteIP` varchar(15) default NULL,
+ `wasavailable` tinyint(1) unsigned default NULL,
+ `timestamp` datetime NOT NULL default '0000-00-00 00:00:00',
+ PRIMARY KEY (`id`),
+ KEY `logid` (`logid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=1 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `clickThroughs`
+--
+
+CREATE TABLE IF NOT EXISTS `clickThroughs` (
+ `userid` mediumint(8) unsigned NOT NULL default '0',
+ `imageid` smallint(5) unsigned NOT NULL default '0',
+ `imagerevisionid` mediumint(8) unsigned default NULL,
+ `accepted` datetime NOT NULL default '0000-00-00 00:00:00',
+ `agreement` text NOT NULL,
+ KEY `userid` (`userid`),
+ KEY `imagerevisionid` (`imagerevisionid`),
+ KEY `imageid` (`imageid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `computer`
+--
+
+CREATE TABLE IF NOT EXISTS `computer` (
+ `id` smallint(5) unsigned NOT NULL auto_increment,
+ `stateid` tinyint(5) unsigned NOT NULL default '10',
+ `ownerid` mediumint(8) unsigned default '1',
+ `deptid` tinyint(3) unsigned NOT NULL default '1',
+ `platformid` tinyint(3) unsigned NOT NULL default '0',
+ `scheduleid` tinyint(3) unsigned default NULL,
+ `currentimageid` smallint(5) unsigned NOT NULL default '0',
+ `preferredimageid` smallint(5) unsigned NOT NULL default '0',
+ `nextimageid` smallint(5) unsigned NOT NULL default '0',
+ `imagerevisionid` mediumint(8) unsigned NOT NULL default '0',
+ `RAM` smallint(5) unsigned NOT NULL default '0',
+ `procnumber` tinyint(5) unsigned NOT NULL default '1',
+ `procspeed` smallint(5) unsigned NOT NULL default '0',
+ `network` smallint(5) unsigned NOT NULL default '100',
+ `hostname` varchar(36) NOT NULL default '',
+ `IPaddress` varchar(15) NOT NULL default '',
+ `privateIPaddress` varchar(15) default NULL,
+ `eth0macaddress` varchar(17) default NULL,
+ `eth1macaddress` varchar(17) default NULL,
+ `type` enum('blade','lab','virtualmachine') NOT NULL default 'blade',
+ `provisioningid` smallint(5) unsigned NOT NULL,
+ `drivetype` varchar(4) NOT NULL default 'hda',
+ `deleted` tinyint(1) unsigned NOT NULL default '0',
+ `notes` text,
+ `lastcheck` datetime default NULL,
+ `location` varchar(10) default NULL,
+ `dsa` mediumtext,
+ `dsapub` mediumtext,
+ `rsa` mediumtext,
+ `rsapub` mediumtext,
+ `host` blob,
+ `hostpub` mediumtext,
+ `vmhostid` smallint(5) unsigned default NULL,
+ `vmtypeid` tinyint(3) unsigned default NULL,
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `hostname` (`hostname`),
+ UNIQUE KEY `eth1macaddress` (`eth1macaddress`),
+ UNIQUE KEY `eth0macaddress` (`eth0macaddress`),
+ KEY `ownerid` (`ownerid`),
+ KEY `stateid` (`stateid`),
+ KEY `deptid` (`deptid`),
+ KEY `platformid` (`platformid`),
+ KEY `scheduleid` (`scheduleid`),
+ KEY `currentimageid` (`currentimageid`),
+ KEY `type` (`type`),
+ KEY `vmhostid` (`vmhostid`),
+ KEY `vmtypeid` (`vmtypeid`),
+ KEY `deleted` (`deleted`),
+ KEY `nextimageid` (`nextimageid`),
+ KEY `provisioningid` (`provisioningid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=1 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `computerloadflow`
+--
+
+CREATE TABLE IF NOT EXISTS `computerloadflow` (
+ `computerloadstateid` smallint(8) NOT NULL,
+ `nextstateid` smallint(8) default NULL,
+ `type` enum('blade','lab','virtualmachine') default NULL,
+ KEY `computerloadstateid` (`computerloadstateid`),
+ KEY `nextstateid` (`nextstateid`),
+ KEY `type` (`type`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `computerloadlog`
+--
+
+CREATE TABLE IF NOT EXISTS `computerloadlog` (
+ `id` mediumint(12) unsigned NOT NULL auto_increment,
+ `reservationid` mediumint(8) unsigned NOT NULL,
+ `computerid` smallint(8) unsigned NOT NULL,
+ `loadstateid` smallint(8) unsigned default NULL,
+ `timestamp` datetime default NULL,
+ `additionalinfo` text,
+ PRIMARY KEY (`id`),
+ KEY `reservationid` (`reservationid`),
+ KEY `loadstateid` (`loadstateid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=1 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `computerloadstate`
+--
+
+CREATE TABLE IF NOT EXISTS `computerloadstate` (
+ `id` smallint(8) unsigned NOT NULL auto_increment,
+ `loadstatename` varchar(24) NOT NULL,
+ `prettyname` varchar(50) default NULL,
+ `est` tinyint(2) unsigned default NULL,
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `loadstatename` (`loadstatename`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=55 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `continuations`
+--
+
+CREATE TABLE IF NOT EXISTS `continuations` (
+ `id` varchar(255) NOT NULL default '',
+ `userid` mediumint(8) unsigned NOT NULL default '0',
+ `expiretime` datetime NOT NULL default '0000-00-00 00:00:00',
+ `frommode` varchar(50) NOT NULL default '',
+ `tomode` varchar(50) NOT NULL default '',
+ `data` text NOT NULL,
+ `multicall` tinyint(1) unsigned NOT NULL default '1',
+ `parentid` varchar(255) default NULL,
+ `deletefromid` varchar(255) NOT NULL default '',
+ PRIMARY KEY (`id`),
+ KEY `parentid` (`parentid`),
+ KEY `userid` (`userid`),
+ KEY `expiretime` (`expiretime`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `curriculum`
+--
+
+CREATE TABLE IF NOT EXISTS `curriculum` (
+ `id` smallint(5) unsigned NOT NULL auto_increment,
+ `name` varchar(30) NOT NULL default '',
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `name` (`name`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=4 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `dept`
+--
+
+CREATE TABLE IF NOT EXISTS `dept` (
+ `id` tinyint(3) unsigned NOT NULL auto_increment,
+ `name` varchar(5) NOT NULL default '',
+ `prettyname` varchar(50) NOT NULL default '',
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `name` (`name`),
+ UNIQUE KEY `prettyname` (`prettyname`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=3 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `documentation`
+--
+
+CREATE TABLE IF NOT EXISTS `documentation` (
+ `name` varchar(255) NOT NULL,
+ `title` varchar(255) NOT NULL,
+ `data` text NOT NULL,
+ UNIQUE KEY `name` (`name`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `image`
+--
+
+CREATE TABLE IF NOT EXISTS `image` (
+ `id` smallint(5) unsigned NOT NULL auto_increment,
+ `name` varchar(70) NOT NULL default '',
+ `prettyname` varchar(60) NOT NULL default '',
+ `ownerid` mediumint(8) unsigned default '1',
+ `deptid` tinyint(3) unsigned NOT NULL default '1',
+ `platformid` tinyint(3) unsigned NOT NULL default '0',
+ `OSid` tinyint(3) unsigned NOT NULL default '0',
+ `imagemetaid` smallint(5) unsigned default NULL,
+ `minram` smallint(5) unsigned NOT NULL default '0',
+ `minprocnumber` tinyint(3) unsigned NOT NULL default '0',
+ `minprocspeed` smallint(5) unsigned NOT NULL default '0',
+ `minnetwork` smallint(3) unsigned NOT NULL default '0',
+ `maxconcurrent` tinyint(3) unsigned default NULL,
+ `reloadtime` tinyint(3) unsigned NOT NULL default '10',
+ `deleted` tinyint(1) unsigned NOT NULL default '0',
+ `test` tinyint(1) unsigned NOT NULL default '0',
+ `lastupdate` datetime default NULL,
+ `forcheckout` tinyint(1) unsigned NOT NULL default '1',
+ `maxinitialtime` smallint(5) unsigned NOT NULL default '0',
+ `project` enum('vcl','hpc','vclhpc') NOT NULL default 'vcl',
+ `size` smallint(5) unsigned NOT NULL default '1450',
+ `architecture` enum('x86','x86_64') NOT NULL default 'x86',
+ `description` text,
+ `usage` text,
+ `basedoffrevisionid` mediumint(8) unsigned NOT NULL default '0',
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `name` (`name`),
+ UNIQUE KEY `prettyname` (`prettyname`),
+ KEY `ownerid` (`ownerid`),
+ KEY `deptid` (`deptid`),
+ KEY `platformid` (`platformid`),
+ KEY `OSid` (`OSid`),
+ KEY `imagemetaid` (`imagemetaid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=10 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `imagemeta`
+--
+
+CREATE TABLE IF NOT EXISTS `imagemeta` (
+ `id` smallint(5) unsigned NOT NULL auto_increment,
+ `checkuser` tinyint(1) unsigned NOT NULL default '1',
+ `subimages` tinyint(1) unsigned NOT NULL default '0',
+ `usergroupid` smallint(5) unsigned default NULL,
+ `sysprep` tinyint(1) unsigned NOT NULL default '1',
+ `postoption` varchar(32) default NULL,
+ `architecture` varchar(10) default NULL,
+ PRIMARY KEY (`id`),
+ KEY `usergroupid` (`usergroupid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=1 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `imagerevision`
+--
+
+CREATE TABLE IF NOT EXISTS `imagerevision` (
+ `id` mediumint(8) unsigned NOT NULL auto_increment,
+ `imageid` smallint(5) unsigned NOT NULL,
+ `revision` smallint(5) unsigned NOT NULL,
+ `userid` mediumint(8) unsigned NOT NULL,
+ `datecreated` datetime NOT NULL,
+ `deleted` tinyint(1) unsigned NOT NULL,
+ `datedeleted` datetime default NULL,
+ `production` tinyint(1) unsigned NOT NULL,
+ `comments` text,
+ `imagename` varchar(75) NOT NULL,
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `production` (`production`,`imagename`),
+ UNIQUE KEY `imageid` (`imageid`,`revision`),
+ KEY `userid` (`userid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=10 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `IMtype`
+--
+
+CREATE TABLE IF NOT EXISTS `IMtype` (
+ `id` tinyint(3) unsigned NOT NULL auto_increment,
+ `name` varchar(20) NOT NULL default '',
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `name` (`name`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=3 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `localauth`
+--
+
+CREATE TABLE IF NOT EXISTS `localauth` (
+ `userid` mediumint(8) unsigned NOT NULL default '0',
+ `passhash` varchar(40) NOT NULL default '',
+ `salt` varchar(8) NOT NULL default '',
+ `lastupdated` datetime NOT NULL default '0000-00-00 00:00:00',
+ `lockedout` tinyint(1) unsigned NOT NULL default '0',
+ PRIMARY KEY (`userid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `log`
+--
+
+CREATE TABLE IF NOT EXISTS `log` (
+ `id` int(10) unsigned NOT NULL auto_increment,
+ `userid` mediumint(8) unsigned NOT NULL default '0',
+ `nowfuture` enum('now','future') NOT NULL default 'now',
+ `start` datetime NOT NULL default '0000-00-00 00:00:00',
+ `loaded` datetime default NULL,
+ `initialend` datetime NOT NULL default '0000-00-00 00:00:00',
+ `finalend` datetime NOT NULL default '0000-00-00 00:00:00',
+ `wasavailable` tinyint(1) unsigned NOT NULL default '0',
+ `ending` enum('deleted','released','failed','noack','nologin','timeout','EOR','none') NOT NULL default 'none',
+ `requestid` mediumint(8) unsigned default NULL,
+ `computerid` smallint(5) unsigned default NULL,
+ `remoteIP` varchar(15) default NULL,
+ `imageid` smallint(5) unsigned NOT NULL default '0',
+ `size` smallint(5) unsigned NOT NULL default '1450',
+ PRIMARY KEY (`id`),
+ KEY `userid` (`userid`),
+ KEY `computerid` (`computerid`),
+ KEY `imageid` (`imageid`),
+ KEY `finalend` (`finalend`),
+ KEY `start` (`start`),
+ KEY `wasavailable` (`wasavailable`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=1 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `managementnode`
+--
+
+CREATE TABLE IF NOT EXISTS `managementnode` (
+ `id` smallint(5) unsigned NOT NULL auto_increment,
+ `IPaddress` varchar(15) NOT NULL default '',
+ `hostname` varchar(50) NOT NULL default '',
+ `ownerid` mediumint(8) unsigned NOT NULL default '1',
+ `stateid` tinyint(3) unsigned NOT NULL default '0',
+ `lastcheckin` datetime default NULL,
+ `checkininterval` tinyint(3) unsigned NOT NULL default '12',
+ `installpath` varchar(100) NOT NULL default '/install',
+ `imagelibenable` tinyint(1) unsigned NOT NULL default '0',
+ `imagelibgroupid` smallint(5) unsigned default NULL,
+ `imagelibuser` varchar(20) default 'vclstaff',
+ `imagelibkey` varchar(100) default '/etc/vcl/imagelib.key',
+ `keys` varchar(1024) default NULL,
+ `predictivemoduleid` smallint(5) unsigned NOT NULL default '1',
+ PRIMARY KEY (`id`),
+ KEY `stateid` (`stateid`),
+ KEY `ownerid` (`ownerid`),
+ KEY `imagelibgroupid` (`imagelibgroupid`),
+ KEY `IPaddress` (`IPaddress`),
+ KEY `predictivemoduleid` (`predictivemoduleid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=1 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `module`
+--
+
+CREATE TABLE IF NOT EXISTS `module` (
+ `id` smallint(5) unsigned NOT NULL auto_increment,
+ `name` varchar(30) NOT NULL,
+ `prettyname` varchar(70) NOT NULL,
+ `description` varchar(255) NOT NULL,
+ `perlpackage` varchar(150) NOT NULL,
+ PRIMARY KEY (`id`),
+ KEY `name` (`name`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=9 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `OS`
+--
+
+CREATE TABLE IF NOT EXISTS `OS` (
+ `id` tinyint(3) unsigned NOT NULL auto_increment,
+ `name` varchar(20) NOT NULL,
+ `prettyname` varchar(35) NOT NULL default '',
+ `type` varchar(30) NOT NULL,
+ `installtype` varchar(30) NOT NULL default 'image',
+ `sourcepath` varchar(30) default NULL,
+ `moduleid` smallint(5) unsigned default NULL,
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `name` (`name`),
+ UNIQUE KEY `prettyname` (`prettyname`),
+ KEY `type` (`type`),
+ KEY `installtype` (`installtype`),
+ KEY `moduleid` (`moduleid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=29 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `OSinstalltype`
+--
+
+CREATE TABLE IF NOT EXISTS `OSinstalltype` (
+ `id` tinyint(3) unsigned NOT NULL auto_increment,
+ `name` varchar(30) NOT NULL,
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `name` (`name`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=5 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `OStype`
+--
+
+CREATE TABLE IF NOT EXISTS `OStype` (
+ `id` tinyint(3) unsigned NOT NULL auto_increment,
+ `name` varchar(30) NOT NULL,
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `name` (`name`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=4 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `platform`
+--
+
+CREATE TABLE IF NOT EXISTS `platform` (
+ `id` tinyint(3) unsigned NOT NULL auto_increment,
+ `name` varchar(20) NOT NULL default '',
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `name` (`name`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=5 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `privnode`
+--
+
+CREATE TABLE IF NOT EXISTS `privnode` (
+ `id` mediumint(8) unsigned NOT NULL auto_increment,
+ `parent` mediumint(8) unsigned NOT NULL default '0',
+ `name` varchar(50) NOT NULL default '',
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `parent` (`parent`,`name`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 COMMENT='nodes for privilege tree' AUTO_INCREMENT=6 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `provisioning`
+--
+
+CREATE TABLE IF NOT EXISTS `provisioning` (
+ `id` smallint(5) unsigned NOT NULL auto_increment,
+ `name` varchar(30) NOT NULL,
+ `prettyname` varchar(70) NOT NULL,
+ `moduleid` smallint(5) unsigned NOT NULL,
+ PRIMARY KEY (`id`),
+ KEY `moduleid` (`moduleid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=4 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `querylog`
+--
+
+CREATE TABLE IF NOT EXISTS `querylog` (
+ `userid` mediumint(8) unsigned NOT NULL default '0',
+ `timestamp` datetime NOT NULL default '0000-00-00 00:00:00',
+ `mode` varchar(30) NOT NULL default '',
+ `query` text NOT NULL,
+ KEY `userid` (`userid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `request`
+--
+
+CREATE TABLE IF NOT EXISTS `request` (
+ `id` mediumint(8) unsigned NOT NULL auto_increment,
+ `stateid` tinyint(3) unsigned NOT NULL default '0',
+ `imageid` smallint(5) unsigned NOT NULL default '0',
+ `userid` mediumint(8) unsigned NOT NULL default '0',
+ `reservationid` mediumint(8) unsigned NOT NULL default '0',
+ `laststateid` tinyint(3) unsigned NOT NULL default '0',
+ `logid` int(10) unsigned NOT NULL default '0',
+ `forimaging` tinyint(1) unsigned NOT NULL default '0',
+ `test` tinyint(1) unsigned NOT NULL default '0',
+ `preload` tinyint(1) unsigned NOT NULL default '0',
+ `start` datetime NOT NULL default '0000-00-00 00:00:00',
+ `end` datetime NOT NULL default '0000-00-00 00:00:00',
+ `daterequested` datetime NOT NULL default '0000-00-00 00:00:00',
+ `datemodified` datetime default NULL,
+ PRIMARY KEY (`id`),
+ KEY `userid` (`userid`),
+ KEY `stateid` (`stateid`),
+ KEY `laststateid` (`laststateid`),
+ KEY `logid` (`logid`),
+ KEY `start` (`start`),
+ KEY `end` (`end`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=1;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `reservation`
+--
+
+CREATE TABLE IF NOT EXISTS `reservation` (
+ `id` mediumint(8) unsigned NOT NULL auto_increment,
+ `requestid` mediumint(8) unsigned NOT NULL default '0',
+ `computerid` smallint(5) unsigned NOT NULL default '0',
+ `imageid` smallint(5) unsigned NOT NULL default '0',
+ `imagerevisionid` mediumint(8) unsigned NOT NULL default '0',
+ `managementnodeid` smallint(5) unsigned NOT NULL default '1',
+ `start` datetime NOT NULL default '0000-00-00 00:00:00',
+ `end` datetime NOT NULL default '0000-00-00 00:00:00',
+ `daterequested` datetime NOT NULL default '0000-00-00 00:00:00',
+ `datemodified` datetime default NULL,
+ `remoteIP` varchar(15) default NULL,
+ `lastcheck` datetime default '0000-00-00 00:00:00',
+ `pw` varchar(10) default NULL,
+ PRIMARY KEY (`id`),
+ KEY `managementnodeid` (`managementnodeid`),
+ KEY `imageid` (`imageid`),
+ KEY `requestid` (`requestid`),
+ KEY `computerid` (`computerid`),
+ KEY `imagerevisionid` (`imagerevisionid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=1 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `resource`
+--
+
+CREATE TABLE IF NOT EXISTS `resource` (
+ `id` mediumint(8) unsigned NOT NULL auto_increment,
+ `resourcetypeid` tinyint(5) unsigned NOT NULL default '0',
+ `subid` mediumint(8) unsigned NOT NULL default '0',
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `resourcetypeid` (`resourcetypeid`,`subid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=11 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `resourcegroup`
+--
+
+CREATE TABLE IF NOT EXISTS `resourcegroup` (
+ `id` smallint(5) unsigned NOT NULL auto_increment,
+ `name` varchar(50) NOT NULL default '',
+ `ownerusergroupid` smallint(5) unsigned NOT NULL default '39',
+ `resourcetypeid` tinyint(3) unsigned NOT NULL default '0',
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `resourcetypeid` (`resourcetypeid`,`name`),
+ KEY `ownerusergroupid` (`ownerusergroupid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=11 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `resourcegroupmembers`
+--
+
+CREATE TABLE IF NOT EXISTS `resourcegroupmembers` (
+ `resourceid` mediumint(8) unsigned NOT NULL default '0',
+ `resourcegroupid` smallint(5) unsigned NOT NULL default '0',
+ PRIMARY KEY (`resourceid`,`resourcegroupid`),
+ KEY `resourcegroupid` (`resourcegroupid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `resourcemap`
+--
+
+CREATE TABLE IF NOT EXISTS `resourcemap` (
+ `resourcegroupid1` smallint(5) unsigned NOT NULL default '0',
+ `resourcetypeid1` tinyint(3) unsigned NOT NULL default '13',
+ `resourcegroupid2` smallint(5) unsigned NOT NULL default '0',
+ `resourcetypeid2` tinyint(3) unsigned NOT NULL default '12',
+ PRIMARY KEY (`resourcegroupid1`,`resourcegroupid2`),
+ KEY `resourcetypeid1` (`resourcetypeid1`),
+ KEY `resourcetypeid2` (`resourcetypeid2`),
+ KEY `resourcegroupid2` (`resourcegroupid2`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `resourcepriv`
+--
+
+CREATE TABLE IF NOT EXISTS `resourcepriv` (
+ `id` mediumint(8) unsigned NOT NULL auto_increment,
+ `resourcegroupid` smallint(5) unsigned NOT NULL default '0',
+ `privnodeid` mediumint(8) unsigned NOT NULL default '0',
+ `type` enum('block','cascade','available','administer','manageGroup') NOT NULL default 'block',
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `resourcegroupid` (`resourcegroupid`,`privnodeid`,`type`),
+ KEY `privnodeid` (`privnodeid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=17 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `resourcetype`
+--
+
+CREATE TABLE IF NOT EXISTS `resourcetype` (
+ `id` tinyint(5) unsigned NOT NULL auto_increment,
+ `name` varchar(50) NOT NULL default '',
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `name` (`name`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=17 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `schedule`
+--
+
+CREATE TABLE IF NOT EXISTS `schedule` (
+ `id` tinyint(3) unsigned NOT NULL auto_increment,
+ `name` varchar(25) NOT NULL default '',
+ `ownerid` mediumint(8) unsigned NOT NULL default '1',
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `name` (`name`),
+ KEY `ownerid` (`ownerid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=2 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `scheduletimes`
+--
+
+CREATE TABLE IF NOT EXISTS `scheduletimes` (
+ `scheduleid` tinyint(3) unsigned NOT NULL default '0',
+ `start` smallint(5) unsigned NOT NULL default '0',
+ `end` smallint(5) unsigned NOT NULL default '0',
+ KEY `scheduleid` (`scheduleid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `state`
+--
+
+CREATE TABLE IF NOT EXISTS `state` (
+ `id` tinyint(3) unsigned NOT NULL auto_increment,
+ `name` varchar(20) NOT NULL default '',
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `name` (`name`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=22 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `subimages`
+--
+
+CREATE TABLE IF NOT EXISTS `subimages` (
+ `imagemetaid` smallint(5) unsigned NOT NULL default '0',
+ `imageid` smallint(5) unsigned NOT NULL default '0',
+ KEY `imagemetaid` (`imagemetaid`),
+ KEY `imageid` (`imageid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `sublog`
+--
+
+CREATE TABLE IF NOT EXISTS `sublog` (
+ `logid` int(10) unsigned NOT NULL default '0',
+ `imageid` smallint(5) unsigned NOT NULL default '0',
+ `imagerevisionid` mediumint(8) unsigned NOT NULL,
+ `computerid` smallint(5) unsigned NOT NULL default '0',
+ `IPaddress` varchar(15) default NULL,
+ `managementnodeid` smallint(5) unsigned NOT NULL default '0',
+ `predictivemoduleid` smallint(5) unsigned NOT NULL default '8',
+ KEY `logid` (`logid`),
+ KEY `imageid` (`imageid`),
+ KEY `imagerevisionid` (`imagerevisionid`),
+ KEY `computerid` (`computerid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `user`
+--
+
+CREATE TABLE IF NOT EXISTS `user` (
+ `id` mediumint(8) unsigned NOT NULL auto_increment,
+ `uid` int(10) unsigned default NULL,
+ `unityid` varchar(80) NOT NULL default '',
+ `affiliationid` mediumint(8) unsigned NOT NULL default '1',
+ `curriculumid` smallint(5) unsigned NOT NULL default '1',
+ `firstname` varchar(20) NOT NULL default '',
+ `middlename` varchar(25) default NULL,
+ `lastname` varchar(25) NOT NULL default '',
+ `preferredname` varchar(25) default NULL,
+ `email` varchar(80) NOT NULL,
+ `emailnotices` tinyint(1) unsigned NOT NULL default '1',
+ `IMtypeid` tinyint(3) unsigned NOT NULL default '1',
+ `IMid` varchar(80) default NULL,
+ `adminlevelid` tinyint(3) unsigned NOT NULL default '1',
+ `width` smallint(4) unsigned NOT NULL default '1024',
+ `height` smallint(4) unsigned NOT NULL default '768',
+ `bpp` tinyint(2) unsigned NOT NULL default '16',
+ `audiomode` enum('none','local') NOT NULL default 'local',
+ `mapdrives` tinyint(1) unsigned NOT NULL default '1',
+ `mapprinters` tinyint(1) unsigned NOT NULL default '1',
+ `mapserial` tinyint(1) unsigned NOT NULL default '0',
+ `showallgroups` tinyint(1) unsigned NOT NULL default '0',
+ `lastupdated` datetime NOT NULL default '0000-00-00 00:00:00',
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `unityid` (`unityid`,`affiliationid`),
+ UNIQUE KEY `uid` (`uid`),
+ KEY `IMtypeid` (`IMtypeid`),
+ KEY `affiliationid` (`affiliationid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=3 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `usergroup`
+--
+
+CREATE TABLE IF NOT EXISTS `usergroup` (
+ `id` smallint(5) unsigned NOT NULL auto_increment,
+ `name` varchar(60) NOT NULL,
+ `affiliationid` mediumint(8) unsigned default NULL,
+ `ownerid` mediumint(8) unsigned default NULL,
+ `editusergroupid` smallint(5) unsigned default NULL,
+ `custom` tinyint(1) unsigned NOT NULL default '0',
+ `courseroll` tinyint(1) unsigned NOT NULL default '0',
+ `initialmaxtime` smallint(5) unsigned NOT NULL default '240',
+ `totalmaxtime` smallint(5) unsigned NOT NULL default '360',
+ `maxextendtime` smallint(5) unsigned NOT NULL default '30',
+ `overlapResCount` smallint(5) unsigned NOT NULL default '0',
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `name` (`name`,`affiliationid`),
+ KEY `ownerid` (`ownerid`),
+ KEY `editusergroupid` (`editusergroupid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=6 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `usergroupmembers`
+--
+
+CREATE TABLE IF NOT EXISTS `usergroupmembers` (
+ `userid` mediumint(8) unsigned NOT NULL default '0',
+ `usergroupid` smallint(5) unsigned NOT NULL default '0',
+ PRIMARY KEY (`userid`,`usergroupid`),
+ KEY `usergroupid` (`usergroupid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `userpriv`
+--
+
+CREATE TABLE IF NOT EXISTS `userpriv` (
+ `id` mediumint(8) unsigned NOT NULL auto_increment,
+ `userid` mediumint(8) unsigned default NULL,
+ `usergroupid` smallint(5) unsigned default NULL,
+ `privnodeid` mediumint(8) unsigned NOT NULL default '0',
+ `userprivtypeid` smallint(5) unsigned NOT NULL default '0',
+ PRIMARY KEY (`id`,`privnodeid`,`userprivtypeid`),
+ UNIQUE KEY `userid` (`userid`,`usergroupid`,`privnodeid`,`userprivtypeid`),
+ KEY `privnodeid` (`privnodeid`),
+ KEY `usergroupid` (`usergroupid`),
+ KEY `userprivtypeid` (`userprivtypeid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=20 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `userprivtype`
+--
+
+CREATE TABLE IF NOT EXISTS `userprivtype` (
+ `id` smallint(5) unsigned NOT NULL auto_increment,
+ `name` varchar(50) NOT NULL default '',
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `name` (`name`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=14 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `vmhost`
+--
+
+CREATE TABLE IF NOT EXISTS `vmhost` (
+ `id` smallint(5) unsigned NOT NULL auto_increment,
+ `computerid` smallint(5) unsigned NOT NULL,
+ `vmlimit` tinyint(3) unsigned NOT NULL,
+ `vmprofileid` tinyint(5) unsigned NOT NULL default '1',
+ `vmkernalnic` varchar(15) default NULL,
+ `vmwaredisk` enum('localdisk','networkdisk') NOT NULL default 'localdisk',
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `computerid` (`computerid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=1 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `vmprofile`
+--
+
+CREATE TABLE IF NOT EXISTS `vmprofile` (
+ `id` smallint(5) unsigned NOT NULL auto_increment,
+ `profilename` varchar(56) NOT NULL,
+ `vmtypeid` tinyint(3) unsigned NOT NULL,
+ `imageid` smallint(5) unsigned NOT NULL,
+ `nasshare` varchar(128) default NULL,
+ `datastorepath` varchar(128) NOT NULL,
+ `vmpath` varchar(128) default NULL,
+ `virtualswitch0` varchar(80) default NULL,
+ `virtualswitch1` varchar(80) default NULL,
+ `vmdisk` enum('localdisk','networkdisk') NOT NULL default 'localdisk',
+ PRIMARY KEY (`id`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=5 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `vmtype`
+--
+
+CREATE TABLE IF NOT EXISTS `vmtype` (
+ `id` tinyint(3) unsigned NOT NULL auto_increment,
+ `name` varchar(30) NOT NULL,
+ PRIMARY KEY (`id`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=6 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `xmlrpcKey`
+--
+
+CREATE TABLE IF NOT EXISTS `xmlrpcKey` (
+ `id` smallint(5) unsigned NOT NULL auto_increment,
+ `ownerid` mediumint(8) unsigned NOT NULL default '0',
+ `key` varchar(255) NOT NULL default '',
+ `active` tinyint(1) NOT NULL default '1',
+ `created` datetime NOT NULL default '0000-00-00 00:00:00',
+ PRIMARY KEY (`id`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1 AUTO_INCREMENT=1 ;
+
+-- --------------------------------------------------------
+
+--
+-- Table structure for table `xmlrpcLog`
+--
+
+CREATE TABLE IF NOT EXISTS `xmlrpcLog` (
+ `xmlrpcKeyid` smallint(5) unsigned NOT NULL default '0' COMMENT 'this is the userid if apiversion greater than 1',
+ `timestamp` datetime NOT NULL default '0000-00-00 00:00:00',
+ `IPaddress` varchar(15) default NULL,
+ `method` varchar(60) default NULL,
+ `apiversion` tinyint(3) unsigned NOT NULL default '1',
+ `comments` text,
+ KEY `xmlrpcKeyid` (`xmlrpcKeyid`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1;
+
+-- =========================================================
+-- Data
+
+--
+-- Dumping data for table `adminlevel`
+--
+
+INSERT INTO `adminlevel` (`id`, `name`) VALUES
+(3, 'developer'),
+(2, 'full'),
+(1, 'none');
+
+--
+-- Dumping data for table `affiliation`
+--
+
+INSERT INTO `affiliation` (`id`, `name`, `dataUpdateText`) VALUES
+(1, 'Local', '');
+
+
+--
+-- Dumping data for table `curriculum`
+--
+
+INSERT INTO `curriculum` (`id`, `name`) VALUES
+(1, 'vcl');
+
+--
+-- Dumping data for table `dept`
+--
+
+INSERT INTO `dept` (`id`, `name`, `prettyname`) VALUES
+(1, 'engr', 'Engineering'),
+(2, 'hpc', 'High Performance Computing');
+
+--
+-- Dumping data for table `computerloadflow`
+--
+INSERT INTO `computerloadflow` (`computerloadstateid`, `nextstateid`, `type`) VALUES
+(4, 22, 'blade'),
+(6, 15, 'blade'),
+(9, 43, 'blade'),
+(12, 9, 'blade'),
+(18, NULL, 'blade'),
+(15, 21, 'blade'),
+(21, 12, 'blade'),
+(22, 6, 'blade'),
+(22, 40, 'virtualmachine'),
+(40, 27, 'virtualmachine'),
+(27, 28, 'virtualmachine'),
+(28, 48, 'virtualmachine'),
+(48, 46, 'virtualmachine'),
+(46, 9, 'virtualmachine'),
+(41, 18, 'virtualmachine'),
+(18, NULL, 'virtualmachine'),
+(41, 18, 'blade'),
+(9, 43, 'virtualmachine'),
+(43, 41, 'blade'),
+(43, 41, 'virtualmachine');
+--
+-- Dumping data for table `computerloadstate`
+--
+
+INSERT INTO `computerloadstate` (`id`, `loadstatename`, `prettyname`, `est`) VALUES
+(1, 'info', 'info', 2),
+(2, 'loadimageblade', 'must reload computer', 0),
+(3, 'loadimagevmware', 'loadimagevmware', 1),
+(4, 'statuscheck', 'computer status check', 10),
+(5, 'assign2project', 'changing VLAN setting ', 0),
+(6, 'rinstall', 'starting install process', 1),
+(7, 'dynamicDHCPaddress', 'detecting dynamic IP address', 2),
+(8, 'staticIPaddress', 'setting static IP address', 2),
+(9, 'loadimagecomplete', 'running post configuration', 0),
+(10, 'loadimagefailed', 'preparing computer failed', 2),
+(11, 'failed', 'reservation failed', 2),
+(12, 'bootstate', 'image loading', 175),
+(13, 'editnodetype', 'edit config file to load requested image', 1),
+(14, 'xcatstage1', 'detected dhcp request from node', 2),
+(15, 'xcatstage2', 'rebooting node for reinstall', 100),
+(16, 'WARNING', 'WARNING', 2),
+(17, 'xcatREADY', 'computer reported READY starting post configs', 2),
+(18, 'reserved', 'ready for Connect', 0),
+(19, 'xcatstage3', 'node starting to received install instructions', 93),
+(20, 'xcatstage4', 'node received install instructions', 0),
+(21, 'xcatstage5', 'starting reload process', 27),
+(22, 'doesimageexists', 'confirming image exists', 4),
+(23, 'vmround1', 'vmround1', 1),
+(26, 'vmround2', 'vmround2', 186),
+(27, 'transfervm', 'transferring image files to host server', 255),
+(28, 'vmsetupconfig', 'creating configuration file', 2),
+(29, 'vmstage1', 'detected stage 1 of 5 loading process', 22),
+(30, 'vmstage2', 'detected stage 2 of 5 loading process', 120),
+(31, 'vmstage3', 'detected stage 3 of 4 loading process', 0),
+(33, 'xcatround2', 'waiting for image loading to complete', 0),
+(34, 'xcatround3', 'loaded - start post configuration', 0),
+(35, 'xcatround1', 'xcatround1', 2),
+(38, 'timeout', 'timeout', 2),
+(39, 'vmwareready', 'machine online', 3),
+(40, 'startload', 'starting load process', 6),
+(41, 'addinguser', 'adding user account', 18),
+(42, 'connected', 'detected user connection', 2),
+(43, 'nodeready', 'resource ready', 0),
+(44, 'inuseend10', '10 minute warning ', 2),
+(45, 'inuseend5', '5 minute warning', 2),
+(46, 'vmstage4', 'machine booting', 68),
+(47, 'checklabstatus', 'checking computer status', 2),
+(48, 'startvm', 'starting virtual machine', 3),
+(49, 'vmstage5', 'detected stage 5 of 5 loading process', 1),
+(50, 'vmconfigcopy', 'copying vm config file', NULL),
+(51, 'imageloadcomplete', 'node ready to add user', 0),
+(52, 'repeat', 'repeat', 0),
+(53, 'deleted', 'deleted', NULL),
+(54, 'begin', 'beginning to process reservation', 0);
+
+--
+-- Dumping data for table `documentation`
+--
+
+INSERT INTO `documentation` (`name`, `title`, `data`) VALUES
+('GrantingAccesstoaNewImageEnvironment1', 'Granting Access to a New Image/Environment', '<div id="docbullets">\r\n<h2>Overview</h2>\r\n<p>Once you have created a new image, there are a few things you have to do to allow other people to use it. If you don''t have access to do any of the following steps, you will need to get a VCL administrator to do them for you.</p>\r\n<p>When you create a new image, it is only available to you, and it is only allowed to be run on a few computers that have been set aside for the testing of new images.</p>\r\n<h2>Step 1: Image Mapping</h2>\r\n<p>Images are mapped to be run on a set of computers. See the documentation on <a href="https://vcl.ncsu.edu/scheduling/index.php?mode=viewdocs&item=Resources"><span style="color: rgb(255, 0, 0);"><b>Resources</b></span></a> to learn more about why this is done. For your new image to be able to run on more computers than just those designated for testing, you need to map it to a set of computers. There are a few steps to this process:</p>\r\n<ol>\r\n <li>You need to make your image a member of an image group\r\n <ul>\r\n <li>Select <span style="color: rgb(0, 0, 255);">Manage Images</span>-><span style="color: rgb(0, 0, 255);">Edit Image Grouping</span></li>\r\n <li>Select your image from the drop down box and click <span style="color: rgb(0, 0, 255);">Get Groups</span></li>\r\n <li>Choose one or more image groups to which you would like to add the image from the box on the right</li>\r\n <li>Click <span style="color: rgb(0, 0, 255);"><-Add</span> to make the image a member of the group(s)</li>\r\n </ul>\r\n </li>\r\n <li>You need to map the image group(s) you selected in step 1 to one or more computer groups\r\n <ul>\r\n <li>Select <span style="color: rgb(0, 0, 255);">Manage Images</span>-><span style="color: rgb(0, 0, 255);">Edit Image Mapping</span></li>\r\n <li>Do the following for each group from step 1:<br />\r\n <ul>\r\n <li>Select the image group from the drop down box and click <span style="color: rgb(0, 0, 255);">Get Computer Groups</span></li>\r\n <li>Choose one or more computer groups to which you would like to map the image group from the box on the right</li>\r\n <li>click <span style="color: rgb(0, 0, 255);"><-Add</span> to make map the image group to the computer group(s)</li>\r\n </ul>\r\n </li>\r\n <li>Note: there is an assumption here that the computer groups you selected already have computers that are in those groups</li>\r\n </ul>\r\n </li>\r\n</ol>\r\n<h2>Step 2: Privileges</h2>\r\n<p>Now, you need to grant access to use the image to a user or group of users under the Privileges section of the site. Here are the steps involved:</p>\r\n<ol>\r\n <li>Select <span style="color: rgb(0, 0, 255);">Privileges</span></li>\r\n <li>Choose an existing node or create a new node in the tree structure in the upper portion of the page where you would like to assign the user(s) access</li>\r\n <li>Now, you need to grant the user <span style="color: rgb(0, 0, 255);">imageCheckOut</span> at the node. You can do this for an individual user or a group of users.\r\n <ul>\r\n <li>Individual User:\r\n <ul>\r\n <li>Click <span style="color: rgb(0, 0, 255);">Add User</span></li>\r\n <li>Enter the user''s id in the text box and select the <span style="color: rgb(0, 0, 255);">imageCheckOut</span> checkbox</li>\r\n <li>Click <span style="color: rgb(0, 0, 255);">Submit New User</span></li>\r\n </ul>\r\n </li>\r\n <li>User Group:\r\n <ul>\r\n <li>Click <span style="color: rgb(0, 0, 255);">Add Group</span></li>\r\n <li>Select the user group from the drop-down box and select the <span style="color: rgb(0, 0, 255);">imageCheckOut</span> checkbox</li>\r\n <li>Click <span style="color: rgb(0, 0, 255);">Submit New User Group</span></li>\r\n </ul>\r\n </li>\r\n </ul>\r\n </li>\r\n <li>Next, you need to make sure the image group in which you placed the image in step 1 of <b>Image Mapping</b> is available at this node. If it is, go on to the next step, if not:\r\n <ul>\r\n <li>Click <span style="color: rgb(0, 0, 255);">Add Resource Group</span></li>\r\n <li>Select the image group from the drop-down box and select the <span style="color: rgb(0, 0, 255);">available</span> checkbox</li>\r\n <li>Click <span style="color: rgb(0, 0, 255);">Submit New Resource Group</span></li>\r\n </ul>\r\n </li>\r\n <li>Finally, you need to make sure the computer group(s) selected in step 2 of <b>Image Mapping</b> are also available here. If so, you are finished. If not:\r\n <ul>\r\n <li>Click <span style="color: rgb(0, 0, 255);">Add Resource Group</span></li>\r\n <li>Select the computer group from the drop-down box and select the <span style="color: rgb(0, 0, 255);">available</span> checkbox</li>\r\n <li>Click <span style="color: rgb(0, 0, 255);">Submit New Resource Group</span></li>\r\n </ul>\r\n </li>\r\n</ol>\r\n<p>Now, the user or user groups you have added to this node will be able to make reservations for the new image.</p>\r\n</div>'),
+('OverviewofPrivileges-Whatpermissionsarerequiredtoaccesspartsofthesite', 'Overview of Privileges - What permissions are required to access parts of the site', '<p>These are the privileges a user needs to access various parts of the VCL site. Unless specifically specified, a user must have both the <span style="color: rgb(0, 0, 255);">user<span style="color: rgb(0, 0, 0);"> and the <span style="color: rgb(255, 102, 0);">resource</span> permissions granted at the same node in the privilege tree.</span></span> "<span style="color: rgb(0, 0, 255);">user</span>" refers to privileges granted on the Privileges page either specifically to a user or to a group of which a user is a member. "<span style="color: rgb(255, 102, 0);">resource</span>" refers to privileges granted on the Privileges page to a resource group. Privileges can only be granted to resource groups; there is no way to grant privileges to a specific resource (image, computer, etc).</p>\r\n<h2>New Reservation</h2>\r\n<p style="margin-left: 40px;">This shows up for everyone, but the following privileges must be granted to be able to actually make a reservation:</p>\r\n<p style="margin-left: 80px;"><span style="color: rgb(0, 0, 255);">user<span style="color: rgb(0, 0, 0);"> - imageCheckOut</span></span><br />\r\n<span style="color: rgb(255, 102, 0);">resource</span> - image group: available, computer group: available</p>\r\n<h2>Manage Groups</h2>\r\n<p style="margin-left: 40px;"><span style="color: rgb(0, 0, 255);">user <span style="color: rgb(0, 0, 0);">- groupAdmin is required to make this link show up</span></span></p>\r\n<h3 style="margin-left: 40px;">User Groups</h3>\r\n<p style="margin-left: 80px;">Groups a user owns and groups that are editable by groups a user is a member of show up in this section.</p>\r\n<h3 style="margin-left: 40px;">Resource Groups</h3>\r\n<p style="margin-left: 80px;">Groups owned by user groups a user is a member of show up here. More groups show up when the following attribute is granted for a resource group:</p>\r\n<p style="margin-left: 80px;"><span style="color: rgb(255, 102, 0);">resource<span style="color: rgb(0, 0, 0);"> - (any type) manageGroup</span></span></p>\r\n<h2>Manage Images</h2>\r\n<p style="margin-left: 40px;"><span style="color: rgb(0, 0, 255);">user</span> - imageAdmin is required to make this link show up</p>\r\n<h3 style="margin-left: 40px;">Edit Image Information</h3>\r\n<p style="margin-left: 80px;"><span style="color: rgb(0, 0, 255);">user</span> - imageAdmin<br />\r\n<span style="color: rgb(255, 102, 0);">resource</span> - image group: administer</p>\r\n<h3 style="margin-left: 40px;">View Image Grouping</h3>\r\n<p style="margin-left: 80px;"><span style="color: rgb(0, 0, 255);">user</span> - imageAdmin<br />\r\n<span style="color: rgb(255, 102, 0);">resource</span> - image group: manageGroup</p>\r\n<h3 style="margin-left: 40px;">View Image Mapping</h3>\r\n<p style="margin-left: 80px;"><span style="color: rgb(0, 0, 255);">user</span> - imageAdmin<br />\r\n<span style="color: rgb(255, 102, 0);">resource</span> - image group: manageGroup</p>\r\n<p style="margin-left: 80px;">at same or different node:</p>\r\n<p style="margin-left: 80px;"><span style="color: rgb(0, 0, 255);">user</span> - computerAdmin<br />\r\n<span style="color: rgb(255, 102, 0);">resource</span> - computer group: manageGroup</p>\r\n<h3 style="margin-left: 40px;">Create New Image</h3>\r\n<p style="margin-left: 80px;"><span style="color: rgb(0, 0, 255);">user</span> - imageAdmin<br />\r\n<span style="color: rgb(255, 102, 0);">resource</span> - image group: available, computer group: available</p>\r\n<h2>Manage Schedules</h2>\r\n<p style="margin-left: 40px;"><span style="color: rgb(0, 0, 255);">user</span> - scheduleAdmin is required to make this link show up</p>\r\n<p style="margin-left: 40px;">All schedules owned by a user will show up by default.</p>\r\n<p style="margin-left: 40px;">To edit schedule information for other schedules, these permissions are required:</p>\r\n<p style="margin-left: 80px;"><span style="color: rgb(0, 0, 255);">user</span> - scheduleAdmin<br />\r\n<span style="color: rgb(255, 102, 0);">resource</span> - schedule group: administer</p>\r\n<h3 style="margin-left: 40px;">Schedule Grouping</h3>\r\n<p style="margin-left: 80px;"><span style="color: rgb(0, 0, 255);">user</span> - scheduleAdmin<br />\r\n<span style="color: rgb(255, 102, 0);">resource</span> - schedule group: manageGroup</p>\r\n<h2>Manage Computers</h2>\r\n<p style="margin-left: 40px;"><span style="color: rgb(0, 0, 255);">user</span> - computerAdmin is required to make this link show up</p>\r\n<p style="margin-left: 40px;">Selection boxes for platforms and schedules only show up if a user has access to more than one platform or schedule.</p>\r\n<h3 style="margin-left: 40px;">Edit Computer Grouping</h3>\r\n<p style="margin-left: 80px;"><span style="color: rgb(0, 0, 255);">user</span> - computerAdmin<br />\r\n<span style="color: rgb(255, 102, 0);">resource</span> - computer group: manageGroup</p>\r\n<h3 style="margin-left: 40px;">Computer Utilities</h3>\r\n<h4 style="margin-left: 80px;">Reload computers with image</h4>\r\n<p style="margin-left: 120px;"><span style="color: rgb(0, 0, 255);">user</span> - computerAdmin<br />\r\n<span style="color: rgb(255, 102, 0);">resource</span> - computer group: administer</p>\r\n<p style="margin-left: 120px;">and at same or different node:</p>\r\n<p style="margin-left: 120px;"><span style="color: rgb(0, 0, 255);">user</span> - imageCheckOut or imageAdmin<br />\r\n<span style="color: rgb(255, 102, 0);">resource</span> - image group: available</p>\r\n<h4 style="margin-left: 80px;">Change state of computers</h4>\r\n<p style="margin-left: 120px;"><span style="color: rgb(0, 0, 255);">user</span> - computerAdmin<br />\r\n<span style="color: rgb(255, 102, 0);">resource</span> - computer group: administer</p>\r\n<h4 style="margin-left: 80px;">Change schedule of computers</h4>\r\n<p style="margin-left: 120px;"><span style="color: rgb(0, 0, 255);">user</span> - computerAdmin<br />\r\n<span style="color: rgb(255, 102, 0);">resource</span> - computer group: administer</p>\r\n<p style="margin-left: 120px;">and at same or different node:</p>\r\n<p style="margin-left: 120px;"><span style="color: rgb(0, 0, 255);">user</span> - scheduleAdmin<br />\r\n<span style="color: rgb(255, 102, 0);">resource</span> - schedule group: manageGroup</p>\r\n<h3 style="margin-left: 40px;">Edit Computer Information</h3>\r\n<p style="margin-left: 80px;"><span style="color: rgb(0, 0, 255);">user</span> - computerAdmin<br />\r\n<span style="color: rgb(255, 102, 0);">resource</span> - computer group: administer</p>\r\n<p style="margin-left: 80px;">and at same or different node:</p>\r\n<p style="margin-left: 80px;"><span style="color: rgb(0, 0, 255);">user</span> - scheduleAdmin<br />\r\n<span style="color: rgb(255, 102, 0);">resource</span> - schedule group: manageGroup</p>\r\n<p style="margin-left: 80px;"> </p>\r\n<h2>Management Nodes</h2>\r\n<p style="margin-left: 40px;"><span style="color: rgb(0, 0, 255);">user</span> - mgmtNodeAdmin is required to make this link show up</p>\r\n<h3 style="margin-left: 40px;">Edit Management Node Information</h3>\r\n<p style="margin-left: 80px;"><span style="color: rgb(0, 0, 255);">user</span> - mgmtNodeAdmin<br />\r\n<span style="color: rgb(255, 102, 0);">resource</span> - management node group: administer</p>\r\n<h3 style="margin-left: 40px;">Edit Management Node Grouping</h3>\r\n<p style="margin-left: 80px;"><span style="color: rgb(0, 0, 255);">user</span> - mgmtNodeAdmin<br />\r\n<span style="color: rgb(255, 102, 0);">resource</span> - management node group: manageGroup</p>\r\n<h3 style="margin-left: 40px;">Edit Management Node Mapping</h3>\r\n<p style="margin-left: 80px;"><span style="color: rgb(0, 0, 255);">user</span> - mgmtNodeAdmin<br />\r\n<span style="color: rgb(255, 102, 0);">resource</span> - management node group: manageGroup</p>\r\n<p style="margin-left: 80px;">at same or different node:</p>\r\n<p style="margin-left: 80px;"><span style="color: rgb(0, 0, 255);">user</span> - computerAdmin<br />\r\n<span style="color: rgb(255, 102, 0);">resource</span> - computer group: manageGroup</p>\r\n<h2>Privileges</h2>\r\n<p style="margin-left: 40px;"><span style="color: rgb(0, 0, 255);">user</span> - nodeAdmin, userGrant, or resourceGrant is required to make this link show up</p>\r\n<h3 style="margin-left: 40px;">Add Child / Delete Node and Children</h3>\r\n<p style="margin-left: 80px;"><span style="color: rgb(0, 0, 255);">user</span> - nodeAdmin</p>\r\n<h3 style="margin-left: 40px;">Add User / modify user privileges</h3>\r\n<p style="margin-left: 80px;"><span style="color: rgb(0, 0, 255);">user</span> - userGrant</p>\r\n<h3 style="margin-left: 40px;">Add Group / modify user group privileges</h3>\r\n<p style="margin-left: 80px;"><span style="color: rgb(0, 0, 255);">user</span> - userGrant</p>\r\n<h3 style="margin-left: 40px;">Add Resource Group / modify resource group privileges</h3>\r\n<p style="margin-left: 80px;"><span style="color: rgb(0, 0, 255);">user</span> - resourceGrant</p>\r\n<p> </p>'),
+('Resources', 'Resources', '<h2>Overview</h2>\r\n<p>Computers, images, management nodes, and schedules have some very similar characteristics in how they are handled within the VCL site. Therefore, there are times where it is easier to refer to them all together as <b><span style="color: rgb(255, 0, 0);">resources</span></b>. Here are some similarities between them:</p>\r\n<ul>\r\n <li>They are all managed by adding them to <span style="color: rgb(255, 0, 0);"><b>resource groups</b></span>. All resource groups have a type associated with them such that only <span style="color: rgb(0, 0, 255);">images</span> can be part of an <span style="color: rgb(0, 0, 255);">image group</span>, only <span style="color: rgb(0, 0, 255);">computers</span> can be part of a <span style="color: rgb(0, 0, 255);">computer group</span>, etc.</li>\r\n <li>Resources of one type can be related to resources of certain other types through <span style="color: rgb(255, 0, 0);"><b>resource mapping</b></span>. <span style="color: rgb(0, 0, 255);">Image groups</span> and <span style="color: rgb(0, 0, 255);">computer groups</span> can be mapped together, and <span style="color: rgb(0, 0, 255);">management node</span><span style="color: rgb(0, 0, 255);"> groups</span> and <span style="color: rgb(0, 0, 255);">computer</span><span style="color: rgb(0, 0, 255);"> groups</span> can be mapped together.</li>\r\n <li>Privileges over resources are only granted through resource groups. Privileges cannot be granted directly to a resource.</li>\r\n <li>There is an <span style="color: rgb(255, 0, 0);"><b>Admin</b></span> privilege that can be granted to users for each type of resource: computerAdmin, imageAdmin, mgmtNodeAdmin, and scheduleAdmin</li>\r\n</ul>\r\n<h2>Grouping</h2>\r\n<p>The amount of images and computers that become part of a VCL install can grow very rappidly. Because of this, it is much easier to deal with them in groups rather than individually. The amount of schedules and management nodes does not typically grow very large. However, due to other similarities as resources, they are handled in groups as well.</p>\r\n<h2>Mapping</h2>\r\n<p>Mapping allows for tight control over how resources can be used together. Through image to computer mapping, one has tight control over which computers an image could end up being run. This can be used to control things like platform dependencies, to ensure only vm images get run on the correct type of vm computer, and to ensure an image containing software purchased by a specific group only gets run on computers owned by the same group (this can be handled with resource privileges as well).</p>\r\n<p>Through management node to computer mapping, assignment of which management nodes control which computers is accomplished. One can quickly switch which management node is in control of a group of computers. Additionally, when management node redundancy is fully implemented, this is how management nodes will be able to control overlapping groups of computers.</p>\r\n<h2>Resource Privileges</h2>\r\n<p>There are three privileges that can be assigned to resource groups:</p>\r\n<ul>\r\n <li>available</li>\r\n <li>administer</li>\r\n <li>manageGroup</li>\r\n</ul>\r\n<p><span style="color: rgb(0, 0, 255);">available</span> is only used for image and computer groups. If it is assigned to a schedule or management node group, it is simply ignored. This privilege correspondes to these user group privileges: imageCheckOut and imageAdmin. When a user has one of these two privileges at a node along with an image group or a computer group having the available privilege at the same node, then the user will have access to make a reservations for the images in the group (imageCheckOut) or make a new images based off of images in the group (imageAdmin). Note that both an image group and a computer group must have the available permission where a user has imageCheckOut for the user to make a reservation for an image in the image group. This is used to determine which computers are available at the node to go along with which images are also available at the node.</p>\r\n<p><span style="color: rgb(0, 0, 255);">administer</span> is used for all types of resources, and thus corresponds to all of the *Admin user privileges (computerAdmin, imageAdmin, mgmtNodeAdmin, and scheduleAdmin). Administer generally grants access to manage specific <i>characteristics</i> of resources in a group, but not to manage any grouping information. For example, if a user has the imageAdmin privilege at a node where an image group has the administer privilege, the user would then have access to modify <i>characteristics</i> of images in that group (name, owner, minimum specs required by the image, etc), but would <b>not</b> have access to edit which images are <i>in the group</i>.</p>\r\n<p><span style="color: rgb(0, 0, 255);">manageGroup</span> is also used for all types of resources. It grants access to a few different things. One is the ability to modify information about a group under <span style="color: rgb(0, 0, 255);">Manage Groups </span>(if a user also has the groupAdmin privilege). Another is the ability to manage membership of a group. Finally, it provides access for mapping one type of group to another (for this, manageGroup must be granted for both types of resources). Additionally, there is an extra way manageGroup is used specifically related to computer groups: a user must have scheduleAdmin and manageGroup over a schedule group to be able to change the schedule of a computer (both through Manage Computers->Edit Computer Information and Manage Computers->Computer Utilities->Change schedule of computers).</p>');
+
+--
+-- Dumping data for table `image`
+--
+
+INSERT INTO `image` (`id`, `name`, `prettyname`, `ownerid`, `deptid`, `platformid`, `OSid`, `imagemetaid`, `minram`, `minprocnumber`, `minprocspeed`, `minnetwork`, `maxconcurrent`, `reloadtime`, `deleted`, `test`, `lastupdate`, `forcheckout`, `maxinitialtime`, `project`, `size`) VALUES
+(1, 'winxp-base1-v0', 'No Apps (WinXP)', 1, 1, 1, 7, NULL, 0, 1, 0, 10, NULL, 14, 0, 0, '2007-04-11 16:07:38', 1, 0, 'vcl', 1045),
+(2, 'rhel4-base2-v0', 'Red Hat Enterprise Linux 4.4 Base (KS)', 1, 1, 1, 12, NULL, 1024, 1, 1024, 100, NULL, 13, 0, 0, '2007-03-02 16:33:33', 1, 0, 'vcl', 0),
+(3, 'rh4image-base3-v0', 'RHEL4 base (image)', 1, 1, 1, 13, NULL, 10, 1, 1024, 100, NULL, 10, 0, 0, '2007-01-24 15:02:07', 1, 0, 'vcl', 1450),
+(4, 'noimage', 'No Image', 1, 1, 1, 2, NULL, 0, 1, 0, 10, NULL, 0, 0, 0, NULL, 1, 0, 'vcl', 1450),
+(5, 'rhfc5-fc5base5-v0', 'Red Hat Fedora Core 5 base (KS)', 1, 1, 1, 15, NULL, 1024, 1, 1024, 100, NULL, 13, 0, 0, '2006-10-02 10:04:24', 1, 0, 'vcl', 1450),
+(6, 'fc5image-FC5baseRHFC56-v0', 'FC5base(RHFC5)', 1, 1, 1, 14, NULL, 64, 1, 500, 10, NULL, 10, 0, 0, '2006-10-02 14:13:26', 1, 0, 'vcl', 0),
+(7, 'vmwarewinxp-base7-v1', 'No Apps (WinXP vmware)', 1, 1, 1, 16, NULL, 512, 1, 1024, 100, NULL, 5, 0, 0, '2007-04-04 09:45:38', 1, 0, 'vcl', 3244),
+(8, 'rh4image-VMwareserverhostRHEL48-v3', 'VMware server host (RHEL4)', 1, 1, 1, 13, NULL, 64, 1, 500, 10, NULL, 10, 0, 0, '2007-11-26 11:23:53', 1, 0, 'vcl', 1450),
+(9, 'esx35-base-v0', 'VMware ESX 3.5 standard server', 1, 1, 1, 20, NULL, 2048, 2, 2000, 100, NULL, 9, 0, 0, '2008-03-24 14:23:54', 1, 0, 'vcl', 1450);
+
+--
+-- Dumping data for table `imagerevision`
+--
+
+INSERT INTO `imagerevision` (`id`, `imageid`, `revision`, `userid`, `datecreated`, `deleted`, `production`, `comments`, `imagename`) VALUES
+(1, 1, 0, 1, '2007-03-01 14:46:26', 0, 1, NULL, 'winxp-base1-v0'),
+(2, 2, 0, 1, '2006-09-22 16:33:24', 0, 1, NULL, 'rhel4-base2-v0'),
+(3, 3, 0, 1, '2007-01-24 15:04:11', 0, 1, NULL, 'rh4image-base3-v0'),
+(4, 4, 0, 1, '1980-01-01 00:00:00', 0, 1, NULL, 'noimage'),
+(5, 5, 0, 1, '2006-10-02 10:04:24', 0, 1, NULL, 'rhfc5-fc5base5-v0'),
+(6, 6, 0, 1, '2006-10-02 14:13:26', 0, 1, NULL, 'fc5image-FC5baseRHFC56-v0'),
+(7, 7, 0, 1, '2007-04-03 11:24:12', 0, 1, NULL, 'vmwarewinxp-base7-v0'),
+(8, 8, 0, 1, '2007-01-30 10:50:56', 0, 1, NULL, 'rh4image-VMwareserverhostRHEL48-v0'),
+(9, 9, 0, 1, '2008-03-24 14:23:54', 0, 1, NULL, 'esx35-base-v0');
+
+--
+-- Dumping data for table `IMtype`
+--
+
+INSERT INTO `IMtype` (`id`, `name`) VALUES
+(2, 'jabber'),
+(1, 'none');
+
+--
+-- Dumping data for table `localauth`
+--
+
+INSERT INTO `localauth` (`userid`, `passhash`, `salt`, `lastupdated`, `lockedout`) VALUES
+(1, 'd8c730cc269d3d6b6147a416fb49c2be1a70aefc', 'QwkCHLpY', '2007-05-17 09:56:01', 0);
+
+--
+-- Dumping data for table `module`
+--
+
+INSERT INTO `module` (`id`, `name`, `prettyname`, `description`, `perlpackage`) VALUES
+(1, 'provisioning_xcat', 'xCAT 1.x Provisioning Module', 'Extreme Cluster Administration Toolkit 1.x VCL support module', 'VCL::Module::Provisioning::xCAT'),
+(2, 'provisioning_vmware_server', 'VMWare Server Provisioning Module', '', 'VCL::Module::Provisioning::vmware'),
+(3, 'provisioning_lab', 'Computing Lab Provisioning Module', '', 'VCL::Module::Provisioning::Lab'),
+(4, 'os_windows', 'Windows Operating System Module', '', 'VCL::Module::OS::Windows'),
+(5, 'os_linux', 'Linux Operating System Module', '', 'VCL::Module::OS::Linux'),
+(6, 'os_unix', 'Unix Operating System Module', '', ''),
+(7, 'os_winvista', 'Windows Vista OS Module', '', 'VCL::Module::OS::Windows::Desktop::Vista'),
+(8, 'predictive_level_0', 'Predictive Loading Level 0 Module', '', 'VCL::Module::Predictive::Level_0'),
+(9, 'predictive_level_1', 'Predictive Loading Level 1 Module', '', 'VCL::Module::Predictive::Level_1');
+
+--
+-- Dumping data for table `OS`
+--
+
+INSERT INTO `OS` (`id`, `name`, `prettyname`, `type`, `installtype`, `sourcepath`, `moduleid`) VALUES
+(2, 'sun4x_58', 'Solaris 5.8', 'unix', 'none', NULL, 6),
+(3, 'win2k', 'Windows 2000', 'windows', 'partimage', 'image', 4),
+(6, 'rhel3', 'Red Hat Enterprise Linux 3.0', 'linux', 'kickstart', 'rhas3', 5),
+(7, 'winxp', 'Windows XP', 'windows', 'partimage', 'image', 4),
+(8, 'realmrhel3', 'Realm Red Hat Enterprise Linux 3.0', 'linux', 'none', NULL, 5),
+(9, 'realmrhel4', 'Realm Red Hat Enterprise Linux 4.0', 'linux', 'none', NULL, 5),
+(10, 'win2003', 'Windows 2003 Server', 'windows', 'partimage', 'image', 4),
+(11, 'rh3image', 'RHEL 3 image', 'linux', 'partimage', 'image', 5),
+(12, 'rhel4', 'Red Hat Enterprise Linux 4', 'linux', 'kickstart', 'rhas4', 5),
+(13, 'rh4image', 'RHEL4 image', 'linux', 'partimage', 'image', 5),
+(14, 'fc5image', 'RH Fedora Core 5 image', 'linux', 'partimage', 'image', 5),
+(15, 'rhfc5', 'Red Hat Fedora Core 5', 'linux', 'kickstart', 'rhfc5', 5),
+(16, 'vmwarewinxp', 'VMware Windows XP', 'windows', 'vmware', 'vmware_images', 4),
+(17, 'rhfc7', 'RH Fedora Core 7 KS', 'linux', 'kickstart', 'rhfc7', 5),
+(18, 'fc7image', 'RH Fedora Core image', 'linux', 'partimage', 'image', 5),
+(19, 'rhel5', 'Red Hat Enterprise Linux 5', 'linux', 'kickstart', 'rhas5', 5),
+(20, 'esx35', 'VMware ESX 3.5', 'linux', 'kickstart', 'esx35', 5),
+(21, 'vmwareesxwinxp', 'VMware ESX Windows XP', 'windows', 'vmware', 'vmware_images', 4),
+(22, 'realmrhel5', 'Realm Red Hat Enterprise Linux 5.0', 'linux', 'none', NULL, 5),
+(23, 'sun4x_510 ', 'Solaris 10', 'unix', 'none', NULL, 6),
+(24, 'centos5', 'CentOS 5.1 ', 'linux', 'kickstart', 'centos5', 5),
+(25, 'rh5image', 'RedHat Enterprise Linux 5 (rhel5 im', 'linux', 'partimage', 'image', 5),
+(26, 'rhfc9', 'RedHat Fedora Core 9 kickstart', 'linux', 'kickstart', 'rhfc9', 5),
+(27, 'fc9image', 'RedHat Fedora Core 9 image', 'linux', 'partimage', 'image', 5),
+(28, 'winvista', 'Windows Vista', 'windows', 'partimage', 'image', 4);
+
+--
+-- Dumping data for table `OSinstalltype`
+--
+
+INSERT INTO `OSinstalltype` (`id`, `name`) VALUES
+(2, 'kickstart'),
+(3, 'none'),
+(1, 'partimage'),
+(4, 'vmware');
+
+--
+-- Dumping data for table `OStype`
+--
+
+INSERT INTO `OStype` (`id`, `name`) VALUES
+(2, 'linux'),
+(3, 'unix'),
+(1, 'windows');
+
+--
+-- Dumping data for table `platform`
+--
+
+INSERT INTO `platform` (`id`, `name`) VALUES
+(1, 'i386'),
+(4, 'i386_lab'),
+(3, 'ultrasparc');
+
+--
+-- Dumping data for table `privnode`
+--
+
+INSERT INTO `privnode` (`id`, `parent`, `name`) VALUES
+(2, 1, 'Developer'),
+(1, 1, 'Root'),
+(3, 2, 'VCL'),
+(4, 3, 'admin'),
+(5, 3, 'newimages');
+
+--
+-- Dumping data for table `privisioning`
+--
+
+INSERT INTO `provisioning` (`id`, `name`, `prettyname`, `moduleid`) VALUES
+(1, 'xcat', 'xCAT 1.x Provisioning', 1),
+(2, 'vmware_server', 'VMWare Server Provisioning', 2),
+(3, 'lab', 'Computing Lab Provisioning', 3);
+
+--
+-- Dumping data for table `resource`
+--
+
+INSERT INTO `resource` (`id`, `resourcetypeid`, `subid`) VALUES
+(1, 13, 1),
+(2, 13, 2),
+(3, 13, 3),
+(4, 13, 4),
+(5, 13, 5),
+(6, 13, 6),
+(7, 13, 7),
+(8, 15, 1),
+(9, 13, 8),
+(10, 13, 9);
+
+--
+-- Dumping data for table `resourcegroup`
+--
+
+INSERT INTO `resourcegroup` (`id`, `name`, `ownerusergroupid`, `resourcetypeid`) VALUES
+(1, 'allComputers', 3, 12),
+(2, 'allImages', 3, 13),
+(3, 'allManagementNodes', 3, 16),
+(4, 'allSchedules', 3, 15),
+(8, 'newimages', 4, 12),
+(9, 'newvmimages', 4, 12),
+(10, 'allVMimages', 4, 13);
+
+--
+-- Dumping data for table `resourcegroupmembers`
+--
+
+INSERT INTO `resourcegroupmembers` (`resourceid`, `resourcegroupid`) VALUES
+(1, 2),
+(2, 2),
+(3, 2),
+(5, 2),
+(6, 2),
+(7, 10),
+(8, 4),
+(9, 2),
+(10, 2);
+
+--
+-- Dumping data for table `resourcemap`
+--
+
+INSERT INTO `resourcemap` (`resourcegroupid1`, `resourcetypeid1`, `resourcegroupid2`, `resourcetypeid2`) VALUES
+(2, 13, 1, 12),
+(3, 16, 1, 12),
+(3, 16, 8, 12);
+
+--
+-- Dumping data for table `resourcepriv`
+--
+
+INSERT INTO `resourcepriv` (`id`, `resourcegroupid`, `privnodeid`, `type`) VALUES
+(1, 1, 4, 'available'),
+(2, 1, 4, 'administer'),
+(3, 1, 4, 'manageGroup'),
+(4, 2, 4, 'available'),
+(5, 2, 4, 'administer'),
+(6, 2, 4, 'manageGroup'),
+(7, 3, 4, 'available'),
+(8, 3, 4, 'administer'),
+(9, 3, 4, 'manageGroup'),
+(10, 4, 4, 'available'),
+(11, 4, 4, 'administer'),
+(12, 4, 4, 'manageGroup'),
+(15, 8, 5, 'cascade'),
+(16, 8, 5, 'available');
+
+--
+-- Dumping data for table `resourcetype`
+--
+
+INSERT INTO `resourcetype` (`id`, `name`) VALUES
+(12, 'computer'),
+(13, 'image'),
+(16, 'managementnode'),
+(15, 'schedule');
+
+--
+-- Dumping data for table `schedule`
+--
+
+INSERT INTO `schedule` (`id`, `name`, `ownerid`) VALUES
+(1, 'VCL 24x7', 1);
+
+--
+-- Dumping data for table `scheduletimes`
+--
+
+INSERT INTO `scheduletimes` (`scheduleid`, `start`, `end`) VALUES
+(1, 0, 10080);
+
+--
+-- Dumping data for table `state`
+--
+
+INSERT INTO `state` (`id`, `name`) VALUES
+(2, 'available'),
+(4, 'classreserved'),
+(9, 'cleaning'),
+(12, 'complete'),
+(1, 'deleted'),
+(5, 'failed'),
+(23, 'hpc'),
+(16, 'image'),
+(7, 'imageinuse'),
+(15, 'imageprep'),
+(8, 'inuse'),
+(10, 'maintenance'),
+(17, 'makeproduction'),
+(13, 'new'),
+(14, 'pending'),
+(19, 'reload'),
+(6, 'reloading'),
+(3, 'reserved'),
+(11, 'timeout'),
+(22, 'tohpc'),
+(18, 'tomaintenance'),
+(21, 'tovmhostinuse'),
+(20, 'vmhostinuse');
+
+--
+-- Dumping data for table `user`
+--
+
+INSERT INTO `user` (`id`, `uid`, `unityid`, `affiliationid`, `curriculumid`, `firstname`, `middlename`, `lastname`, `preferredname`, `email`, `emailnotices`, `IMtypeid`, `IMid`, `adminlevelid`, `width`, `height`, `bpp`, `audiomode`, `mapdrives`, `mapprinters`, `mapserial`, `showallgroups`, `lastupdated`) VALUES
+(1, 101, 'admin', 1, 1, 'vcl', '', 'admin', '', 'root@localhost', 0, 1, NULL, 3, 1024, 768, 16, 'local', 1, 1, 1, 1, '2007-05-17 09:58:39'),
+(2, NULL, 'vclreload', 1, 3, 'vcl', NULL, 'reload', NULL, '', 1, 1, NULL, 1, 1024, 768, 16, 'local', 1, 1, 0, 0, '0000-00-00 00:00:00');
+
+--
+-- Dumping data for table `usergroup`
+--
+
+INSERT INTO `usergroup` (`id`, `name`, `affiliationid`, `ownerid`, `editusergroupid`, `custom`, `courseroll`, `initialmaxtime`, `totalmaxtime`, `maxextendtime`) VALUES
+(1, 'global', 1, 1, 1, 1, 0, 240, 360, 30),
+(3, 'adminUsers', 1, 1, 1, 1, 0, 480, 600, 180),
+(4, 'manageNewImages', 1, 1, 3, 1, 0, 240, 360, 30),
+(5, 'Specify End Time', 1, 1, 3, 1, 0, 240, 360, 30);
+
+--
+-- Dumping data for table `usergroupmembers`
+--
+
+INSERT INTO `usergroupmembers` (`userid`, `usergroupid`) VALUES
+(1, 1);
+
+--
+-- Dumping data for table `userpriv`
+--
+
+INSERT INTO `userpriv` (`id`, `userid`, `usergroupid`, `privnodeid`, `userprivtypeid`) VALUES
+(16, NULL, 3, 4, 3),
+(11, NULL, 3, 4, 4),
+(13, NULL, 3, 4, 5),
+(14, NULL, 3, 4, 6),
+(19, NULL, 3, 4, 7),
+(17, NULL, 3, 4, 10),
+(12, NULL, 3, 4, 11),
+(18, NULL, 3, 4, 12),
+(15, NULL, 3, 4, 13),
+(1, 1, NULL, 3, 2),
+(6, 1, NULL, 3, 3),
+(2, 1, NULL, 3, 4),
+(7, 1, NULL, 3, 5),
+(3, 1, NULL, 3, 6),
+(8, 1, NULL, 3, 7),
+(4, 1, NULL, 3, 10),
+(9, 1, NULL, 3, 11),
+(5, 1, NULL, 3, 12),
+(10, 1, NULL, 3, 13);
+
+--
+-- Dumping data for table `userprivtype`
+--
+
+INSERT INTO `userprivtype` (`id`, `name`) VALUES
+(1, 'block'),
+(2, 'cascade'),
+(4, 'computerAdmin'),
+(11, 'groupAdmin'),
+(5, 'imageAdmin'),
+(6, 'imageCheckOut'),
+(13, 'mgmtNodeAdmin'),
+(3, 'nodeAdmin'),
+(10, 'resourceGrant'),
+(12, 'scheduleAdmin'),
+(7, 'userGrant');
+
+--
+-- Dumping data for table `vmprofile`
+--
+
+INSERT INTO `vmprofile` (`id`, `profilename`, `vmtypeid`, `imageid`, `nasshare`, `datastorepath`, `vmpath`, `virtualswitch0`, `virtualswitch1`, `vmdisk`) VALUES
+(1, 'VMware GSX standard', 3, 8, NULL, '/var/lib/vmware/Virtual Machines', NULL, NULL, 'VMnet2', 'localdisk'),
+(2, 'Vmware ESX standard network mounted share', 5, 9, NULL, '/vmfs/volumes/nfs1', '/vmfs/volumes/storage1', 'VM Network', 'Virtual Machine Public Network', 'networkdisk'),
+(3, 'Vmware ESX standard localdisk', 5, 9, NULL, '/vmfs/volumes/storage1', NULL, 'VM Network', 'Virtual Machine Public Network', 'localdisk'),
+(4, 'Vmware ESX SAN ', 5, 9, NULL, '/vmfs/volumes/NetApp', '/vmfs/volumes/storage1', 'Intranet2', 'MCNC Public', 'networkdisk');
+
+-- =========================================================
+
+--
+-- Constraints for dumped tables
+--
+
+--
+-- Constraints for table `blockComputers`
+--
+ALTER TABLE `blockComputers`
+ ADD CONSTRAINT `blockComputers_ibfk_1` FOREIGN KEY (`blockTimeid`) REFERENCES `blockTimes` (`id`) ON DELETE CASCADE ON UPDATE CASCADE,
+ ADD CONSTRAINT `blockComputers_ibfk_2` FOREIGN KEY (`computerid`) REFERENCES `computer` (`id`);
+
+--
+-- Constraints for table `blockRequest`
+--
+ALTER TABLE `blockRequest`
+ ADD CONSTRAINT `blockRequest_ibfk_4` FOREIGN KEY (`imageid`) REFERENCES `image` (`id`),
+ ADD CONSTRAINT `blockRequest_ibfk_5` FOREIGN KEY (`groupid`) REFERENCES `usergroup` (`id`),
+ ADD CONSTRAINT `blockRequest_ibfk_6` FOREIGN KEY (`ownerid`) REFERENCES `user` (`id`);
+
+--
+-- Constraints for table `blockTimes`
+--
+ALTER TABLE `blockTimes`
+ ADD CONSTRAINT `blockTimes_ibfk_1` FOREIGN KEY (`blockRequestid`) REFERENCES `blockRequest` (`id`) ON DELETE CASCADE;
+
+--
+-- Constraints for table `blockWebDate`
+--
+ALTER TABLE `blockWebDate`
+ ADD CONSTRAINT `blockWebDate_ibfk_1` FOREIGN KEY (`blockRequestid`) REFERENCES `blockRequest` (`id`) ON DELETE CASCADE;
+
+--
+-- Constraints for table `blockWebTime`
+--
+ALTER TABLE `blockWebTime`
+ ADD CONSTRAINT `blockWebTime_ibfk_1` FOREIGN KEY (`blockRequestid`) REFERENCES `blockRequest` (`id`) ON DELETE CASCADE;
+
+--
+-- Constraints for table `computer`
+--
+ALTER TABLE `computer`
+ ADD CONSTRAINT `computer_ibfk_12` FOREIGN KEY (`ownerid`) REFERENCES `user` (`id`) ON DELETE SET NULL ON UPDATE CASCADE,
+ ADD CONSTRAINT `computer_ibfk_30` FOREIGN KEY (`scheduleid`) REFERENCES `schedule` (`id`) ON DELETE SET NULL ON UPDATE CASCADE,
+ ADD CONSTRAINT `computer_ibfk_33` FOREIGN KEY (`stateid`) REFERENCES `state` (`id`) ON UPDATE CASCADE,
+ ADD CONSTRAINT `computer_ibfk_34` FOREIGN KEY (`deptid`) REFERENCES `dept` (`id`) ON UPDATE CASCADE,
+ ADD CONSTRAINT `computer_ibfk_35` FOREIGN KEY (`platformid`) REFERENCES `platform` (`id`) ON UPDATE CASCADE,
+ ADD CONSTRAINT `computer_ibfk_36` FOREIGN KEY (`currentimageid`) REFERENCES `image` (`id`) ON UPDATE CASCADE;
+
+--
+-- Constraints for table `computerloadlog`
+--
+ALTER TABLE `computerloadlog`
+ ADD CONSTRAINT `computerloadlog_ibfk_1` FOREIGN KEY (`reservationid`) REFERENCES `reservation` (`id`) ON DELETE CASCADE;
+
+--
+-- Constraints for table `continuations`
+--
+ALTER TABLE `continuations`
+ ADD CONSTRAINT `continuations_ibfk_1` FOREIGN KEY (`parentid`) REFERENCES `continuations` (`id`) ON DELETE CASCADE;
+
+--
+-- Constraints for table `image`
+--
+ALTER TABLE `image`
+ ADD CONSTRAINT `image_ibfk_1` FOREIGN KEY (`ownerid`) REFERENCES `user` (`id`) ON DELETE SET NULL ON UPDATE CASCADE,
+ ADD CONSTRAINT `image_ibfk_5` FOREIGN KEY (`deptid`) REFERENCES `dept` (`id`) ON UPDATE CASCADE,
+ ADD CONSTRAINT `image_ibfk_6` FOREIGN KEY (`platformid`) REFERENCES `platform` (`id`) ON UPDATE CASCADE,
+ ADD CONSTRAINT `image_ibfk_7` FOREIGN KEY (`OSid`) REFERENCES `OS` (`id`) ON UPDATE CASCADE;
+
+--
+-- Constraints for table `imagerevision`
+--
+ALTER TABLE `imagerevision`
+ ADD CONSTRAINT `imagerevision_ibfk_1` FOREIGN KEY (`imageid`) REFERENCES `image` (`id`) ON DELETE CASCADE ON UPDATE CASCADE,
+ ADD CONSTRAINT `imagerevision_ibfk_2` FOREIGN KEY (`userid`) REFERENCES `user` (`id`) ON UPDATE CASCADE;
+
+--
+-- Constraints for table `localauth`
+--
+ALTER TABLE `localauth`
+ ADD CONSTRAINT `localauth_ibfk_1` FOREIGN KEY (`userid`) REFERENCES `user` (`id`) ON DELETE CASCADE;
+
+--
+-- Constraints for table `log`
+--
+ALTER TABLE `log`
+ ADD CONSTRAINT `log_ibfk_1` FOREIGN KEY (`userid`) REFERENCES `user` (`id`) ON UPDATE CASCADE,
+ ADD CONSTRAINT `log_ibfk_3` FOREIGN KEY (`imageid`) REFERENCES `image` (`id`) ON UPDATE CASCADE;
+
+--
+-- Constraints for table `managementnode`
+--
+ALTER TABLE `managementnode`
+ ADD CONSTRAINT `managementnode_ibfk_3` FOREIGN KEY (`predictivemoduleid`) REFERENCES `module` (`id`),
+ ADD CONSTRAINT `managementnode_ibfk_1` FOREIGN KEY (`stateid`) REFERENCES `state` (`id`),
+ ADD CONSTRAINT `managementnode_ibfk_2` FOREIGN KEY (`imagelibgroupid`) REFERENCES `resourcegroup` (`id`);
+
+--
+-- Constraints for table `OS`
+--
+ALTER TABLE `OS`
+ ADD CONSTRAINT `OS_ibfk_4` FOREIGN KEY (`moduleid`) REFERENCES `module` (`id`),
+ ADD CONSTRAINT `OS_ibfk_2` FOREIGN KEY (`type`) REFERENCES `OStype` (`name`) ON UPDATE CASCADE,
+ ADD CONSTRAINT `OS_ibfk_3` FOREIGN KEY (`installtype`) REFERENCES `OSinstalltype` (`name`) ON UPDATE CASCADE;
+
+--
+-- Constraints for table `privnode`
+--
+ALTER TABLE `privnode`
+ ADD CONSTRAINT `privnode_ibfk_1` FOREIGN KEY (`parent`) REFERENCES `privnode` (`id`) ON DELETE CASCADE ON UPDATE CASCADE;
+
+--
+-- Constraints for table `querylog`
+--
+ALTER TABLE `querylog`
+ ADD CONSTRAINT `querylog_ibfk_1` FOREIGN KEY (`userid`) REFERENCES `user` (`id`);
+
+--
+-- Constraints for table `request`
+--
+ALTER TABLE `request`
+ ADD CONSTRAINT `request_ibfk_15` FOREIGN KEY (`stateid`) REFERENCES `state` (`id`) ON UPDATE CASCADE,
+ ADD CONSTRAINT `request_ibfk_16` FOREIGN KEY (`laststateid`) REFERENCES `state` (`id`) ON UPDATE CASCADE,
+ ADD CONSTRAINT `request_ibfk_2` FOREIGN KEY (`userid`) REFERENCES `user` (`id`) ON DELETE CASCADE ON UPDATE CASCADE;
+
+--
+-- Constraints for table `reservation`
+--
+ALTER TABLE `reservation`
+ ADD CONSTRAINT `reservation_ibfk_11` FOREIGN KEY (`requestid`) REFERENCES `request` (`id`) ON DELETE CASCADE,
+ ADD CONSTRAINT `reservation_ibfk_10` FOREIGN KEY (`managementnodeid`) REFERENCES `managementnode` (`id`),
+ ADD CONSTRAINT `reservation_ibfk_9` FOREIGN KEY (`computerid`) REFERENCES `computer` (`id`) ON UPDATE CASCADE;
+
+--
+-- Constraints for table `resource`
+--
+ALTER TABLE `resource`
+ ADD CONSTRAINT `resource_ibfk_1` FOREIGN KEY (`resourcetypeid`) REFERENCES `resourcetype` (`id`) ON UPDATE CASCADE;
+
+--
+-- Constraints for table `resourcegroup`
+--
+ALTER TABLE `resourcegroup`
+ ADD CONSTRAINT `resourcegroup_ibfk_2` FOREIGN KEY (`ownerusergroupid`) REFERENCES `usergroup` (`id`) ON UPDATE CASCADE,
+ ADD CONSTRAINT `resourcegroup_ibfk_3` FOREIGN KEY (`resourcetypeid`) REFERENCES `resourcetype` (`id`) ON UPDATE CASCADE;
+
+--
+-- Constraints for table `resourcegroupmembers`
+--
+ALTER TABLE `resourcegroupmembers`
+ ADD CONSTRAINT `resourcegroupmembers_ibfk_1` FOREIGN KEY (`resourceid`) REFERENCES `resource` (`id`) ON DELETE CASCADE ON UPDATE CASCADE,
+ ADD CONSTRAINT `resourcegroupmembers_ibfk_2` FOREIGN KEY (`resourcegroupid`) REFERENCES `resourcegroup` (`id`) ON DELETE CASCADE ON UPDATE CASCADE;
+
+--
+-- Constraints for table `resourcemap`
+--
+ALTER TABLE `resourcemap`
+ ADD CONSTRAINT `resourcemap_ibfk_1` FOREIGN KEY (`resourcegroupid1`) REFERENCES `resourcegroup` (`id`) ON DELETE CASCADE,
+ ADD CONSTRAINT `resourcemap_ibfk_2` FOREIGN KEY (`resourcegroupid2`) REFERENCES `resourcegroup` (`id`) ON DELETE CASCADE;
+
+--
+-- Constraints for table `resourcepriv`
+--
+ALTER TABLE `resourcepriv`
+ ADD CONSTRAINT `resourcepriv_ibfk_1` FOREIGN KEY (`resourcegroupid`) REFERENCES `resourcegroup` (`id`) ON DELETE CASCADE ON UPDATE CASCADE,
+ ADD CONSTRAINT `resourcepriv_ibfk_2` FOREIGN KEY (`privnodeid`) REFERENCES `privnode` (`id`) ON DELETE CASCADE ON UPDATE CASCADE;
+
+--
+-- Constraints for table `schedule`
+--
+ALTER TABLE `schedule`
+ ADD CONSTRAINT `schedule_ibfk_1` FOREIGN KEY (`ownerid`) REFERENCES `user` (`id`) ON UPDATE CASCADE;
+
+--
+-- Constraints for table `user`
+--
+ALTER TABLE `user`
+ ADD CONSTRAINT `user_ibfk_2` FOREIGN KEY (`affiliationid`) REFERENCES `affiliation` (`id`),
+ ADD CONSTRAINT `user_ibfk_3` FOREIGN KEY (`IMtypeid`) REFERENCES `IMtype` (`id`) ON UPDATE CASCADE;
+
+--
+-- Constraints for table `usergroup`
+--
+ALTER TABLE `usergroup`
+ ADD CONSTRAINT `usergroup_ibfk_1` FOREIGN KEY (`ownerid`) REFERENCES `user` (`id`) ON DELETE SET NULL ON UPDATE CASCADE,
+ ADD CONSTRAINT `usergroup_ibfk_2` FOREIGN KEY (`editusergroupid`) REFERENCES `usergroup` (`id`) ON DELETE SET NULL ON UPDATE CASCADE;
+
+--
+-- Constraints for table `usergroupmembers`
+--
+ALTER TABLE `usergroupmembers`
+ ADD CONSTRAINT `usergroupmembers_ibfk_1` FOREIGN KEY (`userid`) REFERENCES `user` (`id`) ON DELETE CASCADE ON UPDATE CASCADE,
+ ADD CONSTRAINT `usergroupmembers_ibfk_2` FOREIGN KEY (`usergroupid`) REFERENCES `usergroup` (`id`) ON DELETE CASCADE ON UPDATE CASCADE;
+
+--
+-- Constraints for table `userpriv`
+--
+ALTER TABLE `userpriv`
+ ADD CONSTRAINT `userpriv_ibfk_1` FOREIGN KEY (`userid`) REFERENCES `user` (`id`) ON DELETE CASCADE ON UPDATE CASCADE,
+ ADD CONSTRAINT `userpriv_ibfk_2` FOREIGN KEY (`usergroupid`) REFERENCES `usergroup` (`id`) ON DELETE CASCADE ON UPDATE CASCADE,
+ ADD CONSTRAINT `userpriv_ibfk_3` FOREIGN KEY (`privnodeid`) REFERENCES `privnode` (`id`) ON DELETE CASCADE ON UPDATE CASCADE,
+ ADD CONSTRAINT `userpriv_ibfk_4` FOREIGN KEY (`userprivtypeid`) REFERENCES `userprivtype` (`id`) ON DELETE CASCADE ON UPDATE CASCADE;
diff --git a/web/.ht-inc/Doxyfile b/web/.ht-inc/Doxyfile
new file mode 100644
index 0000000..9f4a619
--- /dev/null
+++ b/web/.ht-inc/Doxyfile
@@ -0,0 +1,233 @@
+# Doxyfile 1.4.1-KDevelop
+
+#---------------------------------------------------------------------------
+# Project related configuration options
+#---------------------------------------------------------------------------
+PROJECT_NAME = vcl.kdevelop
+PROJECT_NUMBER = $VERSION$
+OUTPUT_DIRECTORY =
+CREATE_SUBDIRS = NO
+OUTPUT_LANGUAGE = English
+USE_WINDOWS_ENCODING = NO
+BRIEF_MEMBER_DESC = YES
+REPEAT_BRIEF = YES
+ABBREVIATE_BRIEF = "The $name class" \
+ "The $name widget" \
+ "The $name file" \
+ is \
+ provides \
+ specifies \
+ contains \
+ represents \
+ a \
+ an \
+ the
+ALWAYS_DETAILED_SEC = NO
+INLINE_INHERITED_MEMB = NO
+FULL_PATH_NAMES = NO
+STRIP_FROM_PATH = /home/jfthomps/
+STRIP_FROM_INC_PATH =
+SHORT_NAMES = NO
+JAVADOC_AUTOBRIEF = NO
+MULTILINE_CPP_IS_BRIEF = NO
+DETAILS_AT_TOP = NO
+INHERIT_DOCS = YES
+DISTRIBUTE_GROUP_DOC = NO
+TAB_SIZE = 8
+ALIASES =
+OPTIMIZE_OUTPUT_FOR_C = NO
+OPTIMIZE_OUTPUT_JAVA = NO
+SUBGROUPING = YES
+#---------------------------------------------------------------------------
+# Build related configuration options
+#---------------------------------------------------------------------------
+EXTRACT_ALL = YES
+EXTRACT_PRIVATE = YES
+EXTRACT_STATIC = YES
+EXTRACT_LOCAL_CLASSES = YES
+EXTRACT_LOCAL_METHODS = YES
+HIDE_UNDOC_MEMBERS = NO
+HIDE_UNDOC_CLASSES = NO
+HIDE_FRIEND_COMPOUNDS = NO
+HIDE_IN_BODY_DOCS = YES
+INTERNAL_DOCS = YES
+CASE_SENSE_NAMES = YES
+HIDE_SCOPE_NAMES = NO
+SHOW_INCLUDE_FILES = YES
+INLINE_INFO = YES
+SORT_MEMBER_DOCS = YES
+SORT_BRIEF_DOCS = YES
+SORT_BY_SCOPE_NAME = NO
+GENERATE_TODOLIST = YES
+GENERATE_TESTLIST = YES
+GENERATE_BUGLIST = YES
+GENERATE_DEPRECATEDLIST= YES
+ENABLED_SECTIONS =
+MAX_INITIALIZER_LINES = 30
+SHOW_USED_FILES = NO
+SHOW_DIRECTORIES = NO
+FILE_VERSION_FILTER =
+#---------------------------------------------------------------------------
+# configuration options related to warning and progress messages
+#---------------------------------------------------------------------------
+QUIET = NO
+WARNINGS = YES
+WARN_IF_UNDOCUMENTED = YES
+WARN_IF_DOC_ERROR = YES
+WARN_NO_PARAMDOC = YES
+WARN_FORMAT = "$file:$line: $text"
+WARN_LOGFILE =
+#---------------------------------------------------------------------------
+# configuration options related to the input files
+#---------------------------------------------------------------------------
+#INPUT = /home/jfthomps/locker/www/vcl/.ht-inc
+INPUT = /afs/eos/engrwww/vcl.ncsu/scheduling/.ht-inc
+FILE_PATTERNS = *.php
+RECURSIVE = yes
+EXCLUDE = /afs/eos/engrwww/vcl.ncsu/scheduling/.ht-inc/jpgraph /afs/eos/engrwww/vcl.ncsu/scheduling/.ht-inc/jpgraph.old
+EXCLUDE_SYMLINKS = NO
+EXCLUDE_PATTERNS =
+EXAMPLE_PATH = /afs/eos/engrwww/vcl.ncsu/scheduling/.ht-inc
+EXAMPLE_PATTERNS = *
+EXAMPLE_RECURSIVE = NO
+IMAGE_PATH =
+INPUT_FILTER =
+FILTER_PATTERNS =
+FILTER_SOURCE_FILES = NO
+#---------------------------------------------------------------------------
+# configuration options related to source browsing
+#---------------------------------------------------------------------------
+SOURCE_BROWSER = YES
+INLINE_SOURCES = NO
+STRIP_CODE_COMMENTS = YES
+REFERENCED_BY_RELATION = YES
+REFERENCES_RELATION = YES
+VERBATIM_HEADERS = YES
+#---------------------------------------------------------------------------
+# configuration options related to the alphabetical class index
+#---------------------------------------------------------------------------
+ALPHABETICAL_INDEX = YES
+COLS_IN_ALPHA_INDEX = 5
+IGNORE_PREFIX =
+#---------------------------------------------------------------------------
+# configuration options related to the HTML output
+#---------------------------------------------------------------------------
+GENERATE_HTML = YES
+HTML_OUTPUT = /home/jfthomps/locker/www/vcl/docs
+HTML_FILE_EXTENSION = .html
+HTML_HEADER =
+HTML_FOOTER =
+HTML_STYLESHEET =
+HTML_ALIGN_MEMBERS = YES
+GENERATE_HTMLHELP = NO
+CHM_FILE =
+HHC_LOCATION =
+GENERATE_CHI = NO
+BINARY_TOC = NO
+TOC_EXPAND = YES
+DISABLE_INDEX = NO
+ENUM_VALUES_PER_LINE = 4
+GENERATE_TREEVIEW = YES
+TREEVIEW_WIDTH = 210
+#---------------------------------------------------------------------------
+# configuration options related to the LaTeX output
+#---------------------------------------------------------------------------
+GENERATE_LATEX = NO
+LATEX_OUTPUT = latex
+LATEX_CMD_NAME = latex
+MAKEINDEX_CMD_NAME = makeindex
+COMPACT_LATEX = NO
+PAPER_TYPE = a4wide
+EXTRA_PACKAGES =
+LATEX_HEADER =
+PDF_HYPERLINKS = NO
+USE_PDFLATEX = NO
+LATEX_BATCHMODE = NO
+LATEX_HIDE_INDICES = NO
+#---------------------------------------------------------------------------
+# configuration options related to the RTF output
+#---------------------------------------------------------------------------
+GENERATE_RTF = NO
+RTF_OUTPUT = rtf
+COMPACT_RTF = NO
+RTF_HYPERLINKS = NO
+RTF_STYLESHEET_FILE =
+RTF_EXTENSIONS_FILE =
+#---------------------------------------------------------------------------
+# configuration options related to the man page output
+#---------------------------------------------------------------------------
+GENERATE_MAN = NO
+MAN_OUTPUT = man
+MAN_EXTENSION = .3
+MAN_LINKS = NO
+#---------------------------------------------------------------------------
+# configuration options related to the XML output
+#---------------------------------------------------------------------------
+GENERATE_XML = NO
+XML_OUTPUT = xml
+XML_SCHEMA =
+XML_DTD =
+XML_PROGRAMLISTING = YES
+#---------------------------------------------------------------------------
+# configuration options for the AutoGen Definitions output
+#---------------------------------------------------------------------------
+GENERATE_AUTOGEN_DEF = NO
+#---------------------------------------------------------------------------
+# configuration options related to the Perl module output
+#---------------------------------------------------------------------------
+GENERATE_PERLMOD = NO
+PERLMOD_LATEX = NO
+PERLMOD_PRETTY = YES
+PERLMOD_MAKEVAR_PREFIX =
+#---------------------------------------------------------------------------
+# Configuration options related to the preprocessor
+#---------------------------------------------------------------------------
+ENABLE_PREPROCESSING = YES
+MACRO_EXPANSION = NO
+EXPAND_ONLY_PREDEF = NO
+SEARCH_INCLUDES = YES
+INCLUDE_PATH =
+INCLUDE_FILE_PATTERNS =
+PREDEFINED =
+EXPAND_AS_DEFINED =
+SKIP_FUNCTION_MACROS = YES
+#---------------------------------------------------------------------------
+# Configuration::additions related to external references
+#---------------------------------------------------------------------------
+TAGFILES =
+GENERATE_TAGFILE = vcl.tag
+ALLEXTERNALS = NO
+EXTERNAL_GROUPS = YES
+PERL_PATH = /usr/bin/perl
+#---------------------------------------------------------------------------
+# Configuration options related to the dot tool
+#---------------------------------------------------------------------------
+CLASS_DIAGRAMS = YES
+HIDE_UNDOC_RELATIONS = NO
+HAVE_DOT = YES
+CLASS_GRAPH = YES
+COLLABORATION_GRAPH = YES
+GROUP_GRAPHS = YES
+UML_LOOK = NO
+TEMPLATE_RELATIONS = NO
+INCLUDE_GRAPH = YES
+INCLUDED_BY_GRAPH = YES
+CALL_GRAPH = YES
+CALLER_GRAPH = NO
+GRAPHICAL_HIERARCHY = YES
+DIRECTORY_GRAPH = YES
+DOT_IMAGE_FORMAT = png
+DOT_PATH = /usr/bin
+DOTFILE_DIRS =
+MAX_DOT_GRAPH_WIDTH = 1536
+MAX_DOT_GRAPH_HEIGHT = 1536
+MAX_DOT_GRAPH_DEPTH = 1000
+DOT_GRAPH_MAX_NODES = 50
+DOT_TRANSPARENT = NO
+DOT_MULTI_TARGETS = YES
+GENERATE_LEGEND = YES
+DOT_CLEANUP = NO
+#---------------------------------------------------------------------------
+# Configuration::additions related to the search engine
+#---------------------------------------------------------------------------
+SEARCHENGINE = NO
diff --git a/web/.ht-inc/authentication.php b/web/.ht-inc/authentication.php
new file mode 100644
index 0000000..6dadf77
--- /dev/null
+++ b/web/.ht-inc/authentication.php
@@ -0,0 +1,605 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+/**
+ * \file
+ */
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getAuthCookieData($loginid, $valid)
+///
+/// \param $loginid - login id for user
+/// \param $valid - (optional, default=600) - time in minutes the cookie
+/// should be valid
+///
+/// \return on failure, an error message; on success, an array with 2 elements:\n
+/// data - encrypted payload for auth cookie\n
+/// ts - unix timestamp it will expire
+///
+/// \brief gets user's information and stores it along with their IP address and
+/// a timestamp
+///
+////////////////////////////////////////////////////////////////////////////////
+function getAuthCookieData($loginid, $valid=600) {
+ global $keys;
+ $ts = time() + ($valid * 60);
+ $remoteIP = $_SERVER["REMOTE_ADDR"];
+ if(empty($remoteIP))
+ return "Failed to obtain remote IP address for fixed cookie type";
+ $cdata = "$loginid|$remoteIP|$ts";
+
+ if(! openssl_private_encrypt($cdata, $cryptdata, $keys["private"]))
+ return "Failed to encrypt cookie data";
+
+ return array("data" => $cryptdata, "ts" => $ts);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn readAuthCookie()
+///
+/// \return on success, an array with the following indices:\n
+/// \b userid - numeric user id\n
+/// \b first - first name\n
+/// \b middle - middle name (may be an empty string)\n
+/// \b last - last name\n
+/// \b email - email address\n
+/// \b created - timestamp of account creation (in mysql datetime format)\n
+/// \b ts - timestamp that authentication cookie will expire (in unix timestamp
+/// format)\n
+/// \b type - 'fixed' or 'floating' - fixed = tied to specific IP address;
+/// floating = not tied to any IP address (only fixed is supported at this time)\n
+/// \b remoteIP - empty for type 'floating'; user's IP address for type 'fixed'
+///
+/// \brief parses the ITECSAUTH cookie and returns an array; on failure, returns
+/// an empty array. You will then need to call ITECSAUTH_getError to get
+/// the reason.
+///
+////////////////////////////////////////////////////////////////////////////////
+function readAuthCookie() {
+ global $keys, $AUTHERROR;
+ if(get_magic_quotes_gpc())
+ $cookie = stripslashes($_COOKIE["VCLAUTH"]);
+ else
+ $cookie = $_COOKIE["VCLAUTH"];
+ if(! openssl_public_decrypt($cookie, $tmp, $keys['public'])) {
+ $AUTHERROR["code"] = 3;
+ $AUTHERROR["message"] = "Failed to decrypt auth cookie";
+ return NULL;
+ }
+
+ $tmparr = explode('|', $tmp);
+ $loginid = $tmparr[0];
+ $remoteIP = $tmparr[1];
+ $ts = $tmparr[2];
+
+ if($ts < time()) {
+ $AUTHERROR["code"] = 4;
+ $AUTHERROR["message"] = "Auth cookie has expired";
+ return NULL;
+ }
+ if($_SERVER["REMOTE_ADDR"] != $remoteIP) {
+ //setcookie("ITECSAUTH", "", time() - 10, "/", COOKIEDOMAIN);
+ $AUTHERROR["code"] = 4;
+ $AUTHERROR["message"] = "remote IP in auth cookie doesn't match user's remote IP";
+ return NULL;
+ }
+
+ return $loginid;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn selectAuth()
+///
+/// \brief prints a page for the user to select the authentication method to use
+///
+////////////////////////////////////////////////////////////////////////////////
+function selectAuth() {
+ global $HTMLheader, $printedHTMLheader, $authMechs, $skin;
+ $authtype = getContinuationVar('authtype', processInputVar("authtype", ARG_STRING));
+ if(array_key_exists($authtype, $authMechs)) {
+ if($authMechs[$authtype]['type'] == 'redirect') {
+ header("Location: {$authMechs[$authtype]['URL']}");
+ dbDisconnect();
+ exit;
+ }
+ elseif($authMechs[$authtype]['type'] == 'ldap' ||
+ $authMechs[$authtype]['type'] == 'local') {
+ printLoginPageWithSkin($authtype);
+ return;
+ }
+ }
+ require_once("themes/$skin/page.php");
+ $HTMLheader = getHeader(0);
+ print $HTMLheader;
+ $printedHTMLheader = 1;
+ print "<H2>Welcome to the Virtual Computing Lab</H2>\n";
+ print "<TABLE>\n";
+ print "<TR>\n";
+ print "<TD nowrap class=rightborder>\n";
+ print "Please select an authentication method to use:<br><br>\n";
+ if(strlen($authtype))
+ print "<font color=red>Selected method failed, please try again</font><br>\n";
+ foreach(array_keys($authMechs) as $mech)
+ $methods["$mech"] = $mech;
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post name=loginform>\n";
+ /*if($skin == 'example1')
+ printSelectInput("authtype", $methods, 'EXAMPLE1 LDAP');
+ elseif($skin == 'example2')
+ printSelectInput("authtype", $methods, 'EXAMPLE2 LDAP');
+ else*/
+ printSelectInput("authtype", $methods, -1, 0, 0, '', 'tabindex=1');
+ print "<br><INPUT type=hidden name=mode value=selectauth>\n";
+ print "<INPUT type=submit value=\"Proceed to Login\" tabindex=2 name=userid>\n";
+ print "</FORM>\n";
+ print "</TD>\n";
+ print "<TD>\n";
+ print "<h3>Explanation of authentication methods:</h3>\n";
+ print "<UL id=expauthul>\n";
+ foreach($authMechs as $mech)
+ print "<LI>{$mech['help']}</LI>\n";
+ print "</UL>\n";
+ print "</TD>\n";
+ print "</TR>\n";
+ print "</TABLE>\n";
+ print getFooter();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn printLoginPageWithSkin($authtype)
+///
+/// \param $authtype - and authentication type
+///
+/// \brief sets up the skin for the page correctly, then calls printLoginPage
+///
+////////////////////////////////////////////////////////////////////////////////
+function printLoginPageWithSkin($authtype) {
+ global $authMechs, $HTMLheader, $skin, $printedHTMLheader;
+ switch(getAffiliationName($authMechs[$authtype]['affiliationid'])) {
+ case 'EXAMPLE1':
+ $skin = 'example1';
+ break;
+ case 'EXAMPLE2':
+ $skin = 'example2';
+ break;
+ default:
+ $skin = 'default';
+ break;
+ }
+ require_once("themes/$skin/page.php");
+ $HTMLheader = getHeader(0);
+ printHTMLHeader();
+ print $HTMLheader;
+ $printedHTMLheader = 1;
+ printLoginPage();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn printLoginPage()
+///
+/// \brief prints a page for a user to login
+///
+////////////////////////////////////////////////////////////////////////////////
+function printLoginPage() {
+ global $authMechs, $skin, $user;
+ $user['id'] = 0;
+ $authtype = getContinuationVar("authtype", processInputVar("authtype", ARG_STRING));
+ $userid = processInputVar('userid', ARG_STRING, '');
+ if($userid == 'Proceed to Login')
+ $userid = '';
+ if(! array_key_exists($authtype, $authMechs)) {
+ // FIXME - hackerish
+ dbDisconnect();
+ exit;
+ }
+ /*if($skin == 'example1') {
+ $useridLabel = 'Pirateid';
+ $passLabel = 'Passphrase';
+ $text1 = 'Login with your Pirate ID';
+ $text2 = "";
+ }
+ elseif($skin == 'example2') {
+ print "<br>";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post name=loginform>\n";
+ if(strlen($userid))
+ print "<font color=red>Login failed</font>\n";
+ print "<TABLE width=\"250\">\n";
+ print " <TR>\n";
+ print " <TH align=right>Key Account:</TH>\n";
+ print " <TD><INPUT type=text name=userid value=\"\"></TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Password:</TH>\n";
+ print " <TD><INPUT type=password name=password></TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TD colspan=2 align=right><INPUT type=submit value=Login class=button></TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ print "<div width=250 align=center>\n";
+ print "<p>\n";
+ $cdata = array('authtype' => $authtype);
+ $cont = addContinuationsEntry('submitLogin', $cdata);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <br>\n";
+ print " </p>\n";
+ print "</div>\n";
+ print "</FORM>\n";
+ print getFooter();
+ return;
+ }
+ else {*/
+ $useridLabel = 'Userid';
+ $passLabel = 'Password';
+ $text1 = "Login with $authtype";
+ $text2 = "";
+ #}
+ print "<H2 style=\"display: block\">$text1</H2>\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post name=loginform>\n";
+ if(strlen($userid))
+ print "<font color=red>Login failed</font>\n";
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TH align=right>$useridLabel:</TH>\n";
+ print " <TD><INPUT type=text name=userid value=\"$userid\"></TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>$passLabel:</TH>\n";
+ print " <TD><INPUT type=password name=password></TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TD colspan=2 align=right><INPUT type=submit value=Login></TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ $cdata = array('authtype' => $authtype);
+ $cont = addContinuationsEntry('submitLogin', $cdata);
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "</FORM>\n";
+ print "$text2<br>\n";
+ print getFooter();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitLogin()
+///
+/// \brief processes a login page submission
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitLogin() {
+ global $authMechs;
+ $authtype = getContinuationVar("authtype", processInputVar('authtype', ARG_STRING));
+ if(! array_key_exists($authtype, $authMechs)) {
+ // FIXME - hackerish
+ dbDisconnect();
+ exit;
+ }
+ $userid = processInputVar('userid', ARG_STRING, '');
+ $passwd = processInputVar('password', ARG_STRING, '');
+ if(empty($userid) || empty($passwd)) {
+ selectAuth();
+ return;
+ }
+ if(get_magic_quotes_gpc())
+ $passwd = stripslashes($passwd);
+ if($authMechs[$authtype]['type'] == 'ldap')
+ ldapLogin($authtype, $userid, $passwd);
+ elseif($authMechs[$authtype]['type'] == 'local')
+ localLogin($authtype, $userid, $passwd);
+ else
+ selectAuth();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn ldapLogin($authtype, $userid, $passwd)
+///
+/// \param $authtype - index from $authMechs array
+/// \param $userid - userid without affiliation
+/// \param $passwd - submitted password
+///
+/// \brief tries to authenticate user via ldap; calls printLoginPageWithSkin if
+/// authentication fails
+///
+////////////////////////////////////////////////////////////////////////////////
+function ldapLogin($authtype, $userid, $passwd) {
+ global $HTMLheader, $printedHTMLheader, $authMechs, $phpVer;
+ $ds = ldap_connect("ldaps://{$authMechs[$authtype]['server']}/");
+ if(! $ds) {
+ print $HTMLheader;
+ $printedHTMLheader = 1;
+ selectAuth();
+ return;
+ }
+ ldap_set_option($ds, LDAP_OPT_PROTOCOL_VERSION, 3);
+ /*if($authtype == 'EXAMPLE1 LDAP') {
+ # in this case, we have to look up what part of the tree the user is in
+ # before we can actually look up the user
+ $auth = $authMechs[$authtype];
+ ldap_set_option($ds, LDAP_OPT_PROTOCOL_VERSION, 3);
+ ldap_set_option($ds, LDAP_OPT_REFERRALS, 0);
+ $res = ldap_bind($ds, $auth['masterlogin'],
+ $auth['masterpwd']);
+ if(! $res) {
+ printLoginPageWithSkin($authtype);
+ return;
+ }
+ $search = ldap_search($ds,
+ $auth['binddn'],
+ "cn=$userid",
+ array('dn'), 0, 3, 15);
+ if($search) {
+ $tmpdata = ldap_get_entries($ds, $search);
+ if(! $tmpdata['count'] || ! array_key_exists('dn', $tmpdata[0])) {
+ printLoginPageWithSkin($authtype);
+ return;
+ }
+ $ldapuser = $tmpdata[0]['dn'];
+ }
+ else {
+ printLoginPageWithSkin($authtype);
+ return;
+ }
+ }
+ elseif($authtype == 'EXAMPLE2 LDAP') {
+ # this is similar to EXAMPLE1, but here we do an anonymous bind
+ $auth = $authMechs[$authtype];
+ $res = ldap_bind($ds);
+ if(! $res) {
+ printLoginPageWithSkin($authtype);
+ return;
+ }
+ $search = ldap_search($ds,
+ $auth['binddn'],
+ "uid=$userid",
+ array('dn'), 0, 3, 15);
+ if($search) {
+ $tmpdata = ldap_get_entries($ds, $search);
+ if(! $tmpdata['count'] || ! array_key_exists('dn', $tmpdata[0])) {
+ printLoginPageWithSkin($authtype);
+ return;
+ }
+ $ldapuser = $tmpdata[0]['dn'];
+ }
+ else {
+ printLoginPageWithSkin($authtype);
+ return;
+ }
+ }
+ else*/
+ $ldapuser = sprintf($authMechs[$authtype]['userid'], $userid);
+ $res = ldap_bind($ds, $ldapuser, $passwd);
+ if(! $res) {
+ // login failed
+ printLoginPageWithSkin($authtype);
+ return;
+ }
+ else {
+ // see if user in our db
+ $query = "SELECT id "
+ . "FROM user "
+ . "WHERE unityid = '$userid' AND "
+ . "affiliationid = {$authMechs[$authtype]['affiliationid']}";
+ $qh = doQuery($query, 101);
+ if(! mysql_num_rows($qh)) {
+ // if not, add user
+ $newid = updateLDAPUser($authtype, $userid);
+ if(is_null($newid))
+ abort(8);
+ }
+ // get cookie data
+ $cookie = getAuthCookieData("$userid@" . getAffiliationName($authMechs[$authtype]['affiliationid']));
+ // set cookie
+ if(version_compare(PHP_VERSION, "5.2", ">=") == true)
+ setcookie("VCLAUTH", "{$cookie['data']}", $cookie['ts'], "/", COOKIEDOMAIN, 1, 1);
+ else
+ setcookie("VCLAUTH", "{$cookie['data']}", $cookie['ts'], "/", COOKIEDOMAIN, 1);
+ # set skin cookie based on affiliation
+ /*if(getAffiliationName($authMechs[$authtype]['affiliationid']) == 'EXAMPLE1')
+ setcookie("VCLSKIN", "EXAMPLE1", (time() + (SECINDAY * 31)), "/", COOKIEDOMAIN);
+ elseif(getAffiliationName($authMechs[$authtype]['affiliationid']) == 'EXAMPLE2')
+ setcookie("VCLSKIN", "EXAMPLE2", (time() + (SECINDAY * 31)), "/", COOKIEDOMAIN);
+ else*/
+ setcookie("VCLSKIN", "DEFAULT", (time() + (SECINDAY * 31)), "/", COOKIEDOMAIN);
+ // redirect to main page
+ $tmp = explode('/', $_SERVER['HTTP_REFERER']);
+ if($tmp[2] != 'vcl.ncsu.edu' ||
+ (array_key_exists(3, $tmp) && $tmp[3] != 'scheduling')) {
+ array_shift($tmp);
+ array_shift($tmp);
+ array_shift($tmp);
+ $rest = implode('/', $tmp);
+ header("Location: https://vcl.ncsu.edu/$rest");
+ }
+ else
+ header("Location: " . BASEURL . SCRIPT);
+ dbDisconnect();
+ exit;
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn localLogin()
+///
+/// \brief tries to authenticate user locally; calls printLoginPageWithSkin if
+/// authentication fails
+///
+////////////////////////////////////////////////////////////////////////////////
+function localLogin() {
+ global $HTMLheader, $phpVer;
+ $userid = processInputVar('userid', ARG_STRING);
+ $passwd = processInputVar('password', ARG_STRING);
+ if(validateLocalAccount($userid, $passwd)) {
+ //set cookie
+ $cookie = getAuthCookieData("$userid@local");
+ if(version_compare(PHP_VERSION, "5.2", ">=") == true)
+ setcookie("VCLAUTH", "{$cookie['data']}", $cookie['ts'], "/", COOKIEDOMAIN, 1, 1);
+ else
+ setcookie("VCLAUTH", "{$cookie['data']}", $cookie['ts'], "/", COOKIEDOMAIN, 1);
+ //load main page
+ setcookie("VCLSKIN", "NCSU", (time() + (SECINDAY * 31)), "/", COOKIEDOMAIN);
+ header("Location: " . BASEURL . SCRIPT);
+ dbDisconnect();
+ exit;
+ }
+ else {
+ printLoginPageWithSkin('Local Account');
+ printHTMLFooter();
+ dbDisconnect();
+ exit;
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn validateLocalAccount($user, $pass)
+///
+/// \param $user - unityid from user table
+/// \param $pass - user's password
+///
+/// \return 1 if account exists in localauth table, 0 if it does not
+///
+/// \brief checks to see if $user has an entry in the localauth table
+///
+////////////////////////////////////////////////////////////////////////////////
+function validateLocalAccount($user, $pass) {
+ $query = "SELECT l.salt "
+ . "FROM localauth l, "
+ . "user u, "
+ . "affiliation a "
+ . "WHERE u.unityid = '$user' AND "
+ . "u.affiliationid = a.id AND "
+ . "a.name = 'Local' AND "
+ . "l.userid = u.id";
+ $qh = doQuery($query, 101);
+ if(mysql_num_rows($qh) != 1 ||
+ (! ($row = mysql_fetch_assoc($qh))))
+ return 0;
+
+ $passhash = sha1("$pass{$row['salt']}");
+ $query = "SELECT u.id "
+ . "FROM user u, "
+ . "localauth l, "
+ . "affiliation a "
+ . "WHERE u.unityid = '$user' AND "
+ . "l.userid = u.id AND "
+ . "l.passhash = '$passhash' AND "
+ . "u.affiliationid = a.id AND "
+ . "a.name = 'Local'";
+ $qh = doQuery($query, 101);
+ if(mysql_num_rows($qh) == 1)
+ return 1;
+ else
+ return 0;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn checkExpiredDemoUser($userid, $groups)
+///
+/// \param $userid - id from user table
+/// \param $groups - (optional) array of user's groups as returned by
+/// getUsersGroups
+///
+/// \brief checks to see if user is only in demo group and if so check to see
+/// if it has been 3 days since start of first reservation or if user has made
+/// 3 reservations; if so, moves user to nodemo group
+///
+////////////////////////////////////////////////////////////////////////////////
+function checkExpiredDemoUser($userid, $groups=0) {
+ global $mode, $skin, $noHTMLwrappers;
+ if($groups == 0)
+ $groups = getUsersGroups($userid, 1);
+
+ if(count($groups) != 1)
+ return;
+
+ $tmp = array_values($groups);
+ if($tmp[0] != 'demo')
+ return;
+
+ $query = "SELECT start "
+ . "FROM log "
+ . "WHERE userid = $userid "
+ . "AND finalend < NOW() "
+ . "ORDER BY start "
+ . "LIMIT 3";
+ $qh = doQuery($query, 101);
+ $expire = time() - (SECINDAY * 3);
+ $rows = mysql_num_rows($qh);
+ if($row = mysql_fetch_assoc($qh)) {
+ if($rows >= 3 || datetimeToUnix($row['start']) < $expire) {
+ if(in_array($mode, $noHTMLwrappers))
+ # do a redirect and handle removal on next page load so user can
+ # be notified - doesn't always work, but handles a few extra
+ # cases
+ header("Location: " . BASEURL . SCRIPT);
+ else {
+ $nodemoid = getUserGroupID('nodemo', getAffiliationID('ITECS'));
+ $query = "DELETE FROM usergroupmembers " # have to do the delete here
+ . "WHERE userid = $userid"; # because updateGroups doesn't
+ # delete from custom groups
+ doQuery($query, 101);
+ updateGroups(array($nodemoid), $userid);
+ if(empty($skin)) {
+ $skin = 'ncsu';
+ require_once("themes/$skin/page.php");
+ }
+ $mode = 'expiredemouser';
+ printHTMLHeader();
+ print "<h2>Account Expired</h2>\n";
+ print "The account you are using is a demo account that has now expired. ";
+ print "You cannot make any more reservations. Please contact <a href=\"";
+ print "mailto:" . HELPEMAIL . "\">" . HELPEMAIL . "</a> if you need ";
+ print "further access to VCL.<br>\n";
+ }
+ semUnlock();
+ printHTMLFooter();
+ dbDisconnect();
+ exit;
+ }
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn testGeneralAffiliation(&$login, &$affilid)
+///
+/// \param $login - (pass by ref) a login id with affiliation
+/// \param $affilid - (pass by ref) gets overwritten
+///
+/// \return - 1 if successfully found affiliation id, 0 if failed
+///
+/// \brief changes $login to be without affiliation and sticks the associated
+/// affiliation id in $affilid
+///
+////////////////////////////////////////////////////////////////////////////////
+function testGeneralAffiliation(&$login, &$affilid) {
+ if(preg_match('/^([^@]*)@([^@\.]*)$/', $login, $matches)) {
+ $login = $matches[1];
+ $affilid = getAffiliationID($matches[2]);
+ return 1;
+ }
+ return 0;
+}
+
+?>
diff --git a/web/.ht-inc/authmethods/itecsauth.php b/web/.ht-inc/authmethods/itecsauth.php
new file mode 100644
index 0000000..205326e
--- /dev/null
+++ b/web/.ht-inc/authmethods/itecsauth.php
@@ -0,0 +1,299 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+/**
+ * \file
+ */
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn addITECSUser($loginid)
+///
+/// \param $loginid - email address of user
+///
+/// \return new id from user table or NULL if there was a problem
+///
+/// \brief looks up a user's info in the accounts database and adds the user to
+/// our database
+///
+////////////////////////////////////////////////////////////////////////////////
+function addITECSUser($loginid) {
+ global $mysql_link_vcl, $ENABLE_ITECSAUTH;
+ if(! $ENABLE_ITECSAUTH)
+ return NULL;
+ $query = "SELECT id AS uid, "
+ . "first, "
+ . "middle, "
+ . "last, "
+ . "email, "
+ . "created, "
+ . "active, "
+ . "lockedout "
+ . "FROM user "
+ . "WHERE email = '$loginid'";
+ $qh = doQuery($query, 101, "accounts");
+ if($row = mysql_fetch_assoc($qh)) {
+ // FIXME test replacing ''s
+ // FIXME do we care if the account is active?
+ $first = ereg_replace("'", "\'", $row['first']);
+ $middle = ereg_replace("'", "\'", $row['middle']);
+ $last = ereg_replace("'", "\'", $row['last']);
+ $loweruser = strtolower($row['email']);
+ $query = "INSERT INTO user ("
+ . "uid, "
+ . "unityid, "
+ . "affiliationid, "
+ . "firstname, "
+ . "middlename, "
+ . "lastname, "
+ . "email, "
+ . "emailnotices, "
+ . "lastupdated) "
+ . "VALUES ("
+ . "{$row['uid']}, "
+ . "'$loweruser', "
+ . "2, "
+ . "'$first', "
+ . "'$middle', "
+ . "'$last', "
+ . "'{$row['email']}', "
+ . "0, "
+ . "NOW())";
+ // FIXME might want this logged
+ doQuery($query, 101, 'vcl', 1);
+ }
+ if(mysql_affected_rows($mysql_link_vcl)) {
+ $qh = doQuery("SELECT LAST_INSERT_ID() FROM user", 101);
+ if(! $row = mysql_fetch_row($qh)) {
+ abort(101);
+ }
+ return $row[0];
+ }
+ return NULL;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn validateITECSUser($loginid)
+///
+/// \param $loginid - email address for user
+///
+/// \return 1 if account exists and is active or not yet activated, 0 otherwise
+///
+/// \brief looks up $loginid in accounts db
+///
+////////////////////////////////////////////////////////////////////////////////
+function validateITECSUser($loginid) {
+ global $ENABLE_ITECSAUTH;
+ if(! $ENABLE_ITECSAUTH)
+ return 0;
+ $query = "SELECT email "
+ . "FROM user "
+ . "WHERE email = '$loginid' AND "
+ . "(active = 1 OR "
+ . "activated = 0)";
+ $qh = doQuery($query, 101, "accounts");
+ if(mysql_num_rows($qh))
+ return 1;
+ return 0;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn updateITECSUser($userid)
+///
+/// \param $userid - email address for user
+///
+/// \return NULL if fail to update data or an array with these elements:\n
+/// \b id - user's numeric from user table\n
+/// \b uid - user's numeric unity id\n
+/// \b unityid - unity ID for the user\n
+/// \b affiliation - user's affiliation\n
+/// \b affiliationid - user's affiliation id\n
+/// \b curriculum - curriculum user is in\n
+/// \b firstname - user's first name\n
+/// \b preferredname - user's preferred name\n
+/// \b middlename - user's middle name\n
+/// \b lastname - user's last name\n
+/// \b email - user's preferred email address\n
+/// \b IMtype - user's preferred IM protocol\n
+/// \b IMid - user's IM id\n
+/// \b adminlevel - user's admin level (= 'none' if no admin access)\n
+/// \b adminlevelid - id of adminlevel\n
+/// \b width - rdp file width\n
+/// \b height - rdp file height\n
+/// \b bpp - rdp file bpp\n
+/// \b audiomode - rdp file audio mode\n
+/// \b mapdrives - rdp file drive mapping\n
+/// \b mapprinters - rdp file printer mapping\n
+/// \b mapserial - rdp file serial port mapping\n
+/// \b showallgroups - show all user groups or not\n
+/// \b lastupdated - datetime the information was last updated
+///
+/// \brief updates user's info in the user table; adds user if not already in
+/// table
+///
+////////////////////////////////////////////////////////////////////////////////
+function updateITECSUser($userid) {
+ global $ENABLE_ITECSAUTH;
+ if(! $ENABLE_ITECSAUTH)
+ return NULL;
+ $query = "SELECT id AS uid, "
+ . "first, "
+ . "middle, "
+ . "last, "
+ . "email, "
+ . "created "
+ . "FROM user "
+ . "WHERE email = '$userid'";
+ $qh = doQuery($query, 101, "accounts");
+ if(! ($userData = mysql_fetch_assoc($qh)))
+ return NULL;
+
+ $now = unixToDatetime(time());
+
+ // select desired data from db
+ $query = "SELECT c.name AS curriculum, "
+ . "i.name AS IMtype, "
+ . "u.IMid AS IMid, "
+ . "u.affiliationid, "
+ . "af.name AS affiliation, "
+ . "a.name AS adminlevel, "
+ . "a.id AS adminlevelid, "
+ . "u.preferredname AS preferredname, "
+ . "u.uid AS uid, "
+ . "u.id AS id, "
+ . "u.width AS width, "
+ . "u.height AS height, "
+ . "u.bpp AS bpp, "
+ . "u.audiomode AS audiomode, "
+ . "u.mapdrives AS mapdrives, "
+ . "u.mapprinters AS mapprinters, "
+ . "u.mapserial AS mapserial, "
+ . "u.showallgroups "
+ . "FROM user u, "
+ . "curriculum c, "
+ . "IMtype i, "
+ . "affiliation af, "
+ . "adminlevel a "
+ . "WHERE u.curriculumid = c.id AND "
+ . "u.IMtypeid = i.id AND "
+ . "u.adminlevelid = a.id AND "
+ . "u.affiliationid = af.id AND "
+ . "u.uid = " . $userData["uid"];
+ $qh = doQuery($query, 255);
+ // if get a row
+ // update db
+ // update results from select
+ if($user = mysql_fetch_assoc($qh)) {
+ $user["unityid"] = $userid;
+ $user["firstname"] = $userData['first'];
+ $user["middlename"] = $userData['middle'];
+ $user["lastname"] = $userData["last"];
+ $user["email"] = $userData["email"];
+ $user["lastupdated"] = $now;
+ $query = "UPDATE user "
+ . "SET unityid = '$userid', "
+ . "firstname = '{$userData['first']}', "
+ . "middlename = '{$userData['middle']}', "
+ . "lastname = '{$userData['last']}', "
+ . "email = '{$userData['email']}', "
+ . "lastupdated = '$now' "
+ . "WHERE uid = " . $userData["uid"];
+ doQuery($query, 256, 'vcl', 1);
+ }
+ else {
+ // call addITECSUser
+ $id = addITECSUser($userid);
+ $query = "SELECT u.unityid AS unityid, "
+ . "u.affiliationid, "
+ . "af.name AS affiliation, "
+ . "c.name AS curriculum, "
+ . "u.firstname AS firstname, "
+ . "u.middlename AS middlename, "
+ . "u.lastname AS lastname, "
+ . "u.preferredname AS preferredname, "
+ . "u.email AS email, "
+ . "i.name AS IMtype, "
+ . "u.IMid AS IMid, "
+ . "u.uid AS uid, "
+ . "u.id AS id, "
+ . "a.name AS adminlevel, "
+ . "a.id AS adminlevelid, "
+ . "u.width AS width, "
+ . "u.height AS height, "
+ . "u.bpp AS bpp, "
+ . "u.audiomode AS audiomode, "
+ . "u.mapdrives AS mapdrives, "
+ . "u.mapprinters AS mapprinters, "
+ . "u.mapserial AS mapserial, "
+ . "u.showallgroups, "
+ . "u.lastupdated AS lastupdated "
+ . "FROM user u, "
+ . "curriculum c, "
+ . "IMtype i, "
+ . "affiliation af, "
+ . "adminlevel a "
+ . "WHERE u.curriculumid = c.id AND "
+ . "u.IMtypeid = i.id AND "
+ . "u.adminlevelid = a.id AND "
+ . "u.affiliationid = af.id AND "
+ . "u.id = $id";
+ $qh = doQuery($query, 101);
+ $user = mysql_fetch_assoc($qh);
+
+ # add account to demo group
+ $demoid = getUserGroupID('demo', getAffiliationID('ITECS'));
+ updateGroups(array($demoid), $user['id']);
+ }
+
+ $user["groups"] = getUsersGroups($user["id"], 1);
+
+ checkExpiredDemoUser($user['id'], $user['groups']);
+
+ $user["privileges"] = getOverallUserPrivs($user["id"]);
+ $tmparr = explode('@', $user['unityid']);
+ $user['login'] = $tmparr[0];
+ return $user;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn testITECSAffiliation(&$login, &$affilid)
+///
+/// \param $login - (pass by ref) a login id with affiliation
+/// \param $affilid - (pass by ref) gets overwritten
+///
+/// \return - 1 if successfully found affiliation id, 0 if failed
+///
+/// \brief changes $login to be without affiliation and sticks the associated
+/// affiliation id for ITECS in $affilid
+///
+////////////////////////////////////////////////////////////////////////////////
+function testITECSAffiliation(&$login, &$affilid) {
+ if(preg_match('/^([^@]*@[^@]*\.[^@]*)@ITECS$/', $login, $matches) ||
+ preg_match('/^([^@]*@[^@]*\.[^@]*)$/', $login, $matches)) {
+ $login = $matches[1];
+ $affilid = getAffiliationID('ITECS');
+ return 1;
+ }
+ return 0;
+}
+
+array_push($findAffilFuncs, "testITECSAffiliation");
+?>
diff --git a/web/.ht-inc/authmethods/ldapauth.php b/web/.ht-inc/authmethods/ldapauth.php
new file mode 100644
index 0000000..d7bf1f0
--- /dev/null
+++ b/web/.ht-inc/authmethods/ldapauth.php
@@ -0,0 +1,487 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+/**
+ * \file
+ */
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn addLDAPUser($authtype, $userid)
+///
+/// \param $authtype - index from the $authMechs array
+/// \param $userid - a userid without the affiliation part
+///
+/// \return id from the user table or NULL on failure
+///
+/// \brief looks up $userid in LDAP according to info in $authMechs array, adds
+/// the user to the user table, and returns the new id from the table
+///
+////////////////////////////////////////////////////////////////////////////////
+function addLDAPUser($authtype, $userid) {
+ global $authMechs, $mysql_link_vcl;
+ $data = getLDAPUserData($authtype, $userid);
+ if(is_null($data))
+ return NULL;
+
+ $loweruserid = strtolower($userid);
+
+ # check for existance of an expired user if a numericid exists
+ if(array_key_exists('numericid', $data)) {
+ $query = "SELECT id, "
+ . "unityid, "
+ . "affiliationid "
+ . "FROM user "
+ . "WHERE lastupdated < DATE_SUB(NOW(), INTERVAL 1 YEAR) AND "
+ . "uid = {$data['numericid']} AND "
+ . "unityid != '$loweruserid'";
+ #. "affiliationid = {$authMechs[$authtype]['affiliationid']}";
+ $qh = doQuery($query, 101);
+ if($row = mysql_fetch_assoc($qh)) {
+ # find the authtype for this user
+ foreach($authMechs as $index => $auth) {
+ if($auth['affiliationid'] == $row['affiliationid'] &&
+ $auth['type'] == 'ldap') {
+ $checktype = $index;
+ break;
+ }
+ }
+ # see if user is still in ldap
+ if(! empty($checktype)) {
+ $testdata = getLDAPUserData($checktype, $row['unityid']);
+ if(! is_null($testdata))
+ abort(52);
+ # if not, null the uid for the user
+ $query = "UPDATE user SET uid = NULL WHERE id = {$row['id']}";
+ doQuery($query, 101);
+ }
+ }
+ }
+
+ $query = "INSERT INTO user (";
+ if(array_key_exists('numericid', $data))
+ $query .= "uid, ";
+ $query .= "unityid, "
+ . "affiliationid, "
+ . "firstname, ";
+ if(array_key_exists('middle', $data))
+ $query .= "middlename, ";
+ $query .= "lastname, "
+ . "email, "
+ . "emailnotices, "
+ . "lastupdated) "
+ . "VALUES (";
+ if(array_key_exists('numericid', $data))
+ $query .= "{$data['numericid']}, ";
+ $query .= "'$loweruserid', "
+ . "{$authMechs[$authtype]['affiliationid']}, "
+ . "'{$data['first']}', ";
+ if(array_key_exists('middle', $data))
+ $query .= "'{$data['middle']}', ";
+ $query .= "'{$data['last']}', "
+ . "'{$data['email']}', "
+ . "'{$data['emailnotices']}', "
+ . "NOW())";
+ doQuery($query, 101, 'vcl', 1);
+ if(mysql_affected_rows($mysql_link_vcl)) {
+ $qh = doQuery("SELECT LAST_INSERT_ID() FROM user", 101);
+ if(! $row = mysql_fetch_row($qh)) {
+ abort(101);
+ }
+ return $row[0];
+ }
+ return NULL;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn validateLDAPUser($type, $loginid)
+///
+/// \param $type - an array from the $authMechs table
+/// \param $loginid - a userid without the affiliation part
+///
+/// \return 1 if user was found in ldap, 0 if not
+///
+/// \brief checks to see if a user is in ldap
+///
+////////////////////////////////////////////////////////////////////////////////
+function validateLDAPUser($type, $loginid) {
+ global $authMechs;
+ $auth = $authMechs[$type];
+ $ds = ldap_connect("ldaps://{$auth['server']}/");
+ if(! $ds)
+ return -1;
+ ldap_set_option($ds, LDAP_OPT_PROTOCOL_VERSION, 3);
+ ldap_set_option($ds, LDAP_OPT_REFERRALS, 0);
+
+ if(array_key_exists('masterlogin', $auth) && strlen($auth['masterlogin']))
+ $res = ldap_bind($ds, $auth['masterlogin'], $auth['masterpwd']);
+ else
+ $res = ldap_bind($ds);
+
+ if(! $res)
+ return -1;
+
+ $return = array($auth['email']);
+
+ $search = ldap_search($ds,
+ $auth['binddn'],
+ "{$auth['unityid']}=$loginid",
+ $return, 0, 3, 15);
+ if(! $search)
+ return -1;
+
+ $data = ldap_get_entries($ds, $search);
+ if($data['count'])
+ return 1;
+
+ return 0;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn updateLDAPUser($authtype, $userid)
+///
+/// \param $authtype - an array from the $authMechs table
+/// \param $userid - a userid without the affiliation part
+///
+/// \return an array of user information or NULL on error
+///
+/// \brief pulls the user's information from ldap, updates it in the db, and
+/// returns an array of the information
+///
+////////////////////////////////////////////////////////////////////////////////
+function updateLDAPUser($authtype, $userid) {
+ global $authMechs;
+ $userData = getLDAPUserData($authtype, $userid);
+ if(is_null($userData))
+ return NULL;
+ if(! array_key_exists('middle', $userData))
+ $userData['middle'] = '';
+ $affilid = $authMechs[$authtype]['affiliationid'];
+ $now = unixToDatetime(time());
+
+ // select desired data from db
+ $query = "SELECT c.name AS curriculum, "
+ . "i.name AS IMtype, "
+ . "u.IMid AS IMid, "
+ . "u.affiliationid, "
+ . "af.name AS affiliation, "
+ . "a.name AS adminlevel, "
+ . "a.id AS adminlevelid, "
+ . "u.preferredname AS preferredname, "
+ . "u.uid AS uid, "
+ . "u.id AS id, "
+ . "u.width AS width, "
+ . "u.height AS height, "
+ . "u.bpp AS bpp, "
+ . "u.audiomode AS audiomode, "
+ . "u.mapdrives AS mapdrives, "
+ . "u.mapprinters AS mapprinters, "
+ . "u.mapserial AS mapserial, "
+ . "u.showallgroups "
+ . "FROM user u, "
+ . "curriculum c, "
+ . "IMtype i, "
+ . "adminlevel a, "
+ . "affiliation af "
+ . "WHERE u.curriculumid = c.id AND "
+ . "u.IMtypeid = i.id AND "
+ . "u.adminlevelid = a.id AND "
+ . "af.id = $affilid AND ";
+ if(array_key_exists('numericid', $userData))
+ $query .= "u.uid = " . $userData["numericid"];
+ else {
+ $query .= "u.unityid = '$userid' AND "
+ . "u.affiliationid = $affilid";
+ }
+ $qh = doQuery($query, 255);
+ // if get a row
+ // update db
+ // update results from select
+ if($user = mysql_fetch_assoc($qh)) {
+ $user["unityid"] = $userid;
+ $user["firstname"] = $userData['first'];
+ $user["middlename"] = $userData['middle'];
+ $user["lastname"] = $userData["last"];
+ $user["email"] = $userData["email"];
+ $user["lastupdated"] = $now;
+ $query = "UPDATE user "
+ . "SET unityid = '$userid', "
+ . "firstname = '{$userData['first']}', "
+ . "middlename = '{$userData['middle']}', "
+ . "lastname = '{$userData['last']}', "
+ . "email = '{$userData['email']}', "
+ . "lastupdated = '$now' ";
+ if(array_key_exists('numericid', $userData))
+ $query .= "WHERE uid = " . $userData["numericid"];
+ else
+ $query .= "WHERE unityid = '$userid' AND "
+ . "affiliationid = $affilid";
+ doQuery($query, 256, 'vcl', 1);
+ }
+ else {
+ // call addLDAPUser
+ $id = addLDAPUser($authtype, $userid);
+ $query = "SELECT u.unityid AS unityid, "
+ . "u.affiliationid, "
+ . "af.name AS affiliation, "
+ . "c.name AS curriculum, "
+ . "u.firstname AS firstname, "
+ . "u.middlename AS middlename, "
+ . "u.lastname AS lastname, "
+ . "u.preferredname AS preferredname, "
+ . "u.email AS email, "
+ . "i.name AS IMtype, "
+ . "u.IMid AS IMid, "
+ . "u.uid AS uid, "
+ . "u.id AS id, "
+ . "a.name AS adminlevel, "
+ . "a.id AS adminlevelid, "
+ . "u.width AS width, "
+ . "u.height AS height, "
+ . "u.bpp AS bpp, "
+ . "u.audiomode AS audiomode, "
+ . "u.mapdrives AS mapdrives, "
+ . "u.mapprinters AS mapprinters, "
+ . "u.mapserial AS mapserial, "
+ . "u.showallgroups, "
+ . "u.lastupdated AS lastupdated "
+ . "FROM user u, "
+ . "curriculum c, "
+ . "IMtype i, "
+ . "affiliation af, "
+ . "adminlevel a "
+ . "WHERE u.curriculumid = c.id AND "
+ . "u.IMtypeid = i.id AND "
+ . "u.adminlevelid = a.id AND "
+ . "u.affiliationid = af.id AND "
+ . "u.id = $id";
+ $qh = doQuery($query, 101);
+ if(! $user = mysql_fetch_assoc($qh))
+ return NULL;
+ }
+
+ // TODO handle generic updating of groups
+ switch(getAffiliationName($affilid)) {
+ case 'EXAMPLE1':
+ updateEXAMPLE1Groups($user);
+ break;
+ case 'EXAMPLE2':
+ updateEXAMPLE2Groups($user);
+ break;
+ default:
+ //TODO possibly add to a default group
+ }
+ $user["groups"] = getUsersGroups($user["id"], 1);
+ $user["privileges"] = getOverallUserPrivs($user["id"]);
+ $user['login'] = $user['unityid'];
+ return $user;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getLDAPUserData($authtype, $userid)
+///
+/// \param $authtype - an array from the $authMechs table
+/// \param $userid - a userid without the affiliation part
+///
+/// \return an array of user information
+///
+/// \brief gets user information from ldap
+///
+////////////////////////////////////////////////////////////////////////////////
+function getLDAPUserData($authtype, $userid) {
+ global $authMechs, $mysql_link_vcl;
+ $auth = $authMechs[$authtype];
+ $domiddle = 0;
+ $donumericid = 0;
+ if(array_key_exists('middlename', $auth))
+ $domiddle = 1;
+ if(array_key_exists('numericid', $auth))
+ $donumericid = 1;
+
+ $ds = ldap_connect("ldaps://{$auth['server']}/");
+ // FIXME
+ ldap_set_option($ds, LDAP_OPT_PROTOCOL_VERSION, 3);
+ ldap_set_option($ds, LDAP_OPT_REFERRALS, 0);
+
+ if(array_key_exists('masterlogin', $auth) && strlen($auth['masterlogin']))
+ $res = ldap_bind($ds, $auth['masterlogin'], $auth['masterpwd']);
+ else
+ $res = ldap_bind($ds);
+
+ // FIXME
+
+ $ldapsearch = array($auth['firstname'],
+ $auth['lastname'],
+ $auth['email']);
+ if($domiddle)
+ array_push($ldapsearch, $auth['middlename']);
+ if($donumericid)
+ array_push($ldapsearch, $auth['numericid']);
+ # FIXME hack
+ array_push($ldapsearch, 'gecos');
+
+ $search = ldap_search($ds,
+ $auth['binddn'],
+ "{$auth['unityid']}=$userid",
+ $ldapsearch, 0, 3, 15);
+ $return = array();
+ if($search) {
+ $tmpdata = ldap_get_entries($ds, $search);
+ if(! $tmpdata['count'])
+ return NULL;
+ $data = array();
+ for($i = 0; $i < $tmpdata['count']; $i++) {
+ for($j = 0; $j < $tmpdata[$i]['count']; $j++) {
+ if(is_array($tmpdata[$i][$tmpdata[$i][$j]]))
+ $data[strtolower($tmpdata[$i][$j])] = $tmpdata[$i][$tmpdata[$i][$j]][0];
+ else
+ $data[strtolower($tmpdata[$i][$j])] = $tmpdata[$i][$tmpdata[$i][$j]];
+ }
+ }
+ // FIXME hack to take care of users that don't have full info in ldap
+ if(! array_key_exists($auth['firstname'], $data) &&
+ ! array_key_exists(strtolower($auth['firstname']), $data)) {
+ if(array_key_exists('gecos', $data)) {
+ $tmpArr = explode(' ', $data['gecos']);
+ if(count($tmpArr) == 3) {
+ $data[strtolower($auth['firstname'])] = $tmpArr[0];
+ $data[strtolower($auth['middlename'])] = $tmpArr[1];
+ $data[strtolower($auth['lastname'])] = $tmpArr[2];
+ }
+ elseif(count($tmpArr) == 2) {
+ $data[strtolower($auth['firstname'])] = $tmpArr[0];
+ $data[strtolower($auth['middlename'])] = '';
+ $data[strtolower($auth['lastname'])] = $tmpArr[1];
+ }
+ elseif(count($tmpArr) == 1) {
+ $data[strtolower($auth['firstname'])] = '';
+ $data[strtolower($auth['middlename'])] = '';
+ $data[strtolower($auth['lastname'])] = $tmpArr[0];
+ }
+ }
+ else {
+ $data[strtolower($auth['firstname'])] = '';
+ if($domiddle)
+ $data[strtolower($auth['middlename'])] = '';
+ $data[strtolower($auth['lastname'])] = '';
+ }
+ }
+ if(! array_key_exists($auth['email'], $data)) {
+ $data[strtolower($auth['email'])] = $userid . $auth['defaultemail'];
+ }
+
+ $return['first'] = ereg_replace("'", "\'", $data[strtolower($auth['firstname'])]);
+ $return['last'] = ereg_replace("'", "\'", $data[strtolower($auth['lastname'])]);
+ if($domiddle && array_key_exists(strtolower($auth['middlename']), $data))
+ $return['middle'] = ereg_replace("'", "\'", $data[strtolower($auth['middlename'])]);
+ if($donumericid)
+ $return['numericid'] = $data[strtolower($auth['numericid'])];
+ $return['email'] = $data[strtolower($auth['email'])];
+ $return['emailnotices'] = 1;
+
+ return $return;
+ }
+ return NULL;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn updateEXAMPLE1Groups($user)
+///
+/// \param $user - an array of user data
+///
+/// \brief builds an array of nisNetgroups user is a member of and calls
+/// updateGroups
+///
+////////////////////////////////////////////////////////////////////////////////
+function updateEXAMPLE1Groups($user) {
+ $count = 0;
+ do {
+ if($count > 2)
+ abort(35);
+ if($count > 0)
+ sleep(1);
+ ldapUIDLookup($user['unityid'], $userData);
+ $count++;
+ } while(! array_key_exists("info", $userData) ||
+ ! array_key_exists("account", $userData["info"]) ||
+ ! array_key_exists("memberNisNetgroup", $userData["info"]["account"]));
+ $newusergroups = array();
+ if(! array_key_exists('info', $userData) ||
+ ! array_key_exists('account', $userData['info']) ||
+ ! array_key_exists('memberNisNetgroup', $userData['info']['account']))
+ return;
+ foreach($userData["info"]["account"]["memberNisNetgroup"] as $item) {
+ $tmpArr = explode(',', $item);
+ $tmpArr = explode('=', $tmpArr[0]);
+ if(! array_key_exists(1, $tmpArr)) {
+ continue;
+ }
+ $grp = mysql_escape_string($tmpArr[1]);
+ array_push($newusergroups, getUserGroupID($grp, $user['affiliationid']));
+ }
+ $newusergroups = array_unique($newusergroups);
+ updateGroups($newusergroups, $user["id"]);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn updateEXAMPLE2Groups($user)
+///
+/// \param $user - an array of user data
+///
+/// \brief builds an array of memberof groups user is a member of and calls
+/// updateGroups
+///
+////////////////////////////////////////////////////////////////////////////////
+function updateEXAMPLE2Groups($user) {
+ global $authMechs;
+ $auth = $authMechs['EXAMPLE2 LDAP'];
+ $ds = ldap_connect("ldaps://{$auth['server']}/");
+ if(! $ds)
+ return 0;
+ ldap_set_option($ds, LDAP_OPT_PROTOCOL_VERSION, 3);
+
+ $res = ldap_bind($ds, $auth['masterlogin'],
+ $auth['masterpwd']);
+ if(! $res)
+ return 0;
+
+ $search = ldap_search($ds,
+ $auth['binddn'],
+ "{$auth['unityid']}={$user['unityid']}",
+ array('memberof'), 0, 10, 15);
+ if(! $search)
+ return 0;
+
+ $data = ldap_get_entries($ds, $search);
+ $newusergroups = array();
+ if(! array_key_exists('memberof', $data[0]))
+ return;
+ for($i = 0; $i < $data[0]['memberof']['count']; $i++) {
+ if(preg_match('/^CN=(.+),OU=CourseRolls,DC=example2,DC=com/', $data[0]['memberof'][$i], $match) ||
+ preg_match('/^CN=(Students_Enrolled),OU=Students,DC=example2,DC=com$/', $data[0]['memberof'][$i], $match) ||
+ preg_match('/^CN=(Staff),OU=IT,DC=example2,DC=com$/', $data[0]['memberof'][$i], $match))
+ array_push($newusergroups, getUserGroupID($match[1], $user['affiliationid']));
+ }
+ $newusergroups = array_unique($newusergroups);
+ updateGroups($newusergroups, $user["id"]);
+}
diff --git a/web/.ht-inc/computers.php b/web/.ht-inc/computers.php
new file mode 100644
index 0000000..f6624ea
--- /dev/null
+++ b/web/.ht-inc/computers.php
@@ -0,0 +1,3791 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+/**
+ * \file
+ */
+
+/// signifies an error with the submitted IP address (or start IP address)
+define("IPADDRERR", 1);
+/// signifies an error with the submitted RAM
+define("RAMERR", 1 << 1);
+/// signifies an error with the submitted processor speed
+define("PROCSPEEDERR", 1 << 2);
+/// signifies an error with the submitted hostname
+define("HOSTNAMEERR", 1 << 3);
+/// signifies an error with the submitted end IP address
+define("IPADDRERR2", 1 << 4);
+/// signifies an error with the submitted start host value
+define("STARTHOSTVALERR", 1 << 5);
+/// signifies an error with the submitted end host value
+define("ENDHOSTVALERR", 1 << 6);
+/// signifies an error with the submitted owner
+define("OWNERERR", 1 << 7);
+/// signifies an error with the submitted start private IP address
+define("IPADDRERR3", 1 << 8);
+/// signifies an error with the submitted end private IP address
+define("IPADDRERR4", 1 << 9);
+/// signifies an error with the submitted start mac address
+define("MACADDRERR", 1 << 10);
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn selectComputers()
+///
+/// \brief prints a form to select which computers to view
+///
+////////////////////////////////////////////////////////////////////////////////
+function selectComputers() {
+ global $viewmode, $user;
+ $test = getComputers();
+ if(empty($test)) {
+ addComputerPrompt();
+ return;
+ }
+
+ $data = getUserComputerMetaData();
+
+ # get a list of computer groups user can manage
+ $tmp = getUserResources(array("computerAdmin"), array("manageGroup"), 1);
+ $computergroups = $tmp["computer"];
+ if((empty($data["platforms"]) || empty($data["schedules"])) &&
+ empty($computergroups)) {
+ print "<H2>Computers</H2>\n";
+ print "You do not have access to manage any computers.<br>\n";
+ return;
+ }
+
+ $platform_cnt = count($data["platforms"]);
+ $schedule_cnt = count($data["schedules"]);
+
+ # get a count of schedules user can manage
+ $tmp = getUserResources(array("scheduleAdmin"), array("manageGroup"));
+ $scheduleAdminCnt = count($tmp['schedule']);
+
+ # get a list of computers user can manage
+ $tmp = getUserResources(array("computerAdmin"), array("administer"));
+ $computers = $tmp["computer"];
+
+ print "<H2 align=center>Computers</H2>\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array();
+ if($platform_cnt > 1 || $schedule_cnt > 1) {
+ print "Select the criteria for the computers you want to view:\n";
+
+ print "<div id=\"mainTabContainer\" dojoType=\"dijit.layout.TabContainer\"\n";
+ print " style=\"width:300px;height:275px\">\n";
+ # by platform/schedule
+ print "<div id=\"platsch\" dojoType=\"dijit.layout.ContentPane\" title=\"Platforms/Schedules\">\n";
+ print "<TABLE id=layouttable summary=\"\">\n";
+ print " <TR>\n";
+ if($platform_cnt > 1)
+ print " <TH>Platforms:</TH>\n";
+ if($schedule_cnt > 1)
+ print " <TH>Schedules:</TH>\n";
+ print " </TR>\n";
+ print " <TR valign=top>\n";
+ if($platform_cnt > 1) {
+ print " <TD>\n";
+ printSelectInput("platforms[]", $data["platforms"], -1, 0, 1);
+ print " </TD>\n";
+ }
+ else {
+ $tmp = array_keys($data["platforms"]);
+ $platform_key = $tmp[0];
+ $cdata['platforms'] = array($platform_key);
+ }
+ if($schedule_cnt > 1) {
+ print " <TD>\n";
+ printSelectInput("schedules[]", $data["schedules"], -1, 0, 1, '', 'size=11');
+ print " </TD>\n";
+ }
+ else {
+ $tmp = array_keys($data["schedules"]);
+ $schedule_key = $tmp[0];
+ $cdata['schedules'] = array($schedule_key);
+ }
+ print " </TR>\n";
+ print "</TABLE>\n";
+ print "</div>\n";
+ # by groups
+ $size = count($computergroups);
+ if($size > 13)
+ $size = 13;
+ print "<div id=\"groups\" dojoType=\"dijit.layout.ContentPane\" ";
+ print "title=\"Computer Groups\" align=center selected=\"true\">\n";
+ printSelectInput("groups[]", $computergroups, -1, 0, 1, '', "size=$size");
+ print "</div>\n";
+ print "</div><br>\n";
+
+ }
+ else {
+ $size = count($computergroups);
+ if($size > 1) {
+ if($size > 13)
+ $size = 13;
+ print "Select the computer groups you want to view:<br>\n";
+ print "<small>(do not select any to view all computers to which you have access)</small><br>\n";
+ printSelectInput("groups[]", $computergroups, -1, 0, 1, '', "size=$size");
+ print "<br><br>\n";
+ }
+ $tmp = array_keys($data["platforms"]);
+ $platform_key = $tmp[0];
+ $cdata['platforms'] = array($platform_key);
+ $tmp = array_keys($data["schedules"]);
+ $schedule_key = $tmp[0];
+ $cdata['schedules'] = array($schedule_key);
+ }
+ if(count($computergroups)) {
+ $cont = addContinuationsEntry('viewComputerGroups', $cdata);
+ print "<INPUT type=radio id=editcomp name=continuation value=\"$cont\">\n";
+ print "<label for=editcomp>Edit Computer Grouping</label><br><br>\n";
+ }
+ if(count($computers)) {
+ $cont = addContinuationsEntry('computerUtilities', $cdata);
+ print "<INPUT type=radio id=computil name=continuation value=\"$cont\" checked>\n";
+ print "<label for=computil>Computer Utilities</label><br><br>\n";
+ }
+ if($scheduleAdminCnt) {
+ $cont = addContinuationsEntry('viewComputers', $cdata);
+ print "<INPUT type=radio id=viewcomp name=continuation value=\"$cont\">";
+ print "<label for=viewcomp>Edit Computer Information:</label>\n";
+ print "<TABLE>\n";
+ print " <TR nowrap>\n";
+ print " <TD rowspan=9><img src=\"images/blank.gif\" width=20></TD>\n";
+ print " <TD><INPUT type=checkbox id=showhostname name=showhostname ";
+ print "value=1 checked><label for=showhostname>Hostname</label></TD>\n";
+ print " <TD><INPUT type=checkbox id=shownextimage name=";
+ print "shownextimage value=1><label for=shownextimage>";
+ print "Next Image</TD>\n";
+ print " </TR>\n";
+ print " <TR nowrap>\n";
+ print " <TD><INPUT type=checkbox id=showipaddress name=showipaddress ";
+ print "value=1 checked><label for=showipaddress>IP Address</label></TD>\n";
+ print " <TD><INPUT type=checkbox id=showram name=showram value=1>";
+ print "<label for=showram>RAM</label></TD>\n";
+ print " </TR>\n";
+ print " <TR nowrap>\n";
+ print " <TD><INPUT type=checkbox id=showstate name=showstate value=1 ";
+ print "checked><label for=showstate>State</label></TD>\n";
+ print " <TD><INPUT type=checkbox id=showprocnumber name=showprocnumber ";
+ print "value=1><label for=showprocnumber>No. Processors</label></TD>\n";
+ print " </TR>\n";
+ print " <TR nowrap>\n";
+ print " <TD><INPUT type=checkbox id=showcurrentimage name=";
+ print "showcurrentimage value=1 checked><label for=showcurrentimage>";
+ print "Current Image</label></TD>\n";
+ print " <TD><INPUT type=checkbox id=showprocspeed name=showprocspeed ";
+ print "value=1><label for=showprocspeed>Processor Speed</label></TD>\n";
+ print " </TR>\n";
+ print " <TR nowrap>\n";
+ print " <TD><INPUT type=checkbox id=showowner name=showowner value=1>";
+ print "<label for=showowner>Owner</label></TD>\n";
+ print " <TD><INPUT type=checkbox id=shownetwork name=shownetwork ";
+ print "value=1><label for=shownetwork>Network Speed</label></TD>\n";
+ print " </TR>\n";
+ print " <TR nowrap>\n";
+ print " <TD><INPUT type=checkbox id=showplatform name=showplatform ";
+ print "value=1 checked><label for=showplatform>Platform</label></TD>\n";
+ print " <TD><INPUT type=checkbox id=showcomputerid name=showcomputerid ";
+ print "value=1><label for=showcomputerid>Computer ID</label></TD>\n";
+ print " </TR>\n";
+ print " <TR nowrap>\n";
+ print " <TD><INPUT type=checkbox id=showschedule name=showschedule ";
+ print "value=1 checked><label for=showschedule>Schedule</label></TD>\n";
+ print " <TD><INPUT type=checkbox id=showtype name=showtype value=1>";
+ print "<label for=showtype>Type</label></TD>\n";
+ print " </TR>\n";
+ print " <TR nowrap>\n";
+ print " <TD><INPUT type=checkbox id=shownotes name=shownotes value=1>";
+ print "<label for=shownotes>Notes</label></TD>\n";
+ print " <TD><INPUT type=checkbox id=showcounts name=showcounts value=1>";
+ print "<label for=showcounts>No. Reservations</label></TD>\n";
+ print " </TR>\n";
+ print " <TR nowrap>\n";
+ print " <TD><INPUT type=checkbox id=showprovisioning ";
+ print "name=showprovisioning value=1>";
+ print "<label for=showprovisioning>Provisioning Engine</label></TD>\n";
+ print " <TD></TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ }
+ print "<INPUT type=submit value=Submit>\n";
+ print "</FORM>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn viewComputers($showall)
+///
+/// \param $showall - (optional) show all computer columns reguardless of what
+/// was checked
+///
+/// \brief prints out information about the computers in the db
+///
+////////////////////////////////////////////////////////////////////////////////
+function viewComputers($showall=0) {
+ global $user, $mode;
+ $data = processComputerInput();
+ if(empty($data['groups']))
+ $bygroups = 0;
+ else {
+ $bygroups = 1;
+ $compidlist = getCompIdList($data['groups']);
+ }
+
+ if($data["showdeleted"]) {
+ $computers = getComputers(1, 1);
+ $resources = getUserResources(array("computerAdmin"),
+ array("administer"), 0, 1);
+ }
+ else {
+ $computers = getComputers(1);
+ $resources = getUserResources(array("computerAdmin"), array("administer"));
+ }
+ if($data["showcounts"])
+ getComputerCounts($computers);
+ $userCompIDs = array_keys($resources["computer"]);
+ $states = array("2" => "available",
+ "10" => "maintenance");
+ $platforms = getPlatforms();
+ $tmp = getUserResources(array("scheduleAdmin"), array("manageGroup"));
+ $schedules = $tmp["schedule"];
+ $allschedules = getSchedules();
+ $images = getImages(1);
+ $provisioning = getProvisioning();
+
+ if($mode == "viewComputers")
+ print "<H2>Computers</H2>\n";
+ elseif($mode == "submitEditComputer" || $mode == "computerAddedMaintenceNote") {
+ print "<H2>Edit Computer</H2>\n";
+ print "<font color=\"#008000\">computer successfully updated</font>\n";
+ }
+ elseif($mode == "submitDeleteComputer") {
+ print "<H2>Delete Computer</H2>\n";
+ $deleted = getContinuationVar("deleted");
+ if($deleted) {
+ print "<font color=\"#008000\">computer successfully restored to the normal ";
+ print "state</font>\n";
+ }
+ else {
+ print "<font color=\"#008000\">computer successfully set to the deleted ";
+ print "state</font>\n";
+ }
+ }
+ elseif($mode == "submitAddComputer") {
+ print "<H2>Add Computer</H2>\n";
+ print "<font color=\"#008000\">computer successfully added</font>\n";
+ }
+ if(! count($schedules)) {
+ print "You don't have access to manage any schedules. You must be able ";
+ print "to manage at least one schedule before you can manage computers.";
+ print "<br>\n";
+ return;
+ }
+ print "<TABLE border=1 id=layouttable>\n";
+ print " <TR>\n";
+ print " <TD></TD>\n";
+ print " <TD></TD>\n";
+ if($data["showhostname"] || $showall)
+ print " <TH>Hostname</TH>\n";
+ if($data["showipaddress"] || $showall)
+ print " <TH>IP Address</TH>\n";
+ if($data["showstate"] || $showall)
+ print " <TH>State</TH>\n";
+ if($data["showowner"] || $showall)
+ print " <TH>Owner</TH>\n";
+ if($data["showplatform"] || $showall)
+ print " <TH>Platform</TH>\n";
+ if($data["showschedule"] || $showall)
+ print " <TH>Schedule</TH>\n";
+ if($data["showcurrentimage"] || $showall)
+ print " <TH>Current Image</TH>\n";
+ if($data["shownextimage"] || $showall)
+ print " <TH>Next Image</TH>\n";
+ if($data["showram"] || $showall)
+ print " <TH>RAM(MB)</TH>\n";
+ if($data["showprocnumber"] || $showall)
+ print " <TH>No. Processors</TH>\n";
+ if($data["showprocspeed"] || $showall)
+ print " <TH>Processor Speed(MHz)</TH>\n";
+ if($data["shownetwork"] || $showall)
+ print " <TH>Network Speed(Mbps)</TH>\n";
+ if($data["showcomputerid"] || $showall)
+ print " <TH>Computer ID</TH>\n";
+ if($data["showtype"] || $showall)
+ print " <TH>Type</TH>\n";
+ if($data["showprovisioning"] || $showall)
+ print " <TH>Provisioning Engine</TH>\n";
+ if($data["showdeleted"])
+ print " <TH>Deleted</TH>\n";
+ if($data["shownotes"] || $showall)
+ print " <TH>Notes</TH>\n";
+ if($data["showcounts"] || $showall)
+ print " <TH>No. of Reservations</TH>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <TD align=center>Add Multiple?";
+ print "<INPUT type=checkbox name=bulk value=1></TD>\n";
+ print " <TD>\n";
+ print " <INPUT type=submit value=Add>\n";
+ print " </TD>\n";
+ if($data["showhostname"] || $showall)
+ print " <TD><INPUT type=text name=hostname maxlength=36></TD>\n";
+ if($data["showipaddress"] || $showall) {
+ print " <TD><INPUT type=text name=ipaddress size=14 maxlength=14>";
+ print "</TD>\n";
+ }
+ if($data["showstate"] || $showall) {
+ print " <TD>\n";
+ printSelectInput("stateid", $states, 2);
+ print " </TD>\n";
+ }
+ if($data["showowner"] || $showall) {
+ print " <TD><INPUT type=text name=owner size=15 value=\"";
+ print "{$user["unityid"]}@{$user['affiliation']}\"></TD>\n";
+ }
+ if($data["showplatform"] || $showall) {
+ print " <TD>\n";
+ printSelectInput("platformid", $platforms);
+ print " </TD>\n";
+ }
+ if($data["showschedule"] || $showall) {
+ print " <TD>\n";
+ printSelectInput("scheduleid", $schedules);
+ print " </TD>\n";
+ }
+ if($data["showcurrentimage"] || $showall)
+ print " <TD><img src=\"images/blank.gif\" width=190 height=1></TD>\n";
+ if($data["shownextimage"] || $showall)
+ print " <TD></TD>\n";
+ if($data["showram"] || $showall)
+ print " <TD><INPUT type=text name=ram size=5 maxlength=5></TD>\n";
+ if($data["showprocnumber"] || $showall) {
+ print " <TD>\n";
+ printSelectInput("numprocs",
+ array("1" => "1", "2" => "2", "4" => "4", "8" => "8"));
+ print " </TD>\n";
+ }
+ if($data["showprocspeed"] || $showall) {
+ print " <TD><INPUT type=text name=procspeed size=5 maxlength=5>";
+ print "</TD>\n";
+ }
+ if($data["shownetwork"] || $showall) {
+ print " <TD>\n";
+ printSelectInput("network",
+ array("10" => "10", "100" => "100", "1000" => "1000"));
+ print " </TD>\n";
+ }
+ if($data["showcomputerid"] || $showall)
+ print " <TD></TD>\n";
+ if($data["showtype"] || $showall) {
+ print " <TD>\n";
+ printSelectInput("type", array("blade" => "blade", "lab" => "lab"), "lab");
+ print " </TD>\n";
+ }
+ if($data["showprovisioning"] || $showall) {
+ print " <TD>\n";
+ printSelectInput("provisioningid", $provisioning);
+ print " </TD>\n";
+ }
+ if($data["showdeleted"])
+ print " <TD align=center>N/A</TD>\n";
+ if($data["shownotes"])
+ print " <TD> </TD>\n";
+ if($data["showcounts"])
+ print " <TD> </TD>\n";
+ $cdata = getComputerSelection($data);
+ $cont = addContinuationsEntry('confirmAddComputer', $cdata);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " </FORM>\n";
+ print " </TR>\n";
+ $count = 0;
+ foreach(array_keys($computers) as $id) {
+ if($bygroups) {
+ if(! array_key_exists($id, $compidlist))
+ continue;
+ }
+ elseif(! in_array($computers[$id]["platformid"], $data["platforms"]) ||
+ ! in_array($computers[$id]["scheduleid"], $data["schedules"]))
+ continue;
+ if(! in_array($id, $userCompIDs)) {
+ continue;
+ }
+ print " <TR align=center>\n";
+ print " <TD align=center>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = $data;
+ $cdata['compid'] = $id;
+ $cont = addContinuationsEntry('confirmDeleteComputer', $cdata);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ if($data["showdeleted"] && $computers[$id]["deleted"])
+ print " <INPUT type=submit value=Undelete>\n";
+ else
+ print " <INPUT type=submit value=Delete>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = $data;
+ $cdata['compid'] = $id;
+ $cont = addContinuationsEntry('editComputer', $cdata);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ if($computers[$id]["deleted"] == 0)
+ print " <INPUT type=submit value=Edit>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ if($data["showhostname"])
+ print " <TD>" . $computers[$id]["hostname"] . "</TD>\n";
+ if($data["showipaddress"])
+ print " <TD>" . $computers[$id]["IPaddress"] . "</TD>\n";
+ if($data["showstate"])
+ print " <TD>" . $computers[$id]["state"] . "</TD>\n";
+ if($data["showowner"])
+ print " <TD>" . $computers[$id]["owner"] . "</TD>\n";
+ if($data["showplatform"]) {
+ print " <TD>" . $platforms[$computers[$id]["platformid"]];
+ print "</TD>\n";
+ }
+ if($data["showschedule"]) {
+ print " <TD>" . $allschedules[$computers[$id]["scheduleid"]]["name"];
+ print "</TD>\n";
+ }
+ if($data["showcurrentimage"]) {
+ print " <TD>" . $images[$computers[$id]["currentimgid"]]["prettyname"];
+ print "</TD>\n";
+ }
+ if($data["shownextimage"]) {
+ if($computers[$id]['nextimgid'])
+ $next = $images[$computers[$id]["nextimgid"]]["prettyname"];
+ else
+ $next = "(selected by system)";
+ print " <TD>$next</TD>\n";
+ }
+ if($data["showram"])
+ print " <TD>" . $computers[$id]["ram"] . "</TD>\n";
+ if($data["showprocnumber"])
+ print " <TD>" . $computers[$id]["procnumber"] . "</TD>\n";
+ if($data["showprocspeed"])
+ print " <TD>" . $computers[$id]["procspeed"] . "</TD>\n";
+ if($data["shownetwork"])
+ print " <TD>" . $computers[$id]["network"] . "</TD>\n";
+ if($data["showcomputerid"])
+ print " <TD>$id</TD>\n";
+ if($data["showtype"])
+ print " <TD>" . $computers[$id]["type"] . "</TD>\n";
+ if($data["showprovisioning"])
+ print " <TD>" . $computers[$id]["provisioning"] . "</TD>\n";
+ if($data["showdeleted"]) {
+ if($computers[$id]["deleted"])
+ print " <TD>yes</TD>\n";
+ else
+ print " <TD>no</TD>\n";
+ }
+ if($data["shownotes"])
+ if(empty($computers[$id]["notes"]))
+ print " <TD> </TD>\n";
+ else {
+ print " <TD>" . str_replace('@', '<br>', $computers[$id]["notes"]);
+ print "</TD>\n";
+ }
+ if($data["showcounts"])
+ print " <TD>{$computers[$id]["counts"]}</TD>\n";
+ print " </TR>\n";
+ $count++;
+ }
+ print "</TABLE>\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = processComputerInput2();
+ if($data["showdeleted"]) {
+ $cdata['showdeleted'] = 0;
+ print "<INPUT type=submit value=\"Hide Deleted Computers\">\n";
+ }
+ else {
+ $cdata['showdeleted'] = 1;
+ print "<INPUT type=submit value=\"Include Deleted Computers\">\n";
+ }
+ $cont = addContinuationsEntry('viewComputers', $cdata);
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "</FORM>\n";
+ print "<br>$count computers found<br>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn addComputerPrompt()
+///
+/// \brief prints a page to add computers when there are none in the db
+///
+////////////////////////////////////////////////////////////////////////////////
+function addComputerPrompt() {
+ print "<h2>Add Computers</h2>\n";
+ print "There are currently no computers in the VCL database. Would you like ";
+ print "to add a single computer or add multiple computers in bulk? To add ";
+ print "them in bulk, they'll need to have contiguous IP addresses and have ";
+ print "hostnames that only differ by a number in the hostname with those ";
+ print "numbers being contiguous.<br><br>\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('nocomps' => 1);
+ $cont = addContinuationsEntry('addComputer', $cdata);
+ print "<INPUT type=radio name=continuation value=\"$cont\">\n";
+ print "<label for=editcomp>Add Single Computer</label><br>\n";
+ $cont = addContinuationsEntry('bulkAddComputer');
+ print "<INPUT type=radio name=continuation value=\"$cont\">\n";
+ print "<label for=editcomp>Add Multiple Computers</label><br><br>\n";
+ print "<INPUT type=submit value=Submit>\n";
+ print "</FORM>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn editOrAddComputer($state)
+///
+/// \param $state - 0 for edit, 1 for add
+///
+/// \brief prints a page to edit a given comptuer
+///
+////////////////////////////////////////////////////////////////////////////////
+function editOrAddComputer($state) {
+ global $submitErr;
+ $data2 = processComputerInput2();
+
+ $computers = getComputers();
+
+ $nocomps = getContinuationVar('nocomps', 0);
+ if($submitErr) {
+ $data = processComputerInput();
+ }
+ elseif($nocomps) {
+ $data["ipaddress"] = '';
+ $data["stateid"] = '';
+ $data["deptid"] = '';
+ $data["owner"] = '';
+ $data["platformid"] = '';
+ $data["scheduleid"] = '';
+ $data["currentimgid"] = '';
+ $data["ram"] = '';
+ $data["numprocs"] = '';
+ $data["procspeed"] = '';
+ $data["network"] = '';
+ $data["hostname"] = '';
+ $data["type"] = '';
+ $data["notes"] = '';
+ $data["computergroup"] = array();
+ $data["provisioningid"] = '';
+ }
+ else {
+ $data["compid"] = getContinuationVar("compid");
+ $id = $data["compid"];
+ $data["ipaddress"] = $computers[$id]["IPaddress"];
+ $data["stateid"] = $computers[$id]["stateid"];
+ $data["deptid"] = $computers[$id]["deptid"];
+ $data["owner"] = $computers[$id]["owner"];
+ $data["platformid"] = $computers[$id]["platformid"];
+ $data["scheduleid"] = $computers[$id]["scheduleid"];
+ $data["currentimgid"] = $computers[$id]["currentimgid"];
+ $data["ram"] = $computers[$id]["ram"];
+ $data["numprocs"] = $computers[$id]["procnumber"];
+ $data["procspeed"] = $computers[$id]["procspeed"];
+ $data["network"] = $computers[$id]["network"];
+ $data["hostname"] = $computers[$id]["hostname"];
+ $data["type"] = $computers[$id]["type"];
+ $data["notes"] = $computers[$id]["notes"];
+ $data["provisioningid"] = $computers[$id]["provisioningid"];
+ }
+
+ $tmpstates = getStates();
+ if($data["stateid"]) {
+ $states = array($data["stateid"] => $tmpstates[$data["stateid"]],
+ 2 => "available",
+ 10 => "maintenance");
+ }
+ else {
+ $states = array(2 => "available",
+ 10 => "maintenance");
+ }
+ $platforms = getPlatforms();
+ $tmp = getUserResources(array("scheduleAdmin"), array("manageGroup"));
+ $schedules = $tmp["schedule"];
+ $allschedules = getSchedules();
+ $images = getImages();
+ $provisioning = getProvisioning();
+
+ if($state) {
+ print "<H2>Add Computer</H2>\n";
+ }
+ else {
+ print "<H2>Edit Computer</H2>\n";
+ }
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TH align=right>Hostname:</TH>\n";
+ print " <TD><INPUT type=text name=hostname maxlength=36 value=";
+ print $data["hostname"] . "></TD>\n";
+ print " <TD>";
+ printSubmitErr(HOSTNAMEERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>IP Address:</TH>\n";
+ print " <TD><INPUT type=text name=ipaddress maxlength=14 value=\"";
+ print $data["ipaddress"] . "\"></TD>\n";
+ print " <TD>";
+ printSubmitErr(IPADDRERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>State:</TH>\n";
+ print " <TD>\n";
+ printSelectInput("stateid", $states, $data["stateid"]);
+ print " </TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Owner:</TH>\n";
+ print " <TD><INPUT type=text name=owner value=\"";
+ print $data["owner"] . "\"></TD>\n";
+ print " <TD>";
+ printSubmitErr(OWNERERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Platform:</TH>\n";
+ print " <TD>\n";
+ printSelectInput("platformid", $platforms, $data["platformid"]);
+ print " </TD>\n";
+ print " </TR>\n";
+ print " <TR colspan=2>\n";
+ print " <TH align=right>Schedule:</TH>\n";
+ print " <TD>\n";
+ if($data["scheduleid"] != "") {
+ if(! array_key_exists($data["scheduleid"], $schedules)) {
+ $schedules[$data["scheduleid"]] =
+ $allschedules[$data["scheduleid"]]["name"];
+ uasort($schedules, "sortKeepIndex");
+ }
+ printSelectInput("scheduleid", $schedules, $data["scheduleid"]);
+ }
+ else
+ printSelectInput("scheduleid", $schedules);
+ print " </TD>\n";
+ print " </TR>\n";
+ if(! $state) {
+ print " <TR>\n";
+ print " <TH align=right>Current Image:</TH>\n";
+ print " <TD>" . $images[$data["currentimgid"]]["prettyname"] . "</TD>\n";
+ print " </TR>\n";
+ }
+ print " <TR>\n";
+ print " <TH align=right>RAM (MB):</TH>\n";
+ print " <TD><INPUT type=text name=ram maxlength=5 value=";
+ print $data["ram"] . "></TD>\n";
+ print " <TD>";
+ printSubmitErr(RAMERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>No. Processors:</TH>\n";
+ print " <TD>\n";
+ $tmpArr = array("1" => "1", "2" => "2", "4" => "4", "8" => "8");
+ printSelectInput("numprocs", $tmpArr, $data["numprocs"]);
+ print " </TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Processor Speed (MHz):</TH>\n";
+ print " <TD><INPUT type=text name=procspeed maxlength=5 value=";
+ print $data["procspeed"] . "></TD>\n";
+ print " <TD>";
+ printSubmitErr(PROCSPEEDERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Network Speed (Mbps):</TH>\n";
+ print " <TD>\n";
+ $tmpArr = array("10" => "10", "100" => "100", "1000" => "1000");
+ printSelectInput("network", $tmpArr, $data["network"]);
+ print " </TD>\n";
+ print " </TR>\n";
+ if(! $state) {
+ print " <TR>\n";
+ print " <TH align=right>Compter ID:</TH>\n";
+ print " <TD>" . $data["compid"] . "</TD>\n";
+ print " </TR>\n";
+ }
+ print " <TR>\n";
+ print " <TH align=right>Type:</TH>\n";
+ print " <TD>\n";
+ $tmpArr = array("blade" => "blade", "lab" => "lab", "virtualmachine" => "virtualmachine");
+ printSelectInput("type", $tmpArr, $data["type"]);
+ print " </TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Provisioning Engine:</TH>\n";
+ print " <TD>\n";
+ printSelectInput("provisioningid", $provisioning, $data["provisioningid"]);
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ if($state) {
+ $tmp = getUserResources(array("computerAdmin"),
+ array("manageGroup"), 1);
+ $computergroups = $tmp["computer"];
+ uasort($computergroups, "sortKeepIndex");
+ print "<H3>Computer Groups</H3>";
+ print "<TABLE border=1>\n";
+ print " <TR>\n";
+ foreach($computergroups as $group) {
+ print " <TH>$group</TH>\n";
+ }
+ print " </TR>\n";
+ print " <TR>\n";
+ foreach(array_keys($computergroups) as $groupid) {
+ $name = "computergroup[$groupid]";
+ if(array_key_exists($groupid, $data["computergroup"]))
+ $checked = "checked";
+ else
+ $checked = "";
+ print " <TD align=center>\n";
+ print " <INPUT type=checkbox name=\"$name\" value=1 $checked>\n";
+ print " </TD>\n";
+ }
+ print " </TR>\n";
+ print "</TABLE>\n";
+ }
+ print "<TABLE>\n";
+ print " <TR valign=top>\n";
+ print " <TD>\n";
+ if($state) {
+ $cont = addContinuationsEntry('confirmAddComputer', $data2, SECINDAY, 0, 1, 1);
+ print " <INPUT type=submit value=\"Confirm Computer\">\n";
+ }
+ else {
+ $data2['currentimgid'] = $data['currentimgid'];
+ $data2['compid'] = $data['compid'];
+ $cont = addContinuationsEntry('confirmEditComputer', $data2, SECINDAY, 0);
+ print " <INPUT type=submit value=\"Confirm Changes\">\n";
+ }
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry('viewComputers', $data2);
+ print " <INPUT type=hidden name=continuation value=\"$cont=\">\n";
+ print " <INPUT type=submit value=Cancel>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn confirmEditOrAddComputer($state)
+///
+/// \param $state - 0 for edit, 1 for add
+///
+/// \brief checks for valid input and allows user to confirm the edit/add
+///
+////////////////////////////////////////////////////////////////////////////////
+function confirmEditOrAddComputer($state) {
+ global $submitErr;
+
+ $data = processComputerInput();
+
+ if($data["bulk"]) {
+ $submitErr = 0;
+ bulkAddComputer();
+ return;
+ }
+
+ if($submitErr) {
+ editOrAddComputer($state);
+ return;
+ }
+
+ if($state) {
+ $data["currentimgid"] = "";
+ $data["compid"] = "";
+ $nextmode = "submitAddComputer";
+ $title = "Add Computer";
+ $question = "Submit the following new computer?";
+ }
+ else {
+ $nextmode = "submitEditComputer";
+ $title = "Edit Computer";
+ $question = "Submit the following changes?";
+ }
+
+ print "<H2>$title</H2>\n";
+ print "<H3>$question</H3>\n";
+ printComputerInfo($data["ipaddress"],
+ $data["stateid"],
+ $data["deptid"],
+ $data["owner"],
+ $data["platformid"],
+ $data["scheduleid"],
+ $data["currentimgid"],
+ $data["ram"],
+ $data["numprocs"],
+ $data["procspeed"],
+ $data["network"],
+ $data["hostname"],
+ $data["compid"],
+ $data["type"],
+ $data["provisioningid"]);
+ if($state) {
+ $tmp = getUserResources(array("computerAdmin"),
+ array("manageGroup"), 1);
+ $computergroups = $tmp["computer"];
+ uasort($computergroups, "sortKeepIndex");
+ print "<H3>Computer Groups</H3>";
+ print "<TABLE border=1>\n";
+ print " <TR>\n";
+ foreach($computergroups as $group) {
+ print " <TH>$group</TH>\n";
+ }
+ print " </TR>\n";
+ print " <TR>\n";
+ foreach(array_keys($computergroups) as $groupid) {
+ if(array_key_exists($groupid, $data["computergroup"]))
+ $checked = "src=images/x.png alt=selected";
+ else
+ $checked = "src=images/blank.gif alt=unselected";
+ print " <TD align=center>\n";
+ print " <img $checked>\n";
+ print " </TD>\n";
+ }
+ print " </TR>\n";
+ print "</TABLE>\n";
+ }
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ if($data['stateid'] == 10)
+ $cont = addContinuationsEntry('computerAddMaintenanceNote', $data, SECINDAY, 0);
+ else
+ $cont = addContinuationsEntry($nextmode, $data, SECINDAY, 0, 0);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Submit>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry('viewComputers', $data);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Cancel>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitEditComputer()
+///
+/// \brief updates submitted information for specified computer
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitEditComputer() {
+ global $mode, $user;
+ $data = processComputerInput();
+ $compdata = getComputers(0, 0, $data["compid"]);
+ # maintenance to maintenance
+ if($compdata[$data["compid"]]["stateid"] == 10 &&
+ $data["stateid"] == 10) {
+ // possibly update notes with new text
+ $testdata = explode('@', $compdata[$data["compid"]]["notes"]);
+ if(count($testdata) != 2)
+ $testdata[1] = "";
+ if($testdata[1] == $data["notes"])
+ // don't update the notes field
+ $data["notes"] = $compdata[$data["compid"]]["notes"];
+ else
+ // update user, timestamp, and text
+ $data["notes"] = $user["unityid"] . " " . unixToDatetime(time()) . "@"
+ . $data["notes"];
+ }
+ # available or failed to maintenance
+ if(($compdata[$data["compid"]]["stateid"] == 2 ||
+ $compdata[$data["compid"]]["stateid"] == 5) &&
+ $data["stateid"] == 10) {
+ // set notes to new data
+ $data["notes"] = $user["unityid"] . " " . unixToDatetime(time()) . "@"
+ . $data["notes"];
+ }
+ # maintenance or failed to available
+ if(($compdata[$data["compid"]]["stateid"] == 10 ||
+ $compdata[$data["compid"]]["stateid"] == 5) &&
+ $data["stateid"] == 2) {
+ $data["notes"] = "";
+ }
+ updateComputer($data);
+ viewComputers();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn computerAddMaintenanceNote($data)
+///
+/// \param $data - array returned from processComputerInput
+///
+/// \brief prints a page asking user to enter a reason for placing a computer
+/// in maintenance state
+///
+////////////////////////////////////////////////////////////////////////////////
+function computerAddMaintenanceNote() {
+ $data = processComputerInput();
+ $compdata = getComputers(0, 0, $data["compid"]);
+ $notes = explode('@', $compdata[$data["compid"]]["notes"]);
+ if(count($notes) != 2)
+ $notes[1] = "";
+ print "<DIV align=center>\n";
+ print "<H2>Edit Computer</H2>\n";
+ print "Why are placing this computer in the maintenance state?\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<TEXTAREA name=notes rows=4 cols=35>{$notes[1]}</TEXTAREA>\n";
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TD><INPUT type=submit value=Submit></TD>\n";
+ $cont = addContinuationsEntry('submitEditComputer', $data, SECINDAY, 0, 0);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " </FORM>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <TD><INPUT type=submit value=Cancel></TD>\n";
+ $cont = addContinuationsEntry('viewComputers', $data);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " </FORM>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitAddComputer()
+///
+/// \brief adds a new computer with the submitted information
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitAddComputer() {
+ $data = processComputerInput();
+ addComputer($data);
+ #print "<H2>Add Computer</H2>\n";
+ #print "The computer has been added.";
+ clearPrivCache();
+ viewComputers();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn confirmDeleteComputer()
+///
+/// \brief prints a confirmation page about deleteing a computer
+///
+////////////////////////////////////////////////////////////////////////////////
+function confirmDeleteComputer() {
+ $data = processComputerInput(0);
+ $computers = getComputers(0, 1);
+
+ $compid = $data["compid"];
+
+ if($computers[$compid]["deleted"]) {
+ $deleted = 1;
+ $title = "Undelete Computer";
+ $question = "Undelete the following computer?";
+ $button = "Undelete";
+ }
+ else {
+ $deleted = 0;
+ $title = "Delete Computer";
+ $question = "Delete the following computer?";
+ $button = "Delete";
+ }
+
+ print "<DIV align=center>\n";
+ print "<H2>$title</H2>\n";
+ print "<H3>$question</H3>\n";
+ printComputerInfo($computers[$compid]["IPaddress"],
+ $computers[$compid]["stateid"],
+ $computers[$compid]["deptid"],
+ $computers[$compid]["owner"],
+ $computers[$compid]["platformid"],
+ $computers[$compid]["scheduleid"],
+ $computers[$compid]["currentimgid"],
+ $computers[$compid]["ram"],
+ $computers[$compid]["procnumber"],
+ $computers[$compid]["procspeed"],
+ $computers[$compid]["network"],
+ $computers[$compid]["hostname"],
+ $compid,
+ $computers[$compid]["type"],
+ $computers[$compid]["provisioningid"]);
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = $data;
+ $cdata['deleted'] = $deleted;
+ $cdata['compid'] = $compid;
+ $cont = addContinuationsEntry('submitDeleteComputer', $cdata, SECINDAY, 0, 0);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=$button>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry('viewComputers', $data);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Cancel>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitDeleteComputer()
+///
+/// \brief deletes a computer from the database and notifies the user
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitDeleteComputer() {
+ $compid = getContinuationVar("compid");
+ $deleted = getContinuationVar("deleted");
+ if($deleted) {
+ $query = "UPDATE computer "
+ . "SET deleted = 0 "
+ . "WHERE id = $compid";
+ $qh = doQuery($query, 190);
+ }
+ else {
+ $query = "UPDATE computer "
+ . "SET deleted = 1 "
+ . "WHERE id = $compid";
+ $qh = doQuery($query, 191);
+ }
+ $_SESSION['userresources'] = array();
+ viewComputers();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn bulkAddComputer()
+///
+/// \brief prints a form for adding a block of computers
+///
+////////////////////////////////////////////////////////////////////////////////
+function bulkAddComputer() {
+ global $submitErr, $viewmode;
+
+ $data = processBulkComputerInput(0);
+ $data2 = processComputerInput2(); //yes, this is somewhat redundant, but it
+ // makes things easier later
+
+ $states = array("2" => "available",
+ "10" => "maintenance");
+ $platforms = getPlatforms();
+ $tmp = getUserResources(array("scheduleAdmin"), array("manageGroup"));
+ $schedules = $tmp["schedule"];
+ $images = getImages();
+ $provisioning = getProvisioning();
+
+ print "<H2>Add Multiple Computers</H2>\n";
+ print "<div>\n";
+ print "<div style=\"width: 600px;\">\n";
+ print "<b>NOTE</b>: 'Start IP' and 'End IP' can only differ in the number ";
+ print "after the last '.'. The hostnames will be generated from the ";
+ print "'Hostname' field. The hostnames for each computer can only differ ";
+ print "by the value of a number in the first part of the hostname. Place ";
+ print "a '%' character in the 'Hostname' field where that number will be. ";
+ print "Then fill in 'Start value' and 'End value' with the first and last ";
+ print "values to be used in the hostname.<br><br>";
+ print "Required text fields are noted with *<br><br>\n";
+ print "</div>\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TH align=right>Hostname*:</TH>\n";
+ print " <TD><INPUT type=text name=hostname maxlength=36 value=";
+ print $data["hostname"] . "></TD>\n";
+ print " <TD>";
+ printSubmitErr(HOSTNAMEERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>Start value*:</TH>\n";
+ print " <TD><INPUT type=text name=starthostval maxlength=8 value=";
+ print $data["starthostval"] . "></TD>\n";
+ print " <TD>";
+ printSubmitErr(STARTHOSTVALERR);
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>End value*:</TH>\n";
+ print " <TD><INPUT type=text name=endhostval maxlength=8 value=";
+ print $data["endhostval"] . "></TD>\n";
+ print " <TD>";
+ printSubmitErr(ENDHOSTVALERR);
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>Start IP Address*:</TH>\n";
+ print " <TD><INPUT type=text name=startipaddress maxlength=14 value=\"";
+ print $data["startipaddress"] . "\"></TD>\n";
+ print " <TD>";
+ printSubmitErr(IPADDRERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>End IP Address*:</TH>\n";
+ print " <TD><INPUT type=text name=endipaddress maxlength=14 value=\"";
+ print $data["endipaddress"] . "\"></TD>\n";
+ print " <TD>";
+ printSubmitErr(IPADDRERR2);
+ print "</TD>\n";
+ print " </TR>\n";
+
+ print " <TR>\n";
+ print " <TH align=right nowrap>Start private IP Address:</TH>\n";
+ print " <TD><INPUT type=text name=startpripaddress maxlength=14 value=\"";
+ print $data["startpripaddress"] . "\"></TD>\n";
+ print " <TD>";
+ printSubmitErr(IPADDRERR3);
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>End private IP Address:</TH>\n";
+ print " <TD><INPUT type=text name=endpripaddress maxlength=14 value=\"";
+ print $data["endpripaddress"] . "\"></TD>\n";
+ print " <TD>";
+ printSubmitErr(IPADDRERR4);
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>Start MAC Address:</TH>\n";
+ print " <TD><INPUT type=text name=startmac maxlength=17 value=\"";
+ print $data["startmac"] . "\"></TD>\n";
+ print " <TD>";
+ printSubmitErr(MACADDRERR);
+ print "</TD>\n";
+ print " </TR>\n";
+
+ print " <TR>\n";
+ print " <TH align=right nowrap>State:</TH>\n";
+ print " <TD>\n";
+ printSelectInput("stateid", $states, $data["stateid"]);
+ print " </TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>Owner*:</TH>\n";
+ print " <TD><INPUT type=text name=owner maxlength=80 value=\"";
+ print $data["owner"] . "\"></TD>\n";
+ print " <TD>";
+ printSubmitErr(OWNERERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>Platform:</TH>\n";
+ print " <TD>\n";
+ printSelectInput("platformid", $platforms, $data["platformid"]);
+ print " </TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>Schedule:</TH>\n";
+ print " <TD>\n";
+ printSelectInput("scheduleid", $schedules, $data["scheduleid"]);
+ print " </TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>RAM (MB)*:</TH>\n";
+ print " <TD><INPUT type=text name=ram maxlength=5 value=";
+ print $data["ram"] . "></TD>\n";
+ print " <TD>";
+ printSubmitErr(RAMERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>No. Processors:</TH>\n";
+ print " <TD>\n";
+ $tmpArr = array("1" => "1", "2" => "2", "4" => "4", "8" => "8");
+ printSelectInput("numprocs", $tmpArr, $data["numprocs"]);
+ print " </TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>Processor Speed (MHz)*:</TH>\n";
+ print " <TD><INPUT type=text name=procspeed maxlength=5 value=";
+ print $data["procspeed"] . "></TD>\n";
+ print " <TD>";
+ printSubmitErr(PROCSPEEDERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>Network Speed (Mbps):</TH>\n";
+ print " <TD>\n";
+ $tmpArr = array("10" => "10", "100" => "100", "1000" => "1000");
+ printSelectInput("network", $tmpArr, $data["network"]);
+ print " </TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Type:</TH>\n";
+ print " <TD>\n";
+ $tmpArr = array("blade" => "blade", "lab" => "lab", "virtualmachine" => "virtualmachine");
+ printSelectInput("type", $tmpArr, $data["type"]);
+ print " </TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>Provisioning Engine:</TH>\n";
+ print " <TD>\n";
+ printSelectInput("provisioningid", $provisioning, $data["provisioningid"]);
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ $tmp = getUserResources(array("computerAdmin"),
+ array("manageGroup"), 1);
+ $computergroups = $tmp["computer"];
+ print "<H3>Computer Groups</H3>";
+ print "<TABLE border=1>\n";
+ print " <TR>\n";
+ foreach($computergroups as $group) {
+ print " <TH>$group</TH>\n";
+ }
+ print " </TR>\n";
+ print " <TR>\n";
+ foreach(array_keys($computergroups) as $groupid) {
+ $name = "computergroup[$groupid]";
+ if(array_key_exists($groupid, $data["computergroup"]))
+ $checked = "checked";
+ else
+ $checked = "";
+ print " <TD align=center>\n";
+ print " <INPUT type=checkbox name=\"$name\" value=1 $checked>\n";
+ print " </TD>\n";
+ }
+ print " </TR>\n";
+ print "</TABLE>\n";
+ print "<TABLE>\n";
+ print " <TR valign=top>\n";
+ print " <TD>\n";
+ $cont = addContinuationsEntry('confirmAddBulkComputers', $data2, SECINDAY, 0, 1, 1);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=\"Confirm Computers\">\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry('viewComputers', $data2);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Cancel>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn confirmAddBulkComputers()
+///
+/// \brief checks for valid input and allows user to confirm the bulk add
+///
+////////////////////////////////////////////////////////////////////////////////
+function confirmAddBulkComputers() {
+ global $submitErr;
+
+ $data = processBulkComputerInput();
+
+ if($submitErr) {
+ bulkAddComputer();
+ return;
+ }
+
+ print "<H2>Add Multiple Computers</H2>\n";
+ print "<H3>Add the following comptuers?</H3>\n";
+
+ $states = getStates();
+ $platforms = getPlatforms();
+ $schedules = getSchedules();
+ $images = getImages();
+ $provisioning = getProvisioning();
+
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TH align=right>Hostnames:</TH>\n";
+ $first = str_replace('%', $data["starthostval"], $data["hostname"]);
+ $last = str_replace('%', $data["endhostval"], $data["hostname"]);
+ print " <TD>$first - $last</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>IP Addresses:</TH>\n";
+ print " <TD>" . $data["startipaddress"] . " - ";
+ print $data["endipaddress"] . "</TD>\n";
+ print " </TR>\n";
+ if(! empty($data['startpraddress'])) {
+ print " <TR>\n";
+ print " <TH align=right nowrap>Private IP Addresses:</TH>\n";
+ print " <TD>" . $data["startpripaddress"] . " - ";
+ print $data["endpripaddress"] . "</TD>\n";
+ print " </TR>\n";
+ }
+ if(! empty($data['macs'])) {
+ $end = $data['count'] * 2 - 1;
+ print " <TR>\n";
+ print " <TH align=right nowrap>MAC Addresses:</TH>\n";
+ print " <TD>{$data['macs'][0]} - {$data['macs'][$end]} (2 for each machine)</TD>\n";
+ print " </TR>\n";
+ }
+ print " <TR>\n";
+ print " <TH align=right>State:</TH>\n";
+ print " <TD>" . $states[$data["stateid"]] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Owner:</TH>\n";
+ print " <TD>" . $data["owner"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Platform:</TH>\n";
+ print " <TD>" . $platforms[$data["platformid"]] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Schedule:</TH>\n";
+ print " <TD>" . $schedules[$data["scheduleid"]]["name"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>RAM (MB):</TH>\n";
+ print " <TD>" . $data["ram"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>No. Processors:</TH>\n";
+ print " <TD>" . $data["numprocs"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>Processor Speed (MHz):</TH>\n";
+ print " <TD>" . $data["procspeed"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>Network Speed (Mbps):</TH>\n";
+ print " <TD>" . $data["network"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Type:</TH>\n";
+ print " <TD>" . $data["type"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Provisioning Engine:</TH>\n";
+ print " <TD>" . $provisioning[$data["provisioningid"]]['prettyname'] . "</TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ $tmp = getUserResources(array("computerAdmin"),
+ array("manageGroup"), 1);
+ $computergroups = $tmp["computer"];
+ print "<H3>Computer Groups</H3>";
+ print "<TABLE border=1>\n";
+ print " <TR>\n";
+ foreach($computergroups as $group) {
+ print " <TH>$group</TH>\n";
+ }
+ print " </TR>\n";
+ print " <TR>\n";
+ foreach(array_keys($computergroups) as $groupid) {
+ if(array_key_exists($groupid, $data["computergroup"]))
+ $checked = "src=images/x.png alt=selected";
+ else
+ $checked = "src=images/blank.gif alt=unselected";
+ print " <TD align=center>\n";
+ print " <img $checked>\n";
+ print " </TD>\n";
+ }
+ print " </TR>\n";
+ print "</TABLE>\n";
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry('submitAddBulkComputers', $data, SECINDAY, 0, 0);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Submit>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry('viewComputers', $data);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Cancel>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitAddBulkComputers()
+///
+/// \brief submits the computers and notifies the user
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitAddBulkComputers() {
+ global $mysql_link_vcl;
+
+ $data = processBulkComputerInput(0);
+ $ownerid = getUserlistID($data["owner"]);
+
+ $tmpArr = explode('.', $data["startipaddress"]);
+ $startip = $tmpArr[3];
+ $tmpArr = explode('.', $data["endipaddress"]);
+ $endip = $tmpArr[3];
+ array_pop($tmpArr);
+ $baseaddr = implode('.', $tmpArr);
+
+ $dopr = 0;
+ if(! empty($data['startpripaddress'])) {
+ $dopr = 1;
+ $tmpArr = explode('.', $data["startpripaddress"]);
+ $startprip = $tmpArr[3];
+ $tmpArr = explode('.', $data["endpripaddress"]);
+ $endprip = $tmpArr[3];
+ array_pop($tmpArr);
+ $basepraddr = implode('.', $tmpArr);
+ }
+ $domacs = 0;
+ if(! empty($data['macs'])) {
+ $domacs = 1;
+ $maccnt = 0;
+ }
+
+ $dhcpdata = array();
+ $count = 0;
+ $addedrows = 0;
+ for($i = $startip, $j = $data["starthostval"]; $i <= $endip; $i++, $j++, $count++) {
+ $hostname = str_replace('%', $j, $data["hostname"]);
+ $ipaddress = $baseaddr . ".$i";
+ $dhcpdata[$count] = array('hostname' => $hostname);
+ if($dopr) {
+ $pripaddress = $basepraddr . '.' . $startprip++;
+ $dhcpdata[$count]['prip'] = $pripaddress;
+ }
+ if($domacs) {
+ $eth0 = $data['macs'][$maccnt++];
+ $eth1 = $data['macs'][$maccnt++];
+ $dhcpdata[$count]['eth0mac'] = $eth0;
+ }
+ $query = "INSERT INTO computer "
+ . "(stateid, "
+ . "ownerid, "
+ . "platformid, "
+ . "provisioningid, "
+ . "scheduleid, "
+ . "currentimageid, "
+ . "RAM, "
+ . "procnumber, "
+ . "procspeed, "
+ . "network, "
+ . "hostname, "
+ . "IPaddress, ";
+ if($dopr)
+ $query .= "privateIPaddress, ";
+ if($domacs)
+ $query .= "eth0macaddress, "
+ . "eth1macaddress, ";
+ $query .= "type) "
+ . "VALUES ({$data["stateid"]}, "
+ . "$ownerid, "
+ . "{$data["platformid"]}, "
+ . "{$data["provisioningid"]}, "
+ . "{$data["scheduleid"]}, "
+ . "4, "
+ . "{$data["ram"]}, "
+ . "{$data["numprocs"]}, "
+ . "{$data["procspeed"]}, "
+ . "{$data["network"]}, "
+ . "'$hostname', "
+ . "'$ipaddress', ";
+ if($dopr)
+ $query .= "'$pripaddress', ";
+ if($domacs)
+ $query .= "'$eth0', "
+ . "'$eth1', ";
+ $query .= "'{$data["type"]}')";
+ $qh = doQuery($query, 235);
+ $addedrows += mysql_affected_rows($mysql_link_vcl);
+ $qh = doQuery("SELECT LAST_INSERT_ID() FROM computer", 236);
+ if(! $row = mysql_fetch_row($qh)) {
+ abort(237);
+ }
+ $query = "INSERT INTO resource "
+ . "(resourcetypeid, "
+ . "subid) "
+ . "VALUES (12, "
+ . $row[0] . ")";
+ doQuery($query, 238);
+
+ // add computer into selected groups
+ $qh = doQuery("SELECT LAST_INSERT_ID() FROM resource", 101);
+ if(! $row = mysql_fetch_row($qh)) {
+ abort(237);
+ }
+
+ foreach(array_keys($data["computergroup"]) as $groupid) {
+ $query = "INSERT INTO resourcegroupmembers "
+ . "(resourceid, "
+ . "resourcegroupid) "
+ . "VALUES ({$row[0]}, "
+ . "$groupid)";
+ doQuery($query, 101);
+ }
+ }
+ print "<DIV align=center>\n";
+ print "<H2>Add Multiple Computers</H2>\n";
+ if($count == $addedrows) {
+ print "The computers were added successfully.<br><br>\n";
+ }
+ else {
+ print $count - $addedrows . " computers failed to get added<br><br>\n";
+ }
+ print "</div>\n";
+ if($domacs)
+ generateDhcpForm($dhcpdata);
+ clearPrivCache();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn generateDhcpForm($data)
+///
+/// \brief prints a form for entering an ip address for a management node so
+/// that data for a dhcpd.conf file can be generated
+///
+////////////////////////////////////////////////////////////////////////////////
+function generateDhcpForm($data) {
+ global $submitErr;
+ $mnipaddr = processInputVar('mnipaddr', ARG_STRING, "");
+ print "<div>\n";
+ print "<h3>Generate Data for dhcpd.conf File (Optional)</h3>\n";
+ print "<form action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "Enter the private address for the management node<br>";
+ print "on which the data will be used:<br>\n";
+ print "<INPUT type=text name=mnipaddr value=\"$mnipaddr\" maxlength=15>\n";
+ printSubmitErr(IPADDRERR);
+ print "<br>\n";
+ print "<input type=submit value=\"Download Data\">\n";
+ $cont = addContinuationsEntry('generateDHCP', $data, SECINDAY, 1, 0);
+ print "<input type=hidden name=continuation value=\"$cont\">\n";
+ print "</form>\n";
+ print "</div>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn generateDHCP()
+///
+/// \brief prints content for a dhcpd.conf file from saved continuation data
+///
+////////////////////////////////////////////////////////////////////////////////
+function generateDHCP() {
+ global $submitErr, $submitErrMsg, $HTMLheader, $printedHTMLheader;
+ $mnipaddr = processInputVar('mnipaddr', ARG_STRING);
+ $data = getContinuationVar();
+ $addrArr = explode('.', $mnipaddr);
+ if(! ereg('^(([0-9]){1,3}\.){3}([0-9]){1,3}$', $mnipaddr) ||
+ $addrArr[0] < 1 || $addrArr[0] > 255 ||
+ $addrArr[1] < 0 || $addrArr[1] > 255 ||
+ $addrArr[2] < 0 || $addrArr[2] > 255 ||
+ $addrArr[3] < 1 || $addrArr[3] > 255) {
+ $submitErr |= IPADDRERR;
+ $submitErrMsg[IPADDRERR] = "Invalid IP address. Must be w.x.y.z with each of "
+ . "w, x, y, and z being between 1 and 255 (inclusive)";
+ print $HTMLheader;
+ $printedHTMLheader = 1;
+ generateDhcpForm($data);
+ print getFooter();
+ return;
+ }
+ header("Content-type: text/plain");
+ header("Content-Disposition: inline; filename=\"dhcpdata.txt\"");
+ foreach($data as $comp) {
+ $tmp = explode('.', $comp['hostname']);
+ print "\t\thost {$tmp[0]} {\n";
+ print "\t\t\toption host-name \"{$tmp[0]}\";\n";
+ print "\t\t\thardware ethernet {$comp['eth0mac']};\n";
+ print "\t\t\tfixed-address {$comp['prip']};\n";
+ print "\t\t\tfilename \"/tftpboot/pxelinux.0\";\n";
+ print "\t\t\toption dhcp-server-identifier $mnipaddr;\n";
+ print "\t\t\tnext-server $mnipaddr;\n";
+ print "\t\t}\n\n";
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn viewComputerGroups()
+///
+/// \brief prints a form for editing computer groups
+///
+////////////////////////////////////////////////////////////////////////////////
+function viewComputerGroups() {
+ global $mode;
+ $platforminput = getContinuationVar('platforms', processInputVar("platforms", ARG_MULTINUMERIC));
+ $scheduleinput = getContinuationVar("schedules", processInputVar("schedules", ARG_MULTINUMERIC));
+ $groups = processInputVar('groups', ARG_MULTINUMERIC);
+
+ $computers = getComputers(1);
+ $tmp = getUserResources(array("computerAdmin"),
+ array("manageGroup"), 1);
+ $computergroups = $tmp["computer"];
+ $computermembership = getResourceGroupMemberships("computer");
+ $resources = getUserResources(array("computerAdmin"), array("manageGroup"));
+ uasort($resources["computer"], "sortKeepIndex");
+
+ if($mode == 'submitComputerGroups')
+ $gridSelected = "selected=\"true\"";
+ else
+ $gridSelected = "";
+
+ print "<H3>Computer Groups</H3>\n";
+ print "<div id=\"mainTabContainer\" dojoType=\"dijit.layout.TabContainer\"\n";
+ print " style=\"width:800px;height:600px\">\n";
+
+ # by computer tab
+ print "<div id=\"resource\" dojoType=\"dijit.layout.ContentPane\" title=\"By Computer\">\n";
+ print "Select a computer and click \"Get Groups\" to see all of the groups ";
+ print "it is in. Then,<br>select a group it is in and click the Remove ";
+ print "button to remove it from that group,<br>or select a group it is not ";
+ print "in and click the Add button to add it to that group.<br><br>\n";
+ print "Computer:<select name=comps id=comps>\n";
+ # build list of computers
+ foreach($resources["computer"] as $compid => $computer) {
+ print "<option value=$compid>$computer</option>\n";
+ }
+ print "</select>\n";
+ print "<button dojoType=\"dijit.form.Button\" id=\"fetchGrpsButton\">\n";
+ print " Get Groups\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ print " getGroupsButton();\n";
+ print " </script>\n";
+ print "</button>\n";
+ print "<table><tbody><tr>\n";
+ # select for groups image is in
+ print "<td valign=top>\n";
+ print "Groups <span style=\"font-weight: bold;\" id=incompname></span> is in:<br>\n";
+ print "<select name=ingroups multiple id=ingroups size=20>\n";
+ print "</select>\n";
+ print "</td>\n";
+ # transfer buttons
+ print "<td style=\"vertical-align: middle;\">\n";
+ print "<button dojoType=\"dijit.form.Button\" id=\"addBtn1\">\n";
+ print " <div style=\"width: 50px;\"><-Add</div>\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ $cont = addContinuationsEntry('AJaddGroupToComp');
+ print " addRemItem('$cont', 'comps', 'outgroups', addRemComp2);\n";
+ print " </script>\n";
+ print "</button>\n";
+ print "<br>\n";
+ print "<br>\n";
+ print "<br>\n";
+ print "<button dojoType=\"dijit.form.Button\" id=\"remBtn1\">\n";
+ print " <div style=\"width: 50px;\">Remove-></div>\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ $cont = addContinuationsEntry('AJremGroupFromComp');
+ print " addRemItem('$cont', 'comps', 'ingroups', addRemComp2);\n";
+ print " </script>\n";
+ print "</button>\n";
+ print "</td>\n";
+ # select for groups computer is not in
+ print "<td valign=top>\n";
+ print "Groups <span style=\"font-weight: bold;\" id=outcompname></span> is not in:<br>\n";
+ print "<select name=outgroups multiple id=outgroups size=20>\n";
+ print "</select>\n";
+ print "</td>\n";
+ print "</tr><tbody/></table>\n";
+ print "</div>\n";
+
+ # by group tab
+ print "<div id=\"group\" dojoType=\"dijit.layout.ContentPane\" title=\"By Group\">\n";
+ print "Select a group and click \"Get Computers\" to see all of the computers ";
+ print "in it. Then,<br>select a computer in it and click the Remove ";
+ print "button to remove it from the group,<br>or select a computer that is not ";
+ print "in it and click the Add button to add it to the group.<br><br>\n";
+ print "Group:<select name=compGroups id=compGroups>\n";
+ # build list of groups
+ foreach($computergroups as $id => $group) {
+ print "<option value=$id>$group</option>\n";
+ }
+ print "</select>\n";
+ print "<button dojoType=\"dijit.form.Button\" id=\"fetchCompsButton\">\n";
+ print " Get Computers\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ print " getCompsButton();\n";
+ print " </script>\n";
+ print "</button>\n";
+ print "<table><tbody><tr>\n";
+ # select for images in group
+ print "<td valign=top>\n";
+ print "Computers in <span style=\"font-weight: bold;\" id=ingroupname></span>:<br>\n";
+ print "<select name=incomps multiple id=incomps size=20>\n";
+ print "</select>\n";
+ print "</td>\n";
+ # transfer buttons
+ print "<td style=\"vertical-align: middle;\">\n";
+ print "<button dojoType=\"dijit.form.Button\" id=\"addBtn2\">\n";
+ print " <div style=\"width: 50px;\"><-Add</div>\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ $cont = addContinuationsEntry('AJaddCompToGroup');
+ print " addRemItem('$cont', 'compGroups', 'outcomps', addRemGroup2);\n";
+ print " </script>\n";
+ print "</button>\n";
+ print "<br>\n";
+ print "<br>\n";
+ print "<br>\n";
+ print "<button dojoType=\"dijit.form.Button\" id=\"remBtn2\">\n";
+ print " <div style=\"width: 50px;\">Remove-></div>\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ $cont = addContinuationsEntry('AJremCompFromGroup');
+ print " addRemItem('$cont', 'compGroups', 'incomps', addRemGroup2);\n";
+ print " </script>\n";
+ print "</button>\n";
+ print "</td>\n";
+ # computers not in group select
+ print "<td valign=top>\n";
+ print "Computers not in <span style=\"font-weight: bold;\" id=outgroupname></span>:<br>\n";
+ print "<select name=outcomps multiple id=outcomps size=20>\n";
+ print "</select>\n";
+ print "</td>\n";
+ print "</tr><tbody/></table>\n";
+ print "</div>\n";
+
+ # grid tab
+ if(empty($gridSelected)) {
+ $cdata = array('platforms' => $platforminput,
+ 'schedules' => $scheduleinput,
+ 'groups' => $groups);
+ }
+ else {
+ $cdata = array('platforms' => getContinuationVar("platforms"),
+ 'schedules' => getContinuationVar("schedules"),
+ 'groups' => getContinuationVar("groups"));
+ }
+ $cont = addContinuationsEntry('compGroupingGrid', $cdata);
+ $loadingmsg = "<span class=dijitContentPaneLoading>Loading page (this may take a really long time)</span>";
+ print "<a jsId=\"checkboxpane\" dojoType=\"dijit.layout.LinkPane\"\n";
+ print " href=\"index.php?continuation=$cont\"\n";
+ print " loadingMessage=\"$loadingmsg\" $gridSelected>\n";
+ print " Checkbox Grid</a>\n";
+
+ print "</div>\n"; # end of main tab container
+ $cont = addContinuationsEntry('jsonCompGroupingComps');
+ print "<input type=hidden id=compcont value=\"$cont\">\n";
+ $cont = addContinuationsEntry('jsonCompGroupingGroups');
+ print "<input type=hidden id=grpcont value=\"$cont\">\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn compGroupingGrid()
+///
+/// \brief prints a page to view and modify computer grouping
+///
+////////////////////////////////////////////////////////////////////////////////
+function compGroupingGrid() {
+ global $mode;
+ $platforminput = getContinuationVar('platforms');
+ $scheduleinput = getContinuationVar('schedules');
+ $groups = getContinuationVar('groups');
+ if(empty($groups)) {
+ if(empty($platforminput) && empty($scheduleinput)) {
+ print "No criteria selected to determine which computers to display. Please go back<br>\n";
+ print "to the <strong>Manage Computers</strong> page and select either a set of platforms<br>\n";
+ print "and schedules or at least one computer group.<br>\n";
+ return;
+ }
+ $bygroups = 0;
+ $compidlist = array();
+ }
+ else {
+ $bygroups = 1;
+ $compidlist = getCompIdList($groups);
+ }
+
+ $computers = getComputers(1);
+ $tmp = getUserResources(array("computerAdmin"),
+ array("manageGroup"), 1);
+ $computergroups = $tmp["computer"];
+ $computermembership = getResourceGroupMemberships("computer");
+ $resources = getUserResources(array("computerAdmin"), array("manageGroup"));
+ uasort($resources["computer"], "sortKeepIndex");
+
+ if($mode == "submitComputerGroups") {
+ print "<font color=\"#008000\">Computer groups successfully updated";
+ print "</font><br><br>\n";
+ }
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<TABLE border=1>\n";
+ print " <col>\n";
+ if($bygroups) {
+ foreach($groups as $id) {
+ print " <col id=compgrp$id>\n";
+ }
+ }
+ else {
+ foreach(array_keys($computergroups) as $id) {
+ print " <col id=compgrp$id>\n";
+ }
+ }
+ print " <TR>\n";
+ print " <TH rowspan=2>Hostname</TH>\n";
+ if($bygroups)
+ print " <TH class=nohlcol colspan=" . count($groups) . ">Groups</TH>\n";
+ else
+ print " <TH class=nohlcol colspan=" . count($computergroups) . ">Groups</TH>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ if($bygroups) {
+ foreach($groups as $id) {
+ print " <TH onclick=\"toggleColSelect('compgrp$id');\">{$computergroups[$id]}</TH>\n";
+ }
+ }
+ else {
+ foreach($computergroups as $id => $group) {
+ print " <TH onclick=\"toggleColSelect('compgrp$id');\">$group</TH>\n";
+ }
+ }
+ print " </TR>\n";
+ $count = 1;
+ foreach($resources["computer"] as $compid => $computer) {
+ if($bygroups) {
+ if(! array_key_exists($compid, $compidlist))
+ continue;
+ }
+ else {
+ if(! in_array($computers[$compid]["platformid"], $platforminput) ||
+ ! in_array($computers[$compid]["scheduleid"], $scheduleinput)) {
+ continue;
+ }
+ }
+ if($bygroups)
+ $items = $groups;
+ else
+ $items = array_keys($computergroups);
+ if($count % 20 == 0) {
+ print " <TR>\n";
+ print " <TH><img src=images/blank.gif></TH>\n";
+ foreach($items as $id) {
+ print " <TH onclick=\"toggleColSelect('compgrp$id');\">{$computergroups[$id]}</TH>\n";
+ }
+ print " </TR>\n";
+ }
+ print " <TR id=compid$compid>\n";
+ print " <TH align=right onclick=\"toggleRowSelect('compid$compid');\">$computer</TH>\n";
+ foreach($items as $groupid) {
+ $name = "computergroup[" . $compid . ":" . $groupid . "]";
+ if(array_key_exists($compid, $computermembership["computer"]) &&
+ in_array($groupid, $computermembership["computer"][$compid])) {
+ $checked = "checked";
+ $value = 1;
+ }
+ else {
+ $checked = "";
+ $value = 2;
+ }
+ print " <TD align=center>\n";
+ print " <INPUT type=checkbox name=\"$name\" value=$value ";
+ print "$checked>\n";
+ print " </TD>\n";
+ }
+ print " </TR>\n";
+ $count++;
+ }
+ print "</TABLE>\n";
+ if($count > 1) {
+ print "<INPUT type=submit value=\"Submit Changes\">\n";
+ print "<INPUT type=reset value=Reset>\n";
+ $cdata = array('platforms' => $platforminput,
+ 'schedules' => $scheduleinput,
+ 'groups' => $groups,
+ 'compidlist' => $compidlist);
+ # set a short timeout because this is a "last one in wins" page
+ $cont = addContinuationsEntry('submitComputerGroups', $cdata, 300, 0, 0, 1);
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ }
+ print "</FORM>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitComputerGroups()
+///
+/// \brief updates computer groupings and notifies user
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitComputerGroups() {
+ $platforminput = getContinuationVar("platforms");
+ $scheduleinput = getContinuationVar("schedules");
+ $groups = getContinuationVar("groups");
+ $compidlist = getContinuationVar('compidlist');
+ $groupinput = processInputVar("computergroup", ARG_MULTINUMERIC);
+
+ if(empty($groups))
+ $bygroups = 0;
+ else
+ $bygroups = 1;
+
+ $computers = getComputers();
+
+ # build an array of memberships currently in the db
+ $tmp = getUserResources(array("groupAdmin"), array("manageGroup"), 1);
+ $computergroupsIDs = array_keys($tmp["computer"]); // ids of groups that user can manage
+ $resources = getUserResources(array("computerAdmin"),
+ array("manageGroup"));
+ $userCompIDs = array_keys($resources["computer"]); // ids of computers that user can manage
+ $computermembership = getResourceGroupMemberships("computer");
+ $basecomputergroups = $computermembership["computer"]; // all computer group memberships
+ $computergroups = array();
+ foreach(array_keys($basecomputergroups) as $compid) {
+ if(in_array($compid, $userCompIDs)) {
+ foreach($basecomputergroups[$compid] as $grpid) {
+ if($bygroups && ! in_array($grpid, $groups))
+ continue;
+ if(in_array($grpid, $computergroupsIDs)) {
+ if(array_key_exists($compid, $computergroups))
+ array_push($computergroups[$compid], $grpid);
+ else
+ $computergroups[$compid] = array($grpid);
+ }
+ }
+ }
+ }
+
+ $newmembers = array();
+ foreach(array_keys($groupinput) as $key) {
+ list($compid, $grpid) = explode(':', $key);
+ if(array_key_exists($compid, $newmembers)) {
+ array_push($newmembers[$compid], $grpid);
+ }
+ else {
+ $newmembers[$compid] = array($grpid);
+ }
+ }
+
+ $adds = array();
+ $removes = array();
+ foreach(array_keys($computers) as $compid) {
+ if($bygroups) {
+ if(! array_key_exists($compid, $compidlist))
+ continue;
+ }
+ else {
+ if(! in_array($computers[$compid]["platformid"], $platforminput) ||
+ ! in_array($computers[$compid]["scheduleid"], $scheduleinput))
+ continue;
+ }
+ if(! array_key_exists($compid, $newmembers) &&
+ ! array_key_exists($compid, $computergroups)) {
+ continue;
+ }
+ $id = $computers[$compid]["resourceid"];
+ // check that $compid is in $newmembers, if not, remove it from all groups
+ if(! array_key_exists($compid, $newmembers)) {
+ $removes[$id] = $computergroups[$compid];
+ continue;
+ }
+ // check that $compid is in $computergroups, if not, add all groups
+ // in $newmembers
+ if(! array_key_exists($compid, $computergroups)) {
+ $adds[$id] = $newmembers[$compid];
+ continue;
+ }
+ // adds are groupids that are in $newmembers, but not in $computergroups
+ $adds[$id] = array_diff($newmembers[$compid], $computergroups[$compid]);
+ if(count($adds[$id]) == 0) {
+ unset($adds[$id]);
+ }
+ // removes are groupids that are in $computergroups, but not in
+ // $newmembers
+ $removes[$id] = array_diff($computergroups[$compid], $newmembers[$compid]);
+ if(count($removes[$id]) == 0) {
+ unset($removes[$id]);
+ }
+ }
+
+ foreach(array_keys($adds) as $compid) {
+ foreach($adds[$compid] as $grpid) {
+ $query = "INSERT INTO resourcegroupmembers "
+ . "(resourceid, resourcegroupid) "
+ . "VALUES ($compid, $grpid)";
+ doQuery($query, 285);
+ }
+ }
+
+ foreach(array_keys($removes) as $compid) {
+ foreach($removes[$compid] as $grpid) {
+ $query = "DELETE FROM resourcegroupmembers "
+ . "WHERE resourceid = $compid AND "
+ . "resourcegroupid = $grpid";
+ doQuery($query, 286);
+ }
+ }
+
+ viewComputerGroups();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn computerUtilities()
+///
+/// \brief prints a page for selecting multiple computers and then choosing from
+/// a few utility type functions to operate on the selected computers
+///
+////////////////////////////////////////////////////////////////////////////////
+function computerUtilities() {
+ global $user, $mode;
+ $data = processComputerInput(0);
+ if(empty($data['groups']))
+ $bygroups = 0;
+ else {
+ $bygroups = 1;
+ $compidlist = getCompIdList($data['groups']);
+ }
+ $computers = getComputers(1);
+ $resources = getUserResources(array("computerAdmin"), array("administer"));
+ $userCompIDs = array_keys($resources["computer"]);
+ $resources = getUserResources(array("imageAdmin", "imageCheckOut"));
+ $platforms = getPlatforms();
+ $tmp = getUserResources(array("scheduleAdmin"), array("manageGroup"));
+ $schedules = $tmp["schedule"];
+ $allschedules = getSchedules();
+ $images = getImages(1);
+
+ print "<H2>Computer Utilities</H2>\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post id=utilform>\n";
+ print "<TABLE border=1>\n";
+ print " <TR>\n";
+ print " <TD></TD>\n";
+ print " <TH>Hostname</TH>\n";
+ print " <TH>IP Address</TH>\n";
+ print " <TH>State</TH>\n";
+ print " <TH>Owner</TH>\n";
+ #print " <TH>Platform</TH>\n";
+ print " <TH>Schedule</TH>\n";
+ print " <TH>Current Image</TH>\n";
+ print " <TH>Next Image</TH>\n";
+ print " <TH>VM Host</TH>\n";
+ /*print " <TH>RAM(MB)</TH>\n";
+ print " <TH>No. Processors</TH>\n";
+ print " <TH>Processor Speed(MHz)</TH>\n";
+ print " <TH>Network Speed(Mbps)</TH>\n";
+ print " <TH>Computer ID</TH>\n";
+ print " <TH>Type</TH>\n";
+ print " <TH>No. of Reservations</TH>\n";*/
+ print " <TH>Notes</TH>\n";
+ print " </TR>\n";
+ $count = 0;
+ foreach(array_keys($computers) as $id) {
+ if($bygroups) {
+ if(! array_key_exists($id, $compidlist))
+ continue;
+ }
+ elseif(! in_array($computers[$id]["platformid"], $data["platforms"]) ||
+ ! in_array($computers[$id]["scheduleid"], $data["schedules"]))
+ continue;
+ if(! in_array($id, $userCompIDs)) {
+ continue;
+ }
+ print " <TR align=center id=compid$count>\n";
+ print " <TD><INPUT type=checkbox name=computerids[] value=$id ";
+ print "id=comp$count onclick=\"toggleRowSelect('compid$count');\"></TD>\n";
+ print " <TD>" . $computers[$id]["hostname"] . "</TD>\n";
+ print " <TD>" . $computers[$id]["IPaddress"] . "</TD>\n";
+ if($computers[$id]['state'] == 'failed')
+ print " <TD><font color=red>{$computers[$id]["state"]}</font></TD>\n";
+ else
+ print " <TD>" . $computers[$id]["state"] . "</TD>\n";
+ print " <TD>" . $computers[$id]["owner"] . "</TD>\n";
+ #print " <TD>{$platforms[$computers[$id]["platformid"]]}</TD>\n";
+ print " <TD>{$allschedules[$computers[$id]["scheduleid"]]["name"]}</TD>\n";
+ print " <TD>{$images[$computers[$id]["currentimgid"]]["prettyname"]}</TD>\n";
+ if($computers[$id]["nextimgid"])
+ print " <TD>{$images[$computers[$id]["nextimgid"]]["prettyname"]}</TD>\n";
+ else
+ print " <TD>(selected by system)</TD>\n";
+ if(is_null($computers[$id]['vmhost']))
+ print " <TD>N/A</TD>\n";
+ else
+ print " <TD>" . $computers[$id]["vmhost"] . "</TD>\n";
+ /*print " <TD>" . $computers[$id]["ram"] . "</TD>\n";
+ print " <TD>" . $computers[$id]["procnumber"] . "</TD>\n";
+ print " <TD>" . $computers[$id]["procspeed"] . "</TD>\n";
+ print " <TD>" . $computers[$id]["network"] . "</TD>\n";
+ print " <TD>$id</TD>\n";
+ print " <TD>" . $computers[$id]["type"] . "</TD>\n";*/
+ if(empty($computers[$id]["notes"]))
+ print " <TD> </TD>\n";
+ else {
+ print " <TD>" . str_replace('@', '<br>', $computers[$id]["notes"]);
+ print "</TD>\n";
+ }
+ print " </TR>\n";
+ $count++;
+ }
+ print "</TABLE>\n";
+ if($count == 0) {
+ print "<br>0 computers found<br>\n";
+ return;
+ }
+ print "<a href=# onclick=\"if(checkAllCompUtils()) return false;\">Check All</a> / \n";
+ print "<a href=# onclick=\"if(uncheckAllCompUtils()) return false;\">Uncheck All</a><br>\n";
+ print "<TABLE>\n";
+ if(count($resources['image'])) {
+ print " <TR>\n";
+ print " <TD>Reload selected computers with this image:</TD>";
+ print " <TD>\n";
+ printSelectInput("imageid", $resources["image"], -1, 1);
+ print " </TD>\n";
+ print " <TD><INPUT type=button onclick=reloadComputerSubmit(); value=\"Confirm Reload\"></TD>";
+ $cont = addContinuationsEntry('reloadComputers', array(), SECINDAY, 0);
+ print " <INPUT type=hidden id=reloadcont value=\"$cont\">\n";
+ print " </TR>\n";
+ }
+ print " <TR>\n";
+ print " <TD>Change state of selected computers to:</TD>";
+ $states = array("2" => "available",
+ "23" => "hpc",
+ "10" => "maintenance",
+ "20" => "vmhostinuse");
+ print " <TD colspan=2>\n";
+ printSelectInput("stateid", $states);
+ print " <INPUT type=button onclick=compStateChangeSubmit(); value=\"Confirm State Change\">";
+ print " </TD>\n";
+ $cont = addContinuationsEntry('compStateChange', array(), SECINDAY, 0);
+ print " <INPUT type=hidden id=statecont value=\"$cont\">\n";
+ print " </TR>\n";
+ if(count($schedules)) {
+ print " <TR>\n";
+ print " <TD>Change schedule of selected computers to:</TD>";
+
+ uasort($schedules, "sortKeepIndex");
+
+ print " <TD colspan=2>\n";
+ printSelectInput("scheduleid", $schedules);
+ print " <INPUT type=button onclick=compScheduleChangeSubmit(); ";
+ print "value=\"Confirm Schedule Change\">";
+ print " </TD>\n";
+ $cont = addContinuationsEntry('compScheduleChange', array(), SECINDAY, 0);
+ print " <INPUT type=hidden id=schcont value=\"$cont\">\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ print "<INPUT type=hidden name=continuation id=continuation>\n";
+ print "</FORM>\n";
+ print "<br>$count computers found<br>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn reloadComputers()
+///
+/// \brief confirms reloading submitted computers with the selected image
+///
+////////////////////////////////////////////////////////////////////////////////
+function reloadComputers() {
+ global $user;
+ $data = processComputerInput3();
+ $computers = getComputers(1);
+ $imagedata = getImages(0, $data['imageid']);
+ $reloadnow = array();
+ $reloadasap = array();
+ $noreload = array();
+ foreach($data['computerids'] as $compid) {
+ switch($computers[$compid]['state']) {
+ case "available":
+ case "failed":
+ case "reloading":
+ array_push($reloadnow, $compid);
+ break;
+ case "inuse":
+ case "timeout":
+ case "reserved":
+ array_push($reloadasap, $compid);
+ break;
+ case "maintenance":
+ array_push($noreload, $compid);
+ break;
+ default:
+ array_push($noreload, $compid);
+ break;
+ }
+ }
+ print "<H2>Reload Computers</H2>\n";
+ if(count($reloadnow)) {
+ print "The following computers will be immediately reloaded with ";
+ print "{$imagedata[$data['imageid']]['prettyname']}:<br>\n";
+ print "<TABLE>\n";
+ foreach($reloadnow as $compid) {
+ print " <TR>\n";
+ print " <TD><font color=\"#008000\">{$computers[$compid]['hostname']}</font></TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ print "<br>\n";
+ }
+
+ if(count($reloadasap)) {
+ print "The following computers are currently in use and will be ";
+ print "reloaded with {$imagedata[$data['imageid']]['prettyname']} at the end ";
+ print "of the user's reservation:<br>\n";
+ print "<TABLE>\n";
+ foreach($reloadasap as $compid) {
+ print " <TR>\n";
+ print " <TD><font color=\"ff8c00\">{$computers[$compid]['hostname']}</font></TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ print "<br>\n";
+ }
+
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<INPUT type=submit value=\"Reload Computers\"><br>\n";
+ $data['imagename'] = $imagedata[$data['imageid']]['prettyname'];
+ $cont = addContinuationsEntry('submitReloadComputers', $data, SECINDAY, 0, 0);
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "</FORM>\n";
+
+ if(count($noreload)) {
+ print "The following computers are currently in the maintenance ";
+ print "state and therefore will have nothing done to them:<br>\n";
+ print "<TABLE>\n";
+ foreach($noreload as $compid) {
+ print " <TR>\n";
+ print " <TD><font color=\"#ff0000\">{$computers[$compid]['hostname']}</font></TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ print "<br>\n";
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitReloadComputers()
+///
+/// \brief configures system to reloaded submitted computers with submitted
+/// image
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitReloadComputers() {
+ $data = getContinuationVar();
+
+ $start = getReloadStartTime();
+ $end = $start + 1200; // + 20 minutes
+ $startstamp = unixToDatetime($start);
+ $endstamp = unixToDatetime($end);
+ $imagerevisionid = getProductionRevisionid($data['imageid']);
+
+ // get semaphore lock
+ if(! semLock())
+ abort(3);
+ $computers = getComputers(1);
+ $reloadnow = array();
+ $reloadasap = array();
+ foreach($data['computerids'] as $compid) {
+ switch($computers[$compid]['state']) {
+ case "available":
+ case "failed":
+ array_push($reloadnow, $compid);
+ break;
+ case "reload":
+ case "reloading":
+ case "inuse":
+ case "timeout":
+ case "reserved":
+ array_push($reloadasap, $compid);
+ break;
+ }
+ }
+ $vclreloadid = getUserlistID('vclreload');
+ $fails = array();
+ $passes = array();
+ foreach($reloadnow as $compid) {
+ if(simpleAddRequest($compid, $data['imageid'], $imagerevisionid, $startstamp, $endstamp, 19, $vclreloadid))
+ $passes[] = $compid;
+ else
+ $fails[] = $compid;
+ }
+ // release semaphore lock
+ semUnlock();
+
+ if(count($reloadasap)) {
+ $compids = implode(',', $reloadasap);
+ $query = "UPDATE computer "
+ . "SET nextimageid = {$data['imageid']} "
+ . "WHERE id IN ($compids)";
+ doQuery($query, 101);
+ }
+ print "<H2>Reload Computers</H2>\n";
+ if(count($passes)) {
+ print "The following computers are being immediately reloaded with ";
+ print "{$data['imagename']}:<br>\n";
+ foreach($passes as $compid)
+ print "<font color=\"#008000\">{$computers[$compid]['hostname']}</font><br>\n";
+ }
+ if(count($reloadasap)) {
+ if(count($passes))
+ print "<br>";
+ print "The following computers will be reloaded with ";
+ print "{$data['imagename']} after their current reservations are over:<br>\n";
+ foreach($reloadasap as $compid)
+ print "<font color=\"ff8c00\">{$computers[$compid]['hostname']}</font><br>\n";
+ }
+ if(count($fails)) {
+ if(count($passes) || count($reloadasap))
+ print "<br>";
+ print "No functional management node was found for the following ";
+ print "computers. They could not be reloaded at this time:<br>\n";
+ foreach($fails as $compid)
+ print "<font color=\"ff0000\">{$computers[$compid]['hostname']}</font><br>\n";
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn compStateChange()
+///
+/// \brief confirms changing computers to selected state, and if new state is
+/// maintenance, asks for reason
+///
+////////////////////////////////////////////////////////////////////////////////
+function compStateChange() {
+ global $submitErr;
+ print "<H2>Change State of Computers</H2>\n";
+ $data = processComputerInput3();
+ $computers = getComputers(1);
+ if($data['stateid'] == 10) {
+ $notes = explode('@', $data['notes']);
+ if(count($notes) != 2)
+ $notes[1] = "";
+ }
+ if($data['stateid'] == 2) {
+ print "You are about to place the following computers into the ";
+ print "available state:\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ }
+ elseif($data['stateid'] == 10) {
+ print "Please enter a reason you are changing the following computers to ";
+ print "the maintenance state:<br><br>\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<TEXTAREA name=notes rows=4 cols=35>{$notes[1]}</TEXTAREA><br>\n";
+ print "<br>Selected computers:\n";
+ }
+ elseif($data['stateid'] == 20) {
+ $profiles = getVMProfiles();
+ $data['profiles'] = $profiles;
+ print "Select a VM Host Profile and then click <strong>Submit</strong>\n";
+ print "to place the computers into the vmhostinuse state:<br><br>\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ printSelectInput('profileid', $profiles);
+ print "<br><br>\n";
+ }
+ elseif($data['stateid'] == 23) {
+ print "You are about to place the following computers into the ";
+ print "hpc state:\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ }
+ $cont = addContinuationsEntry('submitCompStateChange', $data, SECINDAY, 0, 0);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "<TABLE>\n";
+ foreach($data['computerids'] as $compid) {
+ print " <TR>\n";
+ #print " <TD><font color=\"#008000\">{$computers[$compid]['hostname']}</font></TD>\n";
+ print " <TD>{$computers[$compid]['hostname']}</TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ print "<br>\n";
+ print "<INPUT type=submit value=Submit>\n";
+ print "</FORM>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitCompStateChange()
+///
+/// \brief configures system to put submitted computers in submitted state
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitCompStateChange() {
+ global $user;
+ print "<H2>Change State of Computers</H2>\n";
+ $data = getContinuationVar();
+ $computers = getComputers(1);
+ # switching to available
+ if($data['stateid'] == 2) {
+ $compids = implode(',', $data['computerids']);
+ $query = "UPDATE computer "
+ . "SET stateid = 2, "
+ . "notes = '' "
+ . "WHERE id IN ($compids)";
+ doQuery($query, 101);
+ print "The following computers were changed to the available state:\n";
+ print "<TABLE>\n";
+ foreach($data['computerids'] as $compid) {
+ print " <TR>\n";
+ print " <TD>{$computers[$compid]['hostname']}</TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ }
+ # switching to maintenance
+ elseif($data['stateid'] == 10) {
+ $data['notes'] = processInputVar('notes', ARG_STRING);
+ if(get_magic_quotes_gpc())
+ $data['notes'] = stripslashes($data['notes']);
+ $data['notes'] = mysql_escape_string($data['notes']);
+ $data["notes"] = $user["unityid"] . " " . unixToDatetime(time()) . "@"
+ . $data["notes"];
+ $vclreloadid = getUserlistID('vclreload');
+ // get semaphore lock
+ if(! semLock())
+ abort(3);
+ $noaction = array();
+ $changenow = array();
+ $changeasap = array();
+ $changetimes = array();
+ foreach($data['computerids'] as $compid) {
+ if($computers[$compid]['state'] == 'maintenance')
+ array_push($noaction, $compid);
+ else
+ array_push($changeasap, $compid);
+ }
+ $passes = array();
+ $fails = array();
+ foreach($changeasap as $compid) {
+ # TODO what about blockComputers?
+ # try to move future reservations off of computer
+ moveReservationsOffComputer($compid);
+ # get end time of last reservation
+ $query = "SELECT rq.end "
+ . "FROM request rq, "
+ . "reservation rs "
+ . "WHERE rs.requestid = rq.id AND "
+ . "rs.computerid = $compid AND "
+ . "rq.stateid NOT IN (1,5,12) "
+ . "ORDER BY end DESC "
+ . "LIMIT 1";
+ $qh = doQuery($query, 101);
+ # create a really long reservation starting at that time in state tomaintenance
+ if($row = mysql_fetch_assoc($qh)) {
+ $start = $row['end'];
+ $changetimes[$compid] = $start;
+ $end = datetimeToUnix($start) + SECINWEEK; // hopefully keep future reservations off of it
+ $end = unixToDatetime($end);
+ if(simpleAddRequest($compid, 4, 3, $start, $end, 18, $vclreloadid))
+ $passes[] = $compid;
+ else
+ $fails[] = $compid;
+ }
+ # change to maintenance state and save in $changenow
+ // if we wait and put them all in maintenance at the same time,
+ # we may end up moving reservations to the computer later in the
+ # loop
+ else {
+ $query = "UPDATE computer "
+ . "SET stateid = 10, "
+ . "notes = '{$data['notes']}' "
+ . "WHERE id = $compid";
+ doQuery($query, 101);
+ unset_by_val($compid, $changeasap);
+ array_push($changenow, $compid);
+ }
+ }
+ // release semaphore lock
+ semUnlock();
+ if(count($noaction) || count($changeasap)) {
+ $comparr = array_merge($noaction, $changeasap);
+ $compids = implode(',', $comparr);
+ $query = "UPDATE computer "
+ . "SET notes = '{$data['notes']}' "
+ . "WHERE id IN ($compids)";
+ doQuery($query, 101);
+ }
+ if(count($changenow)) {
+ print "The following computers were immediately placed into the ";
+ print "maintenance state:\n";
+ print "<TABLE>\n";
+ foreach($changenow as $compid) {
+ print " <TR>\n";
+ print " <TD><font color=\"#008000\">{$computers[$compid]['hostname']}</font></TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ print "<br>\n";
+ }
+ if(count($passes)) {
+ print "The following computers currently have reservations on them ";
+ print "and will be placed in the maintenance state at the time listed ";
+ print "for each computer:\n";
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TH>Computer</TH>\n";
+ print " <TH>Maintenance time</TH>\n";
+ print " </TR>\n";
+ foreach($passes as $compid) {
+ print " <TR>\n";
+ print " <TD align=center><font color=\"ff8c00\">{$computers[$compid]['hostname']}</font></TD>\n";
+ $time = date('n/j/y g:i a', datetimeToUnix($changetimes[$compid]));
+ print " <TD align=center>$time</TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ print "<br>\n";
+ }
+ if(count($fails)) {
+ print "The following computers currently have reservations on them ";
+ print "but no functional management node was found for them. Nothing ";
+ print "be done with them at this time:\n";
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TH>Computer</TH>\n";
+ print " </TR>\n";
+ foreach($passes as $compid) {
+ print " <TR>\n";
+ print " <TD align=center><font color=\"ff0000\">{$computers[$compid]['hostname']}</font></TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ print "<br>\n";
+ }
+ if(count($noaction)) {
+ print "The following computers were already in the maintenance ";
+ print "state and had their notes on being in the maintenance state ";
+ print "updated:\n";
+ print "<TABLE>\n";
+ foreach($noaction as $compid) {
+ print " <TR>\n";
+ print " <TD>{$computers[$compid]['hostname']}</TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ print "<br>\n";
+ }
+ }
+ # switching to vmhostinuse
+ elseif($data['stateid'] == 20) {
+ $profileid = processInputVar('profileid', ARG_NUMERIC);
+ if(! array_key_exists($profileid, $data['profiles'])) {
+ $keys = array_keys($data['profiles']);
+ $profileid = $keys[0];
+ }
+ $noaction = array();
+ $changenow = array();
+ $changeasap = array();
+ $changetimes = array();
+ foreach($data['computerids'] as $compid) {
+ if($computers[$compid]['state'] == 'vmhostinuse')
+ array_push($noaction, $compid);
+ else
+ array_push($changeasap, $compid);
+ }
+ if(! semLock())
+ abort(3);
+ foreach($changeasap as $compid) {
+ # TODO what about blockComputers?
+ moveReservationsOffComputer($compid);
+ # get end time of last reservation
+ $query = "SELECT rq.end "
+ . "FROM request rq, "
+ . "reservation rs "
+ . "WHERE rs.requestid = rq.id AND "
+ . "rs.computerid = $compid AND "
+ . "rq.stateid NOT IN (1,5,12) "
+ . "ORDER BY end DESC "
+ . "LIMIT 1";
+ $qh = doQuery($query, 101);
+ if($row = mysql_fetch_assoc($qh)) {
+ // if there is a reservation, leave in $changeasap so we can
+ # notify that we can't change this one
+ }
+ # change to vmhostinuse state and save in $changenow
+ // if we wait and put them all in vmhostinuse at the same time,
+ # we may end up moving reservations to the computer later in the
+ # loop
+ else {
+ # create a reload reservation to load machine with image
+ # corresponding to selected vm profile
+ $start = getReloadStartTime();
+ $end = $start + SECINYEAR; # don't want anyone making a future reservation for this machine
+ $start = unixToDatetime($start);
+ $end = unixToDatetime($end);
+ $imagerevisionid = getProductionRevisionid($data['profiles'][$profileid]['imageid']);
+ $vclreloadid = getUserlistID('vclreload');
+ simpleAddRequest($compid, $data['profiles'][$profileid]['imageid'],
+ $imagerevisionid, $start, $end, 21, $vclreloadid);
+ unset_by_val($compid, $changeasap);
+ array_push($changenow, $compid);
+
+ # check for existing vmhost entry
+ $query = "SELECT id, "
+ . "vmprofileid "
+ . "FROM vmhost "
+ . "WHERE computerid = $compid";
+ $qh = doQuery($query, 101);
+ if($row = mysql_fetch_assoc($qh)) {
+ if($row['vmprofileid'] != $profileid) {
+ # update vmprofile
+ $query = "UPDATE vmhost "
+ . "SET vmprofileid = $profileid "
+ . "WHERE id = {$row['id']}";
+ doQuery($query, 101);
+ }
+ }
+ else {
+ # create vmhost entry
+ $query = "INSERT INTO vmhost "
+ . "(computerid, "
+ . "vmlimit, "
+ . "vmprofileid) "
+ . "VALUES ($compid, "
+ . "2, "
+ . "$profileid)";
+ doQuery($query, 101);
+ }
+ }
+ }
+ // release semaphore lock
+ semUnlock();
+ if(count($changenow)) {
+ print "The following computers were placed into the ";
+ print "vmhostinuse state:\n";
+ print "<TABLE>\n";
+ foreach($changenow as $compid) {
+ print " <TR>\n";
+ print " <TD><font color=\"#008000\">{$computers[$compid]['hostname']}</font></TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ print "<br>\n";
+ }
+ if(count($changeasap)) {
+ print "The following computers currently have reservations on them ";
+ print "and cannot be placed in the vmhostinuse state at this time:\n";
+ print "<TABLE>\n";
+ foreach($changeasap as $compid) {
+ print " <TR>\n";
+ print " <TD><font color=\"ff0000\">{$computers[$compid]['hostname']}</font></TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ print "<br>\n";
+ }
+ if(count($noaction)) {
+ print "The following computers were already in the vmhostinuse ";
+ print "state:\n";
+ print "<TABLE>\n";
+ foreach($noaction as $compid) {
+ print " <TR>\n";
+ print " <TD>{$computers[$compid]['hostname']}</TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ print "<br>\n";
+ }
+ }
+ # switching to hpc
+ elseif($data['stateid'] == 23) {
+ $noaction = array();
+ $changenow = array();
+ $changeasap = array();
+ $changetimes = array();
+ foreach($data['computerids'] as $compid) {
+ if($computers[$compid]['state'] == 'hpc')
+ array_push($noaction, $compid);
+ else
+ array_push($changeasap, $compid);
+ }
+ if(! semLock())
+ abort(3);
+ foreach($changeasap as $compid) {
+ # TODO what about blockComputers?
+ moveReservationsOffComputer($compid);
+ # get end time of last reservation
+ $query = "SELECT rq.end "
+ . "FROM request rq, "
+ . "reservation rs "
+ . "WHERE rs.requestid = rq.id AND "
+ . "rs.computerid = $compid AND "
+ . "rq.stateid NOT IN (1,5,12) "
+ . "ORDER BY end DESC "
+ . "LIMIT 1";
+ $qh = doQuery($query, 101);
+ if($row = mysql_fetch_assoc($qh)) {
+ // if there is a reservation, leave in $changeasap so we can
+ # notify that we can't change this one
+ }
+ # change to hpc state and save in $changenow
+ // if we wait and put them all in hpc at the same time,
+ # we may end up moving reservations to the computer later in the
+ # loop
+ else {
+ $query = "UPDATE computer "
+ . "SET stateid = 23 "
+ . "WHERE id = $compid";
+ doQuery($query, 101);
+ unset_by_val($compid, $changeasap);
+ array_push($changenow, $compid);
+ }
+ }
+ // release semaphore lock
+ semUnlock();
+ if(count($changenow)) {
+ print "The following computers were placed into the ";
+ print "hpc state:\n";
+ print "<TABLE>\n";
+ foreach($changenow as $compid) {
+ print " <TR>\n";
+ print " <TD><font color=\"#008000\">{$computers[$compid]['hostname']}</font></TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ print "<br>\n";
+ }
+ if(count($changeasap)) {
+ print "The following computers currently have reservations on them ";
+ print "and cannot be placed in the hpc state at this time:\n";
+ print "<TABLE>\n";
+ foreach($changeasap as $compid) {
+ print " <TR>\n";
+ print " <TD><font color=\"ff0000\">{$computers[$compid]['hostname']}</font></TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ print "<br>\n";
+ }
+ if(count($noaction)) {
+ print "The following computers were already in the hpc ";
+ print "state:\n";
+ print "<TABLE>\n";
+ foreach($noaction as $compid) {
+ print " <TR>\n";
+ print " <TD>{$computers[$compid]['hostname']}</TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ print "<br>\n";
+ }
+ }
+ else
+ abort(50);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn compScheduleChange()
+///
+/// \brief confirms changing computers to selected schedule
+///
+////////////////////////////////////////////////////////////////////////////////
+function compScheduleChange() {
+ global $submitErr;
+ print "<H2>Change Schedule of Computers</H2>\n";
+ $data = processComputerInput3();
+ $computers = getComputers(1);
+ $schedules = getSchedules();
+ print "You are about to place the following computer(s) into schedule ";
+ print "<strong><big>{$schedules[$data['scheduleid']]['name']}</big></strong>";
+ print ".<br><strong>Note:</strong> ";
+ print "This will not affect reservations currently on the computer(s). It ";
+ print "will only affect new reservations made on the computer(s).<br>\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('scheduleid' => $data['scheduleid'],
+ 'schedule' => $schedules[$data['scheduleid']]['name'],
+ 'computerids' => $data['computerids']);
+ $cont = addContinuationsEntry('submitCompScheduleChange', $cdata, SECINDAY, 1, 0);
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "<TABLE>\n";
+ foreach($data['computerids'] as $compid) {
+ print " <TR>\n";
+ print " <TD>{$computers[$compid]['hostname']}</TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ print "<INPUT type=submit value=Submit>\n";
+ print "</FORM>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitCompScheduleChange()
+///
+/// \brief configures system to put submitted computers in submitted state
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitCompScheduleChange() {
+ global $user;
+ print "<H2>Change Schedule of Computers</H2>\n";
+ $data = getContinuationVar();
+ $computers = getComputers(1);
+ $compids = implode(',', $data['computerids']);
+ $query = "UPDATE computer "
+ . "SET scheduleid = {$data['scheduleid']} "
+ . "WHERE id IN ($compids)";
+ doQuery($query, 101);
+ print "The schedule for the following computer(s) was set to ";
+ print "{$data['schedule']}:<br>\n";
+ print "<TABLE>\n";
+ foreach($data['computerids'] as $compid) {
+ print " <TR>\n";
+ print " <TD>{$computers[$compid]['hostname']}</TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn processComputerInput($checks)
+///
+/// \param $checks - (optional) 1 to perform validation, 0 not to
+///
+/// \return an array with the following keys:\n
+/// bulk, ipaddress, stateid, deptid, platformid, scheduleid, currentimgid,
+/// ram, numprocs, procspeed, network, hostname, compid, type
+///
+/// \brief validates input from the previous form; if anything was improperly
+/// submitted, sets submitErr and submitErrMsg
+///
+////////////////////////////////////////////////////////////////////////////////
+function processComputerInput($checks=1) {
+ global $submitErr, $submitErrMsg, $mode;
+ $return = processComputerInput2();
+
+ $return["bulk"] = getContinuationVar("bulk", processInputVar("bulk", ARG_NUMERIC));
+ $return["ipaddress"] = getContinuationVar("ipaddress", processInputVar("ipaddress", ARG_STRING));
+ $return["stateid"] = getContinuationVar("stateid", processInputVar("stateid", ARG_NUMERIC));
+ $return["deptid"] = getContinuationVar("deptid", processInputVar("deptid", ARG_NUMERIC));
+ $return["owner"] = getContinuationVar("owner", processInputVar("owner", ARG_STRING));
+ $return["platformid"] = getContinuationVar("platformid", processInputVar("platformid", ARG_NUMERIC));
+ $return["scheduleid"] = getContinuationVar("scheduleid", processInputVar("scheduleid", ARG_NUMERIC));
+ $return["currentimgid"] = getContinuationVar("currentimgid", processInputVar("currentimgid", ARG_NUMERIC));
+ $return["ram"] = getContinuationVar("ram", processInputVar("ram", ARG_NUMERIC));
+ $return["numprocs"] = getContinuationVar("numprocs", processInputVar("numprocs", ARG_NUMERIC));
+ $return["procspeed"] = getContinuationVar("procspeed", processInputVar("procspeed", ARG_NUMERIC));
+ $return["network"] = getContinuationVar("network", processInputVar("network", ARG_NUMERIC));
+ $return["hostname"] = getContinuationVar("hostname", processInputVar("hostname", ARG_STRING));
+ $return["compid"] = getContinuationVar("compid", processInputVar("compid", ARG_NUMERIC));
+ $return["type"] = getContinuationVar("type", processInputVar("type", ARG_STRING, "lab"));
+ $return["provisioningid"] = getContinuationVar("provisioningid", processInputVar("provisioningid", ARG_NUMERIC));
+ $return["notes"] = getContinuationVar("notes", processInputVar("notes", ARG_STRING));
+ $return["computergroup"] = getContinuationVar("computergroup", processInputVar("computergroup", ARG_MULTINUMERIC));
+ $return["showcounts"] = getContinuationVar("showcounts", processInputVar("showcounts", ARG_NUMERIC));
+ $return["showdeleted"] = getContinuationVar('showdeleted', 0);
+
+ if(! $checks) {
+ return $return;
+ }
+
+ $ipaddressArr = explode('.', $return["ipaddress"]);
+ if(! ereg('^(([0-9]){1,3}\.){3}([0-9]){1,3}$', $return["ipaddress"]) ||
+ $ipaddressArr[0] < 1 || $ipaddressArr[0] > 255 ||
+ $ipaddressArr[1] < 0 || $ipaddressArr[1] > 255 ||
+ $ipaddressArr[2] < 0 || $ipaddressArr[2] > 255 ||
+ $ipaddressArr[3] < 1 || $ipaddressArr[3] > 255) {
+ $submitErr |= IPADDRERR;
+ $submitErrMsg[IPADDRERR] = "Invalid IP address. Must be w.x.y.z with each of "
+ . "w, x, y, and z being between 1 and 255 (inclusive)";
+ }
+ /*if(! ($submitErr & IPADDRERR) &&
+ checkForIPaddress($return["ipaddress"], $return["compid"])) {
+ $submitErr |= IPADDRERR;
+ $submitErrMsg[IPADDRERR] = "There is already a computer with this IP address.";
+ }*/
+ if($return["ram"] < 32 || $return["ram"] > 20480) {
+ $submitErr |= RAMERR;
+ $submitErrMsg[RAMERR] = "RAM must be between 32 and 20480";
+ }
+ if($return["procspeed"] < 500 || $return["procspeed"] > 20000) {
+ $submitErr |= PROCSPEEDERR;
+ $submitErrMsg[PROCSPEEDERR] = "Processor Speed must be between 500 and 20000";
+ }
+ if(! ereg('^[a-zA-Z0-9_][-a-zA-Z0-9_.]{1,35}$', $return["hostname"])) {
+ $submitErr |= HOSTNAMEERR;
+ $submitErrMsg[HOSTNAMEERR] = "Hostname must be <= 36 characters";
+ }
+ if(! ($submitErr & HOSTNAMEERR) &&
+ checkForHostname($return["hostname"], $return["compid"])) {
+ $submitErr |= HOSTNAMEERR;
+ $submitErrMsg[HOSTNAMEERR] = "There is already a computer with this hostname.";
+ }
+ if($mode != 'viewComputers' && ! validateUserid($return["owner"])) {
+ $submitErr |= OWNERERR;
+ $submitErrMsg[OWNERERR] = "Submitted ID is not valid";
+ }
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn processComputerInput2()
+///
+/// \return an array with the following keys:\n
+/// depts, platforms, schedules, showhostname, shownextimage,
+/// showipaddress, showram, showstate, showprocnumber, showdepartment,
+/// showprocspeed, showplatform, shownetwork, showschedule, showcomputerid,
+/// showcurrentimage, showtype, showprovisioning
+///
+/// \brief processes depts, platforms, schedules, and all of the flags for
+/// what data to show
+///
+////////////////////////////////////////////////////////////////////////////////
+function processComputerInput2() {
+ $return = array();
+
+ $return["depts"] = getContinuationVar('depts', processInputVar("depts", ARG_MULTINUMERIC));
+ $return["platforms"] = getContinuationVar('platforms', processInputVar("platforms", ARG_MULTINUMERIC));
+ $return["schedules"] = getContinuationVar('schedules', processInputVar("schedules", ARG_MULTINUMERIC));
+ $return["groups"] = getContinuationVar('groups', processInputVar("groups", ARG_MULTINUMERIC));
+ $return["showhostname"] = getContinuationVar('showhostname', processInputVar("showhostname", ARG_NUMERIC, 0));
+ $return["shownextimage"] = getContinuationVar('shownextimage', processInputVar("shownextimage", ARG_NUMERIC, 0));
+ $return["showipaddress"] = getContinuationVar('showipaddress', processInputVar("showipaddress", ARG_NUMERIC, 0));
+ $return["showram"] = getContinuationVar('showram', processInputVar("showram", ARG_NUMERIC, 0));
+ $return["showstate"] = getContinuationVar('showstate', processInputVar("showstate", ARG_NUMERIC, 0));
+ $return["showprocnumber"] = getContinuationVar('showprocnumber', processInputVar("showprocnumber", ARG_NUMERIC, 0));
+ $return["showdepartment"] = getContinuationVar('showdepartment', processInputVar("showdepartment", ARG_NUMERIC, 0));
+ $return["showowner"] = getContinuationVar('showowner', processInputVar("showowner", ARG_NUMERIC, 0));
+ $return["showprocspeed"] = getContinuationVar('showprocspeed', processInputVar("showprocspeed", ARG_NUMERIC, 0));
+ $return["showplatform"] = getContinuationVar('showplatform', processInputVar("showplatform", ARG_NUMERIC, 0));
+ $return["shownetwork"] = getContinuationVar('shownetwork', processInputVar("shownetwork", ARG_NUMERIC, 0));
+ $return["showschedule"] = getContinuationVar('showschedule', processInputVar("showschedule", ARG_NUMERIC, 0));
+ $return["showcomputerid"] = getContinuationVar('showcomputerid', processInputVar("showcomputerid", ARG_NUMERIC, 0));
+ $return["showcurrentimage"] = getContinuationVar('showcurrentimage', processInputVar("showcurrentimage", ARG_NUMERIC, 0));
+ $return["showtype"] = getContinuationVar('showtype', processInputVar("showtype", ARG_NUMERIC, 0));
+ $return["showprovisioning"] = getContinuationVar('showprovisioning', processInputVar("showprovisioning", ARG_NUMERIC, 0));
+ $return["shownotes"] = getContinuationVar('shownotes', processInputVar("shownotes", ARG_NUMERIC, 0));
+ $return["showcounts"] = getContinuationVar('showcounts', processInputVar("showcounts", ARG_NUMERIC, 0));
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn processComputerInput3()
+///
+/// \return an array with the following indexes:\n
+/// notes, imageid, stateid, computerids
+///
+/// \brief processes input for computer utilities pages
+///
+////////////////////////////////////////////////////////////////////////////////
+function processComputerInput3() {
+ global $submitErr, $submitErrMsg;
+ $compids = getContinuationVar("computerids", processInputVar('computerids', ARG_MULTINUMERIC));
+ $return['notes'] = getContinuationVar("notes", processInputVar('notes', ARG_STRING));
+ $return['imageid'] = getContinuationVar("imageid", processInputVar('imageid', ARG_NUMERIC));
+ $return['stateid'] = getContinuationVar("stateid", processInputVar('stateid', ARG_NUMERIC));
+ $return['scheduleid'] = getContinuationVar("scheduleid", processInputVar('scheduleid', ARG_NUMERIC));
+ $resources = getUserResources(array("computerAdmin"), array("administer"));
+ $userCompIDs = array_keys($resources["computer"]);
+ $remove = array_diff($compids, $userCompIDs);
+ $return['computerids'] = array_diff($compids, $remove);
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn processBulkComputerInput($checks)
+///
+/// \param $checks - (optional) 1 to perform validation, 0 not to
+///
+/// \return an array with the following indexes:\n
+/// startipaddress, endipaddress, starthostval, endhostval, stateid, deptid,
+/// platformid, scheduleid, ram, numprocs, procspeed, network,
+/// hostname, type, count (0 if any errors found)
+///
+/// \brief validates input from the previous form; if anything was improperly
+/// submitted, sets submitErr and submitErrMsg
+///
+////////////////////////////////////////////////////////////////////////////////
+function processBulkComputerInput($checks=1) {
+ global $submitErr, $submitErrMsg, $viewmode;
+ $return = processComputerInput2();
+ $ipaddress = getContinuationVar("ipaddress", processInputVar("ipaddress", ARG_STRING));
+ if(! empty($ipaddress)) {
+ $return["startipaddress"] = $ipaddress;
+ $tmp = $ipaddress;
+ $tmpArr = explode('.', $tmp);
+ array_pop($tmpArr);
+ $return["endipaddress"] = implode('.', $tmpArr);
+ $return["starthostval"] = "";
+ $return["endhostval"] = "";
+ }
+ else {
+ $return["startipaddress"] = getContinuationVar("startipaddress", processInputVar("startipaddress", ARG_STRING));
+ $return["endipaddress"] = getContinuationVar("endipaddress", processInputVar("endipaddress", ARG_STRING));
+ $return["startpripaddress"] = getContinuationVar("startpripaddress", processInputVar("startpripaddress", ARG_STRING));
+ $return["endpripaddress"] = getContinuationVar("endpripaddress", processInputVar("endpripaddress", ARG_STRING));
+ $return["starthostval"] = getContinuationVar("starthostval", processInputVar("starthostval", ARG_NUMERIC));
+ $return["endhostval"] = getContinuationVar("endhostval", processInputVar("endhostval", ARG_NUMERIC));
+ $return["startmac"] = getContinuationVar("startmac", processInputVar("startmac", ARG_STRING));
+ }
+
+ $return["stateid"] = getContinuationVar("stateid", processInputVar("stateid", ARG_NUMERIC));
+ $return["deptid"] = getContinuationVar("deptid", processInputVar("deptid", ARG_NUMERIC));
+ $return["owner"] = getContinuationVar("owner", processInputVar("owner", ARG_STRING));
+ $return["platformid"] = getContinuationVar("platformid", processInputVar("platformid", ARG_NUMERIC));
+ $return["scheduleid"] = getContinuationVar("scheduleid", processInputVar("scheduleid", ARG_NUMERIC));
+ $return["ram"] = getContinuationVar("ram", processInputVar("ram", ARG_NUMERIC));
+ $return["numprocs"] = getContinuationVar("numprocs", processInputVar("numprocs", ARG_NUMERIC));
+ $return["procspeed"] = getContinuationVar("procspeed", processInputVar("procspeed", ARG_NUMERIC));
+ $return["network"] = getContinuationVar("network", processInputVar("network", ARG_NUMERIC));
+ $return["hostname"] = getContinuationVar("hostname", processInputVar("hostname", ARG_STRING));
+ $return["type"] = getContinuationVar("type", processInputVar("type", ARG_STRING));
+ $return["provisioningid"] = getContinuationVar("provisioningid", processInputVar("provisioningid", ARG_NUMERIC));
+ $return["computergroup"] = getContinuationVar("computergroup", processInputVar("computergroup", ARG_MULTINUMERIC));
+ $return['macs'] = getContinuationVar('macs', array());
+
+ if(! $checks) {
+ return $return;
+ }
+
+ $startaddrArr = explode('.', $return["startipaddress"]);
+ if(! ereg('^(([0-9]){1,3}\.){3}([0-9]){1,3}$', $return["startipaddress"]) ||
+ $startaddrArr[0] < 1 || $startaddrArr[0] > 255 ||
+ $startaddrArr[1] < 0 || $startaddrArr[1] > 255 ||
+ $startaddrArr[2] < 0 || $startaddrArr[2] > 255 ||
+ $startaddrArr[3] < 1 || $startaddrArr[3] > 255) {
+ $submitErr |= IPADDRERR;
+ $submitErrMsg[IPADDRERR] = "Invalid IP address. Must be w.x.y.z with each of "
+ . "w, x, y, and z being between 1 and 255 (inclusive)";
+ }
+ $endaddrArr = explode('.', $return["endipaddress"]);
+ if(! ereg('^(([0-9]){1,3}\.){3}([0-9]){1,3}$', $return["endipaddress"]) ||
+ $endaddrArr[0] < 1 || $endaddrArr[0] > 255 ||
+ $endaddrArr[1] < 0 || $endaddrArr[1] > 255 ||
+ $endaddrArr[2] < 0 || $endaddrArr[2] > 255 ||
+ $endaddrArr[3] < 1 || $endaddrArr[3] > 255) {
+ $submitErr |= IPADDRERR2;
+ $submitErrMsg[IPADDRERR2] = "Invalid IP address. Must be w.x.y.z with each of "
+ . "w, x, y, and z being between 1 and 255 (inclusive)";
+ }
+ $endpraddrArr = array();
+ if($viewmode == ADMIN_DEVELOPER) {
+ if(! empty($return['startpripaddress']) ||
+ ! empty($return['endpripaddress'])) {
+ $startpraddrArr = explode('.', $return["startpripaddress"]);
+ if(! ereg('^(([0-9]){1,3}\.){3}([0-9]){1,3}$', $return["startpripaddress"]) ||
+ $startpraddrArr[0] < 1 || $startpraddrArr[0] > 255 ||
+ $startpraddrArr[1] < 0 || $startpraddrArr[1] > 255 ||
+ $startpraddrArr[2] < 0 || $startpraddrArr[2] > 255 ||
+ $startpraddrArr[3] < 1 || $startpraddrArr[3] > 255) {
+ $submitErr |= IPADDRERR3;
+ $submitErrMsg[IPADDRERR3] = "Invalid IP address. Must be w.x.y.z with each of "
+ . "w, x, y, and z being between 1 and 255 (inclusive)";
+ }
+ $endpraddrArr = explode('.', $return["endpripaddress"]);
+ if(! ereg('^(([0-9]){1,3}\.){3}([0-9]){1,3}$', $return["endpripaddress"]) ||
+ $endpraddrArr[0] < 1 || $endpraddrArr[0] > 255 ||
+ $endpraddrArr[1] < 0 || $endpraddrArr[1] > 255 ||
+ $endpraddrArr[2] < 0 || $endpraddrArr[2] > 255 ||
+ $endpraddrArr[3] < 1 || $endpraddrArr[3] > 255) {
+ $submitErr |= IPADDRERR4;
+ $submitErrMsg[IPADDRERR4] = "Invalid IP address. Must be w.x.y.z with each of "
+ . "w, x, y, and z being between 1 and 255 (inclusive)";
+ }
+ }
+ if(! empty($return['startmac'])) {
+ if(! ereg('^(([A-Fa-f0-9]){2}:){5}([A-Fa-f0-9]){2}$', $return["startmac"])) {
+ $submitErr |= MACADDRERR;
+ $submitErrMsg[MACADDRERR] = "Invalid MAC address. Must be XX:XX:XX:XX:XX:XX "
+ . "with each pair of XX being from 00 to FF (inclusive)";
+ }
+ elseif(! $submitErr) {
+ $tmp = explode(':', $return['startmac']);
+ $topdec = hexdec($tmp[0] . $tmp[1] . $tmp[2]);
+ $botdec = hexdec($tmp[3] . $tmp[4] . $tmp[5]);
+ $topmac = "{$tmp[0]}:{$tmp[1]}:{$tmp[2]}";
+ $topplus = implode(':', str_split(dechex($topdec + 1), 2));
+ $start = $botdec;
+ $return['macs'] = array();
+ $end = $start + (($endaddrArr[3] - $startaddrArr[3] + 1) * 2);
+ for($i = $start; $i < $end; $i++) {
+ if($i > 16777215) {
+ $val = $i - 16777216;
+ $tmp = sprintf('%06x', $val);
+ $tmp2 = str_split($tmp, 2);
+ $return['macs'][] = $topplus . ':' . implode(':', $tmp2);
+ }
+ else {
+ $tmp = sprintf('%06x', $i);
+ $tmp2 = str_split($tmp, 2);
+ $return['macs'][] = $topmac . ':' . implode(':', $tmp2);
+ }
+ }
+ if($i > 16777215 && $topdec == 16777215) {
+ $submitErr |= MACADDRERR;
+ $submitErrMsg[MACADDRERR] = "Starting MAC address too large for given "
+ . "given number of machines";
+ }
+ }
+ }
+ }
+ if($return["ram"] < 32 || $return["ram"] > 20480) {
+ $submitErr |= RAMERR;
+ $submitErrMsg[RAMERR] = "RAM must be between 32 and 20480";
+ }
+ if($return["procspeed"] < 500 || $return["procspeed"] > 20000) {
+ $submitErr |= PROCSPEEDERR;
+ $submitErrMsg[PROCSPEEDERR] = "Processor Speed must be between 500 and 20000";
+ }
+ if(! ereg('^[a-zA-Z0-9_%][-a-zA-Z0-9_.%]{1,35}$', $return["hostname"])) {
+ $submitErr |= HOSTNAMEERR;
+ $submitErrMsg[HOSTNAMEERR] = "Hostname must be <= 36 characters";
+ }
+ if(empty($return["starthostval"]) && $return["starthostval"] != 0) {
+ $submitErr |= STARTHOSTVALERR;
+ $submitErrMsg[STARTHOSTVALERR] = "Start value can only be numeric.";
+ }
+ if(empty($return["endhostval"]) && $return["endhostval"] != 0) {
+ $submitErr |= ENDHOSTVALERR;
+ $submitErrMsg[ENDHOSTVALERR] = "End value can only be numeric.";
+ }
+ if(! ($submitErr & IPADDRERR2 || $submitErr & ENDHOSTVALERR) &&
+ ($endaddrArr[3] - $startaddrArr[3] != $return["endhostval"] - $return["starthostval"])) {
+ $numipaddrs = $endaddrArr[3] - $startaddrArr[3] + 1;
+ $numhostnames = $return["endhostval"] - $return["starthostval"] + 1;
+ $submitErr |= IPADDRERR2;
+ $submitErrMsg[IPADDRERR2] = "The number of IP addresses ($numipaddrs) "
+ . "does not match the number of hostnames ($numhostnames).";
+ $submitErr |= ENDHOSTVALERR;
+ $submitErrMsg[ENDHOSTVALERR] = "The number of IP addresses ($numipaddrs) "
+ . "does not match the number of hostnames ($numhostnames).";
+ }
+ if($viewmode == ADMIN_DEVELOPER &&
+ ! empty($return['startpripaddress']) && ! empty($return['endpripaddress']) &&
+ (! ($submitErr & IPADDRERR2 || $submitErr & IPADDRERR4) &&
+ ! empty($endpraddrArr) &&
+ ($endaddrArr[3] - $startaddrArr[3] != $endpraddrArr[3] - $startpraddrArr[3]))) {
+ $numpubaddrs = $endaddrArr[3] - $startaddrArr[3] + 1;
+ $numpraddrs = $endpraddrArr[3] - $startpraddrArr[3] + 1;
+ $submitErr |= IPADDRERR2;
+ $submitErrMsg[IPADDRERR2] = "The number of public IP addresses ($numpubaddrs) "
+ . "does not match the number of private IP addresses ($numpraddrs).";
+ $submitErr |= IPADDRERR4;
+ $submitErrMsg[IPADDRERR4] = $submitErrMsg[IPADDRERR2];
+ }
+ if(! validateUserid($return["owner"])) {
+ $submitErr |= OWNERERR;
+ $submitErrMsg[OWNERERR] = "Submitted ID is not valid";
+ }
+ $return['count'] = 0;
+ if(! $submitErr)
+ $return['count'] = $endaddrArr[3] - $startaddrArr[3] + 1;
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn checkForHostname($hostname, $compid)
+///
+/// \param $hostname - a computer hostname
+/// \param $compid - a computer id to ignore
+///
+/// \return 1 if $hostname is already in the computer table, 0 if not
+///
+/// \brief checks for $hostname being somewhere in the computer table except
+/// for $compid
+///
+////////////////////////////////////////////////////////////////////////////////
+function checkForHostname($hostname, $compid) {
+ $query = "SELECT id FROM computer "
+ . "WHERE hostname = '$hostname'";
+ if(! empty($compid))
+ $query .= " AND id != $compid";
+ $qh = doQuery($query, 101);
+ if(mysql_num_rows($qh))
+ return 1;
+ return 0;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn checkForIPaddress($ipaddress, $compid)
+///
+/// \param $ipaddress - a computer ip address
+/// \param $compid - a computer id to ignore
+///
+/// \return 1 if $ipaddress is already in the computer table, 0 if not
+///
+/// \brief checks for $ipaddress being somewhere in the computer table except
+/// for $compid
+///
+////////////////////////////////////////////////////////////////////////////////
+function checkForIPaddress($ipaddress, $compid) {
+ $query = "SELECT id FROM computer "
+ . "WHERE IPaddress = '$ipaddress'";
+ if(! empty($compid))
+ $query .= " AND id != $compid";
+ $qh = doQuery($query, 101);
+ if(mysql_num_rows($qh))
+ return 1;
+ return 0;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getCompIdList($groups)
+///
+/// \param $groups - an array of computer group ids
+///
+/// \return an array where each key is a computer id and each value is 1
+///
+/// \brief builds a list of computer ids that are either in $groups or are not
+/// in any groups but owned by the logged in user
+///
+////////////////////////////////////////////////////////////////////////////////
+function getCompIdList($groups) {
+ global $user;
+ $inlist = implode(',', $groups);
+ $query = "SELECT DISTINCT r.subid as compid "
+ . "FROM resource r, "
+ . "resourcegroupmembers rgm "
+ . "WHERE r.id = rgm.resourceid AND "
+ . "rgm.resourcegroupid IN ($inlist)";
+ $qh = doQuery($query, 101);
+ $compidlist = array();
+ while($row = mysql_fetch_assoc($qh))
+ $compidlist[$row['compid']] = 1;
+ $query = "SELECT id "
+ . "FROM computer "
+ . "WHERE ownerid = {$user['id']} AND "
+ . "id NOT IN (SELECT r.subid "
+ . "FROM resource r, "
+ . "resourcegroupmembers rgm "
+ . "WHERE r.id = rgm.resourceid AND "
+ . "r.resourcetypeid = 12)";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_assoc($qh))
+ $compidlist[$row['id']] = 1;
+ return $compidlist;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn updateComputer($data)
+///
+/// \param $data - an array with the following indexes:\n
+/// ipaddress, stateid, deptid, platformid, scheduleid,
+/// ram, numprocs, procspeed, network, hostname, compid, type
+///
+/// \return number of rows affected by the update\n
+/// \b NOTE: mysql reports that no rows were affected if none of the fields
+/// were actually changed even if the update matched a row
+///
+/// \brief performs a query to update the computer with data from $data
+///
+////////////////////////////////////////////////////////////////////////////////
+function updateComputer($data) {
+ $ownerid = getUserlistID($data["owner"]);
+ $query = "UPDATE computer "
+ . "SET stateid = {$data["stateid"]}, "
+ /*. "deptid = " . $data["deptid"] . ", "*/
+ . "ownerid = $ownerid, "
+ . "platformid = {$data["platformid"]}, "
+ . "scheduleid = {$data["scheduleid"]}, "
+ . "RAM = {$data["ram"]}, "
+ . "procnumber = {$data["numprocs"]}, "
+ . "procspeed = {$data["procspeed"]}, "
+ . "network = {$data["network"]}, "
+ . "hostname = '{$data["hostname"]}', "
+ . "IPaddress = '{$data["ipaddress"]}', "
+ . "type = '{$data["type"]}', "
+ . "provisioningid = {$data["provisioningid"]}, "
+ . "notes = '{$data["notes"]}' "
+ . "WHERE id = {$data["compid"]}";
+ $qh = doQuery($query, 185);
+ return mysql_affected_rows($GLOBALS["mysql_link_vcl"]);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn addComputer($data)
+///
+/// \param $data - an array with the following indexes:\n
+/// ipaddress, stateid, deptid, platformid, scheduleid,
+/// ram, numprocs, procspeed, network, hostname, type
+///
+/// \brief adds a computer to the computer table
+///
+////////////////////////////////////////////////////////////////////////////////
+function addComputer($data) {
+ $ownerid = getUserlistID($data["owner"]);
+ $query = "INSERT INTO computer "
+ . "(stateid, "
+ . "ownerid, "
+ . "platformid, "
+ . "scheduleid, "
+ . "currentimageid, "
+ . "RAM, "
+ . "procnumber, "
+ . "procspeed, "
+ . "network, "
+ . "hostname, "
+ . "IPaddress, "
+ . "type, "
+ . "provisioningid) "
+ . "VALUES (" . $data["stateid"] . ", "
+ . "$ownerid, "
+ . $data["platformid"] . ", "
+ . $data["scheduleid"] . ", "
+ . "4, "
+ . $data["ram"] . ", "
+ . $data["numprocs"] . ", "
+ . $data["procspeed"] . ", "
+ . $data["network"] . ", "
+ . "'" . $data["hostname"] . "', "
+ . "'" . $data["ipaddress"] . "', "
+ . "'" . $data["type"] . "', "
+ . "'" . $data["provisioningid"] . "')";
+ doQuery($query, 195);
+
+ $qh = doQuery("SELECT LAST_INSERT_ID() FROM computer", 196);
+ if(! $row = mysql_fetch_row($qh)) {
+ abort(197);
+ }
+ $query = "INSERT INTO resource "
+ . "(resourcetypeid, "
+ . "subid) "
+ . "VALUES (12, "
+ . $row[0] . ")";
+ doQuery($query, 198);
+
+ // add computer into selected groups
+ $qh = doQuery("SELECT LAST_INSERT_ID() FROM resource", 101);
+ if(! $row = mysql_fetch_row($qh)) {
+ abort(197);
+ }
+
+ foreach(array_keys($data["computergroup"]) as $groupid) {
+ $query = "INSERT INTO resourcegroupmembers "
+ . "(resourceid, "
+ . "resourcegroupid) "
+ . "VALUES ({$row[0]}, "
+ . "$groupid)";
+ doQuery($query, 101);
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn printComputerInfo($ipaddress, $stateid, $deptid, $owner,
+/// $platformid, $scheduleid, $currentimgid,
+/// $ram, $numprocs, $procspeed,
+/// $network, $hostname, $compid, $type,
+/// $provisioningid) {
+///
+/// \param $ipaddress - IP address of computer
+/// \param $stateid - stateid of computer
+/// \param $deptid - departmentid of computer
+/// \param $owner - owner of computer
+/// \param $platformid - platformid of computer
+/// \param $scheduleid - scheduleid of computer
+/// \param $currentimgid - current imageid of computer
+/// \param $ram - ram in MB of computer
+/// \param $numprocs - number of processors in computer
+/// \param $procspeed - processor speed of computer
+/// \param $network - network speed of computer's NIC in MBbps
+/// \param $hostname - hostname of computer
+/// \param $compid - id of computer from computer table
+/// \param $type - type of computer (blade or lab)
+/// \param $provisioningid - id of provisioning engine
+///
+/// \brief prints a table of information about the computer
+///
+////////////////////////////////////////////////////////////////////////////////
+function printComputerInfo($ipaddress, $stateid, $deptid, $owner, $platformid,
+ $scheduleid, $currentimgid, $ram, $numprocs,
+ $procspeed, $network, $hostname, $compid, $type,
+ $provisioningid) {
+
+ $states = getStates();
+ $platforms = getPlatforms();
+ $schedules = getSchedules();
+ $images = getImages();
+ $provisioning = getProvisioning();
+
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TH align=right>Hostname:</TH>\n";
+ print " <TD>$hostname</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>IP Address:</TH>\n";
+ print " <TD>$ipaddress</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>State:</TH>\n";
+ print " <TD>" . $states[$stateid] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Owner:</TH>\n";
+ print " <TD>$owner</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Platform:</TH>\n";
+ print " <TD>" . $platforms[$platformid] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Schedule:</TH>\n";
+ print " <TD>" . $schedules[$scheduleid]["name"] . "</TD>\n";
+ print " </TR>\n";
+ if(! empty($currentimgid)) {
+ print " <TR>\n";
+ print " <TH align=right>Current Image:</TH>\n";
+ print " <TD>" . $images[$currentimgid]["prettyname"] . "</TD>\n";
+ print " </TR>\n";
+ }
+ print " <TR>\n";
+ print " <TH align=right>RAM (MB):</TH>\n";
+ print " <TD>$ram</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>No. Processors:</TH>\n";
+ print " <TD>$numprocs</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Processor Speed (MHz):</TH>\n";
+ print " <TD>$procspeed</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Network Speed (Mbps):</TH>\n";
+ print " <TD>$network</TD>\n";
+ print " </TR>\n";
+ if(! empty($compid)) {
+ print " <TR>\n";
+ print " <TH align=right>Computer ID:</TH>\n";
+ print " <TD>$compid</TD>\n";
+ print " </TR>\n";
+ }
+ print " <TR>\n";
+ print " <TH align=right>Type:</TH>\n";
+ print " <TD>$type</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Provisioning Engine:</TH>\n";
+ print " <TD>" . $provisioning[$provisioningid]['prettyname'] . "</TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getComputerSelection($data)
+///
+/// \param $data - array of data as returned from processComputerInput
+///
+/// \return an array of data to be passed to addContinuationsEntry
+///
+/// \brief returns only the selection data from $data
+///
+////////////////////////////////////////////////////////////////////////////////
+function getComputerSelection($data) {
+ $ret = array();
+ $ret['platforms'] = $data['platforms'];
+ $ret['schedules'] = $data['schedules'];
+ $ret['groups'] = $data['groups'];
+ $keys = array("showhostname", "shownextimage", "showipaddress",
+ "showram", "showstate", "showprocnumber", "showdepartment",
+ "showowner", "showprocspeed", "showplatform", "shownetwork",
+ "showschedule", "showcomputerid", "showcurrentimage",
+ "showtype", "showdeleted", "shownotes", "showcounts",
+ "showprovisioning");
+ foreach($keys as $key)
+ $ret[$key] = $data[$key];
+ return $ret;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn jsonCompGroupingComps()
+///
+/// \brief accepts a groupid via form input and prints a json array with 3
+/// arrays: an array of computers that are in the group, an array of computers
+/// not in it, and an array of all computers user has access to
+///
+////////////////////////////////////////////////////////////////////////////////
+function jsonCompGroupingComps() {
+ $groupid = processInputVar('groupid', ARG_NUMERIC);
+ $groups = getUserResources(array("computerAdmin"), array("manageGroup"), 1);
+ if(! array_key_exists($groupid, $groups['computer'])) {
+ $arr = array('incomps' => array(), 'outcomps' => array(), 'all' => array());
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+
+ $resources = getUserResources(array('computerAdmin'), array('manageGroup'));
+ uasort($resources['computer'], 'sortKeepIndex');
+ $memberships = getResourceGroupMemberships('computer');
+ $all = array();
+ $in = array();
+ $out = array();
+ foreach($resources['computer'] as $id => $comp) {
+ if(array_key_exists($id, $memberships['computer']) &&
+ in_array($groupid, $memberships['computer'][$id])) {
+ $all[] = array('inout' => 1, 'id' => $id, 'name' => $comp);
+ $in[] = array('name' => $comp, 'id' => $id);
+ }
+ else {
+ $all[] = array('inout' => 0, 'id' => $id, 'name' => $comp);
+ $out[] = array('name' => $comp, 'id' => $id);
+ }
+ }
+ $arr = array('incomps' => $in, 'outcomps' => $out, 'all' => $all);
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn jsonCompGroupingGroups()
+///
+/// \brief accepts a computer id via form input and prints a json array with 3
+/// arrays: an array of groups that the computer is in, an array of groups it
+/// is not in and an array of all groups user has access to
+///
+////////////////////////////////////////////////////////////////////////////////
+function jsonCompGroupingGroups() {
+ $compid = processInputVar('compid', ARG_NUMERIC);
+ $resources = getUserResources(array("computerAdmin"), array("manageGroup"));
+ if(! array_key_exists($compid, $resources['computer'])) {
+ $arr = array('ingroups' => array(), 'outgroups' => array(), 'all' => array());
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+ $groups = getUserResources(array('computerAdmin'), array('manageGroup'), 1);
+ $memberships = getResourceGroupMemberships('computer');
+ $in = array();
+ $out = array();
+ $all = array();
+ foreach($groups['computer'] as $id => $group) {
+ if(array_key_exists($compid, $memberships['computer']) &&
+ in_array($id, $memberships['computer'][$compid])) {
+ $all[] = array('inout' => 1, 'id' => $id, 'name' => $group);
+ $in[] = array('name' => $group, 'id' => $id);
+ }
+ else {
+ $all[] = array('inout' => 0, 'id' => $id, 'name' => $group);
+ $out[] = array('name' => $group, 'id' => $id);
+ }
+ }
+ $arr = array('ingroups' => $in, 'outgroups' => $out, 'all' => $all);
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJaddCompToGroup()
+///
+/// \brief accepts a groupid and a comma delimited list of computer ids to be
+/// added to the group; adds them and returns an array of computer ids that were
+/// added
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJaddCompToGroup() {
+ $groupid = processInputVar('id', ARG_NUMERIC);
+ $groups = getUserResources(array("computerAdmin"), array("manageGroup"), 1);
+ if(! array_key_exists($groupid, $groups['computer'])) {
+ $arr = array('comps' => array(), 'addrem' => 1);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+
+ $resources = getUserResources(array("computerAdmin"), array("manageGroup"));
+ $tmp = processInputVar('listids', ARG_STRING);
+ $tmp = explode(',', $tmp);
+ $compids = array();
+ foreach($tmp as $id) {
+ if(! is_numeric($id))
+ continue;
+ if(! array_key_exists($id, $resources['computer'])) {
+ $arr = array('comps' => array(), 'addrem' => 1);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+ $compids[] = $id;
+ }
+
+ $allcomps = getComputers();
+ $adds = array();
+ foreach($compids as $id) {
+ $adds[] = "({$allcomps[$id]['resourceid']}, $groupid)";
+ }
+ $query = "INSERT IGNORE INTO resourcegroupmembers "
+ . "(resourceid, resourcegroupid) VALUES ";
+ $query .= implode(',', $adds);
+ doQuery($query, 287);
+ $_SESSION['userresources'] = array();
+ $arr = array('comps' => $compids, 'addrem' => 1);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJremCompFromGroup()
+///
+/// \brief accepts a groupid and a comma delimited list of computer ids to be
+/// removed from the group; removes them and returns an array of computer ids
+/// that were removed
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJremCompFromGroup() {
+ $groupid = processInputVar('id', ARG_NUMERIC);
+ $groups = getUserResources(array("computerAdmin"), array("manageGroup"), 1);
+ if(! array_key_exists($groupid, $groups['computer'])) {
+ $arr = array('comps' => array(), 'addrem' => 0);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+
+ $resources = getUserResources(array("computerAdmin"), array("manageGroup"));
+ $tmp = processInputVar('listids', ARG_STRING);
+ $tmp = explode(',', $tmp);
+ $compids = array();
+ foreach($tmp as $id) {
+ if(! is_numeric($id))
+ continue;
+ if(! array_key_exists($id, $resources['computer'])) {
+ $arr = array('comps' => array(), 'addrem' => 0, 'id' => $id, 'extra' => $resources['computer']);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+ $compids[] = $id;
+ }
+
+ $allcomps = getComputers();
+ foreach($compids as $id) {
+ $query = "DELETE FROM resourcegroupmembers "
+ . "WHERE resourceid = {$allcomps[$id]['resourceid']} AND "
+ . "resourcegroupid = $groupid";
+ doQuery($query, 288);
+ }
+ $_SESSION['userresources'] = array();
+ $arr = array('comps' => $compids, 'addrem' => 0);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJaddGroupToComp()
+///
+/// \brief accepts a computer id and a comma delimited list of group ids that
+/// the computer should be added to; adds it to them and returns an array of
+/// groups it was added to
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJaddGroupToComp() {
+ $compid = processInputVar('id', ARG_NUMERIC);
+ $resources = getUserResources(array("computerAdmin"), array("manageGroup"));
+ if(! array_key_exists($compid, $resources['computer'])) {
+ $arr = array('groups' => array(), 'addrem' => 1);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+
+ $groups = getUserResources(array("computerAdmin"), array("manageGroup"), 1);
+ $tmp = processInputVar('listids', ARG_STRING);
+ $tmp = explode(',', $tmp);
+ $groupids = array();
+ foreach($tmp as $id) {
+ if(! is_numeric($id))
+ continue;
+ if(! array_key_exists($id, $groups['computer'])) {
+ $arr = array('groups' => array(), 'addrem' => 1);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+ $groupids[] = $id;
+ }
+
+ $comp = getComputers(0, $compid);
+ $adds = array();
+ foreach($groupids as $id) {
+ $adds[] = "({$comp[$compid]['resourceid']}, $id)";
+ }
+ $query = "INSERT IGNORE INTO resourcegroupmembers "
+ . "(resourceid, resourcegroupid) VALUES ";
+ $query .= implode(',', $adds);
+ doQuery($query, 101);
+ $_SESSION['userresources'] = array();
+ $arr = array('groups' => $groupids, 'addrem' => 1);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJremGroupFromComp()
+///
+/// \brief accepts a computer id and a comma delimited list of group ids that
+/// the computer should be removed from; removes it from them and returns an
+/// array of groups it was removed from
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJremGroupFromComp() {
+ $compid = processInputVar('id', ARG_NUMERIC);
+ $resources = getUserResources(array("computerAdmin"), array("manageGroup"));
+ if(! array_key_exists($compid, $resources['computer'])) {
+ $arr = array('groups' => array(), 'addrem' => 0);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+
+ $groups = getUserResources(array("computerAdmin"), array("manageGroup"), 1);
+ $tmp = processInputVar('listids', ARG_STRING);
+ $tmp = explode(',', $tmp);
+ $groupids = array();
+ foreach($tmp as $id) {
+ if(! is_numeric($id))
+ continue;
+ if(! array_key_exists($id, $groups['computer'])) {
+ $arr = array('groups' => array(), 'addrem' => 0);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+ $groupids[] = $id;
+ }
+
+ $comp = getComputers(0, $compid);
+ foreach($groupids as $id) {
+ $query = "DELETE FROM resourcegroupmembers "
+ . "WHERE resourceid = {$comp[$compid]['resourceid']} AND "
+ . "resourcegroupid = $id";
+ doQuery($query, 288);
+ }
+ $_SESSION['userresources'] = array();
+ $arr = array('groups' => $groupids, 'addrem' => 0);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+?>
diff --git a/web/.ht-inc/conf.php b/web/.ht-inc/conf.php
new file mode 100644
index 0000000..b9ada69
--- /dev/null
+++ b/web/.ht-inc/conf.php
@@ -0,0 +1,127 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+define("ONLINEDEBUG", 1); // 1 to display errors to screen, 0 to email errors
+
+
+################ Things in this section must be modified #####################
+
+define("BASEURL", "https://vcl.example.org"); // no trailing slash
+define("SCRIPT", "/index.php");
+define("HELPURL", "https://vcl.example.org/help/");
+define("HELPFAQURL", "http://vcl.example.org/help-faq/");
+define("HELPEMAIL", "vcl_help@example.org");
+define("ERROREMAIL", "webmaster@example.org");
+define("ENVELOPESENDER", "webserver@example.org"); // email address for envelope sender of mail messages
+ // if a message gets bounced, it goes to this address
+define("COOKIEDOMAIN", ".example.org"); // domain in which cookies are set
+define("HOMEURL", "http://vcl.example.org/"); // url to go to when someone clicks HOME or Logout
+
+####################### end required modifications ###########################
+
+
+
+
+
+define("DEFAULTGROUP", "adminUsers"); // if a user is in no groups, use reservation
+ // length attriubtes from this group
+define("DEFAULT_AFFILID", 1);
+define("DAYSAHEAD", 4); // number of days after today that can be scheduled
+define("DEFAULT_PRIVNODE", 2);
+define("MAXVMLIMIT", 100);
+define("PRIV_CACHE_TIMEOUT", 15); // time (in minutes) that we cache privileges in a session before reloading them
+/// defines the min number of block request machines
+define("MIN_BLOCK_MACHINES", 5);
+/// defines the max number of block request machines
+define("MAX_BLOCK_MACHINES", 70);
+
+$ENABLE_ITECSAUTH = 0; // use ITECS accounts (also called "Non-NCSU" accounts)
+
+$userlookupUsers = array(1, # admin
+);
+
+$clickThroughText =
+"<center><h2>Installer Agreement</h2></center>
+<p>As the creator of the VCL image, you are responsible for understanding and
+complying with the terms and conditions of the license agreement(s) for all
+software installed within the VCL image.</p>
+
+<p>Please note that many licenses for instructional use do not allow research
+or other use. You should be familiar with these license terms and
+conditions, and limit the use of your image accordingly.</p>
+
+%s
+
+<p>** If you have software licensing questions or would like assistance
+regarding specific terms and conditions, please contact
+<a href=mailto:software@example.org>software@example.org</a>.</p>";
+
+@require_once(".ht-inc/secrets.php");
+
+$authMechs = array(
+ "Local Account" => array("type" => "local",
+ "affiliationid" => 4,
+ "help" => "Only use Local Account if there are no other options"),
+ /*"EXAMPLE1 LDAP" => array("type" => "ldap",
+ "server" => "ldap.example.com", # hostname of the ldap server
+ "binddn" => "dc=example,dc=com", # base dn for ldap server
+ "userid" => "%s@example.com", # this is what we add to the actual login id to authenticate a user via ldap
+ # use a '%s' where the actual login id will go
+ # for example1: 'uid=%s,ou=accounts,dc=example,dc=com'
+ # example2: '%s@example.com'
+ # example3: '%s@ad.example.com'
+ "unityid" => "samAccountName", # ldap field that contains the user's login id
+ "firstname" => "givenname", # ldap field that contains the user's first name
+ #"middlename" => "middlename", # ldap field that contains the user's middle name (optional)
+ "lastname" => "sn", # ldap field that contains the user's last name
+ "email" => "mail", # ldap field that contains the user's email address
+ "defaultemail" => "@example.com", # if for some reason an email address may not be returned for a user, this is what
+ # can be added to the user's login id to send mail
+ "masterlogin" => "vcluser", # privileged login id for ldap server
+ "masterpwd" => "*********", # privileged login password for ldap server
+ "affiliationid" => 2, # id from affiliation id this login method is associated with
+ "help" => "Use EXAMPLE1 LDAP if you are using an EXAMPLE1 account"), # message to be displayed on login page about when
+ # to use this login mechanism*/
+);
+
+$affilValFunc = array(1 => create_function('', 'return 0;'),
+ /*2 => "validateLDAPUser",*/
+);
+
+$affilValFuncArgs = array(/*2 => 'EXAMPLE1 LDAP',*/
+);
+
+$addUserFunc = array(1 => create_function('', 'return 0;'),
+ /*2 => 'addLDAPUser',*/
+);
+
+$addUserFuncArgs = array(/*2 => 'EXAMPLE1 LDAP',*/
+);
+
+$updateUserFunc = array(1 => create_function('', 'return 0;'),
+ /*2 => 'updateLDAPUser',*/
+);
+
+$updateUserFuncArgs = array(/*2 => 'EXAMPLE1 LDAP',*/
+);
+
+$findAffilFuncs = array("testGeneralAffiliation");
+
+#require_once(".ht-inc/authmethods/itecsauth.php");
+#require_once(".ht-inc/authmethods/ldapauth.php");
+?>
diff --git a/web/.ht-inc/doxyfile.xmlrpc b/web/.ht-inc/doxyfile.xmlrpc
new file mode 100644
index 0000000..c36d006
--- /dev/null
+++ b/web/.ht-inc/doxyfile.xmlrpc
@@ -0,0 +1,235 @@
+# Doxyfile 1.4.7
+
+#---------------------------------------------------------------------------
+# Project related configuration options
+#---------------------------------------------------------------------------
+PROJECT_NAME = "VCL XML RPC"
+PROJECT_NUMBER =
+OUTPUT_DIRECTORY = xmlrpcdocs/
+CREATE_SUBDIRS = NO
+OUTPUT_LANGUAGE = English
+USE_WINDOWS_ENCODING = NO
+BRIEF_MEMBER_DESC = YES
+REPEAT_BRIEF = YES
+ABBREVIATE_BRIEF = "The $name class" \
+ "The $name widget" \
+ "The $name file" \
+ is \
+ provides \
+ specifies \
+ contains \
+ represents \
+ a \
+ an \
+ the
+ALWAYS_DETAILED_SEC = NO
+INLINE_INHERITED_MEMB = NO
+FULL_PATH_NAMES = YES
+STRIP_FROM_PATH = /afs/eos.ncsu.edu/lockers/people/j/jfthomps/www/vcl_rpc/.ht-inc/
+STRIP_FROM_INC_PATH =
+SHORT_NAMES = NO
+JAVADOC_AUTOBRIEF = NO
+MULTILINE_CPP_IS_BRIEF = NO
+DETAILS_AT_TOP = NO
+INHERIT_DOCS = YES
+SEPARATE_MEMBER_PAGES = NO
+TAB_SIZE = 8
+ALIASES =
+OPTIMIZE_OUTPUT_FOR_C = NO
+OPTIMIZE_OUTPUT_JAVA = NO
+BUILTIN_STL_SUPPORT = NO
+DISTRIBUTE_GROUP_DOC = NO
+SUBGROUPING = NO
+#---------------------------------------------------------------------------
+# Build related configuration options
+#---------------------------------------------------------------------------
+EXTRACT_ALL = NO
+EXTRACT_PRIVATE = NO
+EXTRACT_STATIC = NO
+EXTRACT_LOCAL_CLASSES = YES
+EXTRACT_LOCAL_METHODS = NO
+HIDE_UNDOC_MEMBERS = YES
+HIDE_UNDOC_CLASSES = YES
+HIDE_FRIEND_COMPOUNDS = NO
+HIDE_IN_BODY_DOCS = NO
+INTERNAL_DOCS = NO
+CASE_SENSE_NAMES = YES
+HIDE_SCOPE_NAMES = NO
+SHOW_INCLUDE_FILES = NO
+INLINE_INFO = YES
+SORT_MEMBER_DOCS = YES
+SORT_BRIEF_DOCS = NO
+SORT_BY_SCOPE_NAME = NO
+GENERATE_TODOLIST = NO
+GENERATE_TESTLIST = NO
+GENERATE_BUGLIST = NO
+GENERATE_DEPRECATEDLIST= YES
+ENABLED_SECTIONS =
+MAX_INITIALIZER_LINES = 30
+SHOW_USED_FILES = NO
+SHOW_DIRECTORIES = NO
+FILE_VERSION_FILTER =
+#---------------------------------------------------------------------------
+# configuration options related to warning and progress messages
+#---------------------------------------------------------------------------
+QUIET = NO
+WARNINGS = YES
+WARN_IF_UNDOCUMENTED = YES
+WARN_IF_DOC_ERROR = YES
+WARN_NO_PARAMDOC = NO
+WARN_FORMAT = "$file:$line: $text"
+WARN_LOGFILE =
+#---------------------------------------------------------------------------
+# configuration options related to the input files
+#---------------------------------------------------------------------------
+INPUT = .
+FILE_PATTERNS = xmlrpcWrappers.php
+RECURSIVE = NO
+EXCLUDE =
+EXCLUDE_SYMLINKS = NO
+EXCLUDE_PATTERNS =
+EXAMPLE_PATH = .
+EXAMPLE_PATTERNS = *
+EXAMPLE_RECURSIVE = NO
+IMAGE_PATH =
+INPUT_FILTER =
+FILTER_PATTERNS =
+FILTER_SOURCE_FILES = NO
+#---------------------------------------------------------------------------
+# configuration options related to source browsing
+#---------------------------------------------------------------------------
+SOURCE_BROWSER = NO
+INLINE_SOURCES = NO
+STRIP_CODE_COMMENTS = YES
+REFERENCED_BY_RELATION = NO
+REFERENCES_RELATION = NO
+REFERENCES_LINK_SOURCE = YES
+USE_HTAGS = NO
+VERBATIM_HEADERS = NO
+#---------------------------------------------------------------------------
+# configuration options related to the alphabetical class index
+#---------------------------------------------------------------------------
+ALPHABETICAL_INDEX = NO
+COLS_IN_ALPHA_INDEX = 5
+IGNORE_PREFIX =
+#---------------------------------------------------------------------------
+# configuration options related to the HTML output
+#---------------------------------------------------------------------------
+GENERATE_HTML = YES
+HTML_OUTPUT = .
+HTML_FILE_EXTENSION = .html
+HTML_HEADER =
+HTML_FOOTER =
+HTML_STYLESHEET =
+HTML_ALIGN_MEMBERS = YES
+GENERATE_HTMLHELP = NO
+CHM_FILE =
+HHC_LOCATION =
+GENERATE_CHI = NO
+BINARY_TOC = NO
+TOC_EXPAND = NO
+DISABLE_INDEX = YES
+ENUM_VALUES_PER_LINE = 4
+GENERATE_TREEVIEW = NO
+TREEVIEW_WIDTH = 250
+#---------------------------------------------------------------------------
+# configuration options related to the LaTeX output
+#---------------------------------------------------------------------------
+GENERATE_LATEX = NO
+LATEX_OUTPUT = latex
+LATEX_CMD_NAME = latex
+MAKEINDEX_CMD_NAME = makeindex
+COMPACT_LATEX = NO
+PAPER_TYPE = a4wide
+EXTRA_PACKAGES =
+LATEX_HEADER =
+PDF_HYPERLINKS = NO
+USE_PDFLATEX = NO
+LATEX_BATCHMODE = NO
+LATEX_HIDE_INDICES = NO
+#---------------------------------------------------------------------------
+# configuration options related to the RTF output
+#---------------------------------------------------------------------------
+GENERATE_RTF = NO
+RTF_OUTPUT = rtf
+COMPACT_RTF = NO
+RTF_HYPERLINKS = NO
+RTF_STYLESHEET_FILE =
+RTF_EXTENSIONS_FILE =
+#---------------------------------------------------------------------------
+# configuration options related to the man page output
+#---------------------------------------------------------------------------
+GENERATE_MAN = NO
+MAN_OUTPUT = man
+MAN_EXTENSION = .3
+MAN_LINKS = NO
+#---------------------------------------------------------------------------
+# configuration options related to the XML output
+#---------------------------------------------------------------------------
+GENERATE_XML = NO
+XML_OUTPUT = xml
+XML_SCHEMA =
+XML_DTD =
+XML_PROGRAMLISTING = YES
+#---------------------------------------------------------------------------
+# configuration options for the AutoGen Definitions output
+#---------------------------------------------------------------------------
+GENERATE_AUTOGEN_DEF = NO
+#---------------------------------------------------------------------------
+# configuration options related to the Perl module output
+#---------------------------------------------------------------------------
+GENERATE_PERLMOD = NO
+PERLMOD_LATEX = NO
+PERLMOD_PRETTY = YES
+PERLMOD_MAKEVAR_PREFIX =
+#---------------------------------------------------------------------------
+# Configuration options related to the preprocessor
+#---------------------------------------------------------------------------
+ENABLE_PREPROCESSING = YES
+MACRO_EXPANSION = NO
+EXPAND_ONLY_PREDEF = NO
+SEARCH_INCLUDES = YES
+INCLUDE_PATH =
+INCLUDE_FILE_PATTERNS =
+PREDEFINED =
+EXPAND_AS_DEFINED =
+SKIP_FUNCTION_MACROS = YES
+#---------------------------------------------------------------------------
+# Configuration::additions related to external references
+#---------------------------------------------------------------------------
+TAGFILES =
+GENERATE_TAGFILE =
+ALLEXTERNALS = NO
+EXTERNAL_GROUPS = YES
+PERL_PATH = /usr/bin/perl
+#---------------------------------------------------------------------------
+# Configuration options related to the dot tool
+#---------------------------------------------------------------------------
+CLASS_DIAGRAMS = YES
+HIDE_UNDOC_RELATIONS = YES
+HAVE_DOT = NO
+CLASS_GRAPH = YES
+COLLABORATION_GRAPH = YES
+GROUP_GRAPHS = YES
+UML_LOOK = NO
+TEMPLATE_RELATIONS = NO
+INCLUDE_GRAPH = YES
+INCLUDED_BY_GRAPH = YES
+CALL_GRAPH = NO
+CALLER_GRAPH = NO
+GRAPHICAL_HIERARCHY = YES
+DIRECTORY_GRAPH = YES
+DOT_IMAGE_FORMAT = png
+DOT_PATH =
+DOTFILE_DIRS =
+MAX_DOT_GRAPH_WIDTH = 1024
+MAX_DOT_GRAPH_HEIGHT = 1024
+MAX_DOT_GRAPH_DEPTH = 1000
+DOT_TRANSPARENT = NO
+DOT_MULTI_TARGETS = NO
+GENERATE_LEGEND = YES
+DOT_CLEANUP = YES
+#---------------------------------------------------------------------------
+# Configuration::additions related to the search engine
+#---------------------------------------------------------------------------
+SEARCHENGINE = NO
diff --git a/web/.ht-inc/errors.php b/web/.ht-inc/errors.php
new file mode 100644
index 0000000..5461533
--- /dev/null
+++ b/web/.ht-inc/errors.php
@@ -0,0 +1,360 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+/**
+ * \file
+ */
+
+// set the error reporting level for this script
+error_reporting(E_ALL);
+
+# 100 - 399: MySQL errors
+/// array containing all the errors to be reported
+$ERRORS = array (
+ "1" => "Failed to get user information from database",
+ "2" => "Failed to get semaphore resource",
+ "3" => "Failed to get acquire semaphore lock",
+ "5" => "Failed to update any rows while submitting image changes",
+ "6" => "Failed to open private key",
+ "7" => "Failed to open public key",
+ "8" => "Failed to add user to database",
+ "9" => 'getRequestInfo was called with an empty $id',
+ "10" => "Failed to insert row while submitting new image",
+ "11" => "getContinuationsData returned an empty array",
+ "15" => "Failed to insert row while submitting new schedule",
+ "20" => "There was an attempt submit data to the page, but the referrer was not the entry script.",
+ "25" => "Failed to get IPaddress of computer in acknowledgeRequest.",
+ "30" => "Failed to get log entry in addChangeLogEntry",
+ "35" => "Failed to retreive nisnetgroup memberships for user in updateNisNetGroups",
+ "40" => "Failed to find any usable management nodes",
+ "45" => "LDAP error",
+ "50" => "received invalid input",
+ "51" => "userid in continuation does not match logged in user",
+ "52" => "tried to add a user with the same uid as an existing user",
+ "101" => "General MySQL error",
+ "104" => "Failed to select database",
+ "105" => "Failed to execute query 1 in getUserInfo",
+ "106" => "Failed to execute query 2 in getUserInfo",
+ "107" => "Failed to execute query 1 in getOverallUserPrivs",
+ "108" => "Failed to get deletefromid in addContinuationsEntry",
+ "110" => "Failed to execute query 1 in showTimeTable",
+ "111" => "Failed to execute query 2 in showTimeTable",
+ "112" => "Failed to execute query 3 in showTimeTable",
+ "113" => "Failed to get reservation data in getCompLoadLog",
+ "115" => "Failed to execute query 1 in getOSList",
+ "120" => "Failed to execute query 1 in getImages",
+ "125" => "Failed to execute query 1 in isAvailable",
+ "126" => "Failed to execute query 2 in isAvailable",
+ "127" => "Failed to execute query 3 in isAvailable",
+ "128" => "Failed to execute query 4 in isAvailable",
+ "129" => "Failed to execute query 5 in isAvailable",
+ "130" => "Failed to execute query 6 in isAvailable",
+ "131" => "Failed to execute query 2 in addRequest",
+ "132" => "Failed to fetch last insert id in addRequest",
+ "133" => "Failed to execute query 3 in addRequest",
+ "134" => "Failed to execute query 4 in addRequest",
+ "135" => "Failed to fetch last insert id in addRequest",
+ "136" => "Failed to execute query 5 in addRequest",
+ "137" => "Failed to execute query 6 in addRequest",
+ "138" => "Failed to fetch last insert id in addRequest",
+ "139" => "Failed to execute query 1 in getAppId",
+ "140" => "Failed to execute query 1 in getUserlistID",
+ "141" => "Failed to execute query 1 in getGroupID",
+ "145" => "Failed to execute query 1 in updateRequest",
+ "146" => "Failed to execute query 2 in updateRequest",
+ "147" => "Failed to execute query 3 in updateRequest",
+ "148" => "Failed to get reservationid in updateRequest",
+ "150" => "Failed to execute query 1 in deleteRequest",
+ "151" => "Failed to execute query 2 in deleteRequest",
+ "152" => "Failed to execute query 3 in deleteRequest",
+ "153" => "Failed to execute query 4 in deleteRequest",
+ "154" => "Failed to execute query 5 in deleteRequest",
+ "155" => "Failed to execute query 1 in getTimeSlots",
+ "156" => "Failed to execute query 2 in getTimeSlots",
+ "160" => "Failed to execute query 1 in getUserRequests",
+ "165" => "Failed to execute query 1 in getRequestInfo",
+ "170" => "Failed to execute query 1 in getImageId",
+ "175" => "Failed to execute query 1 in getOSId",
+ "176" => "Failed to execute query 1 in getStates",
+ "177" => "Failed to execute query 1 in getDepartments",
+ "178" => "Failed to execute query 1 in getPlatforms",
+ "179" => "Failed to execute query 1 in getSchedules",
+ "180" => "Failed to execute query 1 in listComputers",
+ "185" => "Failed to execute query 1 in updateComputer",
+ "190" => "Failed to execute query 1 in submitDeleteComputer",
+ "191" => "Failed to execute query 2 in submitDeleteComputer",
+ "195" => "Failed to execute query 1 in addComputer",
+ "196" => "Failed to execute query 2 in addComputer",
+ "197" => "Failed to fetch last insert id in addComputer",
+ "198" => "Failed to execute query 3 in addComputer",
+ "200" => "Failed to execute query 1 in updateImage",
+ "205" => "Failed to execute query 1 in addImage",
+ "206" => "Failed to execute query 2 in addImage",
+ "207" => "Failed to fetch last insert id in addImage",
+ "208" => "Failed to execute query 3 in addImage",
+ "209" => "Failed to execute query 4 in addImage",
+ "210" => "Failed to execute query 1 in submitDeleteImage",
+ "211" => "Failed to execute query 2 in submitDeleteImage",
+ "212" => "Failed to execute query 3 in submitDeleteImage",
+ "215" => "Failed to execute query 1 in updateSchedule",
+ "220" => "Failed to execute query 1 in addSchedule",
+ "221" => "Failed to execute query 2 in addSchedule",
+ "222" => "Failed to fetch last insert id in addSchedule",
+ "223" => "Failed to execute query 3 in addSchedule",
+ "225" => "Failed to execute query 1 in acknowledgeRequest",
+ "226" => "Failed to execute query 2 in acknowledgeRequest",
+ "227" => "Failed to execute query 3 in acknowledgeRequest",
+ "228" => "Failed to execute query 4 in acknowledgeRequest",
+ "229" => "Failed to execute query 5 in acknowledgeRequest",
+ "235" => "Failed to execute query 1 in submitBulkAddComputers",
+ "236" => "Failed to execute query 2 in submitBulkAddComputers",
+ "237" => "Failed to fetch last insert id in submitBulkAddComputers",
+ "238" => "Failed to execute query 3 in submitBulkAddComputers",
+ "240" => "Failed to execute query 1 in addUser",
+ "241" => "Failed to execute query 2 in addUser",
+ "242" => "Failed to fetch last insert id in addUser",
+ "245" => "Failed to execute query 1 in addLoadTime",
+ "250" => "Failed to execute query 1 in checkForImageUsage",
+ "255" => "Failed to execute query 1 in updateUserData",
+ "256" => "Failed to execute query 2 in updateUserData",
+ "257" => "Failed to execute query 3 in updateUserData",
+ "258" => "Failed to execute query 4 in updateUserData",
+ "259" => "Failed to fetch last insert id in updateUserData",
+ "260" => "Failed to execute query 1 in addLogEntry",
+ "265" => "Failed to execute query 1 in addChangeLogEntry",
+ "266" => "Failed to execute query 2 in addChangeLogEntry",
+ "267" => "Failed to execute query 3 in addChangeLogEntry",
+ "270" => "Failed to execute query 1 in updateUserPrefs",
+ "275" => "Failed to execute query 1 in viewStatistics",
+ "280" => "Failed to execute query 1 in getUserGroups",
+ "281" => "Failed to execute query 1 in getResourceGroups",
+ "282" => "Failed to execute query 1 in getResourceGroupMemberships",
+ "285" => "Failed to execute query 1 in submitComputerGroups",
+ "286" => "Failed to execute query 2 in submitComputerGroups",
+ "287" => "Failed to execute query 1 in submitImageGroups",
+ "288" => "Failed to execute query 2 in submitImageGroups",
+ "290" => "Failed to execute query 1 in submitHelpForm",
+ "291" => "Failed to execute query 1 in submitScheduleGroups",
+ "292" => "Failed to execute query 2 in submitScheduleGroups",
+ "295" => "Failed to execute query 1 in getGraphDataDay",
+ "296" => "Failed to execute query 1 in getGraphDataHour",
+ "300" => "Failed to execute query 1 in updateGroup",
+ "301" => "Failed to execute query 2 in updateGroup",
+ "305" => "Failed to execute query 1 in addGroup",
+ "306" => "Failed to execute query 2 in updateNisNetGroups",
+ "307" => "Failed to execute query 3 in updateNisNetGroups",
+ "310" => "Failed to execute query 1 in checkForGroupUsage",
+ "315" => "Failed to execute query 1 in submitDeleteGroup",
+ "320" => "Failed to execute query 1 in getUserImages",
+ "325" => "Failed to execute query 1 in getChildNodes",
+ "330" => "Failed to execute query 1 in getNodeInfo",
+ "335" => "Failed to execute query 1 in submitAddChildNode",
+ "336" => "Failed to execute query 2 in submitAddChildNode",
+ "340" => "Failed to execute query 1 in recurseGetChildren",
+ "345" => "Failed to execute query 1 in submitDeleteNode",
+ "350" => "Failed to execute query 1 in getNodePrivileges",
+ "351" => "Failed to execute query 2 in getNodePrivileges",
+ "352" => "Failed to execute query 3 in getNodePrivileges",
+ "353" => "Failed to execute query 1 in getNodeCascadePrivileges",
+ "354" => "Failed to execute query 2 in getNodeCascadePrivileges",
+ "355" => "Failed to execute query 3 in getNodeCascadePrivileges",
+ "356" => "Failed to execute query 4 in getNodeCascadePrivileges",
+ "357" => "Failed to execute query 5 in getNodeCascadePrivileges",
+ "358" => "Failed to execute query 6 in getNodeCascadePrivileges",
+ "359" => "Failed to execute query 1 in computerGetResourceInfo",
+ "360" => "Failed to execute query 1 in imageGetResourceInfo",
+ "365" => "Failed to execute query 1 in getTypes",
+ "366" => "Failed to execute query 2 in getTypes",
+ "370" => "Failed to execute query 1 in getUserPrivTypeID",
+ "371" => "Failed to execute query 1 in getResourceGroupID",
+ "375" => "Failed to execute query 1 in updateUserGroupPrivs",
+ "376" => "Failed to execute query 2 in updateUserGroupPrivs",
+ "377" => "Failed to execute query 1 in updateResourcePrivs",
+ "378" => "Failed to execute query 2 in updateResourcePrivs",
+ "380" => "Failed to fetch last insert id in submitBlockRequest",
+ "385" => "Failed to execute query in submitDeleteMgmtnode",
+);
+
+$XMLRPCERRORS = array(
+ 1 => 'Internal error while processing your method call. If the '
+ . 'problem persists, please email vcl_help@ncsu.edu for further '
+ . 'assistance. In your email message, please include the time you '
+ . 'made the call, the user you connected as, the method you '
+ . 'called, and all passed in arguments.',
+ 2 => 'unknown function',
+ 3 => 'Access denied',
+ 4 => 'xmlrpccall requires SSL to be enabled - connection aborted',
+ 5 => 'Failed to connect to authentication server',
+ 6 => 'Unable to authenticate passed in X-User',
+ 7 => 'Unknown API version, cannot continue',
+ 100 => 'overwrite this with a custom error message',
+);
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn errorHandler($errno, $errstr, $errfile, $errline, $errcontext)
+///
+/// \param $errno - level of the error raised
+/// \param $errstr - error message
+/// \param $errfile - (optional) filename where error occured
+/// \param $errline - (optional) line number where error occured
+/// \param $errcontext - (optional) array, active symbol table where error occurred
+///
+/// \brief reports errors
+///
+////////////////////////////////////////////////////////////////////////////////
+function errorHandler($errno, $errstr, $errfile=NULL, $errline=NULL, $errcontext=NULL) {
+ global $user;
+ if($user["adminlevel"] != "developer") {
+ dbDisconnect();
+ printHTMLFooter();
+ semUnlock();
+ exit();
+ }
+ print "Error encountered<br>\n";
+ switch ($errno) {
+ case E_USER_ERROR:
+ echo "<b>FATAL</b> [$errno] $errstr<br />\n";
+ echo " Fatal error in line $errline of file $errfile";
+ echo ", PHP " . PHP_VERSION . " (" . PHP_OS . ")<br />\n";
+ echo "Aborting...<br />\n";
+ semUnlock();
+ exit(1);
+ break;
+ case E_USER_WARNING:
+ echo "<b>ERROR</b> [$errno] $errstr<br />\n";
+ break;
+ case E_USER_NOTICE:
+ echo "<b>WARNING</b> [$errno] $errstr<br />\n";
+ break;
+ default:
+ echo "Unkown error type: [$errno] $errstr<br />\n";
+ break;
+ }
+ if(! empty($errfile) && ! empty($errline)) {
+ print "Error at $errline in $errfile<br>\n";
+ }
+ if(! empty($errcontext)) {
+ print "<pre>\n";
+ print_r($errcontext);
+ print "</pre>\n";
+ }
+ print "<br><br><br>\n";
+ print "<pre>\n";
+ print getBacktraceString();
+ print "</pre>\n";
+ dbDisconnect();
+ printHTMLFooter();
+ semUnlock();
+ exit();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getBacktraceString($includeCaller, $showArgs, $includeMe)
+///
+/// \param $includeCaller - show info about the calling function
+/// \param $showArgs - show args passed to functions
+/// \param $includeMe - show info about this function
+///
+/// \return a string of text with backtrace information
+///
+/// \brief calls debug_backtrace and nicely formats all of its information
+///
+////////////////////////////////////////////////////////////////////////////////
+function getBacktraceString($includeCaller=TRUE, $showArgs=TRUE, $includeMe=FALSE) {
+ $callArray = array();
+ $argArray = array();
+
+ $MAX_ARG_LENGTH = 64;
+
+ $backtraceArray = debug_backtrace();
+ $backtraceArray = array_reverse($backtraceArray);
+
+ // pop last element off - 'me'
+ if(! $includeMe)
+ array_pop($backtraceArray);
+
+ // includeCaller?
+ if(! $includeCaller)
+ array_pop($backtraceArray);
+
+ $functionOrder = 0;
+ foreach($backtraceArray as $backtraceEntry) {
+ $functionOrder++;
+ $callString = "Call#:" . $functionOrder . " => ";
+ if(isset($backtraceEntry["file"]))
+ $callString .= basename($backtraceEntry["file"]) . ":";
+ else
+ $callString .= "unknown:";
+ if(isset($backtraceEntry['class']))
+ $callString .= $backtraceEntry['class'] . '.';
+ $callString .= $backtraceEntry['function'] . '()';
+ $callString .= " (line#:";
+ if(isset($backtraceEntry['line']))
+ $callString .= $backtraceEntry['line'] . ")";
+ else
+ $callString .= "unknown)";
+ $callArray[] = $callString;
+
+ if(!$showArgs)
+ continue;
+
+ $argString = "Arguments";
+
+ if(! empty($backtraceEntry["args"])) {
+ $argString .= "(" . count($backtraceEntry["args"]) . ")\n\n";
+ $argNumber = 0;
+ foreach($backtraceEntry["args"] as $argument) {
+ $argNumber++;
+ $argString .= "Argument#: $argNumber => ";
+ if(is_null($argument))
+ $argString .= " (null)\n";
+ elseif(empty($argument))
+ $argString .= " (empty " . gettype($argument) . ")\n";
+ else
+ $argString .= print_r($argument,TRUE) . "\n";
+ }
+ }
+ else {
+ $argString .= "(none):\n";
+ }
+
+ $argString .= "-----------------------";
+
+ $argArray[] = $callString;
+ $argArray[] = $argString;
+ }
+
+ $returnString = "\nBacktrace:\n";
+ $returnString .= "=-=-=-=-=-=-=-=-=-=-=-=\n";
+ foreach($callArray as $callString) {
+ $returnString .= $callString . "\n";
+ }
+
+ if($showArgs) {
+ $returnString .= "\nBacktrace with Arguments:\n";
+ $returnString .= "=-=-=-=-=-=-=-=-=-=-=-=\n";
+ foreach($argArray as $callString) {
+ $returnString .= $callString . "\n";
+ }
+ }
+
+ return $returnString;
+}
+?>
diff --git a/web/.ht-inc/genkeys.sh b/web/.ht-inc/genkeys.sh
new file mode 100644
index 0000000..2884626
--- /dev/null
+++ b/web/.ht-inc/genkeys.sh
@@ -0,0 +1,20 @@
+#!/bin/bash
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+
+openssl genrsa -aes256 -out keys.pem 2048
+openssl rsa -pubout -in keys.pem -out pubkey.pem
diff --git a/web/.ht-inc/groups.php b/web/.ht-inc/groups.php
new file mode 100644
index 0000000..ba1e2d1
--- /dev/null
+++ b/web/.ht-inc/groups.php
@@ -0,0 +1,1127 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+/**
+ * \file
+ */
+
+/// signifies an error with the submitted name
+define("IDNAMEERR", 1);
+/// signifies an error with the submitted group name
+define("GRPNAMEERR", 1 << 1);
+/// signifies an error with the submitted owner
+define("GRPOWNER", 1 << 2);
+/// signifies an error with the submitted initial max time
+define("INITIALMAXERR", 1 << 3);
+/// signifies an error with the submitted total max time
+define("TOTALMAXERR", 1 << 4);
+/// signifies an error with the submitted max extend time
+define("MAXEXTENDERR", 1 << 5);
+/// signifies an error with the submitted max overlapping reservations
+define("MAXOVERLAPERR", 1 << 6);
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn viewGroups()
+///
+/// \brief prints a page to view group information
+///
+////////////////////////////////////////////////////////////////////////////////
+function viewGroups() {
+ global $viewmode, $user, $mode;
+ $modetype = getContinuationVar("type");
+
+ $usergroups = getUserGroups(1);
+ unset($usergroups[82]); // remove None group
+ if($user['showallgroups'])
+ $affilusergroups = $usergroups;
+ else
+ $affilusergroups = getUserGroups(1, $user['affiliationid']);
+ $resourcetypes = getTypes("resources");
+ $resourcegroups = getResourceGroups();
+ $resources = array();
+ $userresources = getUserResources(array("groupAdmin"),
+ array("manageGroup"), 1);
+ foreach(array_keys($userresources) as $type) {
+ foreach($userresources[$type] as $id => $group) {
+ if(array_key_exists($id, $resourcegroups)) { // have to make sure it exists in case something was deleted from the session priv cache
+ $resources[$id]["type"] = $type;
+ $resources[$id]["name"] = $group;
+ $resources[$id]["owner"] = $resourcegroups[$id]["owner"];
+ }
+ }
+ }
+
+ print "<H2>User Groups</H2>\n";
+ if($modetype == "user") {
+ if($mode == "submitAddGroup") {
+ print "<font color=\"#008000\">User group successfully added";
+ print "</font><br><br>\n";
+ }
+ elseif($mode == "submitDeleteGroup") {
+ print "<font color=\"#008000\">User group successfully deleted";
+ print "</font><br><br>\n";
+ }
+ elseif($mode == "submitEditGroup") {
+ print "<font color=\"#008000\">User group successfully updated";
+ print "</font><br><br>\n";
+ }
+ }
+ print "<TABLE class=usergrouptable border=1>\n";
+ print " <TR>\n";
+ print " <TD></TD>\n";
+ print " <TD></TD>\n";
+ print " <TH>Name</TH>\n";
+ print " <TH>Owner</TH>\n";
+ print " <TH>Editable by</TH>\n";
+ print " <TH>Initial Max Time (minutes)</TH>\n";
+ print " <TH>Total Max Time (minutes)</TH>\n";
+ print " <TH>Max Extend Time (minutes)</TH>\n";
+ if($viewmode == ADMIN_DEVELOPER)
+ print " <TH>Max Overlapping Reservations</TH>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <TD></TD>\n";
+ print " <TD><INPUT type=submit value=Add></TD>\n";
+ if($user['showallgroups']) {
+ $affils = getAffiliations();
+ print " <TD nowrap><INPUT type=text name=name maxlength=30 size=10>";
+ print "@";
+ printSelectInput("affiliationid", $affils, $user['affiliationid']);
+ }
+ else
+ print " <TD nowrap><INPUT type=text name=name maxlength=30 size=20>";
+ print "</TD>\n";
+ print " <TD><INPUT type=text name=owner size=15></TD>\n";
+ print " <TD>\n";
+ printSelectInput("editgroupid", $affilusergroups, 82);
+ print " </TD>\n";
+ print " <TD><INPUT type=text name=initialmax maxlength=4 size=4 ";
+ print "value=240></TD>\n";
+ print " <TD><INPUT type=text name=totalmax maxlength=4 size=4 value=360>";
+ print "</TD>\n";
+ print " <TD><INPUT type=text name=maxextend maxlength=4 size=4 value=30>";
+ print "</TD>\n";
+ if($viewmode == ADMIN_DEVELOPER) {
+ print " <TD><INPUT type=text name=overlap maxlength=4 size=4 value=0>";
+ print "</TD>\n";
+ }
+ $cont = addContinuationsEntry('submitAddGroup', array('type' => 'user'));
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " </FORM>\n";
+ print " </TR>\n";
+ $dispUserGrpIDs = array();
+ foreach(array_keys($usergroups) as $id) {
+ if($usergroups[$id]["name"] == " None")
+ continue;
+ # figure out if user is owner or in editor group
+ $owner = 0;
+ $editor = 0;
+ if($usergroups[$id]["ownerid"] == $user["id"])
+ $owner = 1;
+ if(array_key_exists("editgroup", $usergroups[$id]) &&
+ in_array($usergroups[$id]["editgroup"], $user["groups"]))
+ $editor = 1;
+ if(! $owner && ! $editor)
+ continue;
+ if($user['showallgroups'])
+ $dispUserGrpIDs[$id] = $usergroups[$id]['name'];
+ elseif($usergroups[$id]['groupaffiliation'] == $user['affiliation'] &&
+ array_key_exists($id, $affilusergroups))
+ $dispUserGrpIDs[$id] = $affilusergroups[$id]['name'];
+ print " <TR>\n";
+ print " <TD>\n";
+ if($owner) {
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>";
+ $cdata = array('type' => 'user',
+ 'groupid' => $id);
+ $cont = addContinuationsEntry('confirmDeleteGroup', $cdata);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">";
+ print " <INPUT type=submit value=Delete>";
+ print " </FORM>";
+ }
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('type' => 'user',
+ 'groupid' => $id,
+ 'isowner' => $owner);
+ $cont = addContinuationsEntry('editGroup', $cdata);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Edit>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD valign=bottom>{$usergroups[$id]["name"]}</TD>\n";
+ print " <TD>{$usergroups[$id]["owner"]}</TD>\n";
+ print " <TD>{$usergroups[$id]["editgroup"]}@";
+ print "{$usergroups[$id]['editgroupaffiliation']}</TD>\n";
+ print " <TD align=center>{$usergroups[$id]["initialmaxtime"]}</TD>\n";
+ print " <TD align=center>{$usergroups[$id]["totalmaxtime"]}</TD>\n";
+ print " <TD align=center>{$usergroups[$id]["maxextendtime"]}</TD>\n";
+ if($viewmode == ADMIN_DEVELOPER)
+ print " <TD align=center>{$usergroups[$id]["overlapResCount"]}</TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+
+ print "<a name=resources></a>\n";
+ print "<H2>Resource Groups</H2>\n";
+ if($modetype == "resource") {
+ if($mode == "submitAddGroup") {
+ print "<font color=\"#008000\">Resource group successfully added";
+ print "</font><br><br>\n";
+ }
+ elseif($mode == "submitDeleteGroup") {
+ print "<font color=\"#008000\">Resource group successfully deleted";
+ print "</font><br><br>\n";
+ }
+ elseif($mode == "submitEditGroup") {
+ print "<font color=\"#008000\">Resource group successfully updated";
+ print "</font><br><br>\n";
+ }
+ }
+ print "<TABLE class=resourcegrouptable border=1>\n";
+ print " <TR>\n";
+ print " <TD></TD>\n";
+ print " <TD></TD>\n";
+ print " <TH>Type</TH>\n";
+ print " <TH>Name</TH>\n";
+ print " <TH>Owning User Group</TH>\n";
+ print " <TD><a onmouseover=\"mouseoverHelp();\" ";
+ print "onmouseout=\"clearGroupPopups();\">";
+ print "<img alt=\"\" src=\"images/list.gif\"></a></TD>\n";
+ print " </TR>\n";
+ if(! empty($dispUserGrpIDs)) {
+ print " <TR>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "#resources\" method=post>\n";
+ print " <TD></TD>\n";
+ print " <TD><INPUT type=submit value=Add></TD>\n";
+ print " <TD>\n";
+ printSelectInput("resourcetypeid", $resourcetypes["resources"]);
+ print " </TD>\n";
+ print " <TD><INPUT type=text name=name maxlength=30 size=10></TD>\n";
+ print " <TD>\n";
+ # remove the "None" group
+ unset($usergroups[82]);
+ # find a custom group the user is in and make it the default
+ $defaultgroupkey = "";
+ foreach(array_keys($user["groups"]) as $grpid) {
+ if(array_key_exists($grpid, $usergroups)) {
+ $defaultgroupkey = $grpid;
+ break;
+ }
+ }
+ printSelectInput("ownergroup", $dispUserGrpIDs, $defaultgroupkey);
+ print " </TD>\n";
+ $cdata = array('type' => 'resource'/*,
+ 'dispUserGrpIDs' => $dispUserGrpIDs*/);
+ $cont = addContinuationsEntry('submitAddGroup', $cdata);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " </FORM>\n";
+ print " </TR>\n";
+ }
+ $jscont = addContinuationsEntry('jsonGetGroupInfo');
+ foreach(array_keys($resources) as $id) {
+ print " <TR>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('type' => 'resource',
+ 'groupid' => $id);
+ $cont = addContinuationsEntry('confirmDeleteGroup', $cdata);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Delete>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('type' => 'resource',
+ 'groupid' => $id,
+ 'dispUserGrpIDs' => $dispUserGrpIDs);
+ $cont = addContinuationsEntry('editGroup', $cdata);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Edit>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>" . $resources[$id]["type"] . "</TD>\n";
+ print " <TD>" . $resources[$id]["name"] . "</TD>\n";
+ print " <TD>" . $resources[$id]["owner"] . "</TD>\n";
+ print " <TD><a onmouseover=\"getGroupInfo('$jscont', $id);\" ";
+ print "onmouseout=\"clearGroupPopups();\">";
+ print "<img alt=\"mouseover for list of resources in the group\" ";
+ print "title=\"\" src=\"images/list.gif\"></a></TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ print "<div id=listitems onmouseover=\"blockClear();\" onmouseout=\"clearGroupPopups2(0);\"></div>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn editOrAddGroup($state)
+///
+/// \param $state - 0 for edit, 1 for add
+///
+/// \brief prints a form for editing a group
+///
+////////////////////////////////////////////////////////////////////////////////
+function editOrAddGroup($state) {
+ global $submitErr, $user, $mode, $viewmode;
+
+ $usergroups = getUserGroups(1);
+ if($user['showallgroups'])
+ $affilusergroups = $usergroups;
+ else
+ $affilusergroups = getUserGroups(1, $user['affiliationid']);
+ $resourcegroups = getResourceGroups();
+ $affils = getAffiliations();
+ $resourcetypes = getTypes("resources");
+
+ if($submitErr) {
+ $data = processGroupInput(0);
+ $newuser = processInputVar("newuser", ARG_STRING);
+ if($mode == "submitEditGroup") {
+ $id = $data["groupid"];
+ if($data["type"] == "resource") {
+ list($grouptype, $junk) = explode('/', $resourcegroups[$id]["name"]);
+ $ownerid = $resourcegroups[$id]["ownerid"];
+ }
+ }
+ else {
+ if($data["type"] == "resource") {
+ if($state)
+ $grouptype = $resourcetypes['resources'][$data['resourcetypeid']];
+ else
+ list($grouptype, $junk) =
+ explode('/', $resourcegroups[$data['groupid']]["name"]);
+ $ownerid = $data["ownergroup"];
+ }
+ else {
+ $selectAffil = getContinuationVar('selectAffil');
+ if(empty($selectAffil) && $user['showallgroups'])
+ $selectAffil = 1;
+ }
+ }
+ }
+ else {
+ $newuser = processInputVar("newuser", ARG_STRING);
+ $data["groupid"] = getContinuationVar("groupid");
+ $data["type"] = getContinuationVar("type");
+ $data["isowner"] = getContinuationVar("isowner");
+ $id = $data["groupid"];
+ if($data["type"] == "user") {
+ $data["name"] = $usergroups[$id]["name"];
+ $data["affiliationid"] = $usergroups[$id]["groupaffiliationid"];
+ $data["owner"] = $usergroups[$id]["owner"];
+ $data["editgroupid"] = $usergroups[$id]["editgroupid"];
+ $data["initialmax"] = $usergroups[$id]["initialmaxtime"];
+ $data["totalmax"] = $usergroups[$id]["totalmaxtime"];
+ $data["maxextend"] = $usergroups[$id]["maxextendtime"];
+ $data["overlap"] = $usergroups[$id]["overlapResCount"];
+ $tmp = explode('@', $data['name']);
+ $data['name'] = $tmp[0];
+ if($user['showallgroups'] ||
+ (array_key_exists(1, $tmp) && $tmp[1] != $user['affiliation']))
+ $selectAffil = 1;
+ else
+ $selectAffil = 0;
+ }
+ else {
+ list($grouptype, $data["name"]) =
+ explode('/', $resourcegroups[$id]["name"]);
+ $ownerid = $resourcegroups[$id]["ownerid"];
+ }
+ }
+
+ $editusergroup = 0;
+ if($data['type'] != 'user')
+ print "<FORM action=\"" . BASEURL . SCRIPT . "#resources\" method=post>\n";
+ else
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<DIV align=center>\n";
+ if($state) {
+ if($data["type"] == "user")
+ print "<H2>Add User Group</H2>\n";
+ else
+ print "<H2>Add Resource Group</H2>\n";
+ }
+ else {
+ if($data["type"] == "user") {
+ print "<H2>Edit User Group</H2>\n";
+ print "{$usergroups[$data['groupid']]['name']}<br>\n";
+ $editusergroup = 1;
+ }
+ else
+ print "<H2>Edit Resource Group</H2>\n";
+ }
+ if(($state && $data["type"] == "user") || $data["isowner"] ||
+ $data["type"] == "resource") {
+ print "<TABLE>\n";
+ if($data["type"] == "resource") {
+ print " <TR>\n";
+ print " <TH align=right>Type:</TH>\n";
+ print " <TD>\n";
+ if($state && $submitErr)
+ $resourcetypeid = $data['resourcetypeid'];
+ else
+ $resourcetypeid = array_search($grouptype, $resourcetypes["resources"]);
+ if($state)
+ printSelectInput("resourcetypeid", $resourcetypes["resources"], $resourcetypeid);
+ else
+ print " $grouptype\n";
+ print " </TD>\n";
+ print " <TD></TD>\n";
+ print " </TR>\n";
+ }
+ print " <TR>\n";
+ print " <TH align=right>Name:</TH>\n";
+ print " <TD><INPUT type=text name=name value=\"{$data['name']}\" ";
+ print "maxlength=30>";
+ if($data['type'] == 'user' && $selectAffil) {
+ print "@";
+ printSelectInput('affiliationid', $affils, $data['affiliationid']);
+ }
+ print "</TD>\n";
+ print " <TD>";
+ printSubmitErr(GRPNAMEERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ if($data["type"] == "user") {
+ print " <TR>\n";
+ print " <TH align=right>Owner:</TH>\n";
+ print " <TD><INPUT type=text name=owner value=\"" . $data["owner"];
+ print "\"></TD>\n";
+ print " <TD>";
+ printSubmitErr(GRPOWNER);
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Editable by:</TH>\n";
+ print " <TD>\n";
+ if(! empty($data['editgroupid']) &&
+ ! array_key_exists($data['editgroupid'], $affilusergroups)) {
+ $affilusergroups[$data['editgroupid']] =
+ array('name' => getUserGroupName($data['editgroupid'], 1));
+ uasort($affilusergroups, "sortKeepIndex");
+ }
+ printSelectInput("editgroupid", $affilusergroups, $data["editgroupid"]);
+ print " </TD>\n";
+ print " <TD></TD>";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Initial Max Time (minutes):</TH>\n";
+ print " <TD><INPUT type=text name=initialmax value=\"";
+ print $data["initialmax"] . "\" maxlength=4></TD>\n";
+ print " <TD>";
+ printSubmitErr(INITIALMAXERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Total Max Time (minutes):</TH>\n";
+ print " <TD><INPUT type=text name=totalmax value=\"";
+ print $data["totalmax"] . "\" maxlength=4></TD>\n";
+ print " <TD>";
+ printSubmitErr(TOTALMAXERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Max Extend Time (minutes):</TH>\n";
+ print " <TD><INPUT type=text name=maxextend value=\"";
+ print $data["maxextend"] . "\" maxlength=4></TD>\n";
+ print " <TD>";
+ printSubmitErr(MAXEXTENDERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ if($viewmode == ADMIN_DEVELOPER) {
+ print " <TR>\n";
+ print " <TH align=right>Max Overlapping Reservations:</TH>\n";
+ print " <TD><INPUT type=text name=overlap value=\"";
+ print $data["overlap"] . "\" maxlength=4></TD>\n";
+ print " <TD>";
+ printSubmitErr(MAXOVERLAPERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ }
+ }
+ else {
+ print " <TR>\n";
+ print " <TH align=right>Owning User Group:</TH>\n";
+ print " <TD>\n";
+ if(! array_key_exists($ownerid, $affilusergroups)) {
+ $affilusergroups[$ownerid] = $usergroups[$ownerid];
+ uasort($affilusergroups, "sortKeepIndex");
+ }
+ printSelectInput("ownergroup", $affilusergroups, $ownerid);
+ print " </TD>\n";
+ print " <TD></TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ print "<TABLE>\n";
+ print " <TR valign=top>\n";
+ print " <TD>\n";
+ if($state) {
+ $cdata = array('type' => $data['type'],
+ 'isowner' => $data['isowner']);
+ $cont = addContinuationsEntry('submitAddGroup', $cdata);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=\"Add Group\">\n";
+ }
+ else {
+ $cdata = array('type' => $data['type'],
+ 'groupid' => $data['groupid'],
+ 'isowner' => $data['isowner']);
+ if($data['type'] == 'resource')
+ $cdata['resourcetypeid'] = $resourcetypeid;
+ else
+ $cdata['selectAffil'] = $selectAffil;
+ $cont = addContinuationsEntry('confirmEditGroup', $cdata);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=\"Confirm Changes\">\n";
+ }
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <INPUT type=hidden name=mode value=viewGroups>\n";
+ print " <INPUT type=submit value=Cancel>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ }
+
+ if($data["type"] != "user")
+ return;
+ if($editusergroup) {
+ print "<H3>Group Membership</H3>\n";
+ if($mode == "addGroupUser" && ! ($submitErr & IDNAMEERR)) {
+ print "<font color=\"#008000\">$newuser successfully added to group";
+ print "</font><br><br>\n";
+ }
+ if($mode == "deleteGroupUser") {
+ print "<font color=\"#008000\">$newuser successfully deleted from ";
+ print "group</font><br><br>\n";
+ }
+ $groupmembers = getUserGroupMembers($data["groupid"]);
+ print "<TABLE border=1>\n";
+ print " <TR>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <TD align=right><INPUT type=submit value=Add></TD>\n";
+ print " <TD><INPUT type=text name=newuser maxlength=80 size=40 ";
+ if($submitErr & IDNAMEERR)
+ print "value=\"$newuser\"></TD>\n";
+ else
+ print "></TD>\n";
+ if($submitErr) {
+ print " <TD>\n";
+ printSubmitErr(IDNAMEERR);
+ print " </TD>\n";
+ }
+ $cont = addContinuationsEntry('addGroupUser', $data);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " </FORM>\n";
+ print " </TR>\n";
+ foreach($groupmembers as $id => $login) {
+ print " <TR>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <INPUT type=submit value=Delete>\n";
+ $data['userid'] = $id;
+ $data['newuser'] = $login;
+ $cont = addContinuationsEntry('deleteGroupUser', $data);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>$login</TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn processGroupInput($checks)
+///
+/// \param $checks - (optional) 1 to perform validation, 0 not to
+///
+/// \return an array with the following indexes:\n
+/// groupid, name, prettyname, platformid, osid
+///
+/// \brief validates input from the previous form; if anything was improperly
+/// submitted, sets submitErr and submitErrMsg
+///
+////////////////////////////////////////////////////////////////////////////////
+function processGroupInput($checks=1) {
+ global $submitErr, $submitErrMsg, $user, $viewmode;
+ $return = array();
+ $return["groupid"] = getContinuationVar("groupid");
+ $return["type"] = getContinuationVar("type");
+ $return["name"] = getContinuationVar('name', processInputVar("name", ARG_STRING));
+ $return["affiliationid"] = getContinuationVar('affiliationid', processInputVar("affiliationid", ARG_NUMERIC, $user['affiliationid']));
+ $return["resourcetypeid"] = getContinuationVar('resourcetypeid', processInputVar("resourcetypeid", ARG_NUMERIC));
+ $return["owner"] = getContinuationVar('owner', processInputVar("owner", ARG_STRING));
+ $return["ownergroup"] = processInputVar("ownergroup", ARG_NUMERIC);
+ $return["editgroupid"] = getContinuationVar('editgroupid', processInputVar("editgroupid", ARG_NUMERIC));
+ $return["isowner"] = getContinuationVar("isowner");
+ $return["initialmax"] = getContinuationVar('initialmax', processInputVar("initialmax", ARG_NUMERIC));
+ $return["totalmax"] = getContinuationVar('totalmax', processInputVar("totalmax", ARG_NUMERIC));
+ $return["maxextend"] = getContinuationVar('maxextend', processInputVar("maxextend", ARG_NUMERIC));
+ $return["overlap"] = getContinuationVar('overlap', processInputVar("overlap", ARG_NUMERIC, 0));
+
+ $affils = getAffiliations();
+ if(! array_key_exists($return['affiliationid'], $affils))
+ $return['affiliationid'] = $user['affiliationid'];
+
+ if(! $checks) {
+ return $return;
+ }
+
+ if(! ereg('^[-a-zA-Z0-9_\.: ]{3,30}$', $return["name"])) {
+ $submitErr |= GRPNAMEERR;
+ $submitErrMsg[GRPNAMEERR] = "Name must be between 3 and 30 characters "
+ . "and can only contain letters, numbers, and "
+ . "these characters: - _ . :";
+ }
+ if(! empty($return["type"]) && ! empty($return["name"]) &&
+ ! ($submitErr & GRPNAMEERR) &&
+ checkForGroupName($return["name"], $return["type"], $return["groupid"],
+ $return["resourcetypeid"])) {
+ $submitErr |= GRPNAMEERR;
+ $submitErrMsg[GRPNAMEERR] = "A group already exists with this name.";
+ }
+ if($return["type"] == "user" && ! validateUserid($return["owner"])) {
+ $submitErr |= GRPOWNER;
+ $submitErrMsg[GRPOWNER] = "Submitted ID is not valid";
+ }
+ if($return["type"] == "user" && $return["initialmax"] < 30) {
+ $submitErr |= INITIALMAXERR;
+ $submitErrMsg[INITIALMAXERR] = "Initial max time must be at least 30 "
+ . "minutes";
+ }
+ if($return["type"] == "user" && $return["totalmax"] < 30) {
+ $submitErr |= TOTALMAXERR;
+ $submitErrMsg[TOTALMAXERR] = "Total max time must be at least 30 "
+ . "minutes";
+ }
+ if($return["type"] == "user" && $return["maxextend"] < 15) {
+ $submitErr |= MAXEXTENDERR;
+ $submitErrMsg[MAXEXTENDERR] = "Max extend time must be at least 15 "
+ . "minutes";
+ }
+ if($viewmode == ADMIN_DEVELOPER &&
+ $return["type"] == "user" &&
+ ($return["overlap"] < 0 ||
+ $return["overlap"] == 1)) {
+ $submitErr |= MAXOVERLAPERR;
+ $submitErrMsg[MAXOVERLAPERR] = "Overlap can be 0 or greater than or equal to 2";
+ }
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn checkForGroupName($name, $type, $id, $resourcetypeid)
+///
+/// \param $name - the name of a group
+/// \param $type - user or resource
+/// \param $id - id of a group to ignore
+/// \param $resourcetypeid - a resource type
+///
+/// \return 1 if $name is already in the associated table, 0 if not
+///
+/// \brief checks for $name being in usergroup/resource group (based on $type)
+/// except for $id
+///
+////////////////////////////////////////////////////////////////////////////////
+function checkForGroupName($name, $type, $id, $resourcetypeid) {
+ if($type == "user")
+ $query = "SELECT id FROM usergroup "
+ . "WHERE name = '$name'";
+ else
+ $query = "SELECT id FROM resourcegroup "
+ . "WHERE name = '$name' AND "
+ . "resourcetypeid = $resourcetypeid";
+ if(! empty($id))
+ $query .= " AND id != $id";
+ $qh = doQuery($query, 101);
+ if(mysql_num_rows($qh))
+ return 1;
+ return 0;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn updateGroup($data)
+///
+/// \param $data - an array returned from processGroupInput
+///
+/// \return number of rows affected by the update\n
+/// \b NOTE: mysql reports that no rows were affected if none of the fields
+/// were actually changed even if the update matched a row
+///
+/// \brief performs a query to update the group with data from $data
+///
+////////////////////////////////////////////////////////////////////////////////
+function updateGroup($data) {
+ global $viewmode;
+ if($data["type"] == "user") {
+ $ownerid = getUserlistID($data["owner"]);
+ $query = "UPDATE usergroup "
+ . "SET name = '{$data["name"]}', "
+ . "affiliationid = {$data['affiliationid']}, "
+ . "ownerid = $ownerid, "
+ . "editusergroupid = {$data["editgroupid"]}, "
+ . "initialmaxtime = {$data["initialmax"]}, "
+ . "totalmaxtime = {$data["totalmax"]}, ";
+ if($viewmode == ADMIN_DEVELOPER)
+ $query .= "overlapResCount = {$data["overlap"]}, ";
+ $query .= "maxextendtime = {$data["maxextend"]} "
+ . "WHERE id = {$data["groupid"]}";
+ }
+ else {
+ $query = "UPDATE resourcegroup "
+ . "SET name = '{$data["name"]}', "
+ . "ownerusergroupid = {$data["ownergroup"]} "
+ . "WHERE id = {$data["groupid"]}";
+ }
+ $qh = doQuery($query, 300);
+ return mysql_affected_rows($GLOBALS["mysql_link_vcl"]);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn addGroup($data)
+///
+/// \param $data - an array returned from processGroupInput
+///
+/// \return number of rows affected by the insert\n
+///
+/// \brief performs a query to insert the group with data from $data
+///
+////////////////////////////////////////////////////////////////////////////////
+function addGroup($data) {
+ global $viewmode;
+ if($data["type"] == "user") {
+ $ownerid = getUserlistID($data["owner"]);
+ $query = "INSERT INTO usergroup "
+ . "(name, "
+ . "affiliationid, "
+ . "ownerid, "
+ . "editusergroupid, "
+ . "custom, "
+ . "initialmaxtime, "
+ . "totalmaxtime, ";
+ if($viewmode == ADMIN_DEVELOPER)
+ $query .= "overlapResCount, ";
+ $query .= "maxextendtime) "
+ . "VALUES ('{$data["name"]}', "
+ . "{$data["affiliationid"]}, "
+ . "$ownerid, "
+ . "{$data["editgroupid"]}, "
+ . "1, "
+ . "{$data["initialmax"]}, "
+ . "{$data["totalmax"]}, ";
+ if($viewmode == ADMIN_DEVELOPER)
+ $query .= "{$data["overlap"]}, ";
+ $query .= "{$data["maxextend"]})";
+ }
+ else {
+ $query = "INSERT INTO resourcegroup "
+ . "(name, "
+ . "ownerusergroupid, "
+ . "resourcetypeid) "
+ . "VALUES ('" . $data["name"] . "', "
+ . $data["ownergroup"] . ", "
+ . "'" . $data["resourcetypeid"] . "')";
+ }
+ $qh = doQuery($query, 305);
+ clearPrivCache();
+ return mysql_affected_rows($GLOBALS["mysql_link_vcl"]);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn checkForGroupUsage($groupid, $type)
+///
+/// \param $groupid - id of an group
+/// \param $type - group type: "user" or "resource"
+///
+/// \return 0 if group is not used, 1 if it is
+///
+/// \brief checks for $groupid being in the priv table corresponding to $type
+///
+////////////////////////////////////////////////////////////////////////////////
+function checkForGroupUsage($groupid, $type) {
+ if($type == "user")
+ $query = "SELECT id FROM userpriv WHERE usergroupid = $groupid";
+ else
+ $query = "SELECT id FROM resourcepriv WHERE resourcegroupid = $groupid";
+ $qh = doQuery($query, 310);
+ if(mysql_num_rows($qh)) {
+ return 1;
+ }
+ return 0;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn confirmEditOrAddGroup($state)
+///
+/// \param $state - 0 for edit, 1 for add
+///
+/// \brief prints a form for confirming changes to an group
+///
+////////////////////////////////////////////////////////////////////////////////
+function confirmEditOrAddGroup($state) {
+ global $submitErr, $user, $viewmode;
+
+ $data = processGroupInput(1);
+
+ if($submitErr) {
+ editOrAddGroup($state);
+ return;
+ }
+
+ $resourcetypes = getTypes("resources");
+ $usergroups = getUserGroups(1);
+ $affils = getAffiliations();
+
+ if($state) {
+ if($data["type"] == "user") {
+ $title = "Add User Group";
+ $question = "Add the following user group?";
+ $target = "";
+ }
+ else {
+ $title = "Add Resource Group";
+ $question = "Add the following resource group?";
+ $target = "#resources";
+ }
+ $nextmode = "submitAddGroup";
+ }
+ else {
+ if($data["type"] == "user") {
+ $title = "Edit User Group";
+ $question = "Submit changes to the user group?";
+ $target = "";
+ }
+ else {
+ $title = "Edit Resource Group";
+ $question = "Submit changes to the resource group?";
+ $target = "#resources";
+ }
+ $nextmode = "submitEditGroup";
+ }
+
+ print "<DIV align=center>\n";
+ print "<H2>$title</H2>\n";
+ print "$question<br><br>\n";
+ print "<TABLE>\n";
+ if($data["type"] == "resource") {
+ print " <TR>\n";
+ print " <TH align=right>Type:</TH>\n";
+ print " <TD>" . $resourcetypes["resources"][$data["resourcetypeid"]];
+ print "</TD>\n";
+ print " </TR>\n";
+ }
+ print " <TR>\n";
+ print " <TH align=right>Name:</TH>\n";
+ if($data['type'] == 'user' && ($user['showallgroups'] ||
+ $data['affiliationid'] != $user['affiliationid']))
+ print " <TD>{$data["name"]}@{$affils[$data['affiliationid']]}</TD>\n";
+ else
+ print " <TD>{$data["name"]}</TD>\n";
+ print " </TR>\n";
+ if($data["type"] == "user") {
+ print " <TR>\n";
+ print " <TH align=right>Owner:</TH>\n";
+ print " <TD>" . $data["owner"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Editable by:</TH>\n";
+ if(! $user['showallgroups']) {
+ $tmp = explode('@', $usergroups[$data["editgroupid"]]["name"]);
+ if($tmp[1] == $user['affiliation'])
+ $usergroups[$data["editgroupid"]]["name"] = $tmp[0];
+ }
+ print " <TD>" . $usergroups[$data["editgroupid"]]["name"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Initial Max Time (minutes):</TH>\n";
+ print " <TD>{$data["initialmax"]}</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n"; print " <TH align=right>Total Max Time (minutes):</TH>\n";
+ print " <TD>{$data["totalmax"]}</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Max Extend Time (minutes):</TH>\n";
+ print " <TD>{$data["maxextend"]}</TD>\n";
+ print " </TR>\n";
+ if($viewmode == ADMIN_DEVELOPER) {
+ print " <TR>\n";
+ print " <TH align=right>Max Overlapping Reservations:</TH>\n";
+ print " <TD>{$data["overlap"]}</TD>\n";
+ print " </TR>\n";
+ }
+ }
+ else {
+ print " <TR>\n";
+ print " <TH align=right>Owning User Group:</TH>\n";
+ if(! $user['showallgroups'] &&
+ preg_match("/^(.+)@{$user['affiliation']}$/",
+ $usergroups[$data['ownergroup']]['name'], $matches))
+ print " <TD>{$matches[1]}";
+ else
+ print " <TD>" . $usergroups[$data["ownergroup"]]["name"];
+ print "</TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ print "<TABLE>\n";
+ print " <TR valign=top>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "$target\" method=post>\n";
+ $cont = addContinuationsEntry($nextmode, $data, SECINDAY, 0, 0);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Submit>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <INPUT type=hidden name=mode value=viewGroups>\n";
+ print " <INPUT type=submit value=Cancel>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitEditGroup()
+///
+/// \brief submits changes to group and notifies user
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitEditGroup() {
+ $data = getContinuationVar();
+ updateGroup($data);
+ $_SESSION['userresources'] = array();
+ $_SESSION['nodeprivileges'] = array();
+ #$_SESSION['cascadenodeprivileges'] = array(); // might need this uncommented
+ viewGroups();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitAddGroup()
+///
+/// \brief adds the group and notifies user
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitAddGroup() {
+ global $submitErr;
+ $data = processGroupInput(1);
+ if($submitErr) {
+ editOrAddGroup(1);
+ return;
+ }
+ if(! addGroup($data))
+ abort(10);
+ viewGroups();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn confirmDeleteGroup()
+///
+/// \brief prints a form to confirm the deletion of an group
+///
+////////////////////////////////////////////////////////////////////////////////
+function confirmDeleteGroup() {
+ $groupid = getContinuationVar("groupid");
+ $type = getContinuationVar("type");
+
+ $usergroups = getUserGroups(1);
+ $resourcegroups = getResourceGroups();
+
+ if($type == "user") {
+ $title = "Delete User Group";
+ $question = "Delete the following user group?";
+ $name = $usergroups[$groupid]["name"];
+ $target = "";
+ }
+ else {
+ $title = "Delete Resource Group";
+ $question = "Delete the following resource group?";
+ list($resourcetype, $name) =
+ split('/', $resourcegroups[$groupid]["name"]);
+ $target = "#resources";
+ }
+
+ if(checkForGroupUsage($groupid, $type)) {
+ print "<H2 align=center>$title</H2>\n";
+ print "This group is currently assigned to at least one node in the ";
+ print "privilege tree. You cannot delete it until it is no longer ";
+ print "in use.";
+ return;
+ }
+
+ print "<DIV align=center>\n";
+ print "<H2>$title</H2>\n";
+ print "$question<br><br>\n";
+ print "<TABLE>\n";
+ if($type == "resource") {
+ print " <TR>\n";
+ print " <TH align=right>Type:</TH>\n";
+ print " <TD>$resourcetype</TD>\n";
+ print " </TR>\n";
+ }
+ print " <TR>\n";
+ print " <TH align=right>Name:</TH>\n";
+ print " <TD>$name</TD>\n";
+ print " </TR>\n";
+ if($type == "resource") {
+ print " <TR>\n";
+ print " <TH align=right>Owning User Group:</TH>\n";
+ print " <TD>" . $resourcegroups[$groupid]["owner"] . "</TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ print "<TABLE>\n";
+ print " <TR valign=top>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "$target\" method=post>\n";
+ $cdata = array('groupid' => $groupid,
+ 'type' => $type);
+ $cont = addContinuationsEntry('submitDeleteGroup', $cdata);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Submit>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <INPUT type=hidden name=mode value=viewGroups>\n";
+ print " <INPUT type=submit value=Cancel>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitDeleteGroup()
+///
+/// \brief deletes an group from the database and notifies the user
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitDeleteGroup() {
+ $groupid = getContinuationVar("groupid");
+ $type = getContinuationVar("type");
+ if($type == "user")
+ $table = "usergroup";
+ else
+ $table = "resourcegroup";
+ $query = "DELETE FROM $table "
+ . "WHERE id = $groupid";
+ doQuery($query, 315);
+ clearPrivCache();
+ viewGroups();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn addGroupUser()
+///
+/// \brief adds a user to a group
+///
+////////////////////////////////////////////////////////////////////////////////
+function addGroupUser() {
+ global $submitErr, $submitErrMsg;
+ $groupid = getContinuationVar("groupid");
+ $newuser = processInputVar("newuser", ARG_STRING);
+ if(! validateUserid($newuser)) {
+ $submitErr |= IDNAMEERR;
+ $submitErrMsg[IDNAMEERR] = "Invalid login ID";
+ editOrAddGroup(0);
+ return;
+ }
+ addUserGroupMember($newuser, $groupid);
+ editOrAddGroup(0);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn deleteGroupUser()
+///
+/// \brief deletes a user from a group
+///
+////////////////////////////////////////////////////////////////////////////////
+function deleteGroupUser() {
+ $groupid = getContinuationVar("groupid");
+ $userid = getContinuationVar("userid");
+ $test = getUserUnityID($userid);
+ if(! empty($test))
+ deleteUserGroupMember($userid, $groupid);
+ editOrAddGroup(0);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn jsonGetGroupInfo()
+///
+/// \brief
+///
+////////////////////////////////////////////////////////////////////////////////
+function jsonGetGroupInfo() {
+ $groupid = processInputVar('groupid', ARG_NUMERIC);
+ $mousex = processInputVar('mousex', ARG_NUMERIC);
+ $mousey = processInputVar('mousey', ARG_NUMERIC);
+ $userresources = getUserResources(array("groupAdmin"),
+ array("manageGroup"), 1);
+ $found = 0;
+ foreach(array_keys($userresources) as $type) {
+ if(array_key_exists($groupid, $userresources[$type])) {
+ $found = 1;
+ break;
+ }
+ }
+ if(! $found || $mousex < 0 || $mousex > 5000 || $mousey < 0 || $mousey > 500000) {
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode(array()) . '}*/';
+ return;
+ }
+ $members = getResourceGroupMembers($type);
+ $data = array();
+ if(! empty($members[$type][$groupid])) {
+ uasort($members[$type][$groupid], "sortKeepIndex");
+ foreach($members[$type][$groupid] as $mem) {
+ $data[] = $mem['name'];
+ }
+ }
+ else
+ $data[] = '(empty group)';
+ $arr = array('members' => $data, 'x' => $mousex, 'y' => $mousey);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+?>
diff --git a/web/.ht-inc/help.php b/web/.ht-inc/help.php
new file mode 100644
index 0000000..2c3f5a6
--- /dev/null
+++ b/web/.ht-inc/help.php
@@ -0,0 +1,206 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+/**
+ * \file
+ */
+
+/// signifies an error with the submitted name
+define("NAMEERR", 1);
+/// signifies an error with the submitted email address
+define("EMAILERR", 1 << 1);
+/// signifies an error with the submitted problem text
+define("TEXTERR", 1 << 2);
+/// signifies an error with the submitted problem summary
+define("SUMMARYERR", 1 << 3);
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn printHelpForm()
+///
+/// \brief prints a form for a user to send in a help request
+///
+////////////////////////////////////////////////////////////////////////////////
+function printHelpForm() {
+ global $user, $submitErr, $noHTMLwrappers;
+ if($submitErr) {
+ $name = processInputVar("name", ARG_STRING);
+ $email = processInputVar("email", ARG_STRING);
+ $summary = processInputVar("summary", ARG_STRING);
+ $text = processInputVar("comments", ARG_STRING);
+ }
+ else {
+ $name = $user["firstname"] . " " . $user["lastname"];
+ $email = $user["email"];
+ $summary = "";
+ $text = "";
+ }
+ if(! in_array('helpform', $noHTMLwrappers))
+ print "<H2>VCL Help</H2>\n";
+ print "This form sends a request to the VCL support group. Please provide ";
+ print "as much information as possible.<br><br>\n";
+ if(! in_array('helpform', $noHTMLwrappers))
+ print "Please see our <a href=\"" . HELPFAQURL . "\">";
+ else
+ print "Please see our <a href=\"http://vcl.ncsu.edu/drupal/?q=faq\">";
+ print "FAQ</a> Section before sending your request - it may be an easy ";
+ print "fix!<br><br>\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TH align=right>Name:</TH>\n";
+ print " <TD><INPUT type=text name=name size=25 value=\"$name\"></TD>\n";
+ print " <TD>";
+ printSubmitErr(NAMEERR);
+ print " </TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Email:</TH>\n";
+ print " <TD><INPUT type=text name=email size=25 value=\"$email\"></TD>\n";
+ print " <TD>";
+ printSubmitErr(EMAILERR);
+ print " </TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Summary:</TH>\n";
+ print " <TD><INPUT type=text name=summary size=25 value=\"$summary\"></TD>\n";
+ print " <TD>";
+ printSubmitErr(SUMMARYERR);
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ print "<br>\n";
+ print "Please describe the problem you are having. Include a description ";
+ print "of how you encountered the problem and any error messages you ";
+ print "received:<br>\n";
+ printSubmitErr(TEXTERR);
+ print "<textarea tabindex=2 name=comments cols=50 rows=8>$text</textarea><br>\n";
+ if(in_array('helpform', $noHTMLwrappers))
+ $cdata = array('indrupal' => 1);
+ else
+ $cdata = array();
+ $cont = addContinuationsEntry('submitHelpForm', $cdata, SECINDAY, 1, 0);
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "<INPUT tabindex=3 type=submit value=\"Submit Help Request\">\n";
+ print "</FORM>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitHelpForm()
+///
+/// \brief processes the help form and notifies the user that it was submitted
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitHelpForm() {
+ global $user, $submitErr, $submitErrMsg;
+ $name = processInputVar("name", ARG_STRING);
+ $email = processInputVar("email", ARG_STRING);
+ $summary = processInputVar("summary", ARG_STRING);
+ $text = processInputVar("comments", ARG_STRING);
+
+ if(! ereg('^([A-Za-z]{1,}( )([A-Za-z]){2,})$', $name)) {
+ $submitErr |= NAMEERR;
+ $submitErrMsg[NAMEERR] = "You must submit your first and last name";
+ }
+ if(! eregi('^[_a-z0-9-]+(\.[_a-z0-9-]+)*@[a-z0-9-]+(\.[a-z0-9-]+)*(\.[a-z]{2,3})$',
+ $email)) {
+ $submitErr |= EMAILERR;
+ $submitErrMsg[EMAILERR] = "Invalid email address, please correct";
+ }
+ if(empty($summary)) {
+ $submitErr |= SUMMARYERR;
+ $submitErrMsg[SUMMARYERR] = "Please fill in a very short summary of the "
+ . "problem";
+ }
+ if(empty($text)) {
+ $submitErr |= TEXTERR;
+ $submitErrMsg[TEXTERR] = "Please fill in your problem in the box below.<br>";
+ }
+ if($submitErr) {
+ printHelpForm();
+ return;
+ }
+
+ $computers = getComputers();
+ $requests = getUserRequests("all");
+ $query = "SELECT l.start AS start, "
+ . "l.finalend AS end, "
+ . "l.computerid AS computerid, "
+ . "i.prettyname AS prettyimage "
+ . "FROM log l, "
+ . "image i "
+ . "WHERE l.userid = " . $user["id"] . " AND "
+ . "i.id = l.imageid AND "
+ . "(unix_timestamp(NOW()) - unix_timestamp(l.finalend)) < 14400";
+ $qh = doQuery($query, 290);
+ while($row = mysql_fetch_assoc($qh)) {
+ array_push($requests, $row);
+ }
+
+ $from = $user["email"];
+ if(get_magic_quotes_gpc())
+ $text = stripslashes($text);
+ $message = "Problem report submitted from VCL web form:\n\n"
+ . "User: " . $user["unityid"] . "\n"
+ . "Name: " . $name . "\n"
+ . "Email: " . $email . "\n"
+ . "Problem description:\n\n$text\n\n";
+ $end = time();
+ $start = $end - 14400;
+ $recentrequests = "";
+ foreach($requests as $request) {
+ if(datetimeToUnix($request["end"]) > $start ||
+ datetimeToUnix($request["start"] < $end)) {
+ $thisstart = str_replace(' ', ' ',
+ prettyDatetime($request["start"]));
+ $thisend = str_replace(' ', ' ',
+ prettyDatetime($request["end"]));
+ $recentrequests .= "Image: " . $request["prettyimage"] . "\n"
+ . "Computer: " . $computers[$request["computerid"]]["hostname"] . "\n"
+ . "Start: $thisstart\n"
+ . "End: $thisend\n\n";
+ }
+ }
+ if(! empty($recentrequests)) {
+ $message .= "-----------------------------------------------\n";
+ $message .= "User's recent reservations:\n\n" . $recentrequests . "\n";
+ }
+ else {
+ $message .= "User has no recent reservations\n";
+ }
+
+
+ $indrupal = getContinuationVar('indrupal', 0);
+ if(! $indrupal)
+ print "<H2>VCL Help</H2>\n";
+ $mailParams = "-f" . ENVELOPESENDER;
+ if(! mail(HELPEMAIL, "$summary", $message,
+ "From: $from\r\nReply-To: $email\r\n", $mailParams)){
+ print "The Server was unable to send mail at this time. Please e-mail ";
+ print "<a href=\"mailto:" . HELPEMAIL . "\">" . HELPEMAIL . "</a> for ";
+ print "help with your problem.";
+ }
+ else {
+ print "Your problem report has been submitted. Thank you for letting ";
+ print "us know of your problem so that we can improve this site.<br>\n";
+ }
+}
+
+?>
diff --git a/web/.ht-inc/images.php b/web/.ht-inc/images.php
new file mode 100644
index 0000000..870dec2
--- /dev/null
+++ b/web/.ht-inc/images.php
@@ -0,0 +1,3737 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+/**
+ * \file
+ */
+
+/// signifies an error with the submitted name
+define("NAMEERR", 1);
+/// signifies an error with the submitted pretty name
+define("PRETTYNAMEERR", 1 << 1);
+/// signifies an error with the submitted minimum number amount of RAM
+define("MINRAMERR", 1 << 2);
+/// signifies an error with the submitted minimum processor speed
+define("MINPROCSPEEDERR", 1 << 3);
+/// signifies an error with the submitted estimated reload time
+define("RELOADTIMEERR", 1 << 4);
+/// signifies an error with the submitted owner
+define("IMGOWNERERR", 1 << 5);
+/// signifies an error with the submitted maximum concurrent usage
+define("MAXCONCURRENTERR", 1 << 6);
+/// signifies an error with the submitted image description
+define("IMAGEDESCRIPTIONERR", 1 << 7);
+
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn selectImageOption()
+///
+/// \brief prints a page for the user to select which image operation they want
+/// to perform; if they only have access to a few options or only a few images,
+/// just send them straight to viewImagesAll
+///
+////////////////////////////////////////////////////////////////////////////////
+function selectImageOption() {
+ # get a count of images user can administer
+ $tmp = getUserResources(array("imageAdmin"), array("administer"));
+ $imgAdminCnt = count($tmp['image']);
+
+ # get a count of images user has access to for creating new images
+ $tmp = getUserResources(array("imageAdmin"), array("available"));
+ $imgCnt = count($tmp['image']);
+
+ # get a count of image groups user can manage
+ $tmp = getUserResources(array("imageAdmin"), array("manageGroup"), 1);
+ $imgGroupCnt = count($tmp['image']);
+
+ # get a count of computer groups user can manage
+ $tmp = getUserResources(array("computerAdmin"), array("manageGroup"), 1);
+ $compGroupCnt = count($tmp['computer']);
+
+ print "<H2>Manage Images</H2>\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ if($imgAdminCnt) {
+ $cont = addContinuationsEntry('viewImages');
+ print "<INPUT type=radio name=continuation value=\"$cont\" checked>Edit ";
+ print "Image Profiles<br>\n";
+ print "<img src=images/blank.gif width=20><INPUT type=checkbox name=";
+ print "details value=1>Include details<br>\n";
+ }
+
+ if($imgGroupCnt) {
+ $cont = addContinuationsEntry('viewImageGrouping');
+ print "<INPUT type=radio name=continuation value=\"$cont\">Edit ";
+ print "Image Grouping<br>\n";
+
+ if($compGroupCnt) {
+ $cont = addContinuationsEntry('viewImageMapping');
+ print "<INPUT type=radio name=continuation value=\"$cont\">Edit ";
+ print "Image Mapping<br>\n";
+ }
+ }
+
+ if($imgCnt) {
+ $cont = addContinuationsEntry('createSelectImage');
+ print "<INPUT type=radio name=continuation value=\"$cont\">Create /";
+ print " Update an Image<br>\n";
+ }
+
+ if($imgAdminCnt || $imgGroupCnt || $imgCnt)
+ print "<br><INPUT type=submit value=Submit>\n";
+ else
+ print "You don't have access to manage any images.<br>\n";
+ print "</FORM>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn viewImages()
+///
+/// \brief prints a page to view image information
+///
+////////////////////////////////////////////////////////////////////////////////
+function viewImages() {
+ global $viewmode, $user, $mode;
+ $showdeleted = getContinuationVar("showdeleted", 0);
+ $deleted = getContinuationVar("deleted");
+ $details = processInputVar("details", ARG_NUMERIC);
+
+ if($showdeleted) {
+ $images = getImages(1);
+ $resources = getUserResources(array("imageAdmin"),
+ array("administer"), 0, 1);
+ }
+ else {
+ $images = getImages();
+ $resources = getUserResources(array("imageAdmin"), array("administer"));
+ }
+ $userImageIDs = array_keys($resources["image"]);
+ $platforms = getPlatforms();
+ $oslist = getOSList();
+ $depts = getDepartments();
+
+ print "<H2>Image Profiles</H2>\n";
+ if($mode == "submitDeleteImage") {
+ if($deleted) {
+ print "<font color=\"#008000\">Image successfully undeleted";
+ print "</font><br><br>\n";
+ }
+ else {
+ print "<font color=\"#008000\">Image successfully set to deleted ";
+ print "state</font><br><br>\n";
+ }
+ }
+ elseif($mode == "submitEditImage") {
+ print "<font color=\"#008000\">Image successfully updated";
+ print "</font><br><br>\n";
+ }
+ print "<TABLE border=1>\n";
+ print " <TR>\n";
+ print " <TD></TD>\n";
+ print " <TH><img src=images/blank.gif width=100 height=1><br>Name</TH>\n";
+ print " <TH>Owner</TH>\n";
+ print " <TH>Platform</TH>\n";
+ print " <TH><img src=images/blank.gif width=70 height=1><br>OS</TH>\n";
+ print " <TH>Estimated Reload Time (min)</TH>\n";
+ if($details) {
+ print " <TH>Minimum RAM (MB)</TH>\n";
+ print " <TH>Minimum Num of Processors</TH>\n";
+ print " <TH>Minimum Processor Speed (MHz)</TH>\n";
+ print " <TH>Minimum Network Speed (Mbps)</TH>\n";
+ print " <TH>Maximum Concurrent Usage</TH>\n";
+ }
+ if($showdeleted) {
+ print " <TH>Deleted</TH>\n";
+ }
+ print " </TR>\n";
+ foreach(array_keys($images) as $id) {
+ if(! in_array($id, $userImageIDs))
+ continue;
+ print " <TR>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('imageid' => $id);
+ $cont = addContinuationsEntry('submitImageButton', $cdata);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <TD align=center>\n";
+ if($showdeleted && $images[$id]["deleted"] == 1) {
+ print " <INPUT type=submit name=submode value=Undelete>\n";
+ }
+ else {
+ print " <INPUT type=submit name=submode value=Edit>\n";
+ print " <INPUT type=submit name=submode value=Delete><br>\n";
+ }
+ print " <INPUT type=submit name=submode value=Details>\n";
+ print " </TD>\n";
+ print " </FORM>\n";
+ print " <TD align=center>" . $images[$id]["prettyname"] . "</TD>\n";
+ print " <TD align=center>" . $images[$id]["owner"] . "</TD>\n";
+ print " <TD align=center>" . $images[$id]["platform"] . "</TD>\n";
+ print " <TD align=center>" . $oslist[$images[$id]["osid"]]["prettyname"] . "</TD>\n";
+ print " <TD align=center>" . $images[$id]["reloadtime"] . "</TD>\n";
+ if($details) {
+ print " <TD align=center>" . $images[$id]["minram"] . "</TD>\n";
+ print " <TD align=center>" . $images[$id]["minprocnumber"] . "</TD>\n";
+ print " <TD align=center>" . $images[$id]["minprocspeed"] . "</TD>\n";
+ print " <TD align=center>" . $images[$id]["minnetwork"] . "</TD>\n";
+ if($images[$id]['maxconcurrent'] == '')
+ print " <TD align=center>N/A</TD>\n";
+ else
+ print " <TD align=center>" . $images[$id]["maxconcurrent"] . "</TD>\n";
+ }
+ if($showdeleted) {
+ print " <TD align=center>" . $images[$id]["deleted"] . "</TD>\n";
+ }
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ if($showdeleted) {
+ $cdata = array('showdeleted' => 0);
+ print "<INPUT type=submit value=\"Hide Deleted Images\">\n";
+ }
+ else {
+ $cdata = array('showdeleted' => 1);
+ print "<INPUT type=submit value=\"Include Deleted Images\">\n";
+ }
+ $cont = addContinuationsEntry('viewImages', $cdata);
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "</FORM>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn viewImageGrouping()
+///
+/// \brief prints a page to view and modify image grouping
+///
+////////////////////////////////////////////////////////////////////////////////
+function viewImageGrouping() {
+ global $mode;
+ $resources = getUserResources(array("imageAdmin"),
+ array("manageGroup"));
+ if(! count($resources["image"])) {
+ print "<H2>Image Grouping</H2>\n";
+ print "You don't have access to modify any image groups.<br>\n";
+ return;
+ }
+ if($mode == 'submitImageGroups')
+ $gridSelected = "selected=\"true\"";
+ else
+ $gridSelected = "";
+
+ print "<H2>Image Grouping</H2>\n";
+ print "<div id=\"mainTabContainer\" dojoType=\"dijit.layout.TabContainer\"\n";
+ print " style=\"width:800px;height:600px\">\n";
+
+ # by image tab
+ print "<div id=\"resource\" dojoType=\"dijit.layout.ContentPane\" title=\"By Image\">\n";
+ print "Select an image and click \"Get Groups\" to see all of the groups ";
+ print "it is in. Then,<br>select a group it is in and click the Remove ";
+ print "button to remove it from that group,<br>or select a group it is not ";
+ print "in and click the Add button to add it to that group.<br><br>\n";
+ print "Image:<select name=images id=images>\n";
+ # build list of images
+ $tmp = getUserResources(array('imageAdmin'), array('manageGroup'));
+ $images = $tmp['image'];
+ uasort($images, 'sortKeepIndex');
+ foreach($images as $id => $image) {
+ print "<option value=$id>$image</option>\n";
+ }
+ print "</select>\n";
+ print "<button dojoType=\"dijit.form.Button\" id=\"fetchGrpsButton\">\n";
+ print " Get Groups\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ print " getGroupsButton();\n";
+ print " </script>\n";
+ print "</button>\n";
+ print "<table><tbody><tr>\n";
+ # select for groups image is in
+ print "<td valign=top>\n";
+ print "Groups <span style=\"font-weight: bold;\" id=inimagename></span> is in:<br>\n";
+ print "<select name=ingroups multiple id=ingroups size=20>\n";
+ print "</select>\n";
+ print "</td>\n";
+ # transfer buttons
+ print "<td style=\"vertical-align: middle;\">\n";
+ print "<button dojoType=\"dijit.form.Button\" id=\"addBtn1\">\n";
+ print " <div style=\"width: 50px;\"><-Add</div>\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ $cont = addContinuationsEntry('AJaddGroupToImage');
+ print " addRemItem('$cont', 'images', 'outgroups', addRemImage2);\n";
+ print " </script>\n";
+ print "</button>\n";
+ print "<br>\n";
+ print "<br>\n";
+ print "<br>\n";
+ print "<button dojoType=\"dijit.form.Button\" id=\"remBtn1\">\n";
+ print " <div style=\"width: 50px;\">Remove-></div>\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ $cont = addContinuationsEntry('AJremGroupFromImage');
+ print " addRemItem('$cont', 'images', 'ingroups', addRemImage2);\n";
+ print " </script>\n";
+ print "</button>\n";
+ print "</td>\n";
+ # select for groups image is not in
+ print "<td valign=top>\n";
+ print "Groups <span style=\"font-weight: bold;\" id=outimagename></span> is not in:<br>\n";
+ print "<select name=outgroups multiple id=outgroups size=20>\n";
+ print "</select>\n";
+ print "</td>\n";
+ print "</tr><tbody/></table>\n";
+ print "</div>\n";
+
+ # by group tab
+ print "<div id=\"group\" dojoType=\"dijit.layout.ContentPane\" title=\"By Group\">\n";
+ print "Select a group and click \"Get Images\" to see all of the images ";
+ print "in it. Then,<br>select an image in it and click the Remove ";
+ print "button to remove it from the group,<br>or select an image that is not ";
+ print "in it and click the Add button to add it to the group.<br><br>\n";
+ print "Group:<select name=imgGroups id=imgGroups>\n";
+ # build list of groups
+ $tmp = getUserResources(array('imageAdmin'), array('manageGroup'), 1);
+ $groups = $tmp['image'];
+ uasort($groups, 'sortKeepIndex');
+ foreach($groups as $id => $group) {
+ print "<option value=$id>$group</option>\n";
+ }
+ print "</select>\n";
+ print "<button dojoType=\"dijit.form.Button\" id=\"fetchImgsButton\">\n";
+ print " Get Images\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ print " getImagesButton();\n";
+ print " </script>\n";
+ print "</button>\n";
+ print "<table><tbody><tr>\n";
+ # select for images in group
+ print "<td valign=top>\n";
+ print "Images in <span style=\"font-weight: bold;\" id=ingroupname></span>:<br>\n";
+ print "<select name=inimages multiple id=inimages size=20>\n";
+ print "</select>\n";
+ print "</td>\n";
+ # transfer buttons
+ print "<td style=\"vertical-align: middle;\">\n";
+ print "<button dojoType=\"dijit.form.Button\" id=\"addBtn2\">\n";
+ print " <div style=\"width: 50px;\"><-Add</div>\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ $cont = addContinuationsEntry('AJaddImageToGroup');
+ print " addRemItem('$cont', 'imgGroups', 'outimages', addRemGroup2);\n";
+ print " </script>\n";
+ print "</button>\n";
+ print "<br>\n";
+ print "<br>\n";
+ print "<br>\n";
+ print "<button dojoType=\"dijit.form.Button\" id=\"remBtn2\">\n";
+ print " <div style=\"width: 50px;\">Remove-></div>\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ $cont = addContinuationsEntry('AJremImageFromGroup');
+ print " addRemItem('$cont', 'imgGroups', 'inimages', addRemGroup2);\n";
+ print " </script>\n";
+ print "</button>\n";
+ print "</td>\n";
+ # images not in group select
+ print "<td valign=top>\n";
+ print "Images not in <span style=\"font-weight: bold;\" id=outgroupname></span>:<br>\n";
+ print "<select name=outimages multiple id=outimages size=20>\n";
+ print "</select>\n";
+ print "</td>\n";
+ print "</tr><tbody/></table>\n";
+ print "</div>\n";
+
+ # grid tab
+ $cont = addContinuationsEntry('imageGroupingGrid');
+ $loadingmsg = "<span class=dijitContentPaneLoading>Loading page (this may take a really long time)</span>";
+ print "<a jsId=\"checkboxpane\" dojoType=\"dijit.layout.LinkPane\"\n";
+ print " href=\"index.php?continuation=$cont\"\n";
+ print " loadingMessage=\"$loadingmsg\" $gridSelected>\n";
+ print " Checkbox Grid</a>\n";
+
+ print "</div>\n"; # end of main tab container
+ $cont = addContinuationsEntry('jsonImageGroupingImages');
+ print "<input type=hidden id=imgcont value=\"$cont\">\n";
+ $cont = addContinuationsEntry('jsonImageGroupingGroups');
+ print "<input type=hidden id=grpcont value=\"$cont\">\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn imageGroupingGrid()
+///
+/// \brief prints a page to view and modify image grouping
+///
+////////////////////////////////////////////////////////////////////////////////
+function imageGroupingGrid() {
+ global $mode;
+ $imagemembership = getResourceGroupMemberships("image");
+ $resources = getUserResources(array("imageAdmin"),
+ array("manageGroup"));
+ $tmp = getUserResources(array("imageAdmin"),
+ array("manageGroup"), 1);
+ $imagegroups = $tmp["image"];
+ uasort($imagegroups, "sortKeepIndex");
+ uasort($resources["image"], "sortKeepIndex");
+
+ print "<FORM id=gridform action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<TABLE border=1 summary=\"\">\n";
+ print " <col>\n";
+ foreach(array_keys($imagegroups) as $id) {
+ print " <col id=imggrp$id>\n";
+ }
+ print " <TR>\n";
+ print " <TH rowspan=2>Image</TH>\n";
+ print " <TH class=nohlcol colspan=" . count($imagegroups) . ">Groups</TH>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ foreach($imagegroups as $id => $group) {
+ print " <TH onclick=\"toggleColSelect('imggrp$id');\">$group</TH>\n";
+ }
+ print " </TR>\n";
+ $count = 1;
+ foreach($resources["image"] as $imageid => $image) {
+ if($image == "No Image")
+ continue;
+ if($count % 8 == 0) {
+ print " <TR>\n";
+ print " <TH><img src=images/blank.gif></TH>\n";
+ foreach($imagegroups as $id => $group) {
+ print " <TH onclick=\"toggleColSelect('imggrp$id');\">$group</TH>\n";
+ }
+ print " </TR>\n";
+ }
+ print " <TR id=imageid$imageid>\n";
+ print " <TH align=right onclick=\"toggleRowSelect('imageid$imageid');\">$image</TH>\n";
+ foreach(array_keys($imagegroups) as $groupid) {
+ $name = "imagegroup[" . $imageid . ":" . $groupid . "]";
+ if(array_key_exists($imageid, $imagemembership["image"]) &&
+ in_array($groupid, $imagemembership["image"][$imageid])) {
+ $checked = "checked";
+ }
+ else {
+ $checked = "";
+ }
+ print " <TD align=center>\n";
+ print " <INPUT type=checkbox name=\"$name\" $checked>\n";
+ print " </TD>\n";
+ }
+ print " </TR>\n";
+ $count++;
+ }
+ print "</TABLE>\n";
+ $cont = addContinuationsEntry('submitImageGroups', array(), SECINWEEK, 1, 0, 1);
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "<INPUT type=submit value=\"Submit Changes\">\n";
+ print "<INPUT type=reset value=Reset>\n";
+ print "</FORM>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn viewImageMapping()
+///
+/// \brief prints a page to modify image group to computer group mappings
+///
+////////////////////////////////////////////////////////////////////////////////
+function viewImageMapping() {
+ global $mode;
+ $tmp = getUserResources(array("imageAdmin"),
+ array("manageGroup"), 1);
+ $imagegroups = $tmp["image"];
+ uasort($imagegroups, "sortKeepIndex");
+ $imagecompmapping = getResourceMapping("image", "computer");
+ $resources = getUserResources(array("computerAdmin"),
+ array("manageGroup"), 1);
+ $compgroups = $resources["computer"];
+ uasort($compgroups, "sortKeepIndex");
+ if(! count($imagegroups) || ! count($compgroups)) {
+ print "<H2>Image Group to Computer Group Mapping</H2>\n";
+ print "You don't have access to manage any image group to computer ";
+ print "group mappings.<br>\n";
+ return;
+ }
+ if($mode == 'submitImageMapping')
+ $gridSelected = "selected=\"true\"";
+ else
+ $gridSelected = "";
+
+ print "<H2>Image Group to Computer Group Mapping</H2>\n";
+ print "<div id=\"mainTabContainer\" dojoType=\"dijit.layout.TabContainer\"\n";
+ print " style=\"width:800px;height:600px\">\n";
+
+ # by image group
+ print "<div id=\"imagegrptab\" dojoType=\"dijit.layout.ContentPane\" ";
+ print "title=\"By Image Group\">\n";
+ print "Select an image group and click \"Get Computer Groups\" to see all ";
+ print "of the computer groups it maps to. Then,<br>select a computer group ";
+ print "it maps to and click the Remove button to unmap it from that group, ";
+ print "or select a<br>computer group it does not map to and click the Add ";
+ print "button to map it to that group.<br><br>\n";
+ print "Image Group:<select name=imagegrps id=imagegrps>\n";
+ foreach($imagegroups as $id => $group) {
+ print "<option value=$id>$group</option>\n";
+ }
+ print "</select>\n";
+ print "<button dojoType=\"dijit.form.Button\" id=\"fetchCompGrpsButton\">\n";
+ print " Get Computer Groups\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ print " getMapCompGroupsButton();\n";
+ print " </script>\n";
+ print "</button>\n";
+ print "<table><tbody><tr>\n";
+ # select for comp groups image groups maps to
+ print "<td valign=top>\n";
+ print "Computer groups <span style=\"font-weight: bold;\" id=inimagegrpname></span> maps to:<br>\n";
+ print "<select name=incompgroups multiple id=incompgroups size=20>\n";
+ print "</select>\n";
+ print "</td>\n";
+ # transfer buttons
+ print "<td style=\"vertical-align: middle;\">\n";
+ print "<button dojoType=\"dijit.form.Button\" id=\"addBtn1\">\n";
+ print " <div style=\"width: 50px;\"><-Add</div>\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ $cont = addContinuationsEntry('AJaddCompGrpToImgGrp');
+ print " addRemItem('$cont', 'imagegrps', 'outcompgroups', addRemCompGrpImgGrp);\n";
+ print " </script>\n";
+ print "</button>\n";
+ print "<br>\n";
+ print "<br>\n";
+ print "<br>\n";
+ print "<button dojoType=\"dijit.form.Button\" id=\"remBtn1\">\n";
+ print " <div style=\"width: 50px;\">Remove-></div>\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ $cont = addContinuationsEntry('AJremCompGrpFromImgGrp');
+ print " addRemItem('$cont', 'imagegrps', 'incompgroups', addRemCompGrpImgGrp);\n";
+ print " </script>\n";
+ print "</button>\n";
+ print "</td>\n";
+ # select for comp groups image groups does not map to
+ print "<td valign=top>\n";
+ print "Computer groups <span style=\"font-weight: bold;\" id=outimagegrpname></span> does not map to:<br>\n";
+ print "<select name=outcompgroups multiple id=outcompgroups size=20>\n";
+ print "</select>\n";
+ print "</td>\n";
+ print "</tr><tbody/></table>\n";
+ print "</div>\n";
+
+ # by computer group tab
+ print "<div id=\"group\" dojoType=\"dijit.layout.ContentPane\" title=\"By Computer Group\">\n";
+ print "Select a computer group and click \"Get Images Groups\" to see all ";
+ print "of the image groups it maps to. Then,<br>select an image group ";
+ print "it maps to and click the Remove button to unmap it from that group, ";
+ print "or select an<br>image group it does not map to and click the Add ";
+ print "button to map it to that group.<br><br>\n";
+ print "Computer Group:<select name=compgroups id=compgroups>\n";
+ # build list of groups
+ $tmp = getUserResources(array('computerAdmin'), array('manageGroup'), 1);
+ $groups = $tmp['computer'];
+ uasort($groups, 'sortKeepIndex');
+ foreach($groups as $id => $group) {
+ print "<option value=$id>$group</option>\n";
+ }
+ print "</select>\n";
+ print "<button dojoType=\"dijit.form.Button\" id=\"fetchCompsButton\">\n";
+ print " Get Image Groups\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ print " getMapImgGroupsButton();\n";
+ print " </script>\n";
+ print "</button>\n";
+ print "<table><tbody><tr>\n";
+ # select for image groups comp group maps to
+ print "<td valign=top>\n";
+ print "Image groups <span style=\"font-weight: bold;\" id=incompgroupname></span> maps to:<br>\n";
+ print "<select name=inimggroups multiple id=inimggroups size=20>\n";
+ print "</select>\n";
+ print "</td>\n";
+ # transfer buttons
+ print "<td style=\"vertical-align: middle;\">\n";
+ print "<button dojoType=\"dijit.form.Button\" id=\"addBtn2\">\n";
+ print " <div style=\"width: 50px;\"><-Add</div>\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ $cont = addContinuationsEntry('AJaddImgGrpToCompGrp');
+ print " addRemItem('$cont', 'compgroups', 'outimggroups', addRemImgGrpCompGrp);\n";
+ print " </script>\n";
+ print "</button>\n";
+ print "<br>\n";
+ print "<br>\n";
+ print "<br>\n";
+ print "<button dojoType=\"dijit.form.Button\" id=\"remBtn2\">\n";
+ print " <div style=\"width: 50px;\">Remove-></div>\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ $cont = addContinuationsEntry('AJremImgGrpFromCompGrp');
+ print " addRemItem('$cont', 'compgroups', 'inimggroups', addRemImgGrpCompGrp);\n";
+ print " </script>\n";
+ print "</button>\n";
+ print "</td>\n";
+ # select for image groups comp group does not map to
+ print "<td valign=top>\n";
+ print "Images groups <span style=\"font-weight: bold;\" id=outcompgroupname></span> does not map to:<br>\n";
+ print "<select name=outimggroups multiple id=outimggroups size=20>\n";
+ print "</select>\n";
+ print "</td>\n";
+ print "</tr><tbody/></table>\n";
+ print "</div>\n";
+
+ # grid tab
+ $cont = addContinuationsEntry('imageMappingGrid');
+ $loadingmsg = "<span class=dijitContentPaneLoading>Loading page (this may take a really long time)</span>";
+ print "<a jsId=\"checkboxpane\" dojoType=\"dijit.layout.LinkPane\"\n";
+ print " href=\"index.php?continuation=$cont\"\n";
+ print " loadingMessage=\"$loadingmsg\" $gridSelected>\n";
+ print " Checkbox Grid</a>\n";
+
+ print "</div>\n"; # end of main tab container
+ $cont = addContinuationsEntry('jsonImageMapCompGroups');
+ print "<input type=hidden id=compcont value=\"$cont\">\n";
+ $cont = addContinuationsEntry('jsonImageMapImgGroups');
+ print "<input type=hidden id=imgcont value=\"$cont\">\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn imageMappingGrid($imagegroups)
+///
+/// \param $imagegroups - (optional) array of imagegroups as returned by
+/// getUserResources
+///
+/// \brief prints a page to view and edit image mapping
+///
+////////////////////////////////////////////////////////////////////////////////
+function imageMappingGrid() {
+ global $mode;
+ $tmp = getUserResources(array("imageAdmin"),
+ array("manageGroup"), 1);
+ $imagegroups = $tmp["image"];
+ uasort($imagegroups, "sortKeepIndex");
+ $imagecompmapping = getResourceMapping("image", "computer");
+ $resources2 = getUserResources(array("computerAdmin"),
+ array("manageGroup"), 1);
+ $compgroups = $resources2["computer"];
+ uasort($compgroups, "sortKeepIndex");
+
+ if(! count($imagegroups) || ! count($compgroups)) {
+ print "You don't have access to manage any image group to computer group ";
+ print "mappings.<br>\n";
+ return;
+ }
+
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<TABLE border=1>\n";
+ print " <col>\n";
+ foreach(array_keys($compgroups) as $id) {
+ print " <col id=compgrp$id>\n";
+ }
+ print " <TR>\n";
+ print " <TH rowspan=2>Image Group</TH>\n";
+ print " <TH class=nohlcol colspan=" . count($compgroups) . ">Computer Groups</TH>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ foreach($compgroups as $id => $group) {
+ print " <TH onclick=\"toggleColSelect('compgrp$id');\">$group</TH>\n";
+ }
+ print " </TR>\n";
+ $count = 1;
+ foreach($imagegroups as $imgid => $imgname) {
+ if($count % 12 == 0) {
+ print " <TR>\n";
+ print " <TH><img src=images/blank.gif></TH>\n";
+ foreach($compgroups as $id => $group) {
+ print " <TH onclick=\"toggleColSelect('compgrp$id');\">$group</TH>\n";
+ }
+ print " </TR>\n";
+ }
+ print " <TR id=imggrpid$imgid>\n";
+ print " <TH align=right onclick=\"toggleRowSelect('imggrpid$imgid');\">$imgname</TH>\n";
+ foreach($compgroups as $compid => $compname) {
+ $name = "mapping[" . $imgid . ":" . $compid . "]";
+ if(array_key_exists($imgid, $imagecompmapping) &&
+ in_array($compid, $imagecompmapping[$imgid])) {
+ $checked = "checked";
+ }
+ else
+ $checked = "";
+ print " <TD align=center>\n";
+ print " <INPUT type=checkbox name=\"$name\" $checked>\n";
+ print " </TD>\n";
+ }
+ print " </TR>\n";
+ $count++;
+ }
+ print "</TABLE>\n";
+ $cont = addContinuationsEntry('submitImageMapping', array(), SECINWEEK, 1, 0, 1);
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "<INPUT type=submit value=\"Submit Changes\">\n";
+ print "<INPUT type=reset value=Reset>\n";
+ print "</FORM>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn createSelectImage()
+///
+/// \brief prints a page to select a base image for new image/image to update
+///
+////////////////////////////////////////////////////////////////////////////////
+function createSelectImage() {
+ global $submitErr, $user;
+ $timestamp = processInputVar("stamp", ARG_NUMERIC);
+ $imageid = processInputVar("imageid", ARG_STRING);
+ $length = processInputVar("length", ARG_NUMERIC);
+ $day = processInputVar("day", ARG_STRING);
+ $hour = processInputVar("hour", ARG_NUMERIC);
+ $minute = processInputVar("minute", ARG_NUMERIC);
+ $meridian = processInputVar("meridian", ARG_STRING);
+
+ if(! $submitErr) {
+ print "<H2>Create / Update an Image</H2>\n";
+ }
+ $resources = getUserResources(array("imageAdmin"));
+ if(empty($resources['image'])) {
+ print "You don't have access to any base images from which to create ";
+ print "new images.<br>\n";
+ return;
+ }
+ print "Please select the environment you will be updating or using as a ";
+ print "base for a new image:<br>\n";
+
+ $OSs = getOSList();
+
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ // list of images
+ uasort($resources["image"], "sortKeepIndex");
+ #printSelectInput("imageid", $resources["image"], $imageid, 1);
+ printSelectInput("imageid", $resources["image"], $imageid, 1, 0, 'imagesel', "onChange=\"updateWaitTime(1);\" tabIndex=1");
+ print "<br><br>\n";
+
+ $imagenotes = getImageNotes($imageid);
+ $desc = '';
+ if(preg_match('/\w/', $imagenotes['description'])) {
+ $desc = preg_replace("/\n/", '<br>', $imagenotes['description']);
+ $desc = preg_replace("/\r/", '', $desc);
+ $desc = "<strong>Image Description</strong>:<br>\n$desc<br><br>\n";
+ }
+ print "<div id=imgdesc>$desc</div>\n";
+
+ print "When would you like to start the imaging process?<br><br>\n";
+ print " <INPUT type=radio name=time id=timenow ";
+ print "onclick='updateWaitTime(0);' value=now>Now<br>\n";
+ print " <INPUT type=radio name=time value=future ";
+ print "onclick='updateWaitTime(0);' checked>Later:\n";
+
+ #print " <INPUT type=radio name=time value=now>Now<br>\n";
+ #print " <INPUT type=radio name=time value=future checked>Later:\n";
+ if($submitErr) {
+ $hour24 = $hour;
+ if($hour24 == 12) {
+ if($meridian == "am") {
+ $hour24 = 0;
+ }
+ }
+ elseif($meridian == "pm") {
+ $hour24 += 12;
+ }
+ list($month, $day, $year) = explode('/', $day);
+ $stamp = datetimeToUnix("$year-$month-$day $hour24:$minute:00");
+ $day = date('l', $stamp);
+ printReserveItems(1, $day, $hour, $minute, $meridian, 0, 0, 1);
+ }
+ elseif(empty($timestamp)) {
+ printReserveItems(1, NULL, NULL, NULL, NULL, 0, 0, 1);
+ }
+ else {
+ $timeArr = explode(',', date('l,g,i,a', $timestamp));
+ printReserveItems(1, $timeArr[0], $timeArr[1], $timeArr[2], $timeArr[3], 0, 0, 1);
+ }
+
+ print "<div id=waittime class=hidden></div><br>\n";
+
+ $cdata = array('length' => 480);
+ $cont = addContinuationsEntry('submitCreateImage', $cdata, SECINDAY, 1, 0);
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "<INPUT type=submit value=\"Create Imaging Reservation\">\n";
+ print "</FORM>\n";
+ $cont = addContinuationsEntry('AJupdateWaitTime');
+ print "<INPUT type=hidden name=waitcontinuation id=waitcontinuation value=\"$cont\">\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitCreateImage()
+///
+/// \brief checks to see if the request can fit in the schedule; adds it if
+/// it fits; notifies the user either way
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitCreateImage() {
+ global $submitErr, $user, $viewmode, $HTMLheader, $printedHTMLheader, $mode;
+
+ if($mode == 'submitCreateTestProd') {
+ $data = getContinuationVar();
+ $data["revisionid"] = processInputVar("revisionid", ARG_MULTINUMERIC);
+ # TODO check for valid revisionid
+ }
+ else {
+ $data = processRequestInput(0);
+ $data['length'] = getContinuationVar('length');
+ }
+
+ $showrevisions = 0;
+ $subimages = 0;
+ $images = getImages();
+ $revcount = count($images[$data['imageid']]['imagerevision']);
+ if($revcount > 1)
+ $showrevisions = 1;
+ if($images[$data['imageid']]['imagemetaid'] != NULL &&
+ count($images[$data['imageid']]['subimages'])) {
+ $subimages = 1;
+ foreach($images[$data['imageid']]['subimages'] as $subimage) {
+ $revcount = count($images[$subimage]['imagerevision']);
+ if($revcount > 1)
+ $showrevisions = 1;
+ }
+ }
+
+ if($data["time"] == "now") {
+ $nowArr = getdate();
+ if($nowArr["minutes"] == 0) {
+ $subtract = 0;
+ $add = 0;
+ }
+ elseif($nowArr["minutes"] < 15) {
+ $subtract = $nowArr["minutes"] * 60;
+ $add = 900;
+ }
+ elseif($nowArr["minutes"] < 30) {
+ $subtract = ($nowArr["minutes"] - 15) * 60;
+ $add = 900;
+ }
+ elseif($nowArr["minutes"] < 45) {
+ $subtract = ($nowArr["minutes"] - 30) * 60;
+ $add = 900;
+ }
+ elseif($nowArr["minutes"] < 60) {
+ $subtract = ($nowArr["minutes"] - 45) * 60;
+ $add = 900;
+ }
+ $start = time() - $subtract;
+ $start -= $start % 60;
+ $nowfuture = "now";
+ }
+ else {
+ $add = 0;
+ $hour = $data["hour"];
+ if($data["hour"] == 12) {
+ if($data["meridian"] == "am") {
+ $hour = 0;
+ }
+ }
+ elseif($data["meridian"] == "pm") {
+ $hour = $data["hour"] + 12;
+ }
+
+ $tmp = explode('/', $data["day"]);
+ $start = mktime($hour, $data["minute"], "0", $tmp[0], $tmp[1], $tmp[2]);
+ if($start < time()) {
+ print $HTMLheader;
+ print "<H2>Create / Update an Image</H2>\n";
+ print "<font color=\"#ff0000\">The time you requested is in the past.";
+ print " Please select \"Now\" or use a time in the future.</font><br>\n";
+ $submitErr = 1;
+ createSelectImage();
+ return;
+ }
+ $nowfuture = "future";
+ }
+ // FIXME hard code length to 8 hours
+ $data["length"] = 480;
+ $end = $start + $data["length"] * 60 + $add;
+
+ // get semaphore lock
+ if(! semLock())
+ abort(3);
+
+ $max = getMaxOverlap($user['id']);
+ if(checkOverlap($start, $end, $max)) {
+ $printedHTMLheader = 1;
+ print $HTMLheader;
+ print "<H2>New Reservation</H2>\n";
+ if($max == 0) {
+ print "<font color=\"#ff0000\">The time you requested overlaps with ";
+ print "another reservation you currently have. You are only allowed ";
+ print "to have a single reservation at any given time. Please select ";
+ print "another time to use the application. If you are finished with ";
+ print "an active reservation, click \"Current Reservations\", ";
+ print "then click the \"End\" button of your active reservation.";
+ print "</font><br><br>\n";
+ }
+ else {
+ print "<font color=\"#ff0000\">The time you requested overlaps with ";
+ print "another reservation you currently have. You are allowed ";
+ print "to have $max overlapping reservations at any given time. ";
+ print "Please select another time to use the application. If you are ";
+ print "finished with an active reservation, click \"Current ";
+ print "Reservations\", then click the \"End\" button of your active ";
+ print "reservation.</font><br><br>\n";
+ }
+ $submitErr = 1;
+ createSelectImage();
+ return;
+ }
+ // if user is owner of the image and there is a test revision of the image
+ # available, ask user if production or test image desired
+ if($mode != "submitCreateTestProd" && $showrevisions &&
+ $images[$data["imageid"]]["ownerid"] == $user["id"]) {
+ $printedHTMLheader = 1;
+ print $HTMLheader;
+ print "<H2>New Reservation</H2>\n";
+ if($subimages) {
+ print "This is a cluster environment. At least one image in the ";
+ print "cluster has more than one revision available. Please select ";
+ print "the revision you desire for each image listed below:<br>\n";
+ }
+ else {
+ print "There are multiple revisions of this environment available. Please ";
+ print "select the revision you would like to check out:<br>\n";
+ }
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post><br>\n";
+ if(! array_key_exists('subimages', $images[$data['imageid']]))
+ $images[$data['imageid']]['subimages'] = array();
+ array_unshift($images[$data['imageid']]['subimages'], $data['imageid']);
+ foreach($images[$data['imageid']]['subimages'] as $subimage) {
+ print "{$images[$subimage]['prettyname']}:<br>\n";
+ print "<table summary=\"lists revisions of the selected environment, one must be selected to continue\">\n";
+ print " <TR>\n";
+ print " <TD></TD>\n";
+ print " <TH>Revision</TH>\n";
+ print " <TH>Creator</TH>\n";
+ print " <TH>Created</TH>\n";
+ print " <TH>Currently in Production</TH>\n";
+ print " </TR>\n";
+ foreach($images[$subimage]['imagerevision'] as $revision) {
+ print " <TR>\n";
+ if(array_key_exists($subimage, $data['revisionid']) &&
+ $data['revisionid'][$subimage] == $revision['id'])
+ print " <TD align=center><INPUT type=radio name=revisionid[$subimage] value={$revision['id']} checked></TD>\n";
+ elseif($revision['production'])
+ print " <TD align=center><INPUT type=radio name=revisionid[$subimage] value={$revision['id']} checked></TD>\n";
+ else
+ print " <TD align=center><INPUT type=radio name=revisionid[$subimage] value={$revision['id']}></TD>\n";
+ print " <TD align=center>{$revision['revision']}</TD>\n";
+ print " <TD align=center>{$revision['user']}</TD>\n";
+ print " <TD align=center>{$revision['prettydate']}</TD>\n";
+ if($revision['production'])
+ print " <TD align=center>Yes</TD>\n";
+ else
+ print " <TD align=center>No</TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ }
+ addContinuationsEntry('submitCreateImage', array(), SECINDAY, 1, 0); // we add this continuation back
+ // so the currently displayed
+ // page can be reloaded
+ $cont = addContinuationsEntry('submitCreateTestProd', $data);
+ print "<br><INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "<INPUT type=submit value=Submit>\n";
+ print "</FORM>\n";
+ return;
+ }
+ $rc = isAvailable($images, $data["imageid"], $start, $end, $data["os"]);
+ if($rc == -1) {
+ $printedHTMLheader = 1;
+ print $HTMLheader;
+ print "<H2>Create / Update an Image</H2>\n";
+ print "You have requested an environment that is limited in the number ";
+ print "of concurrent reservations that can be made. No further ";
+ print "reservations for the environment can be made for the time you ";
+ print "have selected. Please select another time to use the ";
+ print "environment.<br>";
+ }
+ elseif($rc > 0) {
+ $requestid = addRequest(1, $data['revisionid']);
+ if($data["time"] == "now") {
+ header("Location: " . BASEURL . SCRIPT . "?mode=viewRequests");
+ dbDisconnect();
+ exit;
+ }
+ else {
+ $time = prettyLength($data["length"]);
+ if($data["minute"] == 0) {
+ $data["minute"] = "00";
+ }
+ $printedHTMLheader = 1;
+ print $HTMLheader;
+ print "<H2>Create / Update an Image</H2>\n";
+ print "Your request to use <b>" . $images[$data["imageid"]]["prettyname"];
+ print "</b> on " . prettyDatetime($start) . " for $time has been ";
+ print "accepted.<br><br>\n";
+ print "When your reservation time has been reached, the ";
+ print "<b>Current Reservations</b> page will give you more ";
+ print "information on connecting to the reserved computer. If you ";
+ print "would like to modify your reservation, you can do that from ";
+ print "the <b>Current Reservations</b> page as well.<br>\n";
+ }
+ }
+ else {
+ $printedHTMLheader = 1;
+ print $HTMLheader;
+ $cdata = array('imageid' => $data['imageid'],
+ 'length' => $data['length']);
+ $cont = addContinuationsEntry('selectTimeTable', $cdata);
+ print "<H2>Create / Update an Image</H2>\n";
+ print "The reservation you have requested is not available. You may ";
+ print "<a href=\"" . BASEURL . SCRIPT . "?continuation=$cont\">";
+ print "view a timetable</a> of free and reserved times to find ";
+ print "a time that will work for you.<br>\n";
+ #addLogEntry($nowfuture, unixToDatetime($start),
+ # unixToDatetime($end), 0, $data["imageid"]);
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn startImage()
+///
+/// \brief prints page prompting user if updating existing image or creating a
+/// new image
+///
+////////////////////////////////////////////////////////////////////////////////
+function startImage() {
+ global $user;
+ $requestid = getContinuationVar("requestid");
+
+ $data = getRequestInfo($requestid);
+ $disableUpdate = 1;
+ $imageid = '';
+ foreach($data["reservations"] as $res) {
+ if($res["forcheckout"]) {
+ $imageid = $res["imageid"];
+ break;
+ }
+ }
+ if(! empty($imageid)) {
+ $imageData = getImages(0, $imageid);
+ if($imageData[$imageid]['ownerid'] == $user['id'])
+ $disableUpdate = 0;
+ }
+ print "<H2>Create / Update an Image</H2>\n";
+ print "Are you creating a new image from a base image or updating an ";
+ print "existing image?<br><br>\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('requestid' => $requestid);
+ $cont = addContinuationsEntry('newImage', $cdata, SECINDAY, 0);
+ print "<INPUT type=radio name=continuation value=\"$cont\" id=newimage checked>";
+ print "<label for=newimage>Creating New Image</label><br>\n";
+ if($disableUpdate) {
+ print "<INPUT type=radio name=continuation value=\"$cont\" ";
+ print "id=updateimage disabled><label for=updateimage><font color=gray>";
+ print "Update Existing Image</font></label>";
+ }
+ else {
+ $cdata['nextmode'] = 'updateExistingImageComments';
+ $cdata['multicall'] = 1;
+ $cont = addContinuationsEntry('imageClickThroughAgreement', $cdata, SECINDAY, 0);
+ print "<INPUT type=radio name=continuation value=\"$cont\" ";
+ print "id=updateimage><label for=updateimage>Update Existing Image";
+ print "</label>";
+ }
+ print "<br><br>\n";
+ print "<INPUT type=submit value=Submit>\n";
+ print "</FORM>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitImageButton
+///
+/// \brief wrapper for confirmDeleteImage, editOrAddImage(0), and
+/// viewImageDetails
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitImageButton() {
+ $submode = processInputVar("submode", ARG_STRING);
+ if($submode == "Edit")
+ editOrAddImage(0);
+ elseif($submode == "Delete" || $submode == "Undelete")
+ confirmDeleteImage();
+ elseif($submode == "Details")
+ viewImageDetails();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn editOrAddImage($state)
+///
+/// \param $state - 0 for edit, 1 for add
+///
+/// \brief prints a form for editing an image
+///
+////////////////////////////////////////////////////////////////////////////////
+function editOrAddImage($state) {
+ global $submitErr, $mode, $submode, $user;
+
+ $images = getImages();
+ $platforms = getPlatforms();
+ $oslist = getOSList();
+ $depts = getDepartments();
+ $groups = getUserGroups(0, $user['affiliationid']);
+ $groups = array_reverse($groups, TRUE);
+ $groups[0] = array("name" => "Any");
+ $groups = array_reverse($groups, TRUE);
+
+ if($submitErr || $state == 1 || $mode == "submitEditImageButtons") {
+ $data = processImageInput(0);
+ if(get_magic_quotes_gpc()) {
+ $data["description"] = stripslashes($data['description']);
+ $data["usage"] = stripslashes($data['usage']);
+ $data["comments"] = stripslashes($data['comments']);
+ }
+ $data['imageid'] = getContinuationVar('imageid');
+ if($mode == "newImage") {
+ $requestdata = getRequestInfo($data['requestid']);
+ $imagedata = getImages(0, $requestdata["reservations"][0]["imageid"]);
+ $data["platformid"] = $imagedata[$requestdata["reservations"][0]["imageid"]]["platformid"];
+ $data["osid"] = $imagedata[$requestdata["reservations"][0]["imageid"]]["osid"];
+ }
+ }
+ elseif($mode == 'submitAddSubimage')
+ $data = getContinuationVar();
+ else {
+ $id = getContinuationVar("imageid");
+ $data = $images[$id];
+ $data["imageid"] = $id;
+ $tmp = getImageNotes($id);
+ $data['description'] = $tmp['description'];
+ $data['usage'] = $tmp['usage'];
+ # commented out sometime before 9-30-08
+ /*$data["prettyname"] = $images[$id]["prettyname"];
+ $data["deptid"] = $images[$id]["deptid"];
+ $data["owner"] = $images[$id]["owner"];
+ $data["platformid"] = $images[$id]["platformid"];
+ $data["osid"] = $images[$id]["osid"];
+ $data["minram"] = $images[$id]["minram"];
+ $data["minprocnumber"] = $images[$id]["minprocnumber"];
+ $data["minprocspeed"] = $images[$id]["minprocspeed"];
+ $data["minnetwork"] = $images[$id]["minnetwork"];
+ $data["reloadtime"] = $images[$id]["reloadtime"];*/
+ }
+
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<DIV align=center>\n";
+ if($state)
+ print "<H2>Add Image</H2>\n";
+ else
+ print "<H2>Edit Image</H2>\n";
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TH align=right>Name:</TH>\n";
+ print " <TD><INPUT type=text name=prettyname value=\"";
+ print $data["prettyname"] . "\" maxlength=60 size=40></TD>\n";
+ print " <TD>";
+ printSubmitErr(PRETTYNAMEERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Owner:</TH>\n";
+ print " <TD><INPUT type=text name=owner value=\"" . $data["owner"];
+ print "\" size=40></TD>\n";
+ print " <TD>";
+ printSubmitErr(IMGOWNERERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ /*print " <TR>\n";
+ print " <TH align=right>Platform:</TH>\n";
+ print " <TD>\n";
+ printSelectInput("platformid", $platforms, $data["platformid"]);
+ print " </TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>OS:</TH>\n";
+ print " <TD>\n";
+ printSelectInput("osid", $oslist, $data["osid"]);
+ print " </TD>\n";
+ print " </TR>\n";*/
+ print " <TR>\n";
+ print " <TD colspan=3>\n";
+ print "<fieldset>\n";
+ print "<legend>Image Description</legend>\n";
+ print "Description of image (required - users will<br>\nsee this on the <strong>";
+ print "New Reservations</strong> page):<br>\n";
+ printSubmitErr(IMAGEDESCRIPTIONERR);
+ print "<textarea dojoType=\"dijit.form.Textarea\" name=description ";
+ print "style=\"width: 400px; text-align: left;\">{$data['description']}\n\n";
+ print "</textarea>\n";
+ print "</fieldset>\n";
+ print "<fieldset>\n";
+ print "<legend>Usage Notes</legend>\n";
+ print "Optional notes to the user explaining how to use the image<br>";
+ print "(users will see this on the <strong>Connect!</strong> page):<br>\n";
+ print "<textarea dojoType=\"dijit.form.Textarea\" name=usage ";
+ print "style=\"width: 400px; text-align: left;\"\">{$data['usage']}\n\n";
+ print "</textarea>\n";
+ print "</fieldset>\n";
+ if($state) {
+ print "<fieldset>\n";
+ print "<legend>Revision Comments</legend>\n";
+ print "Notes for yourself and other admins about how the image ";
+ print "was setup/installed.<br>\nThese are optional and not visible to end ";
+ print "users.<br>\n";
+ print "<textarea dojoType=\"dijit.form.Textarea\" name=comments ";
+ print "style=\"width: 400px; text-align: left;\"\">{$data['comments']}\n\n";
+ print "</textarea>\n";
+ print "</fieldset>\n";
+ }
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE><br>\n";
+ print "<div dojoType=\"dijit.TitlePane\" title=\"Advanced Options - leave ";
+ print "default values unless you really know what you are doing\" ";
+ print "open=false style=\"width: 500px\">\n";
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TD colspan=3 id=hide1><hr></TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TD colspan=3 id=hide2><strong>Advanced Options - leave default values unless you really know what you are doing</strong><br><br></TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Minimum RAM (MB):</TH>\n";
+ print " <TD><INPUT type=text name=minram value=\"";
+ print $data["minram"] . "\" maxlength=5 size=6></TD>\n";
+ print " <TD>";
+ printSubmitErr(MINRAMERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Minimum Num of Processors:</TH>\n";
+ print " <TD>\n";
+ $tmpArr = array("1" => "1", "2" => "2", "4" => "4", "8" => "8");
+ printSelectInput("minprocnumber", $tmpArr, $data["minprocnumber"]);
+ print " </TD>\n";
+ print " <TD></TD>";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Minimum Processor Speed (MHz):</TH>\n";
+ print " <TD><INPUT type=text name=minprocspeed value=\"";
+ print $data["minprocspeed"] . "\" maxlength=5 size=5></TD>\n";
+ print " <TD>";
+ printSubmitErr(MINPROCSPEEDERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Minimum Network Speed (Mbps):</TH>\n";
+ print " <TD>\n";
+ $tmpArr = array("10" => "10", "100" => "100", "1000" => "1000");
+ printSelectInput("minnetwork", $tmpArr, $data["minnetwork"]);
+ print " </TD>\n";
+ print " <TD></TD>";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Maximum Concurrent Usage:</TH>\n";
+ print " <TD><INPUT type=text name=maxconcurrent value=\"";
+ print $data["maxconcurrent"] . "\" maxlength=3 size=4>(leave empty for unlimited)</TD>\n";
+ print " <TD>";
+ printSubmitErr(MAXCONCURRENTERR);
+ print "</TD>\n";
+ print " <TD></TD>";
+ print " </TR>\n";
+ if(! $state) {
+ print " <TR>\n";
+ print " <TH align=right>Estimated Reload Time (min):</TH>\n";
+ print " <TD><INPUT type=text name=reloadtime value=\"";
+ print $data["reloadtime"] . "\" maxlength=3></TD>\n";
+ print " <TD>";
+ printSubmitErr(RELOADTIMEERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ }
+ print " <TR>\n";
+ print " <TH align=right>Available for checkout:</TH>\n";
+ print " <TD>\n";
+ $yesno = array(1 => "Yes", 0 => "No");
+ printSelectInput("forcheckout", $yesno, $data["forcheckout"]);
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Check for logged in user:</TH>\n";
+ if(array_key_exists("checkuser", $data) && ! $data["checkuser"])
+ $default = 0;
+ else
+ $default = 1;
+ print " <TD>\n";
+ printSelectInput("checkuser", $yesno, $default);
+ print " </TD>\n";
+ print " </TR>\n";
+ # finally just limited access so only high level access people see this
+ # because it confused too many people
+ if($user["adminlevel"] == "developer") {
+ print " <TR>\n";
+ print " <TH align=right>User group allowed to log in:<br>\n";
+ print " <small>(This does not grant permission to<br>\n";
+ print "make a reservation for the image)</small></TH>\n";
+ print " <TD>\n";
+ if(! empty($data["usergroupid"])) {
+ $default = $data["usergroupid"];
+ if(! array_key_exists($default, $groups)) {
+ if($submitErr || $mode == 'submitEditImageButtons' || $mode == 'submitAddSubimage')
+ $groups[$data['usergroupid']] = array('name' => $images[$data['imageid']]['usergroup']);
+ else
+ $groups[$data['usergroupid']] = array('name' => $data['usergroup']);
+ uasort($groups, 'sortKeepIndex');
+ }
+ }
+ else
+ $default = 0;
+ printSelectInput("usergroupid", $groups, $default);
+ print " </TD>\n";
+ print " </TR>\n";
+ }
+ if(! $state) {
+ print " <TR>\n";
+ print " <TH style=\"vertical-align:top; text-align:right;\">Subimages:</TH>\n";
+ print " <TD>\n";
+ if(array_key_exists("subimages", $images[$data["imageid"]]) &&
+ count($images[$data["imageid"]]["subimages"])) {
+ foreach($images[$data["imageid"]]["subimages"] as $imgid) {
+ print "<INPUT type=checkbox name=\"removeimgid[$imgid]\" value=$imgid>\n";
+ print "{$images[$imgid]["prettyname"]}<br>\n";
+ }
+ print "<INPUT type=submit name=submode value=\"Remove Selected\"><br>\n"; # Remove Selected
+ }
+ print " <INPUT type=submit name=submode value=\"Add Subimage\">\n"; # Add Subimage
+ print " </TD>\n";
+ print " </TR>\n";
+ }
+ else {
+ if(array_key_exists("sysprep", $data) && ! $data["sysprep"])
+ $default = 0;
+ else
+ $default = 1;
+ print " <TR>\n";
+ print " <TH style=\"vertical-align:top; text-align:right;\">Use sysprep:</TH>\n";
+ print " <TD>\n";
+ printSelectInput("sysprep", $yesno, $default);
+ print " </TD>\n";
+ print " </TR>\n";
+ }
+ print " <TR>\n";
+ print " <TD colspan=3 id=hide3><hr></TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ print "</div>\n";
+ print "<TABLE>\n";
+ print " <TR valign=top>\n";
+ print " <TD>\n";
+ if($state) {
+ $cdata = array('requestid' => $data['requestid'],
+ 'imageid' => $data['imageid']);
+ $cont = addContinuationsEntry('submitEditImageButtons', $cdata, SECINDAY, 0);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n"; # confirmAddImage
+ print " <INPUT type=submit name=submode value=\"Confirm Image\">\n";
+ }
+ else {
+ $cdata = array('imageid' => $data['imageid']);
+ $cont = addContinuationsEntry('submitEditImageButtons', $cdata, SECINDAY, 0, 1, 1);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n"; # confirmEditImage
+ print " <INPUT type=submit name=submode value=\"Confirm Changes\">\n";
+ }
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ if($state)
+ $cont = addContinuationsEntry('viewRequests');
+ else
+ $cont = addContinuationsEntry('viewImages');
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Cancel>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+
+ if($state)
+ return;
+ print "<div id=revisiondiv>\n";
+ print getRevisionHTML($data['imageid']);
+ print "</div>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getRevisionHTML($imageid)
+///
+/// \param $imageid - id of an image
+///
+/// \return string of HTML data
+///
+/// \brief builds HTML table for in place editing of image revision data
+///
+////////////////////////////////////////////////////////////////////////////////
+function getRevisionHTML($imageid) {
+ $rt = '';
+ $rt .= "<h3>Revisions of this Image</h3>\n";
+ $rt .= "<table summary=\"\"><tr><td>\n";
+ $rt .= "<table summary=\"\" id=\"revisiontable\">\n";
+ $rt .= " <tr>\n";
+ $rt .= " <td></td>\n";
+ $rt .= " <th>Revision</th>\n";
+ $rt .= " <th>Creator</th>\n";
+ $rt .= " <th>Created</th>\n";
+ $rt .= " <th nowrap>In Production</th>\n";
+ $rt .= " <th>Comments (click to edit)</th>\n";
+ $rt .= " </tr>\n";
+ $revisions = getImageRevisions($imageid);
+ foreach($revisions AS $rev) {
+ $rt .= " <tr>\n";
+ $rt .= " <td><INPUT type=checkbox\n";
+ $rt .= " id=chkrev{$rev['id']}\n";
+ $rt .= " name=chkrev[{$rev['id']}]\n";
+ $rt .= " value=1></td>\n";
+ $rt .= " <td align=center>{$rev['revision']}</td>\n";
+ $rt .= " <td>{$rev['creator']}</td>\n";
+ $created = date('g:ia n/j/Y', datetimeToUnix($rev['datecreated']));
+ $rt .= " <td>$created</td>\n";
+ $cdata = array('imageid' => $imageid, 'revisionid' => $rev['id']);
+ $cont = addContinuationsEntry('AJupdateRevisionProduction', $cdata);
+ if($rev['production']) {
+ $rt .= " <td align=center><INPUT type=radio\n";
+ $rt .= " name=production\n";
+ $rt .= " value={$rev['id']}\n";
+ $rt .= " id=radrev{$rev['id']}\n";
+ $rt .= " onclick=\"updateRevisionProduction('$cont');\"\n";
+ $rt .= " checked></td>\n";
+ }
+ else {
+ $rt .= " <td align=center><INPUT type=radio\n";
+ $rt .= " name=production\n";
+ $rt .= " value={$rev['id']}\n";
+ $rt .= " id=radrev{$rev['id']}\n";
+ $rt .= " onclick=\"updateRevisionProduction('$cont');\">\n";
+ $rt .= " </td>\n";
+ }
+ $cdata = array('imageid' => $imageid, 'revisionid' => $rev['id']);
+ $cont = addContinuationsEntry('AJupdateRevisionComments', $cdata);
+ $rt .= " <td width=200px><span id=comments{$rev['id']} \n";
+ $rt .= " dojoType=\"dijit.InlineEditBox\"\n";
+ $rt .= " editor=\"dijit.form.Textarea\"\n";
+ $rt .= " onChange=\"updateRevisionComments('comments{$rev['id']}', '$cont');\"\n";
+ $rt .= " noValueIndicator=\"(empty)\">\n";
+ $rt .= " {$rev['comments']}</span></td>\n";
+ $rt .= " </tr>\n";
+ }
+ $rt .= "</table>\n";
+ $rt .= "<div align=left>\n";
+ $keys = array_keys($revisions);
+ $cdata = array('revids' => $keys, 'imageid' => $imageid);
+ $cont = addContinuationsEntry('AJdeleteRevisions', $cdata);
+ $ids = implode(',', $keys);
+ $rt .= "<button onclick=\"deleteRevisions('$cont', '$ids'); return false;\">Delete selected revisions</button>\n";
+ $rt .= "</div>\n";
+ $rt .= "</td></tr></table>\n";
+ return $rt;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitEditImageButtons()
+///
+/// \brief wrapper for confirmEditOrAddImage, addSubimage, and removeSubimages
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitEditImageButtons() {
+ $submode = processInputVar("submode", ARG_STRING);
+ if($submode == "Confirm Image") # confirmAddImage
+ confirmEditOrAddImage(1);
+ elseif($submode == "Confirm Changes") # confirmEditImage
+ confirmEditOrAddImage(0);
+ elseif($submode == "Remove Selected")
+ removeSubImages();
+ elseif($submode == "Add Subimage")
+ printAddSubimage();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn confirmEditOrAddImage($state)
+///
+/// \param $state - 0 for edit, 1 for add
+///
+/// \brief prints a form for confirming changes to an image
+///
+////////////////////////////////////////////////////////////////////////////////
+function confirmEditOrAddImage($state) {
+ global $submitErr, $user;
+
+ $data = processImageInput(1);
+
+ if($submitErr) {
+ editOrAddImage($state);
+ return;
+ }
+
+ if(get_magic_quotes_gpc()) {
+ $data['description'] = stripslashes($data['description']);
+ $data['usage'] = stripslashes($data['usage']);
+ $data['comments'] = stripslashes($data['comments']);
+ }
+
+ $groups = getUserGroups();
+ $groups[0] = array("name" => "Any");
+ if(! $state)
+ $images = getImages();
+
+ if($state) {
+ $nextmode = "imageClickThroughAgreement";
+ $title = "Add Image";
+ $question = "Add the following image?";
+ }
+ else {
+ $nextmode = "submitEditImage";
+ $title = "Edit Image";
+ $question = "Submit changes to the image?";
+ }
+
+ $platforms = getPlatforms();
+ $oslist = getOSList();
+ $depts = getDepartments();
+
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<DIV align=center>\n";
+ print "<H2>$title</H2>\n";
+ print "$question<br><br>\n";
+ print "<TABLE>\n";
+ if(! $state) {
+ /*print " <TR>\n";
+ print " <TH align=right>Short Name:</TH>\n";
+ print " <TD>" . $data["name"] . "</TD>\n";
+ print " </TR>\n";*/
+ }
+ print " <TR>\n";
+ print " <TH align=right>Name:</TH>\n";
+ print " <TD>" . $data["prettyname"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Owner:</TH>\n";
+ print " <TD>" . $data["owner"] . "</TD>\n";
+ print " </TR>\n";
+ /*print " <TR>\n";
+ print " <TH align=right>Platform:</TH>\n";
+ print " <TD>" . $platforms[$data["platformid"]] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>OS:</TH>\n";
+ print " <TD>" . $oslist[$data["osid"]]["prettyname"] . "</TD>\n";
+ print " </TR>\n";*/
+ print " <TR>\n";
+ print " <TD colspan=2>\n";
+ print "<br><strong>Image Description</strong>:<br>\n";
+ print "{$data['description']}<br><br>\n";
+ print "<strong>Usage Notes</strong>:<br>\n";
+ print "{$data['usage']}<br><br>\n";
+ if($state) {
+ print "<strong>Revision Comments</strong>:<br>\n";
+ print "{$data['comments']}<br><br>\n";
+ }
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TD colspan=2><strong>Advanced Options</strong>:</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TD colspan=2><hr></TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Minimum RAM (MB):</TH>\n";
+ print " <TD>" . $data["minram"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Minimum Num of Processors:</TH>\n";
+ print " <TD>" . $data["minprocnumber"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Minimum Processor Speed (MHz):</TH>\n";
+ print " <TD>" . $data["minprocspeed"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Minimum Network Speed (Mbps):</TH>\n";
+ print " <TD>" . $data["minnetwork"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Maximum Concurrent Usage:</TH>\n";
+ if($data['maxconcurrent'] == '')
+ print " <TD>N/A</TD>\n";
+ else
+ print " <TD>" . $data["maxconcurrent"] . "</TD>\n";
+ print " </TR>\n";
+ if(! $state) {
+ print " <TR>\n";
+ print " <TH align=right>Estimated Reload Time (min):</TH>\n";
+ print " <TD>" . $data["reloadtime"] . "</TD>\n";
+ print " </TR>\n";
+ }
+ print " <TR>\n";
+ print " <TH align=right>Available for checkout:</TH>\n";
+ if($data["forcheckout"])
+ print " <TD>Yes</TD>\n";
+ else
+ print " <TD>No</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Check for logged in user:</TH>\n";
+ if($data["checkuser"])
+ print " <TD>Yes</TD>\n";
+ else
+ print " <TD>No</TD>\n";
+ print " </TR>\n";
+ if($user["adminlevel"] == "developer" || $user['adminlevel'] == 'full') {
+ print " <TR>\n";
+ print " <TH align=right>User group allowed to log in:</TH>\n";
+ $tmp = explode('@', $groups[$data["usergroupid"]]["name"]);
+ if(array_key_exists(1, $tmp) && $tmp[1] != $user['affiliation'])
+ print " <TD>" . $groups[$data["usergroupid"]]["name"] . "</TD>\n";
+ else
+ print " <TD>{$tmp[0]}</TD>\n";
+ print " </TR>\n";
+ }
+ if(! $state) {
+ print " <TR>\n";
+ print " <TH style=\"vertical-align:top; text-align:right;\">Subimages:</TH>\n";
+ print " <TD>\n";
+ if(array_key_exists("subimages", $images[$data["imageid"]]) &&
+ count($images[$data["imageid"]]["subimages"])) {
+ foreach($images[$data["imageid"]]["subimages"] as $imgid) {
+ print "{$images[$imgid]["prettyname"]}<br>\n";
+ }
+ }
+ else
+ print "None";
+ print " </TD>\n";
+ print " </TR>\n";
+ }
+ else {
+ print " <TR>\n";
+ print " <TH align=right>Use sysprep:</TH>\n";
+ if($data["sysprep"])
+ print " <TD>Yes</TD>\n";
+ else
+ print " <TD>No</TD>\n";
+ print " </TR>\n";
+ }
+ print " <TR>\n";
+ print " <TD colspan=2><hr></TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ print "<TABLE>\n";
+ print " <TR valign=top>\n";
+ print " <TD>\n";
+ $data['description'] = mysql_escape_string($data['description']);
+ $data['usage'] = mysql_escape_string($data['usage']);
+ $data['comments'] = mysql_escape_string($data['comments']);
+
+ if($state) {
+ $data['nextmode'] = 'submitAddImage';
+ $cont = addContinuationsEntry($nextmode, $data, SECINDAY, 0);
+ }
+ else
+ $cont = addContinuationsEntry($nextmode, $data, SECINDAY, 0, 0);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ if($state)
+ print " <INPUT type=submit value=\"Add Image\">\n";
+ else
+ print " <INPUT type=submit value=\"Submit Changes\">\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ if($state)
+ $cont = addContinuationsEntry('viewRequests');
+ else
+ $cont = addContinuationsEntry('viewImages');
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Cancel>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitEditImage()
+///
+/// \brief submits changes to image and notifies user
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitEditImage() {
+ $data = getContinuationVar();
+ updateImage($data);
+ viewImages();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn imageClickThrough()
+///
+/// \brief prints a page with the software license agreement
+///
+////////////////////////////////////////////////////////////////////////////////
+function imageClickThrough() {
+ global $clickThroughText;
+ printf($clickThroughText, "");
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn imageClickThroughAgreement()
+///
+/// \brief prints a page where the user must agree to the software licensing
+/// agreement before actually creating the new image
+///
+////////////////////////////////////////////////////////////////////////////////
+function imageClickThroughAgreement() {
+ global $clickThroughText;
+ $data = getContinuationVar();
+ $nextmode = $data['nextmode'];
+ $multicall = getContinuationVar('multicall', 0);
+ unset($data['nextmode']);
+ $data['fromAgreement'] = 1;
+ $buttons = "<center>\n";
+ $buttons .= "<table summary=\"\">\n";
+ $buttons .= " <tr>\n";
+ $buttons .= " <td>\n";
+ $buttons .= " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry($nextmode, $data, SECINDAY, 0, $multicall);
+ $buttons .= " <input type=hidden name=continuation value=\"$cont\">\n";
+ $buttons .= " <input type=submit value=\"I agree\">\n";
+ $buttons .= " </FORM>\n";
+ $buttons .= " </td>\n";
+ $buttons .= " <td>\n";
+ $buttons .= " <img src=\"images/blank.gif\" alt=\"\" width=30px>\n";
+ $buttons .= " </td>\n";
+ $buttons .= " <td>\n";
+ $buttons .= " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry('viewRequests');
+ $buttons .= " <input type=hidden name=continuation value=\"$cont\">\n";
+ $buttons .= " <input type=submit value=\"I do not agree\">\n";
+ $buttons .= " </FORM>\n";
+ $buttons .= " </td>\n";
+ $buttons .= " </tr>\n";
+ $buttons .= " <tr>\n";
+ $buttons .= " <td colspan=3>\n";
+ $buttons .= " Clicking <b>I agree</b> will start the imaging process.\n";
+ $buttons .= " </td>\n";
+ $buttons .= " </tr>\n";
+ $buttons .= "</table>\n";
+ $buttons .= "</center>\n";
+ printf($clickThroughText, "$buttons");
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitAddImage()
+///
+/// \brief adds the image and notifies user
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitAddImage() {
+ global $user, $clickThroughText;
+ $data = getContinuationVar();
+
+ // get platformid and osid
+ $requestdata = getRequestInfo($data['requestid']);
+ $imagedata = getImages(0, $requestdata["reservations"][0]["imageid"]);
+ $data["platformid"] = $imagedata[$requestdata["reservations"][0]["imageid"]]["platformid"];
+ $data["osid"] = $imagedata[$requestdata["reservations"][0]["imageid"]]["osid"];
+ $data["basedoffrevisionid"] = $requestdata["reservations"][0]["imagerevisionid"];
+
+ // add estimated reload time
+ $data["reloadtime"] = 20;
+
+ // FIXME check for existance of image again
+ if(! $imageid = addImage($data))
+ abort(10);
+
+ // change imageid in request and reservation table and set state to image(16)
+ # FIXME will need to figure out which reservation to update for multi-image
+ # requests
+
+ // get imagerevisionid
+ $query = "SELECT id "
+ . "FROM imagerevision "
+ . "WHERE imageid = $imageid";
+ $qh = doQuery($query, 101);
+ $row = mysql_fetch_assoc($qh);
+ $imagerevisionid = $row['id'];
+
+ $requestid = $data["requestid"];
+ $query = "UPDATE request rq, "
+ . "reservation rs "
+ . "SET rs.imageid = $imageid, "
+ . "rs.imagerevisionid = $imagerevisionid, "
+ . "rq.stateid = 16,"
+ . "rq.forimaging = 1 "
+ . "WHERE rq.id = $requestid AND "
+ . "rq.id = rs.requestid";
+ doQuery($query, 101);
+
+ if(array_key_exists('fromAgreement', $data) && $data['fromAgreement']) {
+ $agreement = sprintf($clickThroughText, "");
+ $query = "INSERT INTO clickThroughs "
+ . "(userid, "
+ . "imageid, "
+ . "imagerevisionid, "
+ . "accepted, "
+ . "agreement) "
+ . "VALUES "
+ . "({$user['id']}, "
+ . "$imageid, "
+ . "$imagerevisionid, "
+ . "NOW(), "
+ . "'$agreement')";
+ doQuery($query, 101);
+ }
+
+ print "<H2>Add Image</H2>\n";
+ print "The image creation process has been started. It normally takes ";
+ print "about 25 minutes to complete (though can sometimes be more than ";
+ print "two hours). You will be notified by email ";
+ print "when the image has been created. At that point, you will be able ";
+ print "to make a new reservation for the image. Once you have done so ";
+ print "and tested that it works as expected, you can add it to an image ";
+ print "group on the <a href=\"" . BASEURL . SCRIPT;
+ print "?mode=viewImageOptions\">Manage Images</a> page if you have ";
+ print "sufficient access or have your computing support add it for you.<br>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn removeSubImages()
+///
+/// \brief removes submitted subimages and calls editOrAddImage
+///
+////////////////////////////////////////////////////////////////////////////////
+function removeSubImages() {
+ $removeimgids = processInputVar("removeimgid", ARG_MULTINUMERIC);
+ $imageid = getContinuationVar("imageid");
+ $data = getImages(0, $imageid);
+ if(count($removeimgids)) {
+ # remove selected images
+ $rmids = implode(',', $removeimgids);
+ $query = "DELETE FROM subimages "
+ . "WHERE imagemetaid = {$data[$imageid]["imagemetaid"]} AND "
+ . "imageid IN ($rmids)";
+ doQuery($query, 101);
+
+ # check to see if any subimages left; if not, set subimages to 0
+ $query = "SELECT COUNT(imageid) "
+ . "FROM subimages "
+ . "WHERE imagemetaid = {$data[$imageid]["imagemetaid"]}";
+ $qh = doQuery($query, 101);
+ $row = mysql_fetch_row($qh);
+ if($row[0] == 0) {
+ $query = "UPDATE imagemeta "
+ . "SET subimages = 0 "
+ . "WHERE id = {$data[$imageid]["imagemetaid"]}";
+ doQuery($query, 101);
+ }
+ }
+
+ editOrAddImage(0);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn printAddSubimage()
+///
+/// \brief prints a page to add a subimage to an image
+///
+////////////////////////////////////////////////////////////////////////////////
+function printAddSubimage() {
+ # FIXME need to pass on form data so if something is changed in the edit
+ # page, it remains changed when we get back there
+ $imageid = getContinuationVar("imageid");
+ $images = getImages();
+ $data = processImageInput(0);
+ print "<H2>Add Subimage</H2>\n";
+ if(array_key_exists("subimages", $images[$imageid]) &&
+ count($images[$imageid]["subimages"])) {
+ print "Current subimages for <strong>{$images[$imageid]["prettyname"]}:";
+ print "</strong><br><br>\n";
+ foreach($images[$imageid]["subimages"] as $imgid) {
+ print "<img src=images/blank.gif width=25 height=1>\n";
+ print "{$images[$imgid]["prettyname"]}<br>\n";
+ }
+ print "<br>Add additional subimage:<br><br>\n";
+ }
+ else
+ print "There are currently no subimages for <strong>";
+ print "{$images[$imageid]["prettyname"]}</strong>.<br><br>";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ unset($images[$imageid]);
+ printSelectInput("addimageid", $images, -1, 1);
+ $cdata = $data;
+ $cdata['imageid'] = $imageid;
+ $cont = addContinuationsEntry('submitAddSubimage', $cdata, SECINDAY, 0, 1, 1);
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "<br><INPUT type=submit value=Add>\n";
+ print "</FORM>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitAddSubimage()
+///
+/// \brief adds a subimage to submitted image and calls editOrAddImage
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitAddSubimage() {
+ $imageid = getContinuationVar("imageid");
+ $addimageid = processInputVar("addimageid", ARG_NUMERIC);
+ $data = getImages(0, $imageid);
+ if(empty($data[$imageid]["imagemetaid"])) {
+ $query = "INSERT INTO imagemeta "
+ . "(subimages) "
+ . "VALUES (1)";
+ doQuery($query, 101);
+ $qh = doQuery("SELECT LAST_INSERT_ID() FROM imagemeta", 101);
+ if(! $row = mysql_fetch_row($qh))
+ abort(101);
+ $imagemetaid = $row[0];
+ $query = "UPDATE image "
+ . "SET imagemetaid = $imagemetaid "
+ . "WHERE id = $imageid";
+ doQuery($query, 101);
+ }
+ else {
+ $imagemetaid = $data[$imageid]["imagemetaid"];
+ if(! count($data[$imageid]["subimages"])) {
+ $query = "UPDATE imagemeta "
+ . "SET subimages = 1 "
+ . "WHERE id = $imagemetaid";
+ doQuery($query, 101);
+ }
+ }
+ $query = "INSERT INTO subimages "
+ . "(imagemetaid, "
+ . "imageid) "
+ . "VALUES ($imagemetaid, "
+ . "$addimageid)";
+ doQuery($query, 101);
+ editOrAddImage(0);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn updateExistingImageComments()
+///
+/// \brief prints a page for getting install comments about the revision before
+/// continuing on to actually creating the revision
+///
+////////////////////////////////////////////////////////////////////////////////
+function updateExistingImageComments() {
+ $cdata = getContinuationVar();
+ $data = getRequestInfo($cdata['requestid']);
+ foreach($data["reservations"] as $res) {
+ if($res["forcheckout"]) {
+ $imageid = $res["imageid"];
+ $revisionid = $res['imagerevisionid'];
+ break;
+ }
+ }
+ $revisions = getImageRevisions($imageid);
+ print "<H2>Update Existing Image</H2>\n";
+ print "<h3>New Revision Comments</h3>\n";
+ print "Enter any notes for yourself and other admins about how the image ";
+ print "was setup/installed.<br>\nThese are optional and not visible to end ";
+ print "users:<br>\n";
+ print "<form action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<textarea dojoType=\"dijit.form.Textarea\" name=comments ";
+ print "style=\"width: 400px; text-align: left;\"\">\n\n</textarea>\n";
+ print "<h3>Previous Revision Comments</h3>\n";
+ if(preg_match('/\w/', $revisions[$revisionid]['comments'])) {
+ print "These are the comments from the previous revision ";
+ print "({$revisions[$revisionid]['revision']}):<br>\n";
+ print "{$revisions[$revisionid]['comments']}<br><br>\n";
+ }
+ else
+ print "The previous revision did not have any comments.<br>\n";
+ print "<table summary=\"\">\n";
+ print " <tr>\n";
+ print " <td>\n";
+ $cont = addContinuationsEntry('updateExistingImage', $cdata, SECINDAY, 0, 0);
+ print " <input type=hidden name=continuation value=\"$cont\">\n";
+ print " <input type=submit value=\"Create New Revision\">\n";
+ print " </form>\n";
+ print " </td>\n";
+ print " <td>\n";
+ print " <form action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry('viewRequests');
+ print " <input type=hidden name=continuation value=\"$cont\">\n";
+ print " <input type=submit value=\"Cancel\">\n";
+ print " </form>\n";
+ print " </td>\n";
+ print " </tr>\n";
+ print "</table>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn updateExistingImage()
+///
+/// \brief sets test flag on image to 1, sets state of request to 'image' and
+/// notifies the user that the imaging process has started
+///
+////////////////////////////////////////////////////////////////////////////////
+function updateExistingImage() {
+ global $user, $clickThroughText;
+ $requestid = getContinuationVar("requestid");
+ $fromAgreement = getContinuationVar('fromAgreement', 0);
+ $comments = processInputVar("comments", ARG_STRING);
+ $comments = preg_replace("/\r/", '', $comments);
+ $comments = htmlspecialchars($comments);
+ #$comments = preg_replace("/\n/", '<br>', $comments);
+ $comments = preg_replace("/\n/", '', $comments);
+ if(get_magic_quotes_gpc())
+ $comments = stripslashes($comments);
+ $comments = mysql_escape_string($comments);
+
+ $data = getRequestInfo($requestid);
+ foreach($data["reservations"] as $res) {
+ if($res["forcheckout"]) {
+ $imageid = $res["imageid"];
+ break;
+ }
+ }
+ $imageData = getImages(0, $imageid);
+ if($imageData[$imageid]['ownerid'] != $user['id']) {
+ editOrAddImage(1);
+ return;
+ }
+ // set the test flag on the image in the image table
+ $query = "UPDATE image SET test = 1 WHERE id = $imageid";
+ doQuery($query, 101);
+
+ # add entry to imagerevision table
+ $query = "SELECT revision, "
+ . "imagename "
+ . "FROM imagerevision "
+ . "WHERE imageid = $imageid "
+ . "ORDER BY revision DESC "
+ . "LIMIT 1";
+ $qh = doQuery($query, 101);
+ $row = mysql_fetch_assoc($qh);
+ $newrevision = $row['revision'] + 1;
+ $newname = preg_replace("/{$row['revision']}$/",
+ $newrevision, $row['imagename']);
+ $query = "INSERT INTO imagerevision "
+ . "(imageid, "
+ . "revision, "
+ . "userid, "
+ . "datecreated, "
+ . "deleted, "
+ . "production, "
+ . "comments, "
+ . "imagename) "
+ . "VALUES ($imageid, "
+ . "$newrevision, "
+ . "{$user['id']}, "
+ . "NOW(), "
+ . "1, "
+ . "0, "
+ . "'$comments', "
+ . "'$newname')";
+ doQuery($query, 101);
+ $qh = doQuery("SELECT LAST_INSERT_ID() FROM imagerevision", 101);
+ $row = mysql_fetch_row($qh);
+ $imagerevisionid = $row[0];
+
+ # update request and reservation
+ $query = "UPDATE request rq, "
+ . "reservation rs "
+ . "SET rs.imagerevisionid = $imagerevisionid, "
+ . "rq.stateid = 16,"
+ . "rq.forimaging = 1 "
+ . "WHERE rq.id = $requestid AND "
+ . "rq.id = rs.requestid AND "
+ . "rs.imageid = $imageid";
+ doQuery($query, 101);
+
+ if($fromAgreement) {
+ $agreement = strip_tags(sprintf($clickThroughText, ""));
+ $query = "INSERT INTO clickThroughs "
+ . "(userid, "
+ . "imageid, "
+ . "accepted, "
+ . "agreement) "
+ . "VALUES "
+ . "({$user['id']}, "
+ . "$imageid, "
+ . "NOW(), "
+ . "'$agreement')";
+ doQuery($query, 101);
+ }
+
+ print "<H2>Update Image</H2>\n";
+ print "The image creation process has been started. It normally takes ";
+ print "about 20-25 minutes to complete. You will be notified by email ";
+ print "when the image has been created. Afterward, there are a few steps ";
+ print "you need to follow to make it the production revision of the image:";
+ print "<ol class=numbers>\n";
+ print "<li>Make a new reservation for the environment (it will have the ";
+ print "same name in the drop-down list).</li>\n";
+ print "<li>After clicking <strong>Submit</strong> on the New Reservations ";
+ print "page, you will be prompted to select the revision of the environment ";
+ print "you want</li>\n";
+ print "<li>Select the most recent revision and click <strong>Submit</strong>";
+ print "</li>\n";
+ print "<li>Test the environment to make sure it works correctly</li>\n";
+ print "<li>After you are satisfied that it works correctly, click the ";
+ print "<strong>End</strong> button on the Current Reservations page</li>\n";
+ print "<li>You will be prompted to make the revision production or just end ";
+ print "the reservation</li>\n";
+ print "<li>Select the <strong>Make this the production revision</strong> ";
+ print "radio button</li> and click <strong>Submit</strong></li>\n";
+ print "</ol>\n";
+ print "Once the revision is made production, everyone that selects it will ";
+ print "get the new revision<br>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn setImageProduction()
+///
+/// \brief prompts user if really ready to set image to production
+///
+////////////////////////////////////////////////////////////////////////////////
+function setImageProduction() {
+ $requestid = getContinuationVar('requestid');
+ $data = getRequestInfo($requestid);
+ foreach($data["reservations"] as $res) {
+ if($res["forcheckout"]) {
+ $prettyimage = $res["prettyimage"];
+ break;
+ }
+ }
+ print "<H2>Change Test Image to Production</H2>\n";
+ print "This will update the <b>$prettyimage</b> ";
+ print "environment to be the newly created revision so that people will ";
+ print "start getting it when they checkout the environment. It will also ";
+ print "cause all the blades that currently have this image preloaded to be ";
+ print "reloaded with this new image. Are you sure the image works ";
+ print "correctly?<br>\n";
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('requestid' => $requestid);
+ $cont = addContinuationsEntry('submitSetImageProduction', $cdata, SECINDAY, 0, 0);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Yes>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry('viewRequests');
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=No>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitSetImageProduction()
+///
+/// \brief sets request state to 'makeproduction', notifies user that
+/// "productioning" process has started
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitSetImageProduction() {
+ $requestid = getContinuationVar('requestid');
+ $data = getRequestInfo($requestid);
+ foreach($data["reservations"] as $res) {
+ if($res["forcheckout"]) {
+ $prettyimage = $res["prettyimage"];
+ break;
+ }
+ }
+ /*$regs = array();
+ if(ereg('(.*)-v([0-9]){1,2}$', $data["image"], $regs)) {
+ $newname = $regs[1] . "-v" . ++$regs[2];
+ print "newname - $newname<br>\n";
+ }
+ else {
+ $newname = $data["image"] . "-v0";
+ }
+ $query = "UPDATE image "
+ . "SET name = '$newname', "
+ . "test = 0 "
+ . "WHERE id = " . $data["imageid"];*/
+ $query = "UPDATE request SET stateid = 17 WHERE id = $requestid";
+ doQuery($query, 101);
+ //deleteRequest($data);
+ print "<H2>Change Test Image to Production</H2>\n";
+ print "<b>$prettyimage</b> is in the process of being ";
+ print "updated to use the newly created image.<br>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn confirmDeleteImage()
+///
+/// \brief prints a form to confirm the deletion of an image
+///
+////////////////////////////////////////////////////////////////////////////////
+function confirmDeleteImage() {
+ $imageid = getContinuationVar("imageid");
+ $images = getImages(1);
+ if($images[$imageid]["deleted"] == 0) {
+ $deleted = 0;
+ $title = "Delete Image";
+ $question = "Delete the following image?";
+ }
+ else {
+ $deleted = 1;
+ $title = "Undelete Image";
+ $question = "Undelete the following image?";
+ }
+
+ if(! $deleted && checkForImageUsage($imageid)) {
+ print "<H2 align=center>Delete Image</H2>\n";
+ print "The image you selected is currently in use. You cannot delete ";
+ print "the image until it is no longer being used.<br>\n";
+ return;
+ }
+
+ $platforms = getPlatforms();
+ $oslist = getOSList();
+ $depts = getDepartments();
+
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<DIV align=center>\n";
+ print "<H2>$title</H2>\n";
+ print "$question<br><br>\n";
+ print "<TABLE>\n";
+ /*print " <TR>\n";
+ print " <TH align=right>Short Name:</TH>\n";
+ print " <TD>" . $images[$imageid]["name"] . "</TD>\n";
+ print " </TR>\n";*/
+ print " <TR>\n";
+ print " <TH align=right>Long Name:</TH>\n";
+ print " <TD>" . $images[$imageid]["prettyname"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Owner:</TH>\n";
+ print " <TD>" . $images[$imageid]["owner"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Platform:</TH>\n";
+ print " <TD>" . $platforms[$images[$imageid]["platformid"]] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>OS:</TH>\n";
+ print " <TD>" . $oslist[$images[$imageid]["osid"]]["prettyname"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Minimum RAM (MB):</TH>\n";
+ print " <TD>" . $images[$imageid]["minram"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Minimum Num of Processors:</TH>\n";
+ print " <TD>" . $images[$imageid]["minprocnumber"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Minimum Processor Speed (MHz):</TH>\n";
+ print " <TD>" . $images[$imageid]["minprocspeed"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Minimum Network Speed (Mbps):</TH>\n";
+ print " <TD>" . $images[$imageid]["minnetwork"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Estimated Reload Time (min):</TH>\n";
+ print " <TD>" . $images[$imageid]["reloadtime"] . "</TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ print "<TABLE>\n";
+ print " <TR valign=top>\n";
+ print " <TD>\n";
+ $cdata = array('deleted' => $deleted,
+ 'imageid' => $imageid);
+ $cont = addContinuationsEntry('submitDeleteImage', $cdata, SECINDAY, 0, 0);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Submit>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry('viewImages');
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Cancel>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitDeleteImage()
+///
+/// \brief deletes an image from the database and notifies the user
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitDeleteImage() {
+ $imageid = getContinuationVar("imageid");
+ $deleted = getContinuationVar("deleted");
+ if($deleted) {
+ $query = "UPDATE image "
+ . "SET deleted = 0 "
+ . "WHERE id = $imageid";
+ $qh = doQuery($query, 210);
+ }
+ else {
+ $query = "UPDATE image "
+ . "SET deleted = 1 "
+ . "WHERE id = $imageid";
+ $qh = doQuery($query, 211);
+ $query = "UPDATE computer "
+ . "SET nextimageid = 0 "
+ . "WHERE nextimageid = $imageid";
+ doQuery($query, 212);
+ }
+ viewImages();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn viewImageDetails
+///
+/// \brief prints a page with all information about an image
+///
+////////////////////////////////////////////////////////////////////////////////
+function viewImageDetails() {
+ $imageid = getContinuationVar("imageid");
+ $images = getImages(1);
+ $platforms = getPlatforms();
+ $oslist = getOSList();
+ print "<DIV align=center>\n";
+ print "<H2>Image Details</H2>\n";
+ print "<TABLE>\n";
+ /*print " <TR>\n";
+ print " <TH align=right>Short Name:</TH>\n";
+ print " <TD>" . $images[$imageid]["name"] . "</TD>\n";
+ print " </TR>\n";*/
+ print " <TR>\n";
+ print " <TH align=right>Long Name:</TH>\n";
+ print " <TD>" . $images[$imageid]["prettyname"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Owner:</TH>\n";
+ print " <TD>" . $images[$imageid]["owner"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Platform:</TH>\n";
+ print " <TD>" . $platforms[$images[$imageid]["platformid"]] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>OS:</TH>\n";
+ print " <TD>" . $oslist[$images[$imageid]["osid"]]["prettyname"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Minimum RAM (MB):</TH>\n";
+ print " <TD>" . $images[$imageid]["minram"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Minimum Num of Processors:</TH>\n";
+ print " <TD>" . $images[$imageid]["minprocnumber"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Minimum Processor Speed (MHz):</TH>\n";
+ print " <TD>" . $images[$imageid]["minprocspeed"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Minimum Network Speed (Mbps):</TH>\n";
+ print " <TD>" . $images[$imageid]["minnetwork"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Maximum Concurrent Usage:</TH>\n";
+ if($images[$imageid]['maxconcurrent'] == '')
+ print " <TD>N/A</TD>\n";
+ else
+ print " <TD>" . $images[$imageid]["maxconcurrent"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Estimated Reload Time (min):</TH>\n";
+ print " <TD>" . $images[$imageid]["reloadtime"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Available for checkout:</TH>\n";
+ if($images[$imageid]["forcheckout"])
+ print " <TD>yes</TD>\n";
+ else
+ print " <TD>no</TD>\n";
+ print " </TR>\n";
+ if(array_key_exists("checkuser", $images[$imageid])) {
+ print " <TR>\n";
+ print " <TH align=right>Check for logged in user:</TH>\n";
+ if($images[$imageid]["checkuser"])
+ print " <TD>yes</TD>\n";
+ else
+ print " <TD>no</TD>\n";
+ print " </TR>\n";
+ }
+ if(! empty($images[$imageid]["usergroupid"])) {
+ print " <TR>\n";
+ print " <TH align=right>User group allowed to log in:</TH>\n";
+ print " <TD>{$images[$imageid]["usergroup"]}</TD>\n";
+ print " </TR>\n";
+ }
+ if($oslist[$images[$imageid]["osid"]]["type"] == 'windows') {
+ print " <TR>\n";
+ print " <TH align=right>Use sysprep:</TH>\n";
+ if(array_key_exists("sysprep", $images[$imageid]) &&
+ $images[$imageid]["sysprep"] == 0)
+ print " <TD>no</TD>\n";
+ else
+ print " <TD>yes</TD>\n";
+ print " </TR>\n";
+ }
+ if(array_key_exists("subimages", $images[$imageid]) &&
+ count($images[$imageid]["subimages"])) {
+ print " <TR>\n";
+ print " <TH style=\"vertical-align:top; text-align:right;\">";
+ print "Subimages:</TH>\n";
+ print " <TD>\n";
+ foreach($images[$imageid]["subimages"] as $imgid) {
+ print "{$images[$imgid]["prettyname"]}<br>\n";
+ }
+ print " </TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ print "</DIV>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitImageGroups
+///
+/// \brief updates image groupings
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitImageGroups() {
+ $groupinput = processInputVar("imagegroup", ARG_MULTINUMERIC);
+
+ $images = getImages();
+
+ # build an array of memberships currently in the db
+ $tmp = getUserResources(array("imageAdmin"), array("manageGroup"), 1);
+ $imagegroupsIDs = array_keys($tmp["image"]); // ids of groups that user can manage
+ $resources = getUserResources(array("imageAdmin"),
+ array("manageGroup"));
+ $userImageIDs = array_keys($resources["image"]); // ids of images that user can manage
+ $imagemembership = getResourceGroupMemberships("image");
+ $baseimagegroups = $imagemembership["image"]; // all image group memberships
+ $imagegroups = array();
+ foreach(array_keys($baseimagegroups) as $imageid) {
+ if(in_array($imageid, $userImageIDs)) {
+ foreach($baseimagegroups[$imageid] as $grpid) {
+ if(in_array($grpid, $imagegroupsIDs)) {
+ if(array_key_exists($imageid, $imagegroups))
+ array_push($imagegroups[$imageid], $grpid);
+ else
+ $imagegroups[$imageid] = array($grpid);
+ }
+ }
+ }
+ }
+
+ # build an array of posted in memberships
+ $newmembers = array();
+ foreach(array_keys($groupinput) as $key) {
+ list($imageid, $grpid) = explode(':', $key);
+ if(array_key_exists($imageid, $newmembers)) {
+ array_push($newmembers[$imageid], $grpid);
+ }
+ else {
+ $newmembers[$imageid] = array($grpid);
+ }
+ }
+
+ $adds = array();
+ $removes = array();
+ foreach(array_keys($images) as $imageid) {
+ $id = $images[$imageid]["resourceid"];
+ // if $imageid not in $userImageIds, don't bother with it
+ if(! in_array($imageid, $userImageIDs))
+ continue;
+ // if $imageid is not in $newmembers and not in $imagegroups, do nothing
+ if(! array_key_exists($imageid, $newmembers) &&
+ ! array_key_exists($imageid, $imagegroups)) {
+ continue;
+ }
+ // check that $imageid is in $newmembers, if not, remove it from all groups
+ // user has access to
+ if(! array_key_exists($imageid, $newmembers)) {
+ $removes[$id] = $imagegroups[$imageid];
+ continue;
+ }
+ // check that $imageid is in $imagegroups, if not, add all groups in
+ // $newmembers
+ if(! array_key_exists($imageid, $imagegroups)) {
+ $adds[$id] = $newmembers[$imageid];
+ continue;
+ }
+ // adds are groupids that are in $newmembers, but not in $imagegroups
+ $adds[$id] = array_diff($newmembers[$imageid], $imagegroups[$imageid]);
+ if(count($adds[$id]) == 0) {
+ unset($adds[$id]);
+ }
+ // removes are groupids that are in $imagegroups, but not in $newmembers
+ $removes[$id] = array_diff($imagegroups[$imageid], $newmembers[$imageid]);
+ if(count($removes[$id]) == 0) {
+ unset($removes[$id]);
+ }
+ }
+
+ foreach(array_keys($adds) as $imageid) {
+ foreach($adds[$imageid] as $grpid) {
+ $query = "INSERT IGNORE INTO resourcegroupmembers "
+ . "(resourceid, resourcegroupid) "
+ . "VALUES ($imageid, $grpid)";
+ doQuery($query, 287);
+ }
+ }
+
+ foreach(array_keys($removes) as $imageid) {
+ foreach($removes[$imageid] as $grpid) {
+ $query = "DELETE FROM resourcegroupmembers "
+ . "WHERE resourceid = $imageid AND "
+ . "resourcegroupid = $grpid";
+ doQuery($query, 288);
+ }
+ }
+
+ viewImageGrouping();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitImageMapping
+///
+/// \brief updates image group to computer group mapping
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitImageMapping() {
+ $mapinput = processInputVar("mapping", ARG_MULTINUMERIC);
+
+ # build an array of memberships currently in the db
+ $tmp = getUserResources(array("imageAdmin"),
+ array("manageGroup"), 1);
+ $imagegroups = $tmp["image"];
+ $tmp = getUserResources(array("computerAdmin"),
+ array("manageGroup"), 1);
+ $compgroups = $tmp["computer"];
+ $imageinlist = implode(',', array_keys($imagegroups));
+ $compinlist = implode(',', array_keys($compgroups));
+ $mapping = getResourceMapping("image", "computer", $imageinlist, $compinlist);
+
+ # build an array of posted in memberships
+ $newmembers = array();
+ foreach(array_keys($mapinput) as $key) {
+ list($imageid, $compid) = explode(':', $key);
+ if(array_key_exists($imageid, $newmembers))
+ array_push($newmembers[$imageid], $compid);
+ else
+ $newmembers[$imageid] = array($compid);
+ }
+
+ $adds = array();
+ $removes = array();
+ foreach(array_keys($imagegroups) as $imageid) {
+ // if $imageid is not in $newmembers and not in $mapping, do nothing
+ if(! array_key_exists($imageid, $newmembers) &&
+ ! array_key_exists($imageid, $mapping)) {
+ continue;
+ }
+ // check that $imageid is in $newmembers, if not, remove it from all groups
+ // user has access to
+ if(! array_key_exists($imageid, $newmembers)) {
+ $removes[$imageid] = $mapping[$imageid];
+ continue;
+ }
+ // check that $imageid is in $mapping, if not, add all groups in
+ // $newmembers
+ if(! array_key_exists($imageid, $mapping)) {
+ $adds[$imageid] = $newmembers[$imageid];
+ continue;
+ }
+ // adds are groupids that are in $newmembers, but not in $mapping
+ $adds[$imageid] = array_diff($newmembers[$imageid], $mapping[$imageid]);
+ if(count($adds[$imageid]) == 0) {
+ unset($adds[$imageid]);
+ }
+ // removes are groupids that are in $mapping, but not in $newmembers
+ $removes[$imageid] = array_diff($mapping[$imageid], $newmembers[$imageid]);
+ if(count($removes[$imageid]) == 0) {
+ unset($removes[$imageid]);
+ }
+ }
+
+ foreach(array_keys($adds) as $imageid) {
+ foreach($adds[$imageid] as $compid) {
+ $query = "INSERT INTO resourcemap "
+ . "(resourcegroupid1, "
+ . "resourcetypeid1, "
+ . "resourcegroupid2, "
+ . "resourcetypeid2) "
+ . "VALUES ($imageid, "
+ . "13, "
+ . "$compid, "
+ . "12)";
+ doQuery($query, 101);
+ }
+ }
+
+ foreach(array_keys($removes) as $imageid) {
+ foreach($removes[$imageid] as $compid) {
+ $query = "DELETE FROM resourcemap "
+ . "WHERE resourcegroupid1 = $imageid AND "
+ . "resourcetypeid1 = 13 AND "
+ . "resourcegroupid2 = $compid AND "
+ . "resourcetypeid2 = 12";
+ doQuery($query, 101);
+ }
+ }
+
+ viewImageMapping();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn processImageInput($checks)
+///
+/// \param $checks - (optional) 1 to perform validation, 0 not to
+///
+/// \return an array with the following indexes:\n
+/// imageid, name, prettyname, platformid, osid
+///
+/// \brief validates input from the previous form; if anything was improperly
+/// submitted, sets submitErr and submitErrMsg
+///
+////////////////////////////////////////////////////////////////////////////////
+function processImageInput($checks=1) {
+ global $submitErr, $submitErrMsg, $user;
+ $return = array();
+ $mode = processInputVar("mode", ARG_STRING);
+ $return["imageid"] = processInputVar("imageid" , ARG_NUMERIC, getContinuationVar('imageid'));
+ $return['requestid'] = getContinuationVar('requestid');
+ #$return["name"] = processInputVar("name", ARG_STRING);
+ $return["prettyname"] = processInputVar("prettyname", ARG_STRING);
+ $return["deptid"] = processInputVar("deptid", ARG_NUMERIC);
+ $return["owner"] = processInputVar("owner", ARG_STRING, "{$user["unityid"]}@{$user['affiliation']}");
+ #$return["platformid"] = processInputVar("platformid", ARG_NUMERIC);
+ #$return["osid"] = processInputVar("osid", ARG_NUMERIC);
+ $return["minram"] = processInputVar("minram", ARG_NUMERIC, 64);
+ $return["minprocnumber"] = processInputVar("minprocnumber", ARG_NUMERIC);
+ $return["minprocspeed"] = processInputVar("minprocspeed", ARG_NUMERIC, 500);
+ $return["minnetwork"] = processInputVar("minnetwork", ARG_NUMERIC);
+ $return["maxconcurrent"] = processInputVar("maxconcurrent", ARG_NUMERIC);
+ $return["reloadtime"] = processInputVar("reloadtime", ARG_NUMERIC, 10);
+ $return["forcheckout"] = processInputVar("forcheckout", ARG_NUMERIC, 1);
+ $return["checkuser"] = processInputVar("checkuser", ARG_NUMERIC, 1);
+ $return["usergroupid"] = processInputVar("usergroupid", ARG_NUMERIC);
+ $return["sysprep"] = processInputVar("sysprep", ARG_NUMERIC, 1);
+ $return["description"] = processInputVar("description", ARG_STRING);
+ $return["usage"] = processInputVar("usage", ARG_STRING);
+ $return["comments"] = processInputVar("comments", ARG_STRING);
+
+ $return['description'] = preg_replace("/[\n\s]*$/", '', $return['description']);
+ $return['description'] = preg_replace("/\r/", '', $return['description']);
+ $return['description'] = htmlspecialchars($return['description']);
+ $return['description'] = preg_replace("/\n/", '<br>', $return['description']);
+ $return['usage'] = preg_replace("/[\n\s]*$/", '', $return['usage']);
+ $return['usage'] = preg_replace("/\r/", '', $return['usage']);
+ $return['usage'] = htmlspecialchars($return['usage']);
+ $return['usage'] = preg_replace("/\n/", '<br>', $return['usage']);
+ $return['comments'] = preg_replace("/[\n\s]*$/", '', $return['comments']);
+ $return['comments'] = preg_replace("/\r/", '', $return['comments']);
+ $return['comments'] = htmlspecialchars($return['comments']);
+ $return['comments'] = preg_replace("/\n/", '<br>', $return['comments']);
+
+ if(! $checks) {
+ return $return;
+ }
+
+ /*if($mode != "confirmAddImage" &&
+ (strlen($return["name"]) > 30 || strlen($return["name"]) < 2)) {
+ $submitErr |= NAMEERR;
+ $submitErrMsg[NAMEERR] = "Short Name must be from 2 to 30 characters";
+ }
+ if(! ($submitErr & NAMEERR) &&
+ checkForImageName($return["name"], "short", $return["imageid"])) {
+ $submitErr |= NAMEERR;
+ $submitErrMsg[NAMEERR] = "An image already exists with this name.";
+ }*/
+ if(ereg('-', $return["prettyname"]) ||
+ strlen($return["prettyname"]) > 60 || strlen($return["prettyname"]) < 2) {
+ $submitErr |= PRETTYNAMEERR;
+ $submitErrMsg[PRETTYNAMEERR] = "Long Name must be from 2 to 60 characters "
+ . "and cannot contain any dashes (-).";
+ }
+ if(! ($submitErr & PRETTYNAMEERR) &&
+ checkForImageName($return["prettyname"], "long", $return["imageid"])) {
+ $submitErr |= PRETTYNAMEERR;
+ $submitErrMsg[PRETTYNAMEERR] = "An image already exists with this name.";
+ }
+ if($return["minram"] < 0 || $return["minram"] > 20480) {
+ $submitErr |= MINRAMERR;
+ $submitErrMsg[MINRAMERR] = "RAM must be between 0 and 20480 MB";
+ }
+ if($return["minprocspeed"] < 0 || $return["minprocspeed"] > 20000) {
+ $submitErr |= MINPROCSPEEDERR;
+ $submitErrMsg[MINPROCSPEEDERR] = "Processor Speed must be between 0 and 20000";
+ }
+ if((! is_numeric($return['maxconcurrent']) && ! empty($return['maxconcurrent'])) ||
+ (is_numeric($return['maxconcurrent']) && ($return["maxconcurrent"] < 1 || $return["maxconcurrent"] > 255))) {
+ $submitErr |= MAXCONCURRENTERR;
+ $submitErrMsg[MAXCONCURRENTERR] = "Max concurrent usage must be blank or between 1 and 255";
+ }
+ if($return["reloadtime"] < 0 || $return["reloadtime"] > 120) {
+ $submitErr |= RELOADTIMEERR;
+ $submitErrMsg[RELOADTIMEERR] = "Estimated Reload Time must be between 0 and 120";
+ }
+ if(! validateUserid($return["owner"])) {
+ $submitErr |= IMGOWNERERR;
+ $submitErrMsg[IMGOWNERERR] = "Submitted ID is not valid";
+ }
+ if(empty($return['description'])) {
+ $submitErr |= IMAGEDESCRIPTIONERR;
+ $submitErrMsg[IMAGEDESCRIPTIONERR] = "You must include a description of the image<br>";
+ }
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn checkForImageName($name, $longshort, $id)
+///
+/// \param $name - the name of an image
+/// \param $longshort - "long" for long/pretty name, "short" for short/name
+/// \param $id - id of an image to ignore
+///
+/// \return 1 if $name is already in the image table, 0 if not
+///
+/// \brief checks for $name being in the image table except for $id
+///
+////////////////////////////////////////////////////////////////////////////////
+function checkForImageName($name, $longshort, $id) {
+ if($longshort == "long")
+ $field = "prettyname";
+ else
+ $field = "name";
+ $query = "SELECT id FROM image "
+ . "WHERE $field = '$name'";
+ if(! empty($id))
+ $query .= " AND id != $id";
+ $qh = doQuery($query, 101);
+ if(mysql_num_rows($qh))
+ return 1;
+ return 0;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn updateImage($data)
+///
+/// \param $data - an array returned from processImageInput
+///
+/// \return number of rows affected by the update\n
+/// \b NOTE: mysql reports that no rows were affected if none of the fields
+/// were actually changed even if the update matched a row
+///
+/// \brief performs a query to update the image with data from $data
+///
+////////////////////////////////////////////////////////////////////////////////
+function updateImage($data) {
+ $imgdata = getImages(0, $data["imageid"]);
+ $imagenotes = getImageNotes($data['imageid']);
+ $ownerid = getUserlistID($data["owner"]);
+ if(empty($data['maxconcurrent']) || ! is_numeric($data['maxconcurrent']))
+ $data['maxconcurrent'] = 'NULL';
+ $query = "UPDATE image "
+ . "SET prettyname = '{$data["prettyname"]}', "
+ . "ownerid = $ownerid, "
+ /*. "platformid = {$data["platformid"]}, "
+ . "OSid = {$data["osid"]}, "*/
+ . "minram = {$data["minram"]}, "
+ . "minprocnumber = {$data["minprocnumber"]}, "
+ . "minprocspeed = {$data["minprocspeed"]}, "
+ . "minnetwork = {$data["minnetwork"]}, "
+ . "maxconcurrent = {$data["maxconcurrent"]}, "
+ . "reloadtime = {$data["reloadtime"]}, "
+ . "forcheckout = {$data["forcheckout"]}, "
+ . "description = '{$data["description"]}', "
+ . "`usage` = '{$data["usage"]}' "
+ . "WHERE id = {$data["imageid"]}";
+ $qh = doQuery($query, 200);
+ $return = mysql_affected_rows($GLOBALS["mysql_link_vcl"]);
+ if(empty($imgdata[$data["imageid"]]["imagemetaid"]) &&
+ ($data["checkuser"] == 0 || $data["usergroupid"] != 0)) {
+ if($data["usergroupid"] == 0)
+ $data["usergroupid"] = "NULL";
+ $query = "INSERT INTO imagemeta "
+ . "(checkuser, "
+ . "usergroupid) "
+ . "VALUES ({$data["checkuser"]}, "
+ . "{$data["usergroupid"]})";
+ doQuery($query, 101);
+ $qh = doQuery("SELECT LAST_INSERT_ID() FROM imagemeta", 101);
+ if(! $row = mysql_fetch_row($qh))
+ abort(101);
+ $imagemetaid = $row[0];
+ $query = "UPDATE image "
+ . "SET imagemetaid = $imagemetaid "
+ . "WHERE id = {$data["imageid"]}";
+ doQuery($query, 101);
+ }
+ elseif(! empty($imgdata[$data["imageid"]]["imagemetaid"]) &&
+ ($data["checkuser"] != $imgdata[$data["imageid"]]["checkuser"] ||
+ $data["usergroupid"] != $imgdata[$data["imageid"]]["usergroupid"])) {
+ if($data["usergroupid"] == 0)
+ $data["usergroupid"] = "NULL";
+ $query = "UPDATE imagemeta "
+ . "SET checkuser = {$data["checkuser"]}, "
+ . "usergroupid = {$data["usergroupid"]} "
+ . "WHERE id = {$imgdata[$data["imageid"]]["imagemetaid"]}";
+ doQuery($query, 101);
+ }
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn addImage($data)
+///
+/// \param $data - an array returned from processImageInput
+///
+/// \return number of rows affected by the insert\n
+///
+/// \brief performs a query to insert the image with data from $data
+///
+////////////////////////////////////////////////////////////////////////////////
+function addImage($data) {
+ global $user;
+ if(get_magic_quotes_gpc()) {
+ $data['description'] = stripslashes($data['description']);
+ $data['usage'] = stripslashes($data['usage']);
+ }
+ $data['description'] = mysql_escape_string($data['description']);
+ $data['usage'] = mysql_escape_string($data['usage']);
+
+ $ownerdata = getUserInfo($data['owner']);
+ $ownerid = $ownerdata['id'];
+ if(empty($data['maxconcurrent']) || ! is_numeric($data['maxconcurrent']))
+ $data['maxconcurrent'] = 'NULL';
+ $query = "INSERT INTO image "
+ . "(prettyname, "
+ . "ownerid, "
+ . "platformid, "
+ . "OSid, "
+ . "minram, "
+ . "minprocnumber, "
+ . "minprocspeed, "
+ . "minnetwork, "
+ . "maxconcurrent, "
+ . "reloadtime, "
+ . "deleted, "
+ . "description, "
+ . "`usage`, "
+ . "basedoffrevisionid) "
+ . "VALUES ('{$data["prettyname"]}', "
+ . "$ownerid, "
+ . "{$data["platformid"]}, "
+ . "{$data["osid"]}, "
+ . "{$data["minram"]}, "
+ . "{$data["minprocnumber"]}, "
+ . "{$data["minprocspeed"]}, "
+ . "{$data["minnetwork"]}, "
+ . "{$data["maxconcurrent"]}, "
+ . "{$data["reloadtime"]}, "
+ . "1, "
+ . "'{$data['description']}', "
+ . "'{$data['usage']}', "
+ . "{$data['basedoffrevisionid']})";
+ doQuery($query, 205);
+
+ // get last insert id
+ $qh = doQuery("SELECT LAST_INSERT_ID() FROM image", 206);
+ if(! $row = mysql_fetch_row($qh)) {
+ abort(207);
+ }
+ $imageid = $row[0];
+
+ // possibly add entry to imagemeta table
+ $imagemetaid = 0;
+ if($data['checkuser'] != 0 && $data['checkuser'] != 1)
+ $data['checkuser'] = 1;
+ if(! is_numeric($data['usergroupid']) || $data['usergroupid'] <= 0)
+ $data['usergroupid'] = "NULL";
+ if($data['sysprep'] != 0 && $data['sysprep'] != 1)
+ $data['sysprep'] = 1;
+ if($data['checkuser'] == 0 ||
+ (is_numeric($data['usergroupid']) && $data['usergroupid'] > 0) ||
+ $data['sysprep'] == 0) {
+ $query = "INSERT INTO imagemeta "
+ . "(checkuser, "
+ . "usergroupid, "
+ . "sysprep) "
+ . "VALUES "
+ . "({$data['checkuser']}, "
+ . "{$data['usergroupid']}, "
+ . "{$data['sysprep']})";
+ doQuery($query, 101);
+
+ // get last insert id
+ $qh = doQuery("SELECT LAST_INSERT_ID() FROM imagemeta", 101);
+ if(! $row = mysql_fetch_row($qh)) {
+ abort(207);
+ }
+ $imagemetaid = $row[0];
+ }
+
+ // create name from pretty name, os, and last insert id
+ $OSs = getOSList();
+ $name = $OSs[$data["osid"]]["name"] . "-" .
+ preg_replace('/\W/', '', $data["prettyname"]) . $imageid . "-v0";
+ if($imagemetaid) {
+ $query = "UPDATE image "
+ . "SET name = '$name', "
+ . "imagemetaid = $imagemetaid "
+ . "WHERE id = $imageid";
+ }
+ else
+ $query = "UPDATE image SET name = '$name' WHERE id = $imageid";
+ doQuery($query, 208);
+
+ $query = "INSERT INTO imagerevision "
+ . "(imageid, "
+ . "userid, "
+ . "datecreated, "
+ . "production, "
+ . "imagename, "
+ . "comments) "
+ . "VALUES ($imageid, "
+ . "{$user['id']}, "
+ . "NOW(), "
+ . "1, "
+ . "'$name', "
+ . "'{$data['comments']}')";
+ doQuery($query, 101);
+
+ // add entry in resource table
+ $query = "INSERT INTO resource "
+ . "(resourcetypeid, "
+ . "subid) "
+ . "VALUES (13, "
+ . "$imageid)";
+ doQuery($query, 209);
+ $qh = doQuery("SELECT LAST_INSERT_ID() FROM resource", 101);
+ $row = mysql_fetch_row($qh);
+ $resourceid = $row[0];
+
+ if(strncmp($OSs[$data['osid']]['name'], 'vmware', 6) == 0)
+ $vmware = 1;
+ else
+ $vmware = 0;
+
+ // create new node if it does not exist
+ if($vmware)
+ $nodename = 'newvmimages';
+ else
+ $nodename = 'newimages';
+ $query = "SELECT id "
+ . "FROM privnode "
+ . "WHERE name = '$nodename' AND "
+ . "parent = 3";
+ $qh = doQuery($query, 101);
+ if(! $row = mysql_fetch_assoc($qh)) {
+ $query2 = "INSERT INTO privnode "
+ . "(parent, "
+ . "name) "
+ . "VALUES "
+ . "(3, "
+ . "'$nodename')";
+ doQuery($query2, 101);
+ $qh = doQuery($query, 101);
+ $row = mysql_fetch_assoc($qh);
+ }
+ $parent = $row['id'];
+ $query = "SELECT id "
+ . "FROM privnode "
+ . "WHERE name = '{$ownerdata['login']}-$ownerid' AND "
+ . "parent = $parent";
+ $qh = doQuery($query, 101);
+ if($row = mysql_fetch_assoc($qh))
+ $newnode = $row['id'];
+ else {
+ $query = "INSERT INTO privnode "
+ . "(parent, name) "
+ . "VALUES ($parent, '{$ownerdata['login']}-$ownerid')";
+ doQuery($query, 101);
+ $qh = doQuery("SELECT LAST_INSERT_ID() FROM privnode", 101);
+ $row = mysql_fetch_row($qh);
+ $newnode = $row[0];
+ }
+
+ // give user imageCheckOut and imageAdmin at new node
+ $newprivs = array('imageCheckOut', 'imageAdmin');
+ updateUserOrGroupPrivs($ownerid, $newnode, $newprivs, array(), 'user');
+
+ // create new image group if it does not exist
+ $query = "SELECT id "
+ . "FROM usergroup "
+ . "WHERE name = 'manageNewImages'";
+ $qh = doQuery($query, 101);
+ $row = mysql_fetch_assoc($qh);
+ $ownergroupid = $row['id'];
+ if($vmware)
+ $prefix = 'newvmimages';
+ else
+ $prefix = 'newimages';
+ $query = "SELECT id "
+ . "FROM resourcegroup "
+ . "WHERE name = '$prefix-{$ownerdata['login']}-$ownerid' AND "
+ . "ownerusergroupid = $ownergroupid AND "
+ . "resourcetypeid = 13";
+ $qh = doQuery($query, 101);
+ if($row = mysql_fetch_assoc($qh))
+ $resourcegroupid = $row['id'];
+ else {
+ $query = "INSERT INTO resourcegroup "
+ . "(name, "
+ . "ownerusergroupid, "
+ . "resourcetypeid) "
+ . "VALUES ('$prefix-{$ownerdata['login']}-$ownerid', "
+ . "$ownergroupid, "
+ . "13)";
+ doQuery($query, 305);
+ $qh = doQuery("SELECT LAST_INSERT_ID() FROM resourcegroup", 101);
+ $row = mysql_fetch_row($qh);
+ $resourcegroupid = $row[0];
+
+ // map group to newimages/newvmimages comp group
+ if($vmware)
+ $rgroupname = 'newvmimages';
+ else
+ $rgroupname = 'newimages';
+ $query = "SELECT id "
+ . "FROM resourcegroup "
+ . "WHERE name = '$rgroupname' AND "
+ . "resourcetypeid = 12";
+ $qh = doQuery($query, 101);
+ $row = mysql_fetch_assoc($qh);
+ $compResGrpid = $row['id'];
+ $query = "INSERT INTO resourcemap "
+ . "(resourcegroupid1, "
+ . "resourcetypeid1, "
+ . "resourcegroupid2, "
+ . "resourcetypeid2) "
+ . "VALUES ($resourcegroupid, "
+ . "13, "
+ . "$compResGrpid, "
+ . "12)";
+ doQuery($query, 101);
+ }
+
+ // make image group available at new node
+ $adds = array('available', 'administer');
+ if($vmware)
+ updateResourcePrivs("image/newvmimages-{$ownerdata['login']}-$ownerid", $newnode, $adds, array());
+ else
+ updateResourcePrivs("image/newimages-{$ownerdata['login']}-$ownerid", $newnode, $adds, array());
+
+ // add image to image group
+ $query = "INSERT INTO resourcegroupmembers "
+ . "(resourceid, resourcegroupid) "
+ . "VALUES ($resourceid, $resourcegroupid)";
+ doQuery($query, 101);
+
+ return $imageid;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn checkForImageUsage($imageid)
+///
+/// \param $imageid - id of an image
+///
+/// \return 0 if image is not used on any computers, 1 if it is
+///
+/// \brief checks for $imageid being the current imageid for any computers in
+/// the computer table or the imageid for any active reservations
+///
+////////////////////////////////////////////////////////////////////////////////
+function checkForImageUsage($imageid) {
+ $query = "SELECT id "
+ . "FROM computer "
+ . "WHERE currentimageid = $imageid";
+ $qh = doQuery($query, 250);
+ if(mysql_num_rows($qh))
+ return 1;
+ $query = "SELECT rs.id "
+ . "FROM reservation rs, "
+ . "request rq "
+ . "WHERE rs.requestid = rq.id "
+ . "AND rs.imageid = $imageid "
+ . "AND rq.end > NOW() "
+ . "AND rq.stateid NOT IN (1, 5, 12)";
+ $qh = doQuery($query, 250);
+ if(mysql_num_rows($qh))
+ return 1;
+ return 0;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn jsonImageGroupingImages()
+///
+/// \brief accepts a groupid via form input and prints a json array with 3
+/// arrays: an array of images that are in the group, an array of images
+/// not in it, and an array of all images user has access to
+///
+////////////////////////////////////////////////////////////////////////////////
+function jsonImageGroupingImages() {
+ $groupid = processInputVar('groupid', ARG_NUMERIC);
+ $groups = getUserResources(array("imageAdmin"), array("manageGroup"), 1);
+ if(! array_key_exists($groupid, $groups['image'])) {
+ $arr = array('inimages' => array(), 'outimages' => array(), 'all' => array());
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+
+ $resources = getUserResources(array('imageAdmin'), array('manageGroup'));
+ uasort($resources['image'], 'sortKeepIndex');
+ $memberships = getResourceGroupMemberships('image');
+ $all = array();
+ $in = array();
+ $out = array();
+ foreach($resources['image'] as $id => $image) {
+ if($image == 'No Image')
+ continue;
+ if(array_key_exists($id, $memberships['image']) &&
+ in_array($groupid, $memberships['image'][$id])) {
+ $all[] = array('inout' => 1, 'id' => $id, 'name' => $image);
+ $in[] = array('name' => $image, 'id' => $id);
+ }
+ else {
+ $all[] = array('inout' => 0, 'id' => $id, 'name' => $image);
+ $out[] = array('name' => $image, 'id' => $id);
+ }
+ }
+ $arr = array('inimages' => $in, 'outimages' => $out, 'all' => $all);
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn jsonImageGroupingGroups()
+///
+/// \brief accepts an image id via form input and prints a json array with 3
+/// arrays: an array of groups that the image is in, an array of groups it
+/// is not in and an array of all groups user has access to
+///
+////////////////////////////////////////////////////////////////////////////////
+function jsonImageGroupingGroups() {
+ $imageid = processInputVar('imageid', ARG_NUMERIC);
+ $resources = getUserResources(array("imageAdmin"), array("manageGroup"));
+ if(! array_key_exists($imageid, $resources['image'])) {
+ $arr = array('ingroups' => array(), 'outgroups' => array(), 'all' => array());
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+ $groups = getUserResources(array('imageAdmin'), array('manageGroup'), 1);
+ $memberships = getResourceGroupMemberships('image');
+ $in = array();
+ $out = array();
+ $all = array();
+ foreach($groups['image'] as $id => $group) {
+ if(array_key_exists($imageid, $memberships['image']) &&
+ in_array($id, $memberships['image'][$imageid])) {
+ $all[] = array('inout' => 1, 'id' => $id, 'name' => $group);
+ $in[] = array('name' => $group, 'id' => $id);
+ }
+ else {
+ $all[] = array('inout' => 0, 'id' => $id, 'name' => $group);
+ $out[] = array('name' => $group, 'id' => $id);
+ }
+ }
+ $arr = array('ingroups' => $in, 'outgroups' => $out, 'all' => $all);
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn jsonImageMapCompGroups()
+///
+/// \brief accepts a image groupid via form input and prints a json array with 3
+/// arrays: an array of computer groups that are mapped to the group, an array
+/// of computer groups not mapped to it, and an array of all computer groups
+/// the user has access to
+///
+////////////////////////////////////////////////////////////////////////////////
+function jsonImageMapCompGroups() {
+ $imagegrpid = processInputVar('imagegrpid', ARG_NUMERIC);
+ $resources = getUserResources(array("imageAdmin"), array("manageGroup"), 1);
+ if(! array_key_exists($imagegrpid, $resources['image'])) {
+ $arr = array('ingroups' => array(), 'outgroups' => array(), 'all' => array());
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+ $compgroups = getUserResources(array('computerAdmin'), array('manageGroup'), 1);
+ $mapping = getResourceMapping('image', 'computer');
+ $in = array();
+ $out = array();
+ $all = array();
+ foreach($compgroups['computer'] as $id => $group) {
+ if(array_key_exists($imagegrpid, $mapping) &&
+ in_array($id, $mapping[$imagegrpid])) {
+ $all[] = array('inout' => 1, 'id' => $id, 'name' => $group);
+ $in[] = array('name' => $group, 'id' => $id);
+ }
+ else {
+ $all[] = array('inout' => 0, 'id' => $id, 'name' => $group);
+ $out[] = array('name' => $group, 'id' => $id);
+ }
+ }
+ $arr = array('ingroups' => $in, 'outgroups' => $out, 'all' => $all);
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn jsonImageMapImgGroups()
+///
+/// \brief accepts a computer groupid via form input and prints a json array
+/// with 3 arrays: an array of image groups that are mapped to the group, an
+/// array of image groups not mapped to it, and an array of all image groups
+/// the user has access to
+///
+////////////////////////////////////////////////////////////////////////////////
+function jsonImageMapImgGroups() {
+ $compgrpid = processInputVar('compgrpid', ARG_NUMERIC);
+ $resources = getUserResources(array("computerAdmin"), array("manageGroup"), 1);
+ if(! array_key_exists($compgrpid, $resources['computer'])) {
+ $arr = array('ingroups' => array(), 'outgroups' => array(), 'all' => array());
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+ $imagegroups = getUserResources(array('imageAdmin'), array('manageGroup'), 1);
+ $mapping = getResourceMapping('computer', 'image');
+ $in = array();
+ $out = array();
+ $all = array();
+ foreach($imagegroups['image'] as $id => $group) {
+ if(array_key_exists($compgrpid, $mapping) &&
+ in_array($id, $mapping[$compgrpid])) {
+ $all[] = array('inout' => 1, 'id' => $id, 'name' => $group);
+ $in[] = array('name' => $group, 'id' => $id);
+ }
+ else {
+ $all[] = array('inout' => 0, 'id' => $id, 'name' => $group);
+ $out[] = array('name' => $group, 'id' => $id);
+ }
+ }
+ $arr = array('ingroups' => $in, 'outgroups' => $out, 'all' => $all);
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJaddImageToGroup()
+///
+/// \brief accepts a groupid and a comma delimited list of image ids to be
+/// added to the group; adds them and returns an array of image ids that were
+/// added
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJaddImageToGroup() {
+ $groupid = processInputVar('id', ARG_NUMERIC);
+ $groups = getUserResources(array("imageAdmin"), array("manageGroup"), 1);
+ if(! array_key_exists($groupid, $groups['image'])) {
+ $arr = array('images' => array(), 'addrem' => 1);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+
+ $resources = getUserResources(array("imageAdmin"), array("manageGroup"));
+ $tmp = processInputVar('listids', ARG_STRING);
+ $tmp = explode(',', $tmp);
+ $imageids = array();
+ foreach($tmp as $id) {
+ if(! is_numeric($id))
+ continue;
+ if(! array_key_exists($id, $resources['image'])) {
+ $arr = array('images' => array(), 'addrem' => 1);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+ $imageids[] = $id;
+ }
+
+ $allimages = getImages();
+ $adds = array();
+ foreach($imageids as $id) {
+ $adds[] = "({$allimages[$id]['resourceid']}, $groupid)";
+ }
+ $query = "INSERT IGNORE INTO resourcegroupmembers "
+ . "(resourceid, resourcegroupid) VALUES ";
+ $query .= implode(',', $adds);
+ doQuery($query, 287);
+ $_SESSION['userresources'] = array();
+ $arr = array('images' => $imageids, 'addrem' => 1);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJremImageFromGroup()
+///
+/// \brief accepts a groupid and a comma delimited list of image ids to be
+/// removed from the group; removes them and returns an array of image ids
+/// that were removed
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJremImageFromGroup() {
+ $groupid = processInputVar('id', ARG_NUMERIC);
+ $groups = getUserResources(array("imageAdmin"), array("manageGroup"), 1);
+ if(! array_key_exists($groupid, $groups['image'])) {
+ $arr = array('images' => array(), 'addrem' => 0);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+
+ $resources = getUserResources(array("imageAdmin"), array("manageGroup"));
+ $tmp = processInputVar('listids', ARG_STRING);
+ $tmp = explode(',', $tmp);
+ $imageids = array();
+ foreach($tmp as $id) {
+ if(! is_numeric($id))
+ continue;
+ if(! array_key_exists($id, $resources['image'])) {
+ $arr = array('images' => array(), 'addrem' => 0, 'id' => $id, 'extra' => $resources['image']);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+ $imageids[] = $id;
+ }
+
+ $allimages = getImages();
+ foreach($imageids as $id) {
+ $query = "DELETE FROM resourcegroupmembers "
+ . "WHERE resourceid = {$allimages[$id]['resourceid']} AND "
+ . "resourcegroupid = $groupid";
+ doQuery($query, 288);
+ }
+ $_SESSION['userresources'] = array();
+ $arr = array('images' => $imageids, 'addrem' => 0);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJaddGroupToImage()
+///
+/// \brief accepts an image id and a comma delimited list of group ids that
+/// the image should be added to; adds it to them and returns an array of
+/// groups it was added to
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJaddGroupToImage() {
+ $imageid = processInputVar('id', ARG_NUMERIC);
+ $resources = getUserResources(array("imageAdmin"), array("manageGroup"));
+ if(! array_key_exists($imageid, $resources['image'])) {
+ $arr = array('groups' => array(), 'addrem' => 1);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+
+ $groups = getUserResources(array("imageAdmin"), array("manageGroup"), 1);
+ $tmp = processInputVar('listids', ARG_STRING);
+ $tmp = explode(',', $tmp);
+ $groupids = array();
+ foreach($tmp as $id) {
+ if(! is_numeric($id))
+ continue;
+ if(! array_key_exists($id, $groups['image'])) {
+ $arr = array('groups' => array(), 'addrem' => 1);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+ $groupids[] = $id;
+ }
+
+ $img = getImages(0, $imageid);
+ $adds = array();
+ foreach($groupids as $id) {
+ $adds[] = "({$img[$imageid]['resourceid']}, $id)";
+ }
+ $query = "INSERT IGNORE INTO resourcegroupmembers "
+ . "(resourceid, resourcegroupid) VALUES ";
+ $query .= implode(',', $adds);
+ doQuery($query, 101);
+ $_SESSION['userresources'] = array();
+ $arr = array('groups' => $groupids, 'addrem' => 1);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJremGroupFromImage()
+///
+/// \brief accepts an image id and a comma delimited list of group ids that
+/// the image should be removed from; removes it from them and returns an
+/// array of groups it was removed from
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJremGroupFromImage() {
+ $imageid = processInputVar('id', ARG_NUMERIC);
+ $resources = getUserResources(array("imageAdmin"), array("manageGroup"));
+ if(! array_key_exists($imageid, $resources['image'])) {
+ $arr = array('groups' => array(), 'addrem' => 0);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+
+ $groups = getUserResources(array("imageAdmin"), array("manageGroup"), 1);
+ $tmp = processInputVar('listids', ARG_STRING);
+ $tmp = explode(',', $tmp);
+ $groupids = array();
+ foreach($tmp as $id) {
+ if(! is_numeric($id))
+ continue;
+ if(! array_key_exists($id, $groups['image'])) {
+ $arr = array('groups' => array(), 'addrem' => 0);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+ $groupids[] = $id;
+ }
+
+ $img = getImages(0, $imageid);
+ foreach($groupids as $id) {
+ $query = "DELETE FROM resourcegroupmembers "
+ . "WHERE resourceid = {$img[$imageid]['resourceid']} AND "
+ . "resourcegroupid = $id";
+ doQuery($query, 288);
+ }
+ $_SESSION['userresources'] = array();
+ $arr = array('groups' => $groupids, 'addrem' => 0);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJaddCompGrpToImgGrp()
+///
+/// \brief accepts an image group id and a comma delimited list of computer
+/// group ids that the image group should be mapped to; maps it to them and
+/// returns an array of groups it was mapped to
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJaddCompGrpToImgGrp() {
+ $imagegrpid = processInputVar('id', ARG_NUMERIC);
+ $resources = getUserResources(array("imageAdmin"), array("manageGroup"), 1);
+ if(! array_key_exists($imagegrpid, $resources['image'])) {
+ $arr = array('groups' => array(), 'addrem' => 1);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+
+ $compgroups = getUserResources(array("computerAdmin"), array("manageGroup"), 1);
+ $tmp = processInputVar('listids', ARG_STRING);
+ $tmp = explode(',', $tmp);
+ $compgroupids = array();
+ foreach($tmp as $id) {
+ if(! is_numeric($id))
+ continue;
+ if(! array_key_exists($id, $compgroups['computer'])) {
+ $arr = array('groups' => array(), 'addrem' => 1);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+ $compgroupids[] = $id;
+ }
+
+ $adds = array();
+ foreach($compgroupids as $id) {
+ $adds[] = "($imagegrpid, 13, $id, 12)";
+ }
+ $query = "INSERT IGNORE INTO resourcemap "
+ . "(resourcegroupid1, resourcetypeid1, resourcegroupid2, resourcetypeid2) VALUES ";
+ $query .= implode(',', $adds);
+ doQuery($query, 101);
+ $_SESSION['userresources'] = array();
+ $arr = array('groups' => $compgroupids, 'addrem' => 1);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJremCompGrpFromImgGrp()
+///
+/// \brief accepts an image group id and a comma delimited list of computer
+/// group ids that the image group should be unmapped from; unmaps it from them
+/// and returns an array of computer groups it was unmapped from
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJremCompGrpFromImgGrp() {
+ $imagegrpid = processInputVar('id', ARG_NUMERIC);
+ $resources = getUserResources(array("imageAdmin"), array("manageGroup"), 1);
+ if(! array_key_exists($imagegrpid, $resources['image'])) {
+ $arr = array('groups' => array(), 'addrem' => 0);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+
+ $compgroups = getUserResources(array("computerAdmin"), array("manageGroup"), 1);
+ $tmp = processInputVar('listids', ARG_STRING);
+ $tmp = explode(',', $tmp);
+ $compgroupids = array();
+ foreach($tmp as $id) {
+ if(! is_numeric($id))
+ continue;
+ if(! array_key_exists($id, $compgroups['computer'])) {
+ $arr = array('groups' => array(), 'addrem' => 0);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+ $compgroupids[] = $id;
+ }
+
+ foreach($compgroupids as $id) {
+ $query = "DELETE FROM resourcemap "
+ . "WHERE resourcegroupid1 = $imagegrpid AND "
+ . "resourcetypeid1 = 13 AND "
+ . "resourcegroupid2 = $id AND "
+ . "resourcetypeid2 = 12";
+ doQuery($query, 288);
+ }
+ $_SESSION['userresources'] = array();
+ $arr = array('groups' => $compgroupids, 'addrem' => 0);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJaddImgGrpToCompGrp()
+///
+/// \brief accepts a computer group id and a comma delimited list of image
+/// group ids that the computer group should be mapped to; maps it to them and
+/// returns an array of groups it was mapped to
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJaddImgGrpToCompGrp() {
+ $compgrpid = processInputVar('id', ARG_NUMERIC);
+ $resources = getUserResources(array("computerAdmin"), array("manageGroup"), 1);
+ if(! array_key_exists($compgrpid, $resources['computer'])) {
+ $arr = array('groups' => array(), 'addrem' => 1);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+
+ $imagegroups = getUserResources(array("imageAdmin"), array("manageGroup"), 1);
+ $tmp = processInputVar('listids', ARG_STRING);
+ $tmp = explode(',', $tmp);
+ $imagegroupids = array();
+ foreach($tmp as $id) {
+ if(! is_numeric($id))
+ continue;
+ if(! array_key_exists($id, $imagegroups['image'])) {
+ $arr = array('groups' => array(), 'addrem' => 1);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+ $imagegroupids[] = $id;
+ }
+
+ $adds = array();
+ foreach($imagegroupids as $id) {
+ $adds[] = "($id, 13, $compgrpid, 12)";
+ }
+ $query = "INSERT IGNORE INTO resourcemap "
+ . "(resourcegroupid1, resourcetypeid1, resourcegroupid2, resourcetypeid2) VALUES ";
+ $query .= implode(',', $adds);
+ doQuery($query, 101);
+ $_SESSION['userresources'] = array();
+ $arr = array('groups' => $imagegroupids, 'addrem' => 1);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJremImgGrpFromCompGrp()
+///
+/// \brief accepts a computer group id and a comma delimited list of image group
+/// ids that the computer group should be unmapped from; unmaps it from them
+/// and returns an array of image groups it was unmapped from
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJremImgGrpFromCompGrp() {
+ $compgrpid = processInputVar('id', ARG_NUMERIC);
+ $resources = getUserResources(array("computerAdmin"), array("manageGroup"), 1);
+ if(! array_key_exists($compgrpid, $resources['computer'])) {
+ $arr = array('groups' => array(), 'addrem' => 0);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+
+ $imagegroups = getUserResources(array("imageAdmin"), array("manageGroup"), 1);
+ $tmp = processInputVar('listids', ARG_STRING);
+ $tmp = explode(',', $tmp);
+ $imagegroupids = array();
+ foreach($tmp as $id) {
+ if(! is_numeric($id))
+ continue;
+ if(! array_key_exists($id, $imagegroups['image'])) {
+ $arr = array('groups' => array(), 'addrem' => 0);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+ $imagegroupids[] = $id;
+ }
+
+ foreach($imagegroupids as $id) {
+ $query = "DELETE FROM resourcemap "
+ . "WHERE resourcegroupid1 = $id AND "
+ . "resourcetypeid1 = 13 AND "
+ . "resourcegroupid2 = $compgrpid AND "
+ . "resourcetypeid2 = 12";
+ doQuery($query, 288);
+ }
+ $_SESSION['userresources'] = array();
+ $arr = array('groups' => $imagegroupids, 'addrem' => 0);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJupdateRevisionProduction()
+///
+/// \brief updates which revision is set as the one in production
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJupdateRevisionProduction() {
+ $imageid = getContinuationVar('imageid');
+ $revisionid = getContinuationVar('revisionid');
+ $query = "UPDATE imagerevision "
+ . "SET production = 0 "
+ . "WHERE imageid = $imageid";
+ doQuery($query, 101);
+ $query = "UPDATE imagerevision "
+ . "SET production = 1 "
+ . "WHERE id = $revisionid";
+ doQuery($query, 101);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJupdateRevisionComments()
+///
+/// \brief updates the comments for a revision
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJupdateRevisionComments() {
+ $imageid = getContinuationVar('imageid');
+ $revisionid = getContinuationVar('revisionid');
+ $comments = processInputVar('comments', ARG_STRING);
+ $comments = htmlspecialchars($comments);
+ if(get_magic_quotes_gpc())
+ $comments = stripslashes($comments);
+ $comments = mysql_escape_string($comments);
+ $query = "UPDATE imagerevision "
+ . "SET comments = '$comments' "
+ . "WHERE id = $revisionid";
+ doQuery($query, 101);
+ $arr = array('comments' => $comments, 'id' => $revisionid);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJdeleteRevisions()
+///
+/// \brief sets deleted flag for submitted revisions
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJdeleteRevisions() {
+ $revids = getContinuationVar('revids');
+ $imageid = getContinuationVar('imageid');
+ $checkedids = processInputVar('checkedids', ARG_STRING);
+ $ids = explode(',', $checkedids);
+ foreach($ids as $id) {
+ if(! is_numeric($id) || ! in_array($id, $revids)) {
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode(array()) . '}*/';
+ return;
+ }
+ }
+ $query = "UPDATE imagerevision "
+ . "SET deleted = 1 "
+ . "WHERE id IN ($checkedids) "
+ . "AND production != 1";
+ doQuery($query, 101);
+ $html = getRevisionHTML($imageid);
+ $arr = array('html' => $html);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+?>
diff --git a/web/.ht-inc/managementnodes.php b/web/.ht-inc/managementnodes.php
new file mode 100644
index 0000000..e7e27ec
--- /dev/null
+++ b/web/.ht-inc/managementnodes.php
@@ -0,0 +1,964 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+/**
+ * \file
+ */
+
+/// signifies an error with submitted hostname
+define("MNHOSTNAMEERR", 1);
+/// signifies an error with submitted IP address
+define("IPADDRESSERR", 1 << 1);
+/// signifies an error with submitted owner
+define("MNOWNERERR", 1 << 2);
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn selectMgmtnodeOption()
+///
+/// \brief prints a page for the user to select which management node operation
+/// they want to perform; if they only have access to a few options or only a
+/// few management nodes, just send them straight to viewImagesAll
+///
+////////////////////////////////////////////////////////////////////////////////
+function selectMgmtnodeOption() {
+ # get all management nodes
+ $nodes = getManagementNodes();
+ if(empty($nodes)) {
+ viewMgmtnodes();
+ return;
+ }
+
+ # get a count of management nodes user can administer
+ $tmp = getUserResources(array("mgmtNodeAdmin"), array("administer"));
+ $mnAdminCnt = count($tmp['managementnode']);
+
+ # get a count of management node groups user can manage
+ $tmp = getUserResources(array("mgmtNodeAdmin"), array("manageGroup"), 1);
+ $mnGroupCnt = count($tmp['managementnode']);
+
+ # get a count of computer groups user can manage
+ $tmp = getUserResources(array("computerAdmin"), array("manageGroup"), 1);
+ $compGroupCnt = count($tmp['computer']);
+
+ print "<H2>Manage Management Nodes</H2>\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ if($mnAdminCnt) {
+ $cont = addContinuationsEntry('viewMgmtnodes');
+ print "<INPUT type=radio name=continuation value=\"$cont\" checked>Edit ";
+ print "Management Node Information<br>\n";
+ }
+ if($mnGroupCnt) {
+ $cont = addContinuationsEntry('viewMgmtnodeGrouping');
+ print "<INPUT type=radio name=continuation value=\"$cont\">Edit ";
+ print "Management Node Grouping<br>\n";
+ if($compGroupCnt) {
+ $cont = addContinuationsEntry('viewMgmtnodeMapping');
+ print "<INPUT type=radio name=continuation value=\"$cont\">Edit ";
+ print "Management Node Mapping<br>\n";
+ }
+ }
+ if($mnAdminCnt || $mnGroupCnt)
+ print "<INPUT type=submit value=Submit>\n";
+ else {
+ print "You do not have access to manage any management nodes.<br>\n";
+ }
+ print "</FORM>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn viewMgmtnodes()
+///
+/// \brief prints a page to view management node information
+///
+////////////////////////////////////////////////////////////////////////////////
+function viewMgmtnodes() {
+ global $viewmode, $user, $mode;
+
+ $mgmtnodes = getManagementNodes();
+ $resources = getUserResources(array("mgmtNodeAdmin"), array("administer"));
+ $userMgmtnodeIDs = array_keys($resources["managementnode"]);
+ $premodules = getPredictiveModules();
+
+ print "<H2>Management Node Information</H2>\n";
+ if($mode == "submitAddMgmtnode") {
+ print "<font color=\"#008000\">Management node successfully added";
+ print "</font><br><br>\n";
+ }
+ elseif($mode == "submitEditMgmtnode") {
+ print "<font color=\"#008000\">Management node successfully updated";
+ print "</font><br><br>\n";
+ }
+ elseif($mode == "submitDeleteMgmtnode") {
+ print "<font color=\"#008000\">Management node successfully deleted";
+ print "</font><br><br>\n";
+ }
+ print "<TABLE border=1>\n";
+ print " <TR>\n";
+ print " <TD></TD>\n";
+ print " <TD></TD>\n";
+ print " <TH>Hostname</TH>\n";
+ print " <TH>IP address</TH>\n";
+ print " <TH>Owner</TH>\n";
+ print " <TH>State</TH>\n";
+ print " <TH>Predictive Loading Module</TH>\n";
+ print " <TH>Last Check In</TH>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TD></TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <TD><INPUT type=submit value=Add></TD>\n";
+ print " <TD><INPUT type=text name=hostname maxlength=50 size=15></TD>\n";
+ print " <TD><INPUT type=text name=IPaddress maxlength=15 size=15></TD>\n";
+ print " <TD><INPUT type=text name=owner size=15 value=\"";
+ print "{$user["unityid"]}@{$user['affiliation']}\"></TD>\n";
+ print " <TD>\n";
+ $mgmtnodestates = array(2 => "available", 1 => "deleted", 10 => "maintenance");
+ printSelectInput("stateid", $mgmtnodestates);
+ print " </TD>\n";
+ print " <TD>\n";
+ printSelectInput('premoduleid', $premodules);
+ print " </TD>\n";
+ print " <TD align=center>N/A</TD>\n";
+ $cont = addContinuationsEntry('confirmAddMgmtnode');
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " </FORM>\n";
+ print " </TR>\n";
+ foreach(array_keys($mgmtnodes) as $id) {
+ if(! in_array($id, $userMgmtnodeIDs))
+ continue;
+ print " <TR align=center>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('mgmtnodeid' => $id);
+ $cont = addContinuationsEntry('confirmDeleteMgmtnode', $cdata);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Delete>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('mgmtnodeid' => $id);
+ $cont = addContinuationsEntry('editMgmtNode', $cdata);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Edit>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>{$mgmtnodes[$id]["hostname"]}</TD>\n";
+ print " <TD>{$mgmtnodes[$id]["IPaddress"]}</TD>\n";
+ print " <TD>{$mgmtnodes[$id]["owner"]}</TD>\n";
+ print " <TD>{$mgmtnodes[$id]["state"]}</TD>\n";
+ print " <TD>{$mgmtnodes[$id]["predictivemodule"]}</TD>\n";
+ if($mgmtnodes[$id]["lastcheckin"] == "")
+ print " <TD>never</TD>\n";
+ else
+ print " <TD>" . $mgmtnodes[$id]["lastcheckin"] . "</TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn editOrAddMgmtnode($state)
+///
+/// \param $state - 0 for edit, 1 for add
+///
+/// \brief prints a form for editing an image
+///
+////////////////////////////////////////////////////////////////////////////////
+function editOrAddMgmtnode($state) {
+ global $submitErr;
+
+ $mgmtnodes = getManagementNodes();
+ $premodules = getPredictiveModules();
+
+ if($submitErr || $state == 1) {
+ $data = processMgmtnodeInput(0);
+ }
+ else {
+ $data["mgmtnodeid"] = getContinuationVar("mgmtnodeid");
+ $id = $data["mgmtnodeid"];
+ $data["hostname"] = $mgmtnodes[$id]["hostname"];
+ $data["IPaddress"] = $mgmtnodes[$id]["IPaddress"];
+ $data["owner"] = $mgmtnodes[$id]["owner"];
+ $data["stateid"] = $mgmtnodes[$id]["stateid"];
+ $data["premoduleid"] = $mgmtnodes[$id]["predictivemoduleid"];
+ }
+
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<DIV align=center>\n";
+ if($state) {
+ print "<H2>Add Management Node</H2>\n";
+ }
+ else {
+ print "<H2>Edit Management Node</H2>\n";
+ }
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TH align=right>Hostname:</TH>\n";
+ print " <TD><INPUT type=text name=hostname value=\"{$data["hostname"]}\" ";
+ print "maxlength=50></TD>\n";
+ print " <TD>";
+ printSubmitErr(MNHOSTNAMEERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>IP address:</TH>\n";
+ print " <TD><INPUT type=text name=IPaddress value=\"";
+ print $data["IPaddress"] . "\" maxlength=15></TD>\n";
+ print " <TD>";
+ printSubmitErr(IPADDRESSERR);
+ print "</TD>\n";
+ print " <TR>\n";
+ print " <TH align=right>Owner:</TH>\n";
+ print " <TD><INPUT type=text name=owner value=\"" . $data["owner"];
+ print "\"></TD>\n";
+ print " <TD>";
+ printSubmitErr(MNOWNERERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>State:</TH>\n";
+ print " <TD>\n";
+ $mgmtnodestates = array(2 => "available", 1 => "deleted", 10 => "maintenance",
+ 5 => "failed");
+ printSelectInput("stateid", $mgmtnodestates, $data["stateid"]);
+ print " </TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Predictive Loading Module:</TH>\n";
+ print " <TD>\n";
+ printSelectInput("premoduleid", $premodules, $data["premoduleid"]);
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ print "<TABLE>\n";
+ print " <TR valign=top>\n";
+ print " <TD>\n";
+ if($state) {
+ $cont = addContinuationsEntry('confirmAddMgmtnode', array(), SECINDAY, 0, 1, 1);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=\"Confirm Management Node\">\n";
+ }
+ else {
+ $cdata = array('mgmtnodeid' => $data['mgmtnodeid']);
+ $cont = addContinuationsEntry('confirmEditMgmtnode', $cdata, SECINDAY, 0, 1, 1);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=\"Confirm Changes\">\n";
+ }
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry('viewMgmtnodes');
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Cancel>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn confirmEditOrAddMgmtnode($state)
+///
+/// \param $state - 0 for edit, 1 for add
+///
+/// \brief prints a form for confirming changes to an image
+///
+////////////////////////////////////////////////////////////////////////////////
+function confirmEditOrAddMgmtnode($state) {
+ global $submitErr;
+
+ $data = processMgmtnodeInput(1);
+ $premodules = getPredictiveModules();
+
+ if($submitErr) {
+ editOrAddMgmtnode($state);
+ return;
+ }
+
+ if($state) {
+ $nextmode = "submitAddMgmtnode";
+ $title = "Add Management Node";
+ $question = "Add the following management node?";
+ }
+ else {
+ $nextmode = "submitEditMgmtnode";
+ $title = "Edit Management Node";
+ $question = "Submit changes to the management node?";
+ }
+ $mgmtnodestates = array(2 => "available", 1 => "deleted", 10 => "maintenance");
+
+ print "<DIV align=center>\n";
+ print "<H2>$title</H2>\n";
+ print "$question<br><br>\n";
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TH align=right>Hostname:</TH>\n";
+ print " <TD>{$data["hostname"]}</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>IP address:</TH>\n";
+ print " <TD>{$data["IPaddress"]}</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Owner:</TH>\n";
+ print " <TD>{$data["owner"]}</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>State:</TH>\n";
+ print " <TD>{$mgmtnodestates[$data["stateid"]]}</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Predictive Loading Module:</TH>\n";
+ print " <TD>{$premodules[$data["premoduleid"]]['prettyname']}</TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ print "<TABLE>\n";
+ print " <TR valign=top>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry($nextmode, $data, SECINDAY, 0, 0);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Submit>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry('viewMgmtnodes');
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Cancel>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitEditMgmtnode()
+///
+/// \brief submits changes to management node and notifies user
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitEditMgmtnode() {
+ $data = processMgmtnodeInput(0);
+ updateMgmtnode($data);
+ viewMgmtnodes();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitAddMgmtnode()
+///
+/// \brief processes form to add the management node
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitAddMgmtnode() {
+ $data = processMgmtnodeInput(0);
+ addMgmtnode($data);
+ clearPrivCache();
+ viewMgmtnodes();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn confirmDeleteMgmtnode()
+///
+/// \brief prints a page confirming deletion of a management node
+///
+////////////////////////////////////////////////////////////////////////////////
+function confirmDeleteMgmtnode() {
+ $mgmtnodeid = getContinuationVar("mgmtnodeid");
+ $nodes = getManagementNodes();
+
+ print "<DIV align=center>\n";
+ print "<H2>Delete Management Node</H2>\n";
+ print "Delete the following management node?<br><br>\n";
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TH align=right>Hostname:</TH>\n";
+ print " <TD>{$nodes[$mgmtnodeid]['hostname']}</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>IP address:</TH>\n";
+ print " <TD>{$nodes[$mgmtnodeid]['IPaddress']}</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Owner:</TH>\n";
+ print " <TD>{$nodes[$mgmtnodeid]['owner']}</TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ print "<TABLE>\n";
+ print " <TR valign=top>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('mgmtnodeid' => $mgmtnodeid);
+ $cont = addContinuationsEntry('submitDeleteMgmtnode', $cdata, SECINDAY, 0, 0);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Submit>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry('viewMgmtnodes');
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Cancel>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitDeleteMgmtnode()
+///
+/// \brief deletes a management node and calls viewMgmtnodes
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitDeleteMgmtnode() {
+ $mgmtnodeid = getContinuationVar("mgmtnodeid");
+ doQuery("DELETE FROM managementnode WHERE id = $mgmtnodeid", 385);
+ doQuery("DELETE FROM resource WHERE resourcetypeid = 16 AND subid = $mgmtnodeid", 385);
+ $_SESSION['userresources'] = array();
+ $_SESSION['usersessiondata'] = array();
+ viewMgmtnodes();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn viewMgmtnodeGrouping()
+///
+/// \brief prints a page to view and modify management node grouping
+///
+////////////////////////////////////////////////////////////////////////////////
+function viewMgmtnodeGrouping() {
+ global $mode;
+ $mgmtnodemembership = getResourceGroupMemberships("managementnode");
+ $resources = getUserResources(array("mgmtNodeAdmin"),
+ array("manageGroup"));
+ $tmp = getUserResources(array("mgmtNodeAdmin"),
+ array("manageGroup"), 1);
+ $mgmtnodegroups = $tmp["managementnode"];
+ uasort($mgmtnodegroups, "sortKeepIndex");
+ uasort($resources["managementnode"], "sortKeepIndex");
+ if(count($resources["managementnode"])) {
+ print "<H2>Management Node Grouping</H2>\n";
+ if($mode == "submitMgmtnodeGroups") {
+ print "<font color=\"#008000\">Management Node groups successfully updated";
+ print "</font><br><br>\n";
+ }
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<TABLE border=1>\n";
+ print " <TR>\n";
+ print " <TH rowspan=2>Management Node</TH>\n";
+ print " <TH colspan=" . count($mgmtnodegroups) . ">Groups</TH>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ foreach($mgmtnodegroups as $group) {
+ print " <TH>$group</TH>\n";
+ }
+ print " </TR>\n";
+ $count = 1;
+ foreach($resources["managementnode"] as $mgmtnodeid => $mgmtnode) {
+ if($count % 8 == 0) {
+ print " <TR>\n";
+ print " <TH><img src=images/blank.gif></TH>\n";
+ foreach($mgmtnodegroups as $group) {
+ print " <TH>$group</TH>\n";
+ }
+ print " </TR>\n";
+ }
+ print " <TR>\n";
+ print " <TH align=right>$mgmtnode</TH>\n";
+ foreach(array_keys($mgmtnodegroups) as $groupid) {
+ $name = "mgmtnodegroup[" . $mgmtnodeid . ":" . $groupid . "]";
+ if(array_key_exists($mgmtnodeid, $mgmtnodemembership["managementnode"]) &&
+ in_array($groupid, $mgmtnodemembership["managementnode"][$mgmtnodeid])) {
+ $checked = "checked";
+ }
+ else {
+ $checked = "";
+ }
+ print " <TD align=center>\n";
+ print " <INPUT type=checkbox name=\"$name\" $checked>\n";
+ print " </TD>\n";
+ }
+ print " </TR>\n";
+ $count++;
+ }
+ print "</TABLE>\n";
+ $cont = addContinuationsEntry('submitMgmtnodeGroups', array(), SECINDAY, 1, 0);
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "<INPUT type=submit value=\"Submit Changes\">\n";
+ print "<INPUT type=reset value=Reset>\n";
+ print "</FORM>\n";
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitMgmtnodeGroups
+///
+/// \brief updates image groupings
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitMgmtnodeGroups() {
+ $groupinput = processInputVar("mgmtnodegroup", ARG_MULTINUMERIC);
+
+ $mgmtnodes = getManagementNodes();
+
+ # build an array of memberships currently in the db
+ $tmp = getUserResources(array("groupAdmin"), array("manageGroup"), 1);
+ $mgmtnodegroupsIDs = array_keys($tmp["managementnode"]); // ids of groups that user can manage
+ $resources = getUserResources(array("mgmtNodeAdmin"),
+ array("manageGroup"));
+ $userMgmtnodeIDs = array_keys($resources["managementnode"]); // ids of images that user can manage
+ $mgmtnodemembership = getResourceGroupMemberships("managementnode");
+ $basemgmtnodegroups = $mgmtnodemembership["managementnode"]; // all image group memberships
+ $mgmtnodegroups = array();
+ foreach(array_keys($basemgmtnodegroups) as $mgmtnodeid) {
+ if(in_array($mgmtnodeid, $userMgmtnodeIDs)) {
+ foreach($basemgmtnodegroups[$mgmtnodeid] as $grpid) {
+ if(in_array($grpid, $mgmtnodegroupsIDs)) {
+ if(array_key_exists($mgmtnodeid, $mgmtnodegroups))
+ array_push($mgmtnodegroups[$mgmtnodeid], $grpid);
+ else
+ $mgmtnodegroups[$mgmtnodeid] = array($grpid);
+ }
+ }
+ }
+ }
+
+ # build an array of posted in memberships
+ $newmembers = array();
+ foreach(array_keys($groupinput) as $key) {
+ list($mgmtnodeid, $grpid) = explode(':', $key);
+ if(array_key_exists($mgmtnodeid, $newmembers)) {
+ array_push($newmembers[$mgmtnodeid], $grpid);
+ }
+ else {
+ $newmembers[$mgmtnodeid] = array($grpid);
+ }
+ }
+
+ $adds = array();
+ $removes = array();
+ foreach(array_keys($mgmtnodes) as $mgmtnodeid) {
+ $id = $mgmtnodes[$mgmtnodeid]["resourceid"];
+ // if $mgmtnodeid not in $userMgmtnodeIds, don't bother with it
+ if(! in_array($mgmtnodeid, $userMgmtnodeIDs))
+ continue;
+ // if $mgmtnodeid is not in $newmembers and not in $mgmtnodegroups, do nothing
+ if(! array_key_exists($mgmtnodeid, $newmembers) &&
+ ! array_key_exists($mgmtnodeid, $mgmtnodegroups)) {
+ continue;
+ }
+ // check that $mgmtnodeid is in $newmembers, if not, remove it from all groups
+ // user has access to
+ if(! array_key_exists($mgmtnodeid, $newmembers)) {
+ $removes[$id] = $mgmtnodegroups[$mgmtnodeid];
+ continue;
+ }
+ // check that $mgmtnodeid is in $mgmtnodegroups, if not, add all groups in
+ // $newmembers
+ if(! array_key_exists($mgmtnodeid, $mgmtnodegroups)) {
+ $adds[$id] = $newmembers[$mgmtnodeid];
+ continue;
+ }
+ // adds are groupids that are in $newmembers, but not in $mgmtnodegroups
+ $adds[$id] = array_diff($newmembers[$mgmtnodeid], $mgmtnodegroups[$mgmtnodeid]);
+ if(count($adds[$id]) == 0) {
+ unset($adds[$id]);
+ }
+ // removes are groupids that are in $mgmtnodegroups, but not in $newmembers
+ $removes[$id] = array_diff($mgmtnodegroups[$mgmtnodeid], $newmembers[$mgmtnodeid]);
+ if(count($removes[$id]) == 0) {
+ unset($removes[$id]);
+ }
+ }
+
+ foreach(array_keys($adds) as $mgmtnodeid) {
+ foreach($adds[$mgmtnodeid] as $grpid) {
+ $query = "INSERT INTO resourcegroupmembers "
+ . "(resourceid, resourcegroupid) "
+ . "VALUES ($mgmtnodeid, $grpid)";
+ doQuery($query, 287);
+ }
+ }
+
+ foreach(array_keys($removes) as $mgmtnodeid) {
+ foreach($removes[$mgmtnodeid] as $grpid) {
+ $query = "DELETE FROM resourcegroupmembers "
+ . "WHERE resourceid = $mgmtnodeid AND "
+ . "resourcegroupid = $grpid";
+ doQuery($query, 288);
+ }
+ }
+
+ viewMgmtnodeGrouping();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn viewMgmtnodeMapping($mngroups)
+///
+/// \param $mngroups - (optional) array of mngroups as returned by
+/// getUserResources
+///
+/// \brief prints a page to view and edit management node to computer group
+/// mappings
+///
+////////////////////////////////////////////////////////////////////////////////
+function viewMgmtnodeMapping($mngroups=0) {
+ global $mode;
+ if(! is_array($mngroups)) {
+ $tmp = getUserResources(array("mgmtNodeAdmin"),
+ array("manageGroup"), 1);
+ $mngroups = $tmp["managementnode"];
+ }
+ $mapping = getResourceMapping("managementnode", "computer");
+ $resources2 = getUserResources(array("computerAdmin"),
+ array("manageGroup"), 1);
+ $compgroups = $resources2["computer"];
+ uasort($compgroups, "sortKeepIndex");
+
+ if(count($mngroups) && count($compgroups)) {
+ print "<H2>Management Node Group to Computer Group Mapping</H2>\n";
+ if($mode == "submitMgmtnodeMapping") {
+ print "<font color=\"#008000\">Management node group to computer ";
+ print "group mapping successfully updated";
+ print "</font><br><br>\n";
+ }
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<TABLE border=1>\n";
+ print " <col>\n";
+ foreach(array_keys($compgroups) as $id) {
+ print " <col id=compgrp$id>\n";
+ }
+ print " <TR>\n";
+ print " <TH rowspan=2>Management Node Group</TH>\n";
+ print " <TH class=nohlcol colspan=" . count($compgroups) . ">Computer Groups</TH>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ foreach($compgroups as $id => $group) {
+ print " <TH onclick=\"toggleColSelect('compgrp$id');\">$group</TH>\n";
+ }
+ print " </TR>\n";
+ $count = 1;
+ foreach($mngroups as $mnid => $mnname) {
+ if($count % 12 == 0) {
+ print " <TR>\n";
+ print " <TH><img src=images/blank.gif></TH>\n";
+ foreach($compgroups as $id => $group) {
+ print " <TH onclick=\"toggleColSelect('compgrp$id');\">$group</TH>\n";
+ }
+ print " </TR>\n";
+ }
+ print " <TR id=mngrpid$mnid>\n";
+ print " <TH align=right onclick=\"toggleRowSelect('mngrpid$mnid');\">$mnname</TH>\n";
+ foreach($compgroups as $compid => $compname) {
+ $name = "mapping[" . $mnid . ":" . $compid . "]";
+ if(array_key_exists($mnid, $mapping) &&
+ in_array($compid, $mapping[$mnid])) {
+ $checked = "checked";
+ }
+ else
+ $checked = "";
+ print " <TD align=center>\n";
+ print " <INPUT type=checkbox name=\"$name\" $checked>\n";
+ print " </TD>\n";
+ }
+ print " </TR>\n";
+ $count++;
+ }
+ print "</TABLE>\n";
+ $cont = addContinuationsEntry('submitMgmtnodeMapping', array(), SECINDAY, 1, 0);
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "<INPUT type=submit value=\"Submit Changes\">\n";
+ print "<INPUT type=reset value=Reset>\n";
+ print "</FORM>\n";
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitMgmtnodeMapping
+///
+/// \brief updates management node group to computer group mapping
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitMgmtnodeMapping() {
+ $mapinput = processInputVar("mapping", ARG_MULTINUMERIC);
+ $mntypeid = getResourceTypeID("managementnode");
+ $comptypeid = getResourceTypeID("computer");
+
+ # build an array of memberships currently in the db
+ $tmp = getUserResources(array("mgmtNodeAdmin"),
+ array("manageGroup"), 1);
+ $mngroups = $tmp["managementnode"];
+ $tmp = getUserResources(array("computerAdmin"),
+ array("manageGroup"), 1);
+ $compgroups = $tmp["computer"];
+ $mninlist = implode(',', array_keys($mngroups));
+ $compinlist = implode(',', array_keys($compgroups));
+ $mapping = getResourceMapping("managementnode", "computer", $mninlist,
+ $compinlist);
+
+ # build an array of posted in memberships
+ $newmembers = array();
+ foreach(array_keys($mapinput) as $key) {
+ list($mnid, $compid) = explode(':', $key);
+ if(array_key_exists($mnid, $newmembers))
+ array_push($newmembers[$mnid], $compid);
+ else
+ $newmembers[$mnid] = array($compid);
+ }
+
+ $adds = array();
+ $removes = array();
+ foreach(array_keys($mngroups) as $mnid) {
+ // if $mnid is not in $newmembers and not in $mapping, do nothing
+ if(! array_key_exists($mnid, $newmembers) &&
+ ! array_key_exists($mnid, $mapping)) {
+ continue;
+ }
+ // check that $mnid is in $newmembers, if not, remove it from all groups
+ // user has access to
+ if(! array_key_exists($mnid, $newmembers)) {
+ $removes[$mnid] = $mapping[$mnid];
+ continue;
+ }
+ // check that $mnid is in $mapping, if not, add all groups in
+ // $newmembers
+ if(! array_key_exists($mnid, $mapping)) {
+ $adds[$mnid] = $newmembers[$mnid];
+ continue;
+ }
+ // adds are groupids that are in $newmembers, but not in $mapping
+ $adds[$mnid] = array_diff($newmembers[$mnid], $mapping[$mnid]);
+ if(count($adds[$mnid]) == 0) {
+ unset($adds[$mnid]);
+ }
+ // removes are groupids that are in $mapping, but not in $newmembers
+ $removes[$mnid] = array_diff($mapping[$mnid], $newmembers[$mnid]);
+ if(count($removes[$mnid]) == 0) {
+ unset($removes[$mnid]);
+ }
+ }
+
+ foreach(array_keys($adds) as $mnid) {
+ foreach($adds[$mnid] as $compid) {
+ $query = "INSERT INTO resourcemap "
+ . "(resourcegroupid1, "
+ . "resourcetypeid1, "
+ . "resourcegroupid2, "
+ . "resourcetypeid2) "
+ . "VALUES ($mnid, "
+ . "$mntypeid, "
+ . "$compid, "
+ . "$comptypeid)";
+ doQuery($query, 101);
+ }
+ }
+
+ foreach(array_keys($removes) as $mnid) {
+ foreach($removes[$mnid] as $compid) {
+ $query = "DELETE FROM resourcemap "
+ . "WHERE resourcegroupid1 = $mnid AND "
+ . "resourcetypeid1 = $mntypeid AND "
+ . "resourcegroupid2 = $compid AND "
+ . "resourcetypeid2 = $comptypeid";
+ doQuery($query, 101);
+ }
+ }
+
+ viewMgmtnodeMapping();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn updateMgmtnode($data)
+///
+/// \param $data - an array returned from processMgmtnodeInput
+///
+/// \return number of rows affected by the update\n
+/// \b NOTE: mysql reports that no rows were affected if none of the fields
+/// were actually changed even if the update matched a row
+///
+/// \brief performs a query to update the management node with data from $data
+///
+////////////////////////////////////////////////////////////////////////////////
+function updateMgmtnode($data) {
+ $ownerid = getUserlistID($data["owner"]);
+ $query = "UPDATE managementnode "
+ . "SET hostname = '{$data["hostname"]}', "
+ . "IPaddress = '{$data["IPaddress"]}', "
+ . "ownerid = $ownerid, "
+ . "stateid = {$data["stateid"]}, "
+ . "predictivemoduleid = {$data["premoduleid"]} "
+ . "WHERE id = " . $data["mgmtnodeid"];
+ $qh = doQuery($query, 101);
+ return mysql_affected_rows($GLOBALS["mysql_link_vcl"]);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn addMgmtnode($data)
+///
+/// \param $data - an array returned from processMgmtnodeInput
+///
+/// \return number of rows affected by the insert\n
+///
+/// \brief performs a query to insert the management node with data from $data
+///
+////////////////////////////////////////////////////////////////////////////////
+function addMgmtnode($data) {
+ $ownerid = getUserlistID($data["owner"]);
+ $query = "INSERT INTO managementnode "
+ . "(hostname, "
+ . "IPaddress, "
+ . "ownerid, "
+ . "stateid, "
+ . "predictivemoduleid) "
+ . "VALUES ('{$data["hostname"]}', "
+ . "'{$data["IPaddress"]}', "
+ . "$ownerid, "
+ . "{$data["stateid"]}, "
+ . "{$data["premoduleid"]})";
+ doQuery($query, 205);
+
+ // get last insert id
+ $qh = doQuery("SELECT LAST_INSERT_ID() FROM managementnode", 101);
+ if(! $row = mysql_fetch_row($qh)) {
+ abort(101);
+ }
+ $id = $row[0];
+
+ // add entry in resource table
+ $query = "INSERT INTO resource "
+ . "(resourcetypeid, "
+ . "subid) "
+ . "VALUES (16, "
+ . "$id)";
+ doQuery($query, 209);
+
+ return $id;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn processMgmtnodeInput($checks)
+///
+/// \param $checks - (optional) 1 to perform validation, 0 not to
+///
+/// \return an array with the following indexes:\n
+/// mgmtnodeid, hostname, IPaddress, owner, stateid
+///
+/// \brief validates input from the previous form; if anything was improperly
+/// submitted, sets submitErr and submitErrMsg
+///
+////////////////////////////////////////////////////////////////////////////////
+function processMgmtnodeInput($checks=1) {
+ global $submitErr, $submitErrMsg, $user, $mode;
+ $return = array();
+ $mgmtnodes = getManagementNodes();
+ $return["mgmtnodeid"] = getContinuationVar("mgmtnodeid");
+ $return["hostname"] = getContinuationVar("hostname", processInputVar("hostname" , ARG_STRING));
+ $return["IPaddress"] = getContinuationVar("IPaddress", processInputVar("IPaddress", ARG_STRING));
+ $return["owner"] = getContinuationVar("owner", processInputVar("owner", ARG_STRING, $user["unityid"]));
+ $return["stateid"] = getContinuationVar("stateid", processInputVar("stateid", ARG_STRING));
+ $return["premoduleid"] = getContinuationVar("premoduleid", processInputVar("premoduleid", ARG_NUMERIC));
+
+ if(! $checks) {
+ return $return;
+ }
+
+ if(! ereg('^[a-zA-Z0-9_][-a-zA-Z0-9_.]{1,49}$', $return["hostname"])) {
+ $submitErr |= MNHOSTNAMEERR;
+ $submitErrMsg[MNHOSTNAMEERR] = "Hostname must be <= 50 characters";
+ }
+ if(! ($submitErr & MNHOSTNAMEERR) &&
+ $mode != "confirmEditMgmtnode" &&
+ checkForMgmtnodeHostname($return["hostname"])) {
+ $submitErr |= MNHOSTNAMEERR;
+ $submitErrMsg[MNHOSTNAMEERR] = "A node already exists with this hostname.";
+ }
+ $ipaddrArr = explode('.', $return["IPaddress"]);
+ if(! ereg('^(([0-9]){1,3}\.){3}([0-9]){1,3}$', $return["IPaddress"]) ||
+ $ipaddrArr[0] < 1 || $ipaddrArr[0] > 255 ||
+ $ipaddrArr[1] < 0 || $ipaddrArr[1] > 255 ||
+ $ipaddrArr[2] < 0 || $ipaddrArr[2] > 255 ||
+ $ipaddrArr[3] < 1 || $ipaddrArr[3] > 255) {
+ $submitErr |= IPADDRESSERR;
+ $submitErrMsg[IPADDRESSERR] = "Invalid IP address. Must be w.x.y.z with each of "
+ . "w, x, y, and z being between 1 and 255 (inclusive)";
+ }
+ if($mode != "confirmEditMgmtnode" &&
+ ! ($submitErr & IPADDRESSERR) &&
+ checkForMgmtnodeIPaddress($return["IPaddress"])) {
+ $submitErr |= IPADDRESSERR;
+ $submitErrMsg[IPADDRESSERR] = "A node already exists with this IP address.";
+ }
+ if(! validateUserid($return["owner"])) {
+ $submitErr |= MNOWNERERR;
+ $submitErrMsg[MNOWNERERR] = "Submitted ID is not valid";
+ }
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn checkForMgmtnodeHostname($hostname)
+///
+/// \param $hostname - a computer hostname
+///
+/// \return 0 if $hostname is not in managementnode table, 1 if it is
+///
+/// \brief checks for the existance of $hostname in the managementnode table
+///
+////////////////////////////////////////////////////////////////////////////////
+function checkForMgmtnodeHostname($hostname) {
+ $query = "SELECT id FROM managementnode WHERE hostname = '$hostname'";
+ $qh = doQuery($query, 101);
+ return mysql_num_rows($qh);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn checkForMgmtnodeIPaddress($addr)
+///
+/// \param $addr - a computer ip address
+///
+/// \return 0 if $addr is not in managementnode table, 1 if it is
+///
+/// \brief checks for the existance of $addr in the managementnode table
+///
+////////////////////////////////////////////////////////////////////////////////
+function checkForMgmtnodeIPaddress($addr) {
+ $query = "SELECT id FROM managementnode WHERE IPaddress = '$addr'";
+ $qh = doQuery($query, 101);
+ return mysql_num_rows($qh);
+}
+
+?>
diff --git a/web/.ht-inc/php5extras.php b/web/.ht-inc/php5extras.php
new file mode 100644
index 0000000..f89190c
--- /dev/null
+++ b/web/.ht-inc/php5extras.php
@@ -0,0 +1,20 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+date_default_timezone_set('America/New_York');
+?>
diff --git a/web/.ht-inc/privileges.php b/web/.ht-inc/privileges.php
new file mode 100644
index 0000000..9db653b
--- /dev/null
+++ b/web/.ht-inc/privileges.php
@@ -0,0 +1,2761 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+/**
+ * \file
+ */
+
+/// signifies an error with the submitted new node name
+define("NEWNODENAMEERR", 1);
+/// signifies an error with the submitted new user id
+define("NEWUSERERR", 1);
+/// signifies no privs were submitted with the new user
+define("ADDUSERNOPRIVS", 1 << 1);
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn viewNodes()
+///
+/// \brief prints a node privilege tree and the privliges at the node
+///
+////////////////////////////////////////////////////////////////////////////////
+function viewNodes() {
+ global $user;
+ # FIXME change activeNode if current one has been deleted
+ $mode = processInputVar("mode", ARG_STRING);
+ $tmp = processInputVar("openNodes", ARG_STRING);
+ if($tmp != "")
+ $openNodes = explode(":", $tmp);
+ else {
+ if(! empty($_COOKIE["VCLNODES"]))
+ $openNodes = explode(":", $_COOKIE["VCLNODES"]);
+ else
+ $openNodes = array(DEFAULT_PRIVNODE);
+ }
+ $topNodes = getChildNodes();
+ if(count($topNodes)) {
+ $keys = array_keys($topNodes);
+ $defaultActive = array_shift($keys);
+ }
+ $activeNode = processInputVar("activeNode", ARG_NUMERIC);
+ if(empty($activeNode))
+ if(! empty($_COOKIE["VCLACTIVENODE"]) &&
+ nodeExists($_COOKIE['VCLACTIVENODE']))
+ $activeNode = $_COOKIE["VCLACTIVENODE"];
+ else
+ $activeNode = $defaultActive;
+
+ $hasNodeAdmin = checkUserHasPriv("nodeAdmin", $user["id"], $activeNode);
+
+ # tree
+ print "<H2>Privilege Tree</H2>\n";
+ /*if($mode == "submitAddChildNode") {
+ print "<font color=\"#008000\">Node successfully added to tree";
+ print "</font><br><br>\n";
+ }
+ if($mode == "submitDeleteNode") {
+ print "<font color=\"#008000\">Nodes successfully deleted from tree";
+ print "</font><br><br>\n";
+ }*/
+ print "<dojo:TreeSelector widgetId=treeSelector eventNames=select:nodeSelected></dojo:TreeSelector>\n";
+ #print "<dojo:TreeRPCController RPCUrl=local widgetId=treeController></dojo:TreeRPCController>\n";
+ print "<div dojoType=Tree widgetId=privTree selector=treeSelector>\n";
+ recursivePrintNodes2($topNodes, $openNodes, $activeNode);
+ print "</div>\n";
+
+ print "<div id=treebuttons>\n";
+ if($hasNodeAdmin) {
+ $openNodes = implode(":", $openNodes);
+ print "<TABLE>\n";
+ print " <TR valign=top>\n";
+ print " <TD><FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <button id=addNodeBtn dojoType=Button ";
+ print "onClick=\"showAddNodePane(); return false;\">";
+ print "Add Child</button>\n";
+ print " </FORM></TD>\n";
+ print " <TD><FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <button id=deleteNodeBtn dojoType=Button onClick=\"dojo.widget.byId('deleteDialog').show();\">";
+ print "Delete Node and Children</button>\n";
+ print " </FORM></TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ }
+ print "</div>\n";
+ $cont = addContinuationsEntry('selectNode');
+ print "<INPUT type=hidden id=nodecont value=\"$cont\">\n";
+
+ # privileges
+ print "<H2>Privileges at Selected Node</H2>\n";
+ $node = $activeNode;
+ if($openNodes == "")
+ $openNodes = DEFAULT_PRIVNODE;
+
+ $nodeInfo = getNodeInfo($node);
+ $privs = getNodePrivileges($node);
+ $cascadePrivs = getNodeCascadePrivileges($node);
+ $usertypes = getTypes("users");
+ $i = 0;
+ $hasUserGrant = checkUserHasPriv("userGrant", $user["id"], $node,
+ $privs, $cascadePrivs);
+ $hasResourceGrant = checkUserHasPriv("resourceGrant", $user["id"],
+ $node, $privs, $cascadePrivs);
+
+ print "<div id=nodePerms>\n";
+
+ # users
+ print "<A name=\"users\"></a>\n";
+ print "<div id=usersDiv>\n";
+ print "<H3>Users</H3>\n";
+ print "<FORM id=usersform action=\"" . BASEURL . SCRIPT . "#users\" method=post>\n";
+ $users = array();
+ if(count($privs["users"]) || count($cascadePrivs["users"])) {
+ print "<TABLE border=1 summary=\"\">\n";
+ print " <TR>\n";
+ print " <TD></TD>\n";
+ print " <TH bgcolor=gray style=\"color: black;\">Block<br>Cascaded<br>Rights</TH>\n";
+ print " <TH bgcolor=\"#008000\" style=\"color: black;\">Cascade<br>to Child<br>Nodes</TH>\n";
+ foreach($usertypes["users"] as $type) {
+ $img = getImageText($type);
+ print " <TD>$img</TD>\n";
+ }
+ print " </TR>\n";
+ $users = array_unique(array_merge(array_keys($privs["users"]),
+ array_keys($cascadePrivs["users"])));
+ sort($users);
+ foreach($users as $_user) {
+ printUserPrivRow($_user, $i, $privs["users"], $usertypes["users"],
+ $cascadePrivs["users"], 'user', ! $hasUserGrant);
+ $i++;
+ }
+ print "</TABLE>\n";
+ print "<div id=lastUserNum class=hidden>" . ($i - 1) . "</div>\n";
+ if($hasUserGrant) {
+ $cont = addContinuationsEntry('AJchangeUserPrivs');
+ print "<INPUT type=hidden id=changeuserprivcont value=\"$cont\">\n";
+ }
+ }
+ else {
+ print "There are no user privileges at the selected node.<br>\n";
+ }
+ if($hasUserGrant) {
+ print "<BUTTON id=addUserBtn dojoType=Button onclick=\"showAddUserPane(); return false;\">";
+ print "Add User</button>\n";
+ }
+ print "</FORM>\n";
+ print "</div>\n";
+
+ # groups
+ print "<A name=\"groups\"></a>\n";
+ print "<div id=usergroupsDiv>\n";
+ print "<H3>User Groups</H3>\n";
+ if(count($privs["usergroups"]) || count($cascadePrivs["usergroups"])) {
+ print "<FORM action=\"" . BASEURL . SCRIPT . "#groups\" method=post>\n";
+ print "<div id=firstUserGroupNum class=hidden>$i</div>";
+ print "<TABLE border=1 summary=\"\">\n";
+ print " <TR>\n";
+ print " <TD></TD>\n";
+ print " <TH bgcolor=gray style=\"color: black;\">Block<br>Cascaded<br>Rights</TH>\n";
+ #$img = getImageText("Block Cascaded Rights");
+ #print " <TD>$img</TD>\n";
+ print " <TH bgcolor=\"#008000\" style=\"color: black;\">Cascade<br>to Child<br>Nodes</TH>\n";
+ #$img = getImageText("Cascade to Child Nodes");
+ #print " <TD>$img</TD>\n";
+ foreach($usertypes["users"] as $type) {
+ $img = getImageText($type);
+ print " <TH>$img</TH>\n";
+ }
+ print " </TR>\n";
+ $groups = array_unique(array_merge(array_keys($privs["usergroups"]),
+ array_keys($cascadePrivs["usergroups"])));
+ sort($groups);
+ foreach($groups as $group) {
+ printUserPrivRow($group, $i, $privs["usergroups"], $usertypes["users"],
+ $cascadePrivs["usergroups"], 'group', ! $hasUserGrant);
+ $i++;
+ }
+ print "</TABLE>\n";
+ print "<div id=lastUserGroupNum class=hidden>" . ($i - 1) . "</div>";
+ if($hasUserGrant) {
+ $cont = addContinuationsEntry('AJchangeUserGroupPrivs');
+ print "<INPUT type=hidden id=changeusergroupprivcont value=\"$cont\">\n";
+ }
+ }
+ else {
+ print "There are no user group privileges at the selected node.<br>\n";
+ $groups = array();
+ }
+ if($hasUserGrant) {
+ print "<BUTTON id=addGroupBtn dojoType=Button onclick=\"showAddUserGroupPane(); return false;\">";
+ print "Add Group</button>\n";
+ }
+ print "</FORM>\n";
+ print "</div>\n";
+
+ # resources
+ $resourcetypes = array("available", "administer", "manageGroup");
+ print "<A name=\"resources\"></a>\n";
+ print "<div id=resourcesDiv>\n";
+ print "<H3>Resources</H3>\n";
+ print "<FORM id=resourceForm action=\"" . BASEURL . SCRIPT . "#resources\" method=post>\n";
+ if(count($privs["resources"]) || count($cascadePrivs["resources"])) {
+ print "<TABLE border=1 summary=\"\">\n";
+ print " <TR>\n";
+ print " <TH>Group<br>Name</TH>\n";
+ print " <TH>Group<br>Type</TH>\n";
+ print " <TH bgcolor=gray style=\"color: black;\">Block<br>Cascaded<br>Rights</TH>\n";
+ print " <TH bgcolor=\"#008000\" style=\"color: black;\">Cascade<br>to Child<br>Nodes</TH>\n";
+ foreach($resourcetypes as $type) {
+ $img = getImageText("$type");
+ print " <TH>$img</TH>\n";
+ }
+ print " </TR>\n";
+ $resources = array_unique(array_merge(array_keys($privs["resources"]),
+ array_keys($cascadePrivs["resources"])));
+ sort($resources);
+ $resourcegroups = getResourceGroups();
+ $resgroupmembers = getResourceGroupMembers();
+ foreach($resources as $resource) {
+ printResourcePrivRow($resource, $i, $privs["resources"], $resourcetypes,
+ $resourcegroups, $resgroupmembers,
+ $cascadePrivs["resources"], ! $hasResourceGrant);
+ $i++;
+ }
+ print "</TABLE>\n";
+ if($hasResourceGrant) {
+ $cont = addContinuationsEntry('AJchangeResourcePrivs');
+ print "<INPUT type=hidden id=changeresourceprivcont value=\"$cont\">\n";
+ }
+ }
+ else {
+ print "There are no resource group privileges at the selected node.<br>\n";
+ $resources = array();
+ }
+ if($hasResourceGrant) {
+ print "<BUTTON id=addResourceBtn dojoType=Button onclick=\"showAddResourceGroupPane(); return false;\">";
+ print "Add Resource Group</button>\n";
+ }
+ print "</FORM>\n";
+ print "</div>\n";
+ print "</div>\n";
+
+ print "<div dojoType=FloatingPane\n";
+ print " id=addUserPane\n";
+ print " title=\"Add User Permission\"\n";
+ print " constrainToContainer=false\n";
+ print " hasShadow=true\n";
+ print " resizable=true\n";
+ print " style=\"width: 520px; height: 410px; position: absolute; left: 15; top: 250px; display: none\"\n";
+ print ">\n";
+ print "<H2>Add User</H2>\n";
+ print "<div id=addPaneNodeName></div>\n";
+ print "<TABLE border=1 summary=\"\">\n";
+ print " <TR>\n";
+ print " <TD></TD>\n";
+ print " <TH bgcolor=gray style=\"color: black;\">Block<br>Cascaded<br>Rights</TH>\n";
+ print " <TH bgcolor=\"#008000\" style=\"color: black;\">Cascade<br>to Child<br>Nodes</TH>\n";
+ foreach($usertypes["users"] as $type) {
+ $img = getImageText($type);
+ print " <TD>$img</TD>\n";
+ }
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TD><INPUT type=text id=newuser name=newuser size=15";
+ print "></TD>\n";
+
+ # block rights
+ $count = count($usertypes) + 1;
+ print " <TD align=center bgcolor=gray><INPUT type=checkbox ";
+ print "dojoType=Checkbox id=blockchk name=block></TD>\n";
+
+ #cascade rights
+ print " <TD align=center bgcolor=\"#008000\" id=usercell0:0>";
+ print "<INPUT type=checkbox dojoType=Checkbox id=userck0:0 name=cascade ";
+ print "></TD>\n";
+
+ # normal rights
+ $j = 1;
+ foreach($usertypes["users"] as $type) {
+ print " <TD align=center id=usercell0:$j><INPUT type=checkbox ";
+ print "dojoType=Checkbox name=\"$type\" id=userck0:$j></TD>\n";
+ $j++;
+ }
+ print " </TR>\n";
+ print "</TABLE>\n";
+ print "<div id=addUserPrivStatus></div>\n";
+ print "<TABLE summary=\"\"><TR>\n";
+ print "<TD><button id=submitAddUserBtn dojoType=Button onclick=\"submitAddUser();\">";
+ print "Submit New User</button></TD>\n";
+ print "<TD><button id=cancelAddUserBtn dojoType=Button onclick=\"addUserPaneHide();\">";
+ print "Cancel</button></TD>\n";
+ print "</TR></TABLE>\n";
+ $cont = addContinuationsEntry('AJsubmitAddUserPriv');
+ print "<INPUT type=hidden id=addusercont value=\"$cont\">\n";
+ print "</div>\n";
+
+ print "<div dojoType=FloatingPane\n";
+ print " id=addUserGroupPane\n";
+ print " title=\"Add User Group Permission\"\n";
+ print " constrainToContainer=false\n";
+ print " hasShadow=true\n";
+ print " resizable=true\n";
+ print " style=\"width: 520px; height: 410px; position: absolute; left: 15; top: 450px; display: none\"\n";
+ print ">\n";
+ print "<H2>Add User Group</H2>\n";
+ print "<div id=addGroupPaneNodeName></div>\n";
+ print "<TABLE border=1 summary=\"\">\n";
+ print " <TR>\n";
+ print " <TD></TD>\n";
+ print " <TH bgcolor=gray style=\"color: black;\">Block<br>Cascaded<br>Rights</TH>\n";
+ print " <TH bgcolor=\"#008000\" style=\"color: black;\">Cascade<br>to Child<br>Nodes</TH>\n";
+ foreach($usertypes["users"] as $type) {
+ $img = getImageText($type);
+ print " <TD>$img</TD>\n";
+ }
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TD>\n";
+ # FIXME should $groups be only the user's groups?
+ $groups = getUserGroups(0, $user['affiliationid']);
+ if(array_key_exists(82, $groups))
+ unset($groups[82]); # remove None group
+ printSelectInput("newgroupid", $groups, -1, 0, 0, 'newgroupid');
+ print " </TD>\n";
+
+ # block rights
+ print " <TD align=center bgcolor=gray><INPUT type=checkbox ";
+ print "dojoType=Checkbox id=blockgrpchk name=blockgrp></TD>\n";
+
+ #cascade rights
+ print " <TD align=center bgcolor=\"#008000\" id=grpcell0:0>";
+ print "<INPUT type=checkbox dojoType=Checkbox id=usergrpck0:0 ";
+ print "name=cascadegrp></TD>\n";
+
+ # normal rights
+ $j = 1;
+ foreach($usertypes["users"] as $type) {
+ print " <TD align=center id=usergrpcell0:$j><INPUT type=checkbox ";
+ print "dojoType=Checkbox name=\"$type\" id=usergrpck0:$j></TD>\n";
+ $j++;
+ }
+ print " </TR>\n";
+ print "</TABLE>\n";
+ print "<div id=addUserGroupPrivStatus></div>\n";
+ print "<TABLE summary=\"\"><TR>\n";
+ print "<TD><button id=submitAddGroupBtn dojoType=Button onclick=\"submitAddUserGroup();\">";
+ print "Submit New User Group</button></TD>\n";
+ print "<TD><button id=cancelAddGroupBtn dojoType=Button onclick=\"addUserGroupPaneHide();\">";
+ print "Cancel</button></TD>\n";
+ print "</TR></TABLE>\n";
+ $cont = addContinuationsEntry('AJsubmitAddUserGroupPriv');
+ print "<INPUT type=hidden id=addusergroupcont value=\"$cont\">\n";
+ print "</div>\n";
+
+ print "<div dojoType=FloatingPane\n";
+ print " id=addResourceGroupPane\n";
+ print " title=\"Add Resource Group Permission\"\n";
+ print " constrainToContainer=false\n";
+ print " hasShadow=true\n";
+ print " resizable=true\n";
+ print " style=\"width: 520px; height: 410px; position: absolute; left: 15; top: 450px; display: none\"\n";
+ print ">\n";
+ print "<H2>Add Resource Group</H2>\n";
+ print "<div id=addResourceGroupPaneNodeName></div>\n";
+ print "<TABLE border=1 summary=\"\">\n";
+ print " <TR>\n";
+ print " <TD></TD>\n";
+ print " <TH bgcolor=gray style=\"color: black;\">Block<br>Cascaded<br>Rights</TH>\n";
+ print " <TH bgcolor=\"#008000\" style=\"color: black;\">Cascade<br>to Child<br>Nodes</TH>\n";
+ $resourcetypes = array("available", "administer", "manageGroup");
+ foreach($resourcetypes as $type) {
+ $img = getImageText("$type");
+ print " <TH>$img</TH>\n";
+ }
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TD>\n";
+ $resources = array();
+ $privs = array("computerAdmin","mgmtNodeAdmin", "imageAdmin", "scheduleAdmin");
+ $resourcesgroups = getUserResources($privs, array("manageGroup"), 1);
+ foreach(array_keys($resourcesgroups) as $type) {
+ foreach($resourcesgroups[$type] as $id => $group) {
+ $resources[$id] = $type . "/" . $group;
+ }
+ }
+ printSelectInput("newresourcegroupid", $resources, -1, 0, 0, 'newresourcegroupid');
+ print " </TD>\n";
+
+ # block rights
+ print " <TD align=center bgcolor=gray><INPUT type=checkbox ";
+ print "dojoType=Checkbox id=blockresgrpck name=blockresgrp></TD>\n";
+
+ #cascade rights
+ print " <TD align=center bgcolor=\"#008000\" id=resgrpcell0:0>";
+ print "<INPUT type=checkbox dojoType=Checkbox id=resgrpck0:0 ";
+ print "name=cascaderesgrp></TD>\n";
+
+ # normal rights
+ print " <TD align=center id=resgrpcell0:1><INPUT type=checkbox ";
+ print "dojoType=Checkbox name=available id=resgrpck0:1></TD>\n";
+ print " <TD align=center id=resgrpcell0:2><INPUT type=checkbox ";
+ print "dojoType=Checkbox name=administer id=resgrpck0:2></TD>\n";
+ print " <TD align=center id=resgrpcell0:3><INPUT type=checkbox ";
+ print "dojoType=Checkbox name=manageGroup id=resgrpck0:3></TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ print "<div id=addResourceGroupPrivStatus></div>\n";
+ print "<TABLE summary=\"\"><TR>\n";
+ print "<TD><button dojoType=Button onclick=\"submitAddResourceGroup();\">";
+ print "Submit New Resource Group</button></TD>\n";
+ print "<TD><button dojoType=Button onclick=\"addResourceGroupPaneHide();\">";
+ print "Cancel</button></TD>\n";
+ print "</TR></TABLE>\n";
+ $cont = addContinuationsEntry('AJsubmitAddResourcePriv');
+ print "<INPUT type=hidden id=addresourcegroupcont value=\"$cont\">\n";
+ print "</div>\n";
+
+ print "<div dojoType=FloatingPane\n";
+ print " id=addNodePane\n";
+ print " title=\"Add Child Node\"\n";
+ print " constrainToContainer=false\n";
+ print " hasShadow=true\n";
+ print " resizable=true\n";
+ print " style=\"width: 280px; height: 200px; position: absolute; left: 15; top: 150px; display: none\"\n";
+ print ">\n";
+ print "<H2>Add Child Node</H2>\n";
+ print "<div id=addChildNodeName></div>\n";
+ print "<strong>New Node:</strong> <INPUT type=text id=childNodeName>\n";
+ print "<div id=addChildNodeStatus></div>\n";
+ print "<TABLE summary=\"\"><TR>\n";
+ print "<TD><button id=submitAddNodeBtn dojoType=Button onclick=\"submitAddChildNode();\">";
+ print "Create Child</button></TD>\n";
+ print "<TD><button id=cancelAddNodeBtn dojoType=Button onclick=\"addNodePaneHide();\">";
+ print "Cancel</button></TD>\n";
+ print "</TR></TABLE>\n";
+ $cont = addContinuationsEntry('AJsubmitAddChildNode');
+ print "<INPUT type=hidden id=addchildcont value=\"$cont\"\n>";
+ print "</div>\n";
+
+ print "<div dojoType=dialog id=deleteDialog bgColor=white bgOpacity=0.5 toggle=fade toggleDuration=250>\n";
+ print "Delete the following node and all of its children?<br><br>\n";
+ print "<div id=deleteNodeName></div><br>\n";
+ print "<div align=center>\n";
+ print "<TABLE summary=\"\"><TR>\n";
+ print "<TD><button id=submitDeleteNodeBtn dojoType=Button onClick=\"deleteNode();\">";
+ print "Delete Nodes</button></TD>\n";
+ print "<TD><button id=cancelDeleteNodeBtn dojoType=Button ";
+ print "onClick=\"dojo.widget.byId('deleteDialog').hide();\">Cancel</button>";
+ print "</TD>\n";
+ print "</TR></TABLE>\n";
+ $cont = addContinuationsEntry('AJsubmitDeleteNode');
+ print "<INPUT type=hidden id=delchildcont value=\"$cont\"\n>";
+ print "</div>\n";
+ print "</div>\n";
+
+ print "<div dojoType=dialog id=workingDialog bgColor=white bgOpacity=0.5 toggle=fade toggleDuration=250>\n";
+ print "Loading...\n";
+ print "</div>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn selectNode()
+///
+/// \brief generates html for ajax update to privileges page when a node is
+/// clicked
+///
+////////////////////////////////////////////////////////////////////////////////
+function selectNode() {
+ global $user;
+ $node = processInputVar("node", ARG_NUMERIC);
+ if(! empty($_COOKIE["VCLNODES"]))
+ $openNodes = $_COOKIE["VCLNODES"];
+ else
+ $openNodes = DEFAULT_PRIVNODE;
+ if(empty($node)) {
+ dbDisconnect();
+ exit;
+ }
+ $return = "";
+ $text = "";
+ $js = "";
+ $privs = getNodePrivileges($node);
+ $cascadePrivs = getNodeCascadePrivileges($node);
+ $usertypes = getTypes("users");
+ $i = 0;
+ $hasUserGrant = checkUserHasPriv("userGrant", $user["id"], $node,
+ $privs, $cascadePrivs);
+ $hasResourceGrant = checkUserHasPriv("resourceGrant", $user["id"],
+ $node, $privs, $cascadePrivs);
+ $hasNodeAdmin = checkUserHasPriv("nodeAdmin", $user["id"], $node, $privs,
+ $cascadePrivs);
+
+ if($hasNodeAdmin) {
+ $text .= "<TABLE>";
+ $text .= " <TR valign=top>";
+ $text .= " <TD><FORM action=\"" . BASEURL . SCRIPT . "\" method=post>";
+ $text .= " <button id=addNodeBtn dojoType=Button ";
+ $text .= "onClick=\"showAddNodePane(); return false;\">";
+ $text .= "Add Child</button>";
+ $text .= " </FORM></TD>";
+ $text .= " <TD><FORM action=\"" . BASEURL . SCRIPT . "\" method=post>";
+ $text .= " <button id=deleteNodeBtn dojoType=Button onClick=\"showDeleteNodeDialog();\">";
+ $text .= "Delete Node and Children</button>";
+ $text .= " </FORM></TD>";
+ $text .= " </TR>";
+ $text .= "</TABLE>";
+ }
+ $return .= setAttribute('treebuttons', 'innerHTML', $text);
+ $return .= "AJdojoCreate('treebuttons');";
+
+
+ # privileges
+ $text = "";
+ $text .= "<H3>Users</H3>";
+ $text .= "<FORM id=usersform action=\"" . BASEURL . SCRIPT . "#users\" method=post>";
+ $users = array();
+ if(count($privs["users"]) || count($cascadePrivs["users"])) {
+ $text .= "<TABLE border=1 summary=\"\">";
+ $text .= " <TR>";
+ $text .= " <TD></TD>";
+ $text .= " <TH bgcolor=gray style=\"color: black;\">Block<br>Cascaded<br>Rights</TH>";
+ $text .= " <TH bgcolor=\"#008000\" style=\"color: black;\">Cascade<br>to Child<br>Nodes</TH>";
+ foreach($usertypes["users"] as $type) {
+ $img = getImageText($type);
+ $text .= " <TD>$img</TD>";
+ }
+ $text .= " </TR>";
+ $users = array_unique(array_merge(array_keys($privs["users"]),
+ array_keys($cascadePrivs["users"])));
+ sort($users);
+ foreach($users as $_user) {
+ $tmpArr = getUserPrivRowHTML($_user, $i, $privs["users"],
+ $usertypes["users"], $cascadePrivs["users"], 'user',
+ ! $hasUserGrant);
+ $text .= $tmpArr['html'];
+ $js .= $tmpArr['javascript'];
+ $i++;
+ }
+ $text .= "</TABLE>";
+ $text .= "<div id=lastUserNum class=hidden>" . ($i - 1) . "</div>";
+ if($hasUserGrant) {
+ $cont = addContinuationsEntry('AJchangeUserPrivs');
+ $text .= "<INPUT type=hidden id=changeuserprivcont value=\"$cont\">";
+ }
+ }
+ else {
+ $text .= "There are no user privileges at the selected node.<br>";
+ }
+ if($hasUserGrant) {
+ $text .= "<BUTTON id=addUserBtn dojoType=Button onClick=\"showAddUserPane(); return false;\">";
+ $text .= "Add User</button>";
+ }
+ $text .= "</FORM>";
+ $return .= setAttribute('usersDiv', 'innerHTML', $text);
+ $return .= "AJdojoCreate('usersDiv');";
+
+ # groups
+ $text = "";
+ $text .= "<H3>User Groups</H3>";
+ if(count($privs["usergroups"]) || count($cascadePrivs["usergroups"])) {
+ $text .= "<FORM action=\"" . BASEURL . SCRIPT . "#groups\" method=post>";
+ $text .= "<div id=firstUserGroupNum class=hidden>$i</div>";
+ $text .= "<TABLE border=1 summary=\"\">";
+ $text .= " <TR>";
+ $text .= " <TD></TD>";
+ $text .= " <TH bgcolor=gray style=\"color: black;\">Block<br>Cascaded<br>Rights</TH>";
+ #$img = getImageText("Block Cascaded Rights");
+ #$text .= " <TD>$img</TD>";
+ $text .= " <TH bgcolor=\"#008000\" style=\"color: black;\">Cascade<br>to Child<br>Nodes</TH>";
+ #$img = getImageText("Cascade to Child Nodes");
+ #$text .= " <TD>$img</TD>";
+ foreach($usertypes["users"] as $type) {
+ $img = getImageText($type);
+ $text .= " <TH>$img</TH>";
+ }
+ $text .= " </TR>";
+ $groups = array_unique(array_merge(array_keys($privs["usergroups"]),
+ array_keys($cascadePrivs["usergroups"])));
+ sort($groups);
+ foreach($groups as $group) {
+ $tmpArr = getUserPrivRowHTML($group, $i, $privs["usergroups"],
+ $usertypes["users"], $cascadePrivs["usergroups"],
+ 'group', ! $hasUserGrant);
+ $text .= $tmpArr['html'];
+ $js .= $tmpArr['javascript'];
+ $i++;
+ }
+ $text .= "</TABLE>";
+ $text .= "<div id=lastUserGroupNum class=hidden>" . ($i - 1) . "</div>";
+ if($hasUserGrant) {
+ $cont = addContinuationsEntry('AJchangeUserGroupPrivs');
+ $text .= "<INPUT type=hidden id=changeusergroupprivcont value=\"$cont\">";
+ }
+ }
+ else {
+ $text .= "There are no user group privileges at the selected node.<br>";
+ $groups = array();
+ }
+ if($hasUserGrant) {
+ $text .= "<BUTTON id=addGroupBtn dojoType=Button onclick=\"showAddUserGroupPane(); return false;\">";
+ $text .= "Add Group</button>";
+ }
+ $text .= "</FORM>";
+ $return .= setAttribute('usergroupsDiv', 'innerHTML', $text);
+ $return .= "AJdojoCreate('usergroupsDiv');";
+
+ # resources
+ $text = "";
+ $resourcetypes = array("available", "administer", "manageGroup");
+ $text .= "<H3>Resources</H3>";
+ $text .= "<FORM id=resourceForm action=\"" . BASEURL . SCRIPT . "#resources\" method=post>";
+ if(count($privs["resources"]) || count($cascadePrivs["resources"])) {
+ $text .= "<TABLE border=1 summary=\"\">";
+ $text .= " <TR>";
+ $text .= " <TH>Group<br>Name</TH>";
+ $text .= " <TH>Group<br>Type</TH>";
+ $text .= " <TH bgcolor=gray style=\"color: black;\">Block<br>Cascaded<br>Rights</TH>";
+ $text .= " <TH bgcolor=\"#008000\" style=\"color: black;\">Cascade<br>to Child<br>Nodes</TH>";
+ foreach($resourcetypes as $type) {
+ $img = getImageText("$type");
+ $text .= " <TH>$img</TH>";
+ }
+ $text .= " </TR>";
+ $resources = array_unique(array_merge(array_keys($privs["resources"]),
+ array_keys($cascadePrivs["resources"])));
+ sort($resources);
+ $resourcegroups = getResourceGroups();
+ $resgroupmembers = getResourceGroupMembers();
+ foreach($resources as $resource) {
+ $tmpArr = getResourcePrivRowHTML($resource, $i, $privs["resources"],
+ $resourcetypes, $resourcegroups, $resgroupmembers,
+ $cascadePrivs["resources"], ! $hasResourceGrant);
+ $text .= $tmpArr['html'];
+ $js .= $tmpArr['javascript'];
+ $i++;
+ }
+ $text .= "</TABLE>";
+ if($hasResourceGrant) {
+ $cont = addContinuationsEntry('AJchangeResourcePrivs');
+ $text .= "<INPUT type=hidden id=changeresourceprivcont value=\"$cont\">";
+ }
+ }
+ else {
+ $text .= "There are no resource group privileges at the selected node.<br>";
+ $resources = array();
+ }
+ if($hasResourceGrant) {
+ $text .= "<BUTTON id=addResourceBtn dojoType=Button onclick=\"showAddResourceGroupPane(); return false;\">";
+ $text .= "Add Resource Group</button>";
+ }
+ $text .= "</FORM>";
+ $return .= setAttribute('resourcesDiv', 'innerHTML', $text);
+ $return .= "AJdojoCreate('resourcesDiv');";
+
+ $return .= "showPrivileges();";
+ print $return;
+ print $js;
+ dbDisconnect();
+ exit;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn recursivePrintNodes($nodelist, $openNodes, $activeNode)
+///
+/// \param $nodelist - array of nodes to print
+/// \param $openNodes - array of nodes whose children should be printed
+/// \param $activeNode - (optional) a selected node
+///
+/// \brief prints all nodes in $nodelist and any children of nodes in
+/// $openNodes, if $activeNode is given, it is printed in red
+///
+////////////////////////////////////////////////////////////////////////////////
+/*function recursivePrintNodes($nodelist, $openNodes, $activeNode="") {
+ print "<UL>\n";
+ foreach(array_keys($nodelist) as $id) {
+ $children = getChildNodes($id);
+ if(is_array($openNodes)) {
+ $openNodes_enc = implode(":", $openNodes);
+ if(! in_array($id, $openNodes))
+ $openNodesNew = implode(":", $openNodes) . ":$id";
+ else {
+ $tmp = $openNodes;
+ unset_by_val($id, $tmp);
+ $openNodesNew = implode(":", $tmp);
+ }
+ }
+ if(! is_array($openNodes) && $openNodes == "all") {
+ print " <img border=0 src=images/node.png> ";
+ print $nodelist[$id]["name"] . "<br>\n";
+ }
+ elseif(count($children)) {
+ if(in_array($id, $openNodes)) {
+ print " <a href=\"" . BASEURL . SCRIPT . "?mode=viewNodes&";
+ print "activeNode=$activeNode&openNodes=$openNodesNew\">";
+ print "<img border=0 src=images/collapse.png></a> ";
+ }
+ else {
+ print " <a href=\"" . BASEURL . SCRIPT . "?mode=viewNodes&";
+ print "activeNode=$activeNode&openNodes=$openNodesNew\">";
+ print "<img border=0 src=images/expand.png></a> ";
+ }
+ if($id == $activeNode) {
+ print "<font color=red>" . $nodelist[$id]["name"] . "</font><br>\n";
+ }
+ else {
+ print "<a href=\"" . BASEURL . SCRIPT . "?mode=viewNodes&";
+ print "activeNode=$id&openNodes=$openNodes_enc\">";
+ print "<font color=black>" . $nodelist[$id]["name"];
+ print "</font></a><br>\n";
+ }
+ }
+ else {
+ print " <img border=0 src=images/node.png> ";
+ if($id == $activeNode) {
+ print "<font color=red>" . $nodelist[$id]["name"] . "</font><br>\n";
+ }
+ else {
+ print "<a href=\"" . BASEURL . SCRIPT . "?mode=viewNodes&";
+ print "activeNode=$id&openNodes=$openNodes_enc\">";
+ print "<font color=black>" . $nodelist[$id]["name"];
+ print "</font></a><br>\n";
+ }
+ }
+ if((! is_array($openNodes) && $openNodes == "all") ||
+ in_array($id, $openNodes)) {
+ if(count($children)) {
+ recursivePrintNodes($children, $openNodes, $activeNode);
+ }
+ }
+ }
+ print "</UL>\n";
+}*/
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn recursivePrintNodes2($nodelist, $openNodes, $activeNode)
+///
+/// \param $nodelist - array of nodes to print
+/// \param $openNodes - array of nodes whose children should be printed
+/// \param $activeNode - (optional) a selected node
+///
+/// \brief prints all nodes in $nodelist and any children of nodes in
+/// $openNodes, if $activeNode is given, it is printed in red
+///
+////////////////////////////////////////////////////////////////////////////////
+function recursivePrintNodes2($nodelist, $openNodes, $activeNode="") {
+ foreach(array_keys($nodelist) as $id) {
+ $opentext = "";
+ if(in_array($id, $openNodes))
+ $opentext = "expandLevel=1";
+ print " <div dojoType=\"TreeNode\" title=\"{$nodelist[$id]['name']}\" widgetId=$id $opentext>\n";
+ $children = getChildNodes($id);
+ if(count($children))
+ recursivePrintNodes2($children, $openNodes);
+ print " </div>\n";
+ }
+ return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn addChildNode()
+///
+/// \brief prints a page for adding a child node
+///
+////////////////////////////////////////////////////////////////////////////////
+/*function addChildNode() {
+ global $submitErr;
+ $parent = processInputVar("activeNode", ARG_NUMERIC);
+ $nodeInfo = getNodeInfo($parent);
+ $newnode = processInputVar("newnode", ARG_STRING);
+ $openNodes = processInputVar("openNodes", ARG_STRING);
+ print "<H2>Add Child Node</H2>\n";
+ print "Add child to " . $nodeInfo["name"] . ":<br><br>\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TH align=right>New Node:</TH>\n";
+ print " <TD><INPUT type=text name=newnode value=\"$newnode\"></TD>\n";
+ print " <TD>";
+ printSubmitErr($submitErr);
+ print "</TD>";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TD colspan=2 align=right><INPUT type=submit value=Submit>";
+ print "</TD>\n";
+ print " <TD></TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ print "<INPUT type=hidden name=mode value=submitAddChildNode>\n";
+ print "<INPUT type=hidden name=openNodes value=$openNodes>\n";
+ print "<INPUT type=hidden name=activeNode value=$parent>\n";
+ print "</FORM>\n";
+}*/
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitAddChildNode()
+///
+/// \brief processes input for adding a child node; if all is ok, adds node
+/// to privnode table; checks to see if submitting user has nodeAdmin,
+/// userGrant, and resourceGrant cascaded to the node; adds any of the privs
+/// that aren't cascaded; calls viewNodes when finished
+///
+////////////////////////////////////////////////////////////////////////////////
+/*function submitAddChildNode() {
+ global $submitErr, $submitErrMsg, $user, $nodechildren;
+ $parent = processInputVar("activeNode", ARG_NUMERIC);
+ $nodeInfo = getNodeInfo($parent);
+ $newnode = processInputVar("newnode", ARG_STRING);
+ $openNodes = processInputVar("openNodes", ARG_STRING);
+ if(! ereg('^[-A-Za-z0-9_. ]+$', $newnode)) {
+ $submitErr |= NEWNODENAMEERR;
+ $submitErrMsg[NEWNODENAMEERR] = "You can only use letters, numbers, "
+ . "spaces, dashes(-), dots(.), underscores(_), and spaces.";
+ }
+
+ # check to see if a node with the submitted name already exists
+ $query = "SELECT id "
+ . "FROM privnode "
+ . "WHERE name = '$newnode' AND "
+ . "parent = $parent";
+ $qh = doQuery($query, 335);
+ if(mysql_num_rows($qh)) {
+ $submitErr |= NEWNODENAMEERR;
+ $submitErrMsg[NEWNODENAMEERR] = "A node of that name already exists "
+ . "under " . $nodeInfo["name"];
+ }
+ if($submitErr) {
+ addChildNode();
+ return;
+ }
+ $query = "INSERT INTO privnode "
+ . "(parent, "
+ . "name) "
+ . "VALUES "
+ . "($parent, "
+ . "'$newnode')";
+ doQuery($query, 336);
+
+ $qh = doQuery("SELECT LAST_INSERT_ID() FROM privnode", 101);
+ if(! $row = mysql_fetch_row($qh)) {
+ abort(101);
+ }
+ $nodeid = $row[0];
+
+ $privs = array();
+ foreach(array("nodeAdmin", "userGrant", "resourceGrant") as $type) {
+ if(! checkUserHasPriv($type, $user["id"], $nodeid))
+ array_push($privs, $type);
+ }
+ if(count($privs))
+ array_push($privs, "cascade");
+ updateUserOrGroupPrivs($user["id"], $nodeid, $privs, array(), "user");
+ $_POST["openNodes"] .= ":$parent";
+ $nodechildren = array();
+ viewNodes();
+}*/
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJsubmitAddChildNode()
+///
+/// \brief processes input for adding a child node; if all is ok, adds node
+/// to privnode table; checks to see if submitting user has nodeAdmin,
+/// userGrant, and resourceGrant cascaded to the node; adds any of the privs
+/// that aren't cascaded; calls viewNodes when finished
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJsubmitAddChildNode() {
+ global $user;
+ $parent = processInputVar("activeNode", ARG_NUMERIC);
+ if(! checkUserHasPriv("nodeAdmin", $user["id"], $parent)) {
+ $text = "You do not have rights to add children to this node.";
+ print "alert('$text');";
+ dbDisconnect();
+ exit;
+ }
+ $nodeInfo = getNodeInfo($parent);
+ $newnode = processInputVar("newnode", ARG_STRING);
+ if(! ereg('^[-A-Za-z0-9_. ]+$', $newnode)) {
+ $text = "You can only use letters, numbers, "
+ . "spaces, dashes(-), dots(.), underscores(_), and spaces.";
+ print "alert('$text');";
+ dbDisconnect();
+ exit;
+ }
+
+ # check to see if a node with the submitted name already exists
+ $query = "SELECT id "
+ . "FROM privnode "
+ . "WHERE name = '$newnode' AND "
+ . "parent = $parent";
+ $qh = doQuery($query, 335);
+ if(mysql_num_rows($qh)) {
+ $text = "A node of that name already exists "
+ . "under " . $nodeInfo["name"];
+ print "alert('$text');";
+ dbDisconnect();
+ exit;
+ }
+ $query = "INSERT INTO privnode "
+ . "(parent, "
+ . "name) "
+ . "VALUES "
+ . "($parent, "
+ . "'$newnode')";
+ doQuery($query, 336);
+
+ $qh = doQuery("SELECT LAST_INSERT_ID() FROM privnode", 101);
+ if(! $row = mysql_fetch_row($qh)) {
+ abort(101);
+ }
+ $nodeid = $row[0];
+
+ $privs = array();
+ foreach(array("nodeAdmin", "userGrant", "resourceGrant") as $type) {
+ if(! checkUserHasPriv($type, $user["id"], $nodeid))
+ array_push($privs, $type);
+ }
+ if(count($privs))
+ array_push($privs, "cascade");
+ updateUserOrGroupPrivs($user["id"], $nodeid, $privs, array(), "user");
+ print "addChildNode('$newnode', $nodeid);";
+ dbDisconnect();
+ exit;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn nodeExists($node)
+///
+/// \param $node - the id of a node
+///
+/// \return 1 if exists, 0 if not
+///
+/// \brief checks to see if $node exists
+///
+////////////////////////////////////////////////////////////////////////////////
+function nodeExists($node) {
+ $query = "SELECT id FROM privnode WHERE id = $node";
+ $qh = doQuery($query, 101);
+ if(mysql_num_rows($qh))
+ return 1;
+ else
+ return 0;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn deleteNode()
+///
+/// \brief prompts user for confirmation on deleting a node and its children
+///
+////////////////////////////////////////////////////////////////////////////////
+/*function deleteNode() {
+ $activeNode = processInputVar("activeNode", ARG_NUMERIC);
+ $openNodes = processInputVar("openNodes", ARG_STRING);
+ $nodeInfo = getNodeInfo($activeNode);
+ $children = getChildNodes($activeNode);
+ print "<H2>Delete Node and Children</H2>\n";
+ if(count($children)) {
+ print "Delete the following part of the privilege tree?<br><br>\n";
+ recursivePrintNodes(array($activeNode => $nodeInfo), "all");
+ }
+ else {
+ print "Delete " . $nodeInfo["name"] . " from the privilege ";
+ print "tree?<br><br>\n";
+ }
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<TABLE>\n";
+ print " <TR valign=top>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <INPUT type=hidden name=mode value=submitDeleteNode>\n";
+ print " <INPUT type=hidden name=activeNode value=$activeNode>\n";
+ print " <INPUT type=hidden name=openNodes value=$openNodes>\n";
+ print " <INPUT type=submit value=Submit>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <INPUT type=hidden name=mode value=viewNodes>\n";
+ print " <INPUT type=hidden name=openNodes value=$openNodes>\n";
+ print " <INPUT type=submit value=Cancel>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+}*/
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitDeleteNode()
+///
+/// \brief deletes a node and its children; calls viewNodes when finished
+///
+////////////////////////////////////////////////////////////////////////////////
+/*function submitDeleteNode() {
+ global $nodechildren;
+ $activeNode = processInputVar("activeNode", ARG_NUMERIC);
+ $nodeinfo = getNodeInfo($activeNode);
+ $_POST["activeNode"] = $nodeinfo["parent"];
+ $nodes = recurseGetChildren($activeNode);
+ array_push($nodes, $activeNode);
+ $deleteNodes = implode(',', $nodes);
+ $query = "DELETE FROM privnode "
+ . "WHERE id IN ($deleteNodes)";
+ doQuery($query, 345);
+ $nodechildren = array();
+ clearPrivCache();
+ viewNodes();
+}*/
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJsubmitDeleteNode()
+///
+/// \brief deletes a node and its children; calls viewNodes when finished
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJsubmitDeleteNode() {
+ global $user;
+ $activeNode = processInputVar("activeNode", ARG_NUMERIC);
+ if(empty($activeNode)) {
+ dbDisconnect();
+ exit;
+ }
+ if(! checkUserHasPriv("nodeAdmin", $user["id"], $activeNode)) {
+ $text = "You do not have rights to delete this node.";
+ print "alert('$text');";
+ dbDisconnect();
+ exit;
+ }
+ clearPrivCache();
+ $nodes = recurseGetChildren($activeNode);
+ $parents = getParentNodes($activeNode);
+ $parent = $parents[0];
+ array_push($nodes, $activeNode);
+ $deleteNodes = implode(',', $nodes);
+ $query = "DELETE FROM privnode "
+ . "WHERE id IN ($deleteNodes)";
+ doQuery($query, 345);
+ print "var obj = dojo.widget.byId('$activeNode'); ";
+ print "dojo.widget.byId('$parent').removeNode(obj); ";
+ print "setSelectedPrivNode('$parent'); ";
+ print "refreshPerms(); ";
+ dbDisconnect();
+ exit;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn userLookup()
+///
+/// \brief prints a page to display a user's privileges
+///
+////////////////////////////////////////////////////////////////////////////////
+function userLookup() {
+ global $user, $viewmode;
+ $userid = processInputVar("userid", ARG_STRING);
+ print "<div align=center>\n";
+ print "<H2>User Lookup</H2>\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TH>User ID:</TH>\n";
+ print " <TD><INPUT type=text name=userid value=\"$userid\" size=25></TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TD></TD>\n";
+ print " <TD align=right><INPUT type=submit value=Submit>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ $cont = addContinuationsEntry('submitUserLookup');
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "</FORM>\n";
+ if(! empty($userid)) {
+ $loginid = $userid;
+ getAffilidAndLogin($loginid, $affilid);
+ if(empty($affilid)) {
+ print "{$matches[2]} is an unknown affiliation<br>\n";
+ return;
+ }
+ if($viewmode != ADMIN_DEVELOPER &&
+ $user['affiliationid'] != $affilid) {
+ print "You are only allowed to look up users from your own affiliation.<br>\n";
+ return;
+ }
+ $query = "SELECT id "
+ . "FROM user "
+ . "WHERE unityid = '$loginid' AND "
+ . "affiliationid = $affilid";
+ $qh = doQuery($query, 101);
+ if(! mysql_num_rows($qh))
+ print "<font color=red>$userid not currently found in VCL user database, will try to add...</font><br>\n";
+
+ $userdata = getUserInfo($userid);
+ if(is_null($userdata)) {
+ print "<font color=red>$userid not found in any known systems</font><br>\n";
+ return;
+ }
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TH align=right>First Name:</TH>\n";
+ print " <TD>{$userdata["firstname"]}</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Middle Name:</TH>\n";
+ print " <TD>{$userdata["middlename"]}</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Last Name:</TH>\n";
+ print " <TD>{$userdata["lastname"]}</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Preferred Name:</TH>\n";
+ print " <TD>{$userdata["preferredname"]}</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Email:</TH>\n";
+ print " <TD>{$userdata["email"]}</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Admin Level:</TH>\n";
+ print " <TD>{$userdata["adminlevel"]}</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right style=\"vertical-align: top\">Groups:</TH>\n";
+ print " <TD>\n";
+ uasort($userdata["groups"], "sortKeepIndex");
+ foreach($userdata["groups"] as $group) {
+ print " $group<br>\n";
+ }
+ print " </TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right style=\"vertical-align: top\">Privileges (found somewhere in the tree):</TH>\n";
+ print " <TD>\n";
+ uasort($userdata["privileges"], "sortKeepIndex");
+ foreach($userdata["privileges"] as $priv) {
+ if($priv == "block" || $priv == "cascade")
+ continue;
+ print " $priv<br>\n";
+ }
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+
+ # get user's resources
+ $userResources = getUserResources(array("imageCheckOut"), array("available"), 0, 0, $userdata['id']);
+
+ # find nodes where user has privileges
+ $query = "SELECT p.name AS privnode, "
+ . "upt.name AS userprivtype, "
+ . "up.privnodeid "
+ . "FROM userpriv up, "
+ . "privnode p, "
+ . "userprivtype upt "
+ . "WHERE up.privnodeid = p.id AND "
+ . "up.userprivtypeid = upt.id AND "
+ . "up.userid = {$userdata['id']} "
+ . "ORDER BY p.name, "
+ . "upt.name";
+ $qh = doQuery($query, 101);
+ if(mysql_num_rows($qh)) {
+ print "Nodes where user is granted privileges:<br>\n";
+ print "<TABLE>\n";
+ $privnodeid = 0;
+ while($row = mysql_fetch_assoc($qh)) {
+ if($privnodeid != $row['privnodeid']) {
+ if($privnodeid) {
+ print " </TD>\n";
+ print " </TR>\n";
+ }
+ print " <TR>\n";
+ $privnodeid = $row['privnodeid'];
+ print " <TH align=right>{$row['privnode']}</TH>\n";
+ print " <TD>\n";
+ }
+ print " {$row['userprivtype']}<br>\n";
+ }
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ }
+
+ # find nodes where user's groups have privileges
+ if(! empty($userdata['groups'])) {
+ $query = "SELECT DISTINCT p.name AS privnode, "
+ . "upt.name AS userprivtype, "
+ . "up.privnodeid "
+ . "FROM userpriv up, "
+ . "privnode p, "
+ . "userprivtype upt "
+ . "WHERE up.privnodeid = p.id AND "
+ . "up.userprivtypeid = upt.id AND "
+ . "upt.name != 'cascade' AND "
+ . "upt.name != 'block' AND "
+ . "up.usergroupid IN (" . implode(',', array_keys($userdata['groups'])) . ") "
+ . "ORDER BY p.name, "
+ . "upt.name";
+ $qh = doQuery($query, 101);
+ if(mysql_num_rows($qh)) {
+ print "Nodes where user's groups are granted privileges:<br>\n";
+ print "<TABLE>\n";
+ $privnodeid = 0;
+ while($row = mysql_fetch_assoc($qh)) {
+ if($privnodeid != $row['privnodeid']) {
+ if($privnodeid) {
+ print " </TD>\n";
+ print " </TR>\n";
+ }
+ print " <TR>\n";
+ $privnodeid = $row['privnodeid'];
+ print " <TH align=right>{$row['privnode']}</TH>\n";
+ print " <TD>\n";
+ }
+ print " {$row['userprivtype']}<br>\n";
+ }
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ }
+ }
+ print "<table>\n";
+ print " <tr>\n";
+ print " <th>Images User Has Access To:<th>\n";
+ print " <td>\n";
+ foreach($userResources['image'] as $img)
+ print " $img<br>\n";
+ print " </td>\n";
+ print " </tr>\n";
+ print "</table>\n";
+
+ $requests = array();
+ $query = "SELECT l.start AS start, "
+ . "l.finalend AS end, "
+ . "c.hostname, "
+ . "i.prettyname AS prettyimage, "
+ . "l.ending "
+ . "FROM log l, "
+ . "image i, "
+ . "computer c, "
+ . "sublog s "
+ . "WHERE l.userid = {$userdata["id"]} AND "
+ . "s.logid = l.id AND "
+ . "i.id = s.imageid AND "
+ . "c.id = s.computerid "
+ . "ORDER BY l.start DESC "
+ . "LIMIT 5";
+ $qh = doQuery($query, 290);
+ while($row = mysql_fetch_assoc($qh))
+ array_push($requests, $row);
+ $requests = array_reverse($requests);
+ if(! empty($requests)) {
+ print "<h3>User's last " . count($requests) . " reservations:</h3>\n";
+ print "<table>\n";
+ $first = 1;
+ foreach($requests as $req) {
+ $thisstart = str_replace(' ', ' ',
+ prettyDatetime($req["start"]));
+ $thisend = str_replace(' ', ' ',
+ prettyDatetime($req["end"]));
+ if($first)
+ $first = 0;
+ else {
+ print " <tr>\n";
+ print " <td colspan=2><hr></td>\n";
+ print " </tr>\n";
+ }
+ print " <tr>\n";
+ print " <th align=right>Image:</th>\n";
+ print " <td>{$req['prettyimage']}</td>\n";
+ print " </tr>\n";
+ print " <tr>\n";
+ print " <th align=right>Computer:</th>\n";
+ print " <td>{$req['hostname']}</td>\n";
+ print " </tr>\n";
+ print " <tr>\n";
+ print " <th align=right>Start:</th>\n";
+ print " <td>$thisstart</td>\n";
+ print " </tr>\n";
+ print " <tr>\n";
+ print " <th align=right>End:</th>\n";
+ print " <td>$thisend</td>\n";
+ print " </tr>\n";
+ print " <tr>\n";
+ print " <th align=right>Ending:</th>\n";
+ print " <td>{$req['ending']}</td>\n";
+ print " </tr>\n";
+ }
+ print "</table>\n";
+ }
+ else
+ print "User made no reservations in the past week.<br>\n";
+ }
+ print "</div>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn recurseGetChildren($node)
+///
+/// \param $node - a node id
+///
+/// \return an array of nodes that are children of $node
+///
+/// \brief foreach child node of $node, adds it to an array and calls
+/// self to add that child's children
+///
+////////////////////////////////////////////////////////////////////////////////
+function recurseGetChildren($node) {
+ $children = array();
+ $qh = doQuery("SELECT id FROM privnode WHERE parent = $node", 340);
+ while($row = mysql_fetch_row($qh)) {
+ array_push($children, $row[0]);
+ $children = array_merge($children, recurseGetChildren($row[0]));
+ }
+ return $children;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn printUserPrivRow($privname, $rownum, $privs, $types,
+/// $cascadeprivs, $usergroup, $disabled)
+///
+/// \param $privname - privilege name
+/// \param $rownum - number of the privilege row on this page
+/// \param $privs - an array of user's privileges
+/// \param $types - an array of privilege types
+/// \param $cascadeprivs - an array of user's cascaded privileges
+/// \param $usergroup - 'user' if this is a user row, or 'group' if this is a
+/// group row
+/// \param $disabled - 0 or 1; whether or not the checkboxes should be disabled
+///
+/// \brief prints a table row for this $privname
+///
+////////////////////////////////////////////////////////////////////////////////
+function printUserPrivRow($privname, $rownum, $privs, $types,
+ $cascadeprivs, $usergroup, $disabled) {
+ $allprivs = array_merge($privs, $cascadeprivs);
+ print " <TR>\n";
+ if($usergroup == 'group' && ! empty($allprivs[$privname]['affiliation']))
+ print " <TH>$privname@{$allprivs[$privname]['affiliation']}</TH>\n";
+ else
+ print " <TH>$privname</TH>\n";
+
+ if($disabled)
+ $disabled = 'disabled=disabled';
+ else
+ $disabled = '';
+
+ # block rights
+ if(array_key_exists($privname, $privs) &&
+ (($usergroup == 'user' &&
+ in_array("block", $privs[$privname])) ||
+ ($usergroup == 'group' &&
+ in_array("block", $privs[$privname]['privs'])))) {
+ $checked = "checked";
+ $blocked = 1;
+ }
+ else {
+ $checked = "";
+ $blocked = 0;
+ }
+ $count = count($types) + 1;
+ if($usergroup == 'user') {
+ $usergroup = 1;
+ $name = "privrow[$privname:block]";
+ }
+ elseif($usergroup == 'group') {
+ $usergroup = 2;
+ $name = "privrow[{$allprivs[$privname]['id']}:block]";
+ }
+ print " <TD align=center bgcolor=gray><INPUT type=checkbox ";
+ print "dojoType=Checkbox id=ck$rownum:block name=\"$name\" $checked ";
+ print "onClick=\"javascript:changeCascadedRights(this.checked, $rownum, ";
+ print "$count, 1, $usergroup);\" $disabled></TD>\n";
+
+ #cascade rights
+ if(array_key_exists($privname, $privs) &&
+ (($usergroup == 1 &&
+ in_array("cascade", $privs[$privname])) ||
+ ($usergroup == 2 &&
+ in_array("cascade", $privs[$privname]['privs']))))
+ $checked = "checked";
+ else
+ $checked = "";
+ if($usergroup == 1)
+ $name = "privrow[$privname:cascade]";
+ else
+ $name = "privrow[{$allprivs[$privname]['id']}:cascade]";
+ print " <TD align=center bgcolor=\"#008000\" id=cell$rownum:0>";
+ print "<INPUT type=checkbox dojoType=Checkbox id=ck$rownum:0 ";
+ print "name=\"$name\" onClick=\"privChange(this.checked, $rownum, 0, ";
+ print "$usergroup);\" $checked $disabled></TD>\n";
+
+ # normal rights
+ $j = 1;
+ foreach($types as $type) {
+ $bgcolor = "";
+ $checked = "";
+ $value = "";
+ $cascaded = 0;
+ if(array_key_exists($privname, $cascadeprivs) &&
+ (($usergroup == 1 &&
+ in_array($type, $cascadeprivs[$privname])) ||
+ ($usergroup == 2 &&
+ in_array($type, $cascadeprivs[$privname]['privs'])))) {
+ $bgcolor = "bgcolor=\"#008000\"";
+ $checked = "checked";
+ $value = "value=cascade";
+ $cascaded = 1;
+ }
+ if(array_key_exists($privname, $privs) &&
+ (($usergroup == 1 &&
+ in_array($type, $privs[$privname])) ||
+ ($usergroup == 2 &&
+ in_array($type, $privs[$privname]['privs'])))) {
+ if($cascaded) {
+ $value = "value=cascadesingle";
+ }
+ else {
+ $checked = "checked";
+ $value = "value=single";
+ }
+ }
+ if($usergroup == 1)
+ $name = "privrow[$privname:$type]";
+ else
+ $name = "privrow[{$allprivs[$privname]['id']}:$type]";
+ print " <TD align=center id=cell$rownum:$j $bgcolor><INPUT ";
+ print "type=checkbox dojoType=Checkbox name=\"$name\" id=ck$rownum:$j ";
+ print "$checked $value $disabled ";
+ print "onClick=\"javascript:nodeCheck(this.checked, $rownum, $j, $usergroup)\" ";
+ print "onBlur=\"javascript:nodeCheck(this.checked, $rownum, $j, $usergroup)\">";
+ print "</TD>\n";
+ $j++;
+ }
+ print " </TR>\n";
+ $count = count($types) + 1;
+ if($blocked) {
+ print "<script language=\"Javascript\">\n";
+ print "dojo.addOnLoad(function() {setTimeout(\"changeCascadedRights(true, $rownum, $count, 0, 0)\", 500)});\n";
+ print "</script>\n";
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getUserPrivRowHTML($privname, $rownum, $privs, $types,
+/// $cascadeprivs, $usergroup, $disabled)
+///
+/// \param $privname - privilege name
+/// \param $rownum - number of the privilege row on this page
+/// \param $privs - an array of user's privileges
+/// \param $types - an array of privilege types
+/// \param $cascadeprivs - an array of user's cascaded privileges
+/// \param $usergroup - 'user' if this is a user row, or 'group' if this is a
+/// group row
+/// \param $disabled - 0 or 1; whether or not the checkboxes should be disabled
+///
+/// \return a string of HTML code for a user privilege row
+///
+/// \brief creates HTML for a user privilege row and returns it
+///
+////////////////////////////////////////////////////////////////////////////////
+function getUserPrivRowHTML($privname, $rownum, $privs, $types,
+ $cascadeprivs, $usergroup, $disabled) {
+ $allprivs = array_merge($privs, $cascadeprivs);
+ $text = "";
+ $js = "";
+ $text .= " <TR>";
+ if($usergroup == 'group' && ! empty($allprivs[$privname]['affiliation']))
+ $text .= " <TH>$privname@{$allprivs[$privname]['affiliation']}</TH>";
+ else
+ $text .= " <TH>$privname</TH>";
+
+ if($disabled)
+ $disabled = 'disabled=disabled';
+ else
+ $disabled = '';
+
+ # block rights
+ if(array_key_exists($privname, $privs) &&
+ (($usergroup == 'user' &&
+ in_array("block", $privs[$privname])) ||
+ ($usergroup == 'group' &&
+ in_array("block", $privs[$privname]['privs'])))) {
+ $checked = "checked";
+ $blocked = 1;
+ }
+ else {
+ $checked = "";
+ $blocked = 0;
+ }
+ $count = count($types) + 1;
+ if($usergroup == 'user') {
+ $usergroup = 1;
+ $name = "privrow[$privname:block]";
+ }
+ elseif($usergroup == 'group') {
+ $usergroup = 2;
+ $name = "privrow[{$allprivs[$privname]['id']}:block]";
+ }
+ $text .= " <TD align=center bgcolor=gray><INPUT type=checkbox ";
+ $text .= "dojoType=Checkbox id=ck$rownum:block name=\"$name\" $checked ";
+ $text .= "$disabled onClick=\"javascript:";
+ $text .= "changeCascadedRights(this.checked, $rownum, $count, 1, $usergroup)\"></TD>";
+
+ #cascade rights
+ if(array_key_exists($privname, $privs) &&
+ (($usergroup == 1 &&
+ in_array("cascade", $privs[$privname])) ||
+ ($usergroup == 2 &&
+ in_array("cascade", $privs[$privname]['privs']))))
+ $checked = "checked";
+ else
+ $checked = "";
+ if($usergroup == 1)
+ $name = "privrow[$privname:cascade]";
+ else
+ $name = "privrow[{$allprivs[$privname]['id']}:cascade]";
+ $text .= " <TD align=center bgcolor=\"#008000\" id=cell$rownum:0>";
+ $text .= "<INPUT type=checkbox dojoType=Checkbox id=ck$rownum:0 name=\"$name\" ";
+ $text .= "onClick=\"privChange(this.checked, $rownum, 0, $usergroup);\" ";
+ $text .= "$checked $disabled></TD>";
+
+ # normal rights
+ $j = 1;
+ foreach($types as $type) {
+ $bgcolor = "";
+ $checked = "";
+ $value = "";
+ $cascaded = 0;
+ if(array_key_exists($privname, $cascadeprivs) &&
+ (($usergroup == 1 &&
+ in_array($type, $cascadeprivs[$privname])) ||
+ ($usergroup == 2 &&
+ in_array($type, $cascadeprivs[$privname]['privs'])))) {
+ $bgcolor = "bgcolor=\"#008000\"";
+ $checked = "checked";
+ $value = "value=cascade";
+ $cascaded = 1;
+ }
+ if(array_key_exists($privname, $privs) &&
+ (($usergroup == 1 &&
+ in_array($type, $privs[$privname])) ||
+ ($usergroup == 2 &&
+ in_array($type, $privs[$privname]['privs'])))) {
+ if($cascaded) {
+ $value = "value=cascadesingle";
+ }
+ else {
+ $checked = "checked";
+ $value = "value=single";
+ }
+ }
+ if($usergroup == 1)
+ $name = "privrow[$privname:$type]";
+ else
+ $name = "privrow[{$allprivs[$privname]['id']}:$type]";
+ $text .= " <TD align=center id=cell$rownum:$j $bgcolor><INPUT ";
+ $text .= "type=checkbox dojoType=Checkbox name=\"$name\" ";
+ $text .= "id=ck$rownum:$j $checked $value $disabled ";
+ $text .= "onClick=\"javascript:nodeCheck(this.checked, $rownum, $j, $usergroup)\" ";
+ $text .= "onBlur=\"javascript:nodeCheck(this.checked, $rownum, $j, $usergroup)\">";
+ $text .= "</TD>";
+ $j++;
+ }
+ $text .= " </TR>";
+ $count = count($types) + 1;
+ if($blocked) {
+ $js .= "changeCascadedRights(true, $rownum, $count, 0, 0);";
+ }
+ return array('html' => $text,
+ 'javascript' => $js);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn printResourcePrivRow($privname, $rownum, $privs, $types,
+/// $resourcegroups, $resgroupmembers, $cascadeprivs,
+/// $disabled)
+///
+/// \param $privname - privilege name
+/// \param $rownum - number of the privilege row on this page
+/// \param $privs - an array of user's privileges
+/// \param $types - an array of privilege types
+/// \param $resourcegroups - array from getResourceGroups()
+/// \param $resgroupmembers - array from getResourceGroupMembers()
+/// \param $cascadeprivs - an array of user's cascaded privileges
+/// \param $disabled - 0 or 1; whether or not the checkboxes should be disabled
+///
+/// \brief prints a table row for this $privname
+///
+////////////////////////////////////////////////////////////////////////////////
+function printResourcePrivRow($privname, $rownum, $privs, $types,
+ $resourcegroups, $resgroupmembers, $cascadeprivs,
+ $disabled) {
+ global $user;
+ print " <TR>\n";
+ list($type, $name, $id) = split('/', $privname);
+ print " <TH>\n";
+ print " <span id=\"resgrp$id\">$name</span>\n";
+ print " <span dojoType=\"tooltip\" connectId=\"resgrp$id\">\n";
+ if(array_key_exists($id, $resgroupmembers[$type]) &&
+ is_array($resgroupmembers[$type][$id])) {
+ foreach($resgroupmembers[$type][$id] as $resource)
+ print " {$resource['name']}<br>\n";
+ }
+ else
+ print "(empty group)\n";
+ print " </span>\n";
+ print " </TH>\n";
+ //print " <TH>$name</TH>\n";
+ print " <TH>$type</TH>\n";
+
+ if($disabled)
+ $disabled = 'disabled=disabled';
+ else
+ $disabled = '';
+
+ # block rights
+ if(array_key_exists($privname, $privs) &&
+ in_array("block", $privs[$privname])) {
+ $checked = "checked";
+ $blocked = 1;
+ }
+ else {
+ $checked = "";
+ $blocked = 0;
+ }
+ $count = count($types) + 1;
+ $name = "privrow[" . $privname . ":block]";
+ print " <TD align=center bgcolor=gray><INPUT type=checkbox ";
+ print "dojoType=Checkbox id=ck$rownum:block name=\"$name\" $checked ";
+ print "$disabled onClick=\"javascript:";
+ print "changeCascadedRights(this.checked, $rownum, $count, 1, 3)\"></TD>\n";
+
+ #cascade rights
+ if(array_key_exists($privname, $privs) &&
+ in_array("cascade", $privs[$privname]))
+ $checked = "checked";
+ else
+ $checked = "";
+ $name = "privrow[" . $privname . ":cascade]";
+ print " <TD align=center bgcolor=\"#008000\" id=cell$rownum:0>";
+ print "<INPUT type=checkbox dojoType=Checkbox id=ck$rownum:0 name=\"$name\" ";
+ print "onClick=\"privChange(this.checked, $rownum, 0, 3);\" ";
+ print "$checked $disabled></TD>\n";
+
+ # normal rights
+ $j = 1;
+ foreach($types as $type) {
+ $bgcolor = "";
+ $checked = "";
+ $value = "";
+ $cascaded = 0;
+ if(array_key_exists($privname, $cascadeprivs) &&
+ in_array($type, $cascadeprivs[$privname])) {
+ $bgcolor = "bgcolor=\"#008000\"";
+ $checked = "checked";
+ $value = "value=cascade";
+ $cascaded = 1;
+ }
+ if(array_key_exists($privname, $privs) &&
+ in_array($type, $privs[$privname])) {
+ if($cascaded) {
+ $value = "value=cascadesingle";
+ }
+ else {
+ $checked = "checked";
+ $value = "value=single";
+ }
+ }
+ // if $type is administer or manageGroup, and it is not checked, and the
+ # user is not in the resource owner group, don't print the checkbox
+ if(($type == "administer" || $type == "manageGroup") &&
+ $checked != "checked" &&
+ ! array_key_exists($resourcegroups[$id]["ownerid"], $user["groups"])) {
+ print "<TD><img src=images/blank.gif></TD>\n";
+ }
+ else {
+ $name = "privrow[" . $privname . ":" . $type . "]";
+ print " <TD align=center id=cell$rownum:$j $bgcolor><INPUT ";
+ print "type=checkbox dojoType=Checkbox name=\"$name\" ";
+ print "id=ck$rownum:$j $checked $value $disabled ";
+ print "onClick=\"javascript:nodeCheck(this.checked, $rownum, $j, 3)\" ";
+ print "onBlur=\"javascript:nodeCheck(this.checked, $rownum, $j, 3)\">";
+ print "</TD>\n";
+ }
+ $j++;
+ }
+ print " </TR>\n";
+ $count = count($types) + 1;
+ if($blocked) {
+ print "<script language=\"Javascript\">\n";
+ print "dojo.addOnLoad(function () {setTimeout(\"changeCascadedRights(true, $rownum, $count, 0, 0)\", 500)});\n";
+ print "</script>\n";
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getResourcePrivRowHTML($privname, $rownum, $privs, $types,
+/// $resourcegroups, $resgroupmembers,
+/// $cascadeprivs, $disabled)
+///
+/// \param $privname - privilege name
+/// \param $rownum - number of the privilege row on this page
+/// \param $privs - an array of user's privileges
+/// \param $types - an array of privilege types
+/// \param $resourcegroups - array from getResourceGroups()
+/// \param $resgroupmembers - array from getResourceGroupMembers()
+/// \param $cascadeprivs - an array of user's cascaded privileges
+/// \param $disabled - 0 or 1; whether or not the checkboxes should be disabled
+///
+/// \return a string of HTML code for a resource row
+///
+/// \brief creates HTML for a resource privilege row and returns it
+///
+////////////////////////////////////////////////////////////////////////////////
+function getResourcePrivRowHTML($privname, $rownum, $privs, $types,
+ $resourcegroups, $resgroupmembers,
+ $cascadeprivs, $disabled) {
+ global $user;
+ $text = "";
+ $js = "";
+ $text .= " <TR>";
+ list($type, $name, $id) = split('/', $privname);
+ $text .= " <TH>";
+ $text .= " <span id=\"resgrp$id\">$name</span>";
+ $text .= " <span dojoType=\"tooltip\" connectId=\"resgrp$id\">";
+ if(array_key_exists($type, $resgroupmembers) &&
+ array_key_exists($id, $resgroupmembers[$type]) &&
+ is_array($resgroupmembers[$type][$id])) {
+ foreach($resgroupmembers[$type][$id] as $resource) {
+ $text .= " {$resource['name']}<br>";
+ }
+ }
+ $text .= " </span>";
+ $text .= " </TH>";
+ //$text .= " <TH>$name</TH>";
+ $text .= " <TH>$type</TH>";
+
+ if($disabled)
+ $disabled = 'disabled=disabled';
+ else
+ $disabled = '';
+
+ # block rights
+ if(array_key_exists($privname, $privs) &&
+ in_array("block", $privs[$privname])) {
+ $checked = "checked";
+ $blocked = 1;
+ }
+ else {
+ $checked = "";
+ $blocked = 0;
+ }
+ $count = count($types) + 1;
+ $name = "privrow[" . $privname . ":block]";
+ $text .= " <TD align=center bgcolor=gray><INPUT type=checkbox ";
+ $text .= "dojoType=Checkbox id=ck$rownum:block name=\"$name\" $checked ";
+ $text .= "$disabled onClick=\"javascript:";
+ $text .= "changeCascadedRights(this.checked, $rownum, $count, 1, 3)\"></TD>";
+
+ #cascade rights
+ if(array_key_exists($privname, $privs) &&
+ in_array("cascade", $privs[$privname]))
+ $checked = "checked";
+ else
+ $checked = "";
+ $name = "privrow[" . $privname . ":cascade]";
+ $text .= " <TD align=center bgcolor=\"#008000\" id=cell$rownum:0>";
+ $text .= "<INPUT type=checkbox dojoType=Checkbox id=ck$rownum:0 name=\"$name\" ";
+ $text .= "onClick=\"privChange(this.checked, $rownum, 0, 3);\" ";
+ $text .= "$checked $disabled></TD>";
+
+ # normal rights
+ $j = 1;
+ foreach($types as $type) {
+ $bgcolor = "";
+ $checked = "";
+ $value = "";
+ $cascaded = 0;
+ if(array_key_exists($privname, $cascadeprivs) &&
+ in_array($type, $cascadeprivs[$privname])) {
+ $bgcolor = "bgcolor=\"#008000\"";
+ $checked = "checked";
+ $value = "value=cascade";
+ $cascaded = 1;
+ }
+ if(array_key_exists($privname, $privs) &&
+ in_array($type, $privs[$privname])) {
+ if($cascaded) {
+ $value = "value=cascadesingle";
+ }
+ else {
+ $checked = "checked";
+ $value = "value=single";
+ }
+ }
+ // if $type is administer or manageGroup, and it is not checked, and the
+ # user is not in the resource owner group, don't print the checkbox
+ if(($type == "administer" || $type == "manageGroup") &&
+ $checked != "checked" &&
+ ! array_key_exists($resourcegroups[$id]["ownerid"], $user["groups"])) {
+ $text .= "<TD><img src=images/blank.gif></TD>";
+ }
+ else {
+ $name = "privrow[" . $privname . ":" . $type . "]";
+ $text .= " <TD align=center id=cell$rownum:$j $bgcolor><INPUT ";
+ $text .= "type=checkbox dojoType=Checkbox name=\"$name\" ";
+ $text .= "id=ck$rownum:$j $checked $value $disabled ";
+ $text .= "onClick=\"javascript:nodeCheck(this.checked, $rownum, $j, 3)\" ";
+ $text .= "onBlur=\"javascript:nodeCheck(this.checked, $rownum, $j, 3)\">";
+ $text .= "</TD>";
+ }
+ $j++;
+ }
+ $text .= " </TR>";
+ $count = count($types) + 1;
+ if($blocked) {
+ $js .= "changeCascadedRights(true, $rownum, $count, 0, 0);";
+ }
+ return array('html' => $text,
+ 'javascript' => $js);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getNodePrivileges($node, $type, $privs)
+///
+/// \param $node - id of node
+/// \param $type - (optional) resources, users, usergroups, or all
+/// \param $privs - (optional) privilege array as returned by this function or
+/// getNodeCascadePrivileges
+///
+/// \return an array of privileges at the node:\n
+///\pre
+///Array\n
+///(\n
+/// [resources] => Array\n
+/// (\n
+/// )\n
+/// [users] => Array\n
+/// (\n
+/// [userid0] => Array\n
+/// (\n
+/// [0] => priv0\n
+/// ...\n
+/// [N] => privN\n
+/// )\n
+/// ...\n
+/// [useridN] => Array()\n
+/// )\n
+/// [usergroups] => Array\n
+/// (\n
+/// [group0] => Array\n
+/// (\n
+/// [0] => priv0\n
+/// ...\n
+/// [N] => privN\n
+/// )\n
+/// ...\n
+/// [groupN] => Array()\n
+/// )\n
+///)
+///
+/// \brief gets the requested privileges at the specified node
+///
+////////////////////////////////////////////////////////////////////////////////
+function getNodePrivileges($node, $type="all", $privs=0) {
+ global $user;
+ $key = getKey(array($node, $type, $privs));
+ if(array_key_exists($key, $_SESSION['nodeprivileges']))
+ return $_SESSION['nodeprivileges'][$key];
+ if(! $privs)
+ $privs = array("resources" => array(),
+ "users" => array(),
+ "usergroups" => array());
+ if($type == "resources" || $type == "all") {
+ $query = "SELECT g.id AS id, "
+ . "p.type AS privtype, "
+ . "g.name AS name, "
+ . "t.name AS type "
+ . "FROM resourcepriv p, "
+ . "resourcetype t, "
+ . "resourcegroup g "
+ . "WHERE p.privnodeid = $node AND "
+ . "p.resourcegroupid = g.id AND "
+ . "g.resourcetypeid = t.id";
+ $qh = doQuery($query, 350);
+ while($row = mysql_fetch_assoc($qh)) {
+ $name = $row["type"] . "/" . $row["name"] . "/" . $row["id"];
+ if(array_key_exists($name, $privs["resources"]))
+ array_push($privs["resources"][$name], $row["privtype"]);
+ else
+ $privs["resources"][$name] = array($row["privtype"]);
+ }
+ }
+ if($type == "users" || $type == "all") {
+ $query = "SELECT t.name AS name, "
+ . "CONCAT(u.unityid, '@', a.name) AS unityid "
+ . "FROM user u, "
+ . "userpriv up, "
+ . "userprivtype t, "
+ . "affiliation a "
+ . "WHERE up.privnodeid = $node AND "
+ . "up.userprivtypeid = t.id AND "
+ . "up.userid = u.id AND "
+ . "up.userid IS NOT NULL AND "
+ . "u.affiliationid = a.id "
+ . "ORDER BY u.unityid";
+ $qh = doQuery($query, 351);
+ while($row = mysql_fetch_assoc($qh)) {
+ if(array_key_exists($row["unityid"], $privs["users"])) {
+ array_push($privs["users"][$row["unityid"]], $row["name"]);
+ }
+ else {
+ $privs["users"][$row["unityid"]] = array($row["name"]);
+ }
+ }
+ }
+ if($type == "usergroups" || $type == "all") {
+ $query = "SELECT t.name AS priv, "
+ . "g.name AS groupname, "
+ . "g.affiliationid, "
+ . "a.name AS affiliation, "
+ . "g.id "
+ . "FROM userpriv up, "
+ . "userprivtype t, "
+ . "usergroup g "
+ . "LEFT JOIN affiliation a ON (g.affiliationid = a.id) "
+ . "WHERE up.privnodeid = $node AND "
+ . "up.userprivtypeid = t.id AND "
+ . "up.usergroupid = g.id AND "
+ . "up.usergroupid IS NOT NULL "
+ . "ORDER BY g.name";
+ $qh = doQuery($query, 352);
+ while($row = mysql_fetch_assoc($qh)) {
+ if(array_key_exists($row["groupname"], $privs["usergroups"]))
+ array_push($privs["usergroups"][$row["groupname"]]['privs'], $row["priv"]);
+ else
+ $privs["usergroups"][$row["groupname"]] = array('id' => $row['id'],
+ 'affiliationid' => $row['affiliationid'],
+ 'affiliation' => $row['affiliation'],
+ 'privs' => array($row['priv']));
+ }
+ }
+ $_SESSION['nodeprivileges'][$key] = $privs;
+ return $privs;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getNodeCascadePrivileges($node, $type="all", $privs=0)
+///
+/// \param $node - id of node
+/// \param $type - (optional) resources, users, usergroups, or all
+/// \param $privs - (optional) privilege array as returned by this function or
+/// getNodeCascadePrivileges
+///
+/// \return an array of privileges cascaded to the node:\n
+///Array\n
+///(\n
+/// [resources] => Array\n
+/// (\n
+/// )\n
+/// [users] => Array\n
+/// (\n
+/// [userid0] => Array\n
+/// (\n
+/// [0] => priv0\n
+/// ...\n
+/// [N] => privN\n
+/// )\n
+/// ...\n
+/// [useridN] => Array()\n
+/// )\n
+/// [usergroups] => Array\n
+/// (\n
+/// [group0] => Array\n
+/// (\n
+/// [0] => priv0\n
+/// ...\n
+/// [N] => privN\n
+/// )\n
+/// ...\n
+/// [groupN] => Array()\n
+/// )\n
+///)
+///
+/// \brief gets the requested cascaded privileges for the specified node
+///
+////////////////////////////////////////////////////////////////////////////////
+function getNodeCascadePrivileges($node, $type="all", $privs=0) {
+ $key = getKey(array($node, $type, $privs));
+ if(array_key_exists($key, $_SESSION['cascadenodeprivileges']))
+ return $_SESSION['cascadenodeprivileges'][$key];
+ if(! $privs)
+ $privs = array("resources" => array(),
+ "users" => array(),
+ "usergroups" => array());
+
+ # get node's parents
+ $nodelist = getParentNodes($node);
+
+ if($type == "resources" || $type == "all") {
+ $mynodelist = $nodelist;
+ # loop through each node, starting at the root
+ while(count($mynodelist)) {
+ $node = array_pop($mynodelist);
+ # get all resource groups with block set at this node and remove any cascaded privs
+ $query = "SELECT g.name AS name, "
+ . "t.name AS type "
+ . "FROM resourcepriv p, "
+ . "resourcetype t, "
+ . "resourcegroup g "
+ . "WHERE p.privnodeid = $node AND "
+ . "p.resourcegroupid = g.id AND "
+ . "g.resourcetypeid = t.id AND "
+ . "p.type = 'block'";
+
+ $qh = doQuery($query, 353);
+ while($row = mysql_fetch_assoc($qh)) {
+ $name = $row["type"] . "/" . $row["name"];
+ unset($privs["resources"][$name]);
+ }
+
+ # get all privs for users with cascaded privs
+ $query = "SELECT g.id AS id, "
+ . "p.type AS privtype, "
+ . "g.name AS name, "
+ . "t.name AS type "
+ . "FROM resourcepriv p, "
+ . "resourcetype t, "
+ . "resourcegroup g "
+ . "WHERE p.privnodeid = $node AND "
+ . "p.resourcegroupid = g.id AND "
+ . "g.resourcetypeid = t.id AND "
+ . "p.type != 'block' AND "
+ . "p.type != 'cascade' AND "
+ . "p.resourcegroupid IN (SELECT resourcegroupid "
+ . "FROM resourcepriv "
+ . "WHERE type = 'cascade' AND "
+ . "privnodeid = $node)";
+ $qh = doQuery($query, 354);
+ while($row = mysql_fetch_assoc($qh)) {
+ $name = $row["type"] . "/" . $row["name"] . "/" . $row["id"];
+ // if we've already seen this resource group, add it to the
+ # resource group's privs
+ if(array_key_exists($name, $privs["resources"]))
+ array_push($privs["resources"][$name], $row["privtype"]);
+ // if we haven't seen this resource group, create an array containing
+ # this priv
+ else
+ $privs["resources"][$name] = array($row["privtype"]);
+ }
+ }
+ }
+ if($type == "users" || $type == "all") {
+ $mynodelist = $nodelist;
+ # loop through each node, starting at the root
+ while(count($mynodelist)) {
+ $node = array_pop($mynodelist);
+ # get all users with block set at this node and remove any cascaded privs
+ $query = "SELECT CONCAT(u.unityid, '@', a.name) AS unityid "
+ . "FROM user u, "
+ . "userpriv up, "
+ . "userprivtype t, "
+ . "affiliation a "
+ . "WHERE up.privnodeid = $node AND "
+ . "up.userprivtypeid = t.id AND "
+ . "up.userid = u.id AND "
+ . "up.userid IS NOT NULL AND "
+ . "t.name = 'block' AND "
+ . "u.affiliationid = a.id";
+ $qh = doQuery($query, 355);
+ while($row = mysql_fetch_assoc($qh)) {
+ unset($privs["users"][$row["unityid"]]);
+ }
+
+ # get all privs for users with cascaded privs
+ $query = "SELECT t.name AS name, "
+ . "CONCAT(u.unityid, '@', a.name) AS unityid "
+ . "FROM user u, "
+ . "userpriv up, "
+ . "userprivtype t, "
+ . "affiliation a "
+ . "WHERE up.privnodeid = $node AND "
+ . "up.userprivtypeid = t.id AND "
+ . "up.userid = u.id AND "
+ . "u.affiliationid = a.id AND "
+ . "up.userid IS NOT NULL AND "
+ . "t.name != 'cascade' AND "
+ . "t.name != 'block' AND "
+ . "up.userid IN (SELECT up.userid "
+ . "FROM userpriv up, "
+ . "userprivtype t "
+ . "WHERE up.userprivtypeid = t.id AND "
+ . "t.name = 'cascade' AND "
+ . "up.privnodeid = $node) "
+ . "ORDER BY u.unityid";
+ $qh = doQuery($query, 356);
+ while($row = mysql_fetch_assoc($qh)) {
+ // if we've already seen this user, add it to the user's privs
+ if(array_key_exists($row["unityid"], $privs["users"])) {
+ array_push($privs["users"][$row["unityid"]], $row["name"]);
+ }
+ // if we haven't seen this user, create an array containing this priv
+ else {
+ $privs["users"][$row["unityid"]] = array($row["name"]);
+ }
+ }
+ }
+ }
+ if($type == "usergroups" || $type == "all") {
+ $mynodelist = $nodelist;
+ # loop through each node, starting at the root
+ while(count($mynodelist)) {
+ $node = array_pop($mynodelist);
+ # get all groups with block set at this node and remove any cascaded privs
+ $query = "SELECT g.name AS groupname "
+ . "FROM usergroup g, "
+ . "userpriv up, "
+ . "userprivtype t "
+ . "WHERE up.privnodeid = $node AND "
+ . "up.userprivtypeid = t.id AND "
+ . "up.usergroupid = g.id AND "
+ . "up.usergroupid IS NOT NULL AND "
+ . "t.name = 'block'";
+ $qh = doQuery($query, 357);
+ while($row = mysql_fetch_assoc($qh)) {
+ unset($privs["usergroups"][$row["groupname"]]);
+ }
+
+ # get all privs for groups with cascaded privs
+ $query = "SELECT t.name AS priv, "
+ . "g.name AS groupname, "
+ . "g.affiliationid, "
+ . "a.name AS affiliation, "
+ . "g.id "
+ . "FROM userpriv up, "
+ . "userprivtype t, "
+ . "usergroup g "
+ . "LEFT JOIN affiliation a ON (g.affiliationid = a.id) "
+ . "WHERE up.privnodeid = $node AND "
+ . "up.userprivtypeid = t.id AND "
+ . "up.usergroupid = g.id AND "
+ . "up.usergroupid IS NOT NULL AND "
+ . "t.name != 'cascade' AND "
+ . "t.name != 'block' AND "
+ . "up.usergroupid IN (SELECT up.usergroupid "
+ . "FROM userpriv up, "
+ . "userprivtype t "
+ . "WHERE up.userprivtypeid = t.id AND "
+ . "t.name = 'cascade' AND "
+ . "up.privnodeid = $node) "
+ . "ORDER BY g.name";
+ $qh = doQuery($query, 358);
+ while($row = mysql_fetch_assoc($qh)) {
+ // if we've already seen this group, add it to the user's privs
+ if(array_key_exists($row["groupname"], $privs["usergroups"]))
+ array_push($privs["usergroups"][$row["groupname"]]['privs'], $row["priv"]);
+ // if we haven't seen this group, create an array containing this priv
+ else
+ $privs["usergroups"][$row["groupname"]] = array('id' => $row['id'],
+ 'affiliationid' => $row['affiliationid'],
+ 'affiliation' => $row['affiliation'],
+ 'privs' => array($row['priv']));
+ }
+ }
+ }
+ $_SESSION['cascadenodeprivileges'][$key] = $privs;
+ return $privs;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJchangeUserPrivs()
+///
+/// \brief processes input for changes in users' privileges at a specific node,
+/// submits the changes to the database returns a call to refreshPerms()
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJchangeUserPrivs() {
+ global $user;
+ $node = processInputVar("activeNode", ARG_NUMERIC);
+ if(! checkUserHasPriv("userGrant", $user["id"], $node)) {
+ $text = "You do not have rights to modify user privileges at this node.";
+ print "alert('$text');";
+ dbDisconnect();
+ exit;
+ }
+ $newuser = processInputVar("item", ARG_STRING);
+ $newpriv = processInputVar('priv', ARG_STRING);
+ $newprivval = processInputVar('value', ARG_STRING);
+ //print "alert('node: $node; newuser: $newuser; newpriv: $newpriv; newprivval: $newprivval');";
+
+ # get cascade privs at this node
+ $cascadePrivs = getNodeCascadePrivileges($node, "users");
+
+ // if $newprivval is true and $newuser already has $newpriv
+ // cascaded to it, do nothing
+ if($newprivval == 'true') {
+ if(array_key_exists($newuser, $cascadePrivs['users']) &&
+ in_array($newpriv, $cascadePrivs['users'][$newuser])) {
+ dbDisconnect();
+ exit;
+ }
+ // add priv
+ $adds = array($newpriv);
+ $removes = array();
+ }
+ else {
+ // remove priv
+ $adds = array();
+ $removes = array($newpriv);
+ }
+ updateUserOrGroupPrivs($newuser, $node, $adds, $removes, "user");
+ $_SESSION['dirtyprivs'] = 1;
+ dbDisconnect();
+ exit;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJchangeUserGroupPrivs()
+///
+/// \brief processes input for changes in user group privileges at a specific
+/// node, submits the changes to the database and calls viewNodes
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJchangeUserGroupPrivs() {
+ global $user;
+ $node = processInputVar("activeNode", ARG_NUMERIC);
+ if(! checkUserHasPriv("userGrant", $user["id"], $node)) {
+ $text = "You do not have rights to modify user privileges at this node.";
+ print "alert('$text');";
+ dbDisconnect();
+ exit;
+ }
+ $newusergrpid = processInputVar("item", ARG_NUMERIC);
+ $newusergrp = getUserGroupName($newusergrpid);
+ $newpriv = processInputVar('priv', ARG_STRING);
+ $newprivval = processInputVar('value', ARG_STRING);
+ //print "alert('node: $node; newuser:grp $newuser;grp newpriv: $newpriv; newprivval: $newprivval');";
+
+ # get cascade privs at this node
+ $cascadePrivs = getNodeCascadePrivileges($node, "usergroups");
+
+ // if $newprivval is true and $newusergrp already has $newpriv
+ // cascaded to it, do nothing
+ if($newprivval == 'true') {
+ if(array_key_exists($newusergrp, $cascadePrivs['usergroups']) &&
+ in_array($newpriv, $cascadePrivs['usergroups'][$newusergrp]['privs'])) {
+ dbDisconnect();
+ exit;
+ }
+ // add priv
+ $adds = array($newpriv);
+ $removes = array();
+ }
+ else {
+ // remove priv
+ $adds = array();
+ $removes = array($newpriv);
+ }
+ updateUserOrGroupPrivs($newusergrpid, $node, $adds, $removes, "group");
+ $_SESSION['dirtyprivs'] = 1;
+ dbDisconnect();
+ exit;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJchangeResourcePrivs()
+///
+/// \brief processes input for changes in resource group privileges at a
+/// specific node and submits the changes to the database
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJchangeResourcePrivs() {
+ global $user;
+ $node = processInputVar("activeNode", ARG_NUMERIC);
+ if(! checkUserHasPriv("resourceGrant", $user["id"], $node)) {
+ $text = "You do not have rights to modify resource privileges at this node.";
+ print "alert('$text');";
+ dbDisconnect();
+ exit;
+ }
+ $resourcegrp = processInputVar("item", ARG_STRING);
+ $newpriv = processInputVar('priv', ARG_STRING);
+ $newprivval = processInputVar('value', ARG_STRING);
+ //print "alert('node: $node; resourcegrp: $resourcegrp; newpriv: $newpriv; newprivval: $newprivval');";
+
+ # get cascade privs at this node
+ $cascadePrivs = getNodeCascadePrivileges($node, "resources");
+
+ // if $newprivval is true and $resourcegrp already has $newpriv
+ // cascaded to it, do nothing
+ if($newprivval == 'true') {
+ if(array_key_exists($resourcegrp, $cascadePrivs['resources']) &&
+ in_array($newpriv, $cascadePrivs['resources'][$resourcegrp])) {
+ dbDisconnect();
+ exit;
+ }
+ // add priv
+ $adds = array($newpriv);
+ $removes = array();
+ }
+ else {
+ // remove priv
+ $adds = array();
+ $removes = array($newpriv);
+ }
+ $tmpArr = explode('/', $resourcegrp);
+ updateResourcePrivs($tmpArr[2], $node, $adds, $removes);
+ $_SESSION['dirtyprivs'] = 1;
+ dbDisconnect();
+ exit;
+}
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn addUserPriv()
+///
+/// \brief prints a page for adding privileges to a node for a user
+///
+////////////////////////////////////////////////////////////////////////////////
+/*function addUserPriv() {
+ global $submitErr;
+ $node = processInputVar("activeNode", ARG_NUMERIC);
+ $newuser = processInputVar("newuser", ARG_STRING);
+ $tmp = processInputVar("openNodes", ARG_STRING);
+ if($tmp != "")
+ $openNodes = explode(":", $tmp);
+ else
+ $openNodes = array(DEFAULT_PRIVNODE);
+ $usertypes = getTypes("users");
+
+ $topNodes = getChildNodes();
+ print "<H2>Add User</H2>\n";
+ recursivePrintNodes($topNodes, $openNodes, $node);
+ printSubmitErr(NEWUSERERR);
+ printSubmitErr(ADDUSERNOPRIVS);
+ print "<FORM action=\"" . BASEURL . SCRIPT . "#users\" method=post>\n";
+ print "<TABLE border=1>\n";
+ print " <TR>\n";
+ print " <TD></TD>\n";
+ print " <TH bgcolor=gray>Block<br>Cascaded<br>Rights</TH>\n";
+ print " <TH bgcolor=\"#008000\">Cascade<br>to Child<br>Nodes</TH>\n";
+ foreach($usertypes["users"] as $type) {
+ $img = getImageText($type);
+ print " <TD>$img</TD>\n";
+ }
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TD><INPUT type=text name=newuser value=\"$newuser\" size=8 ";
+ print "maxlength=8></TD>\n";
+
+ # block rights
+ $count = count($usertypes) + 1;
+ print " <TD align=center bgcolor=gray><INPUT type=checkbox ";
+ print "name=block></TD>\n";
+
+ #cascade rights
+ print " <TD align=center bgcolor=\"#008000\" id=usercell0:0>";
+ print "<INPUT type=checkbox id=userck0:0 name=cascade ";
+ print "></TD>\n";
+
+ # normal rights
+ $j = 1;
+ foreach($usertypes["users"] as $type) {
+ print " <TD align=center id=usercell0:$j><INPUT type=checkbox ";
+ print "name=\"$type\" id=userck0:$j></TD>\n";
+ $j++;
+ }
+ print " </TR>\n";
+ print "</TABLE>\n";
+ $openNodes = implode(':', $openNodes);
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TD><INPUT type=submit value=\"Submit New User\"></TD>\n";
+ print " </TR>\n";
+ # FIXME add javascript to reset button
+ print "</TABLE>\n";
+ print "<INPUT type=hidden name=mode value=submitAddUserPriv>\n";
+ print "<INPUT type=hidden name=activeNode value=$node>\n";
+ print "<INPUT type=hidden name=openNodes value=\"$openNodes \">\n";
+ print "</FORM>\n";
+}*/
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitAddUserPriv()
+///
+/// \brief processes input for adding privileges to a node for a user; adds the
+/// privileges; calls viewNodes
+///
+////////////////////////////////////////////////////////////////////////////////
+/*function submitAddUserPriv() {
+ global $submitErr, $submitErrMsg;
+ $newuser = processInputVar("newuser", ARG_STRING);
+ if(! validateUserid($newuser)) {
+ $submitErr |= NEWUSERERR;
+ $submitErrMsg[NEWUSERERR] = "<strong>$newuser was not found</strong>";
+ addUserPriv();
+ return;
+ }
+ $usertypes = getTypes("users");
+ array_push($usertypes["users"], "block");
+ array_push($usertypes["users"], "cascade");
+ $newuserprivs = array();
+ foreach($usertypes["users"] as $type) {
+ $tmp = processInputVar($type, ARG_STRING);
+ if($tmp == "on")
+ array_push($newuserprivs, $type);
+ }
+ if(empty($newuserprivs) || (count($newuserprivs) == 1 &&
+ in_array("cascade", $newuserprivs))) {
+ $submitErr |= ADDUSERNOPRIVS;
+ $submitErrMsg[ADDUSERNOPRIVS] = "No user privileges were specified";
+ addUserPriv();
+ return;
+ }
+
+ $node = processInputVar("activeNode", ARG_NUMERIC);
+ updateUserOrGroupPrivs($newuser, $node, $newuserprivs, array(), "user");
+ clearPrivCache();
+ viewNodes();
+}*/
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJsubmitAddUserPriv()
+///
+/// \brief processes input for adding privileges to a node for a user; adds the
+/// privileges; returns call to refreshPerms()
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJsubmitAddUserPriv() {
+ global $submitErr, $submitErrMsg, $user;
+ $node = processInputVar("activeNode", ARG_NUMERIC);
+ if(! checkUserHasPriv("userGrant", $user["id"], $node)) {
+ $text = "You do not have rights to add new users at this node.";
+ print "addUserPaneHide(); ";
+ print "alert('$text');";
+ dbDisconnect();
+ exit;
+ }
+ $newuser = processInputVar("newuser", ARG_STRING);
+ if(! validateUserid($newuser)) {
+ $text = "<font color=red>$newuser is not a valid userid</font>";
+ print setAttribute('addUserPrivStatus', 'innerHTML', $text);
+ dbDisconnect();
+ exit;
+ }
+
+ $perms = explode(':', processInputVar('perms', ARG_STRING));
+ $usertypes = getTypes("users");
+ array_push($usertypes["users"], "block");
+ array_push($usertypes["users"], "cascade");
+ $newuserprivs = array();
+ foreach($usertypes["users"] as $type) {
+ if(in_array($type, $perms))
+ array_push($newuserprivs, $type);
+ }
+ if(empty($newuserprivs) || (count($newuserprivs) == 1 &&
+ in_array("cascade", $newuserprivs))) {
+ $text = "<font color=red>No user privileges were specified</font>";
+ print setAttribute('addUserPrivStatus', 'innerHTML', $text);
+ dbDisconnect();
+ exit;
+ }
+ $node = processInputVar("activeNode", ARG_NUMERIC);
+
+ updateUserOrGroupPrivs($newuser, $node, $newuserprivs, array(), "user");
+ clearPrivCache();
+ print "refreshPerms();";
+ dbDisconnect();
+ exit;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn addUserGroupPriv()
+///
+/// \brief prints a page for adding privileges to a node for a user group
+///
+////////////////////////////////////////////////////////////////////////////////
+/*function addUserGroupPriv() {
+ global $submitErr;
+ $node = processInputVar("activeNode", ARG_NUMERIC);
+ $newgroup = processInputVar("newgroup", ARG_STRING);
+ $tmp = processInputVar("openNodes", ARG_STRING);
+ if($tmp != "")
+ $openNodes = explode(":", $tmp);
+ else
+ $openNodes = array(DEFAULT_PRIVNODE);
+ $usertypes = getTypes("users");
+
+ $groups = getUserGroups();
+ unset($groups["82"]); // remove the "None" group
+
+ $topNodes = getChildNodes();
+ print "<H2>Add User Group</H2>\n";
+ recursivePrintNodes($topNodes, $openNodes, $node);
+ printSubmitErr(ADDUSERNOPRIVS);
+ print "<FORM action=\"" . BASEURL . SCRIPT . "#groups\" method=post>\n";
+ print "<TABLE border=1>\n";
+ print " <TR>\n";
+ print " <TD></TD>\n";
+ print " <TH bgcolor=gray>Block<br>Cascaded<br>Rights</TH>\n";
+ print " <TH bgcolor=\"#008000\">Cascade<br>to Child<br>Nodes</TH>\n";
+ foreach($usertypes["users"] as $type) {
+ $img = getImageText($type);
+ print " <TD>$img</TD>\n";
+ }
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TD>\n";
+ printSelectInput("newgroupid", $groups);
+ print " </TD>\n";
+ #print "</TD>\n";
+
+ # block rights
+ print " <TD align=center bgcolor=gray><INPUT type=checkbox ";
+ print "name=block></TD>\n";
+
+ #cascade rights
+ print " <TD align=center bgcolor=\"#008000\"><INPUT type=checkbox ";
+ print "name=cascade></TD>\n";
+
+ # normal rights
+ foreach($usertypes["users"] as $type) {
+ print " <TD align=center><INPUT type=checkbox ";
+ print "name=\"$type\"></TD>\n";
+ }
+ print " </TR>\n";
+ print "</TABLE>\n";
+ $openNodes = implode(':', $openNodes);
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TD><INPUT type=submit value=\"Submit New Group\"></TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ print "<INPUT type=hidden name=mode value=submitAddUserGroupPriv>\n";
+ print "<INPUT type=hidden name=activeNode value=$node>\n";
+ print "<INPUT type=hidden name=openNodes value=\"$openNodes \">\n";
+ print "</FORM>\n";
+}*/
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitAddUserGroupPriv()
+///
+/// \brief processes input for adding privileges to a node for a user group;
+/// adds the privileges; calls viewNodes
+///
+////////////////////////////////////////////////////////////////////////////////
+/*function submitAddUserGroupPriv() {
+ global $submitErr, $submitErrMsg;
+ $newgroupid = processInputVar("newgroupid", ARG_NUMERIC);
+ $usertypes = getTypes("users");
+ array_push($usertypes["users"], "block");
+ array_push($usertypes["users"], "cascade");
+ $newgroupprivs = array();
+ foreach($usertypes["users"] as $type) {
+ $tmp = processInputVar($type, ARG_STRING);
+ if($tmp == "on")
+ array_push($newgroupprivs, $type);
+ }
+ if(empty($newgroupprivs) || (count($newgroupprivs) == 1 &&
+ in_array("cascade", $newgroupprivs))) {
+ $submitErr |= ADDUSERNOPRIVS;
+ $submitErrMsg[ADDUSERNOPRIVS] = "No user group privileges were specified";
+ addUserGroupPriv();
+ return;
+ }
+
+ $node = processInputVar("activeNode", ARG_NUMERIC);
+ updateUserOrGroupPrivs($newgroupid, $node, $newgroupprivs, array(), "group");
+ clearPrivCache();
+ viewNodes();
+}*/
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJsubmitAddUserGroupPriv()
+///
+/// \brief processes input for adding privileges to a node for a user group;
+/// adds the privileges; calls viewNodes
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJsubmitAddUserGroupPriv() {
+ global $user;
+ $node = processInputVar("activeNode", ARG_NUMERIC);
+ if(! checkUserHasPriv("userGrant", $user["id"], $node)) {
+ $text = "You do not have rights to add new user groups at this node.";
+ print "addUserGroupPaneHide(); ";
+ print "alert('$text');";
+ dbDisconnect();
+ exit;
+ }
+ $newgroupid = processInputVar("newgroupid", ARG_NUMERIC);
+ # FIXME validate newgroupid
+
+ $perms = explode(':', processInputVar('perms', ARG_STRING));
+ $usertypes = getTypes("users");
+ array_push($usertypes["users"], "block");
+ array_push($usertypes["users"], "cascade");
+ $newgroupprivs = array();
+ foreach($usertypes["users"] as $type) {
+ if(in_array($type, $perms))
+ array_push($newgroupprivs, $type);
+ }
+ if(empty($newgroupprivs) || (count($newgroupprivs) == 1 &&
+ in_array("cascade", $newgroupprivs))) {
+ $text = "<font color=red>No user group privileges were specified</font>";
+ print setAttribute('addUserGroupPrivStatus', 'innerHTML', $text);
+ dbDisconnect();
+ exit;
+ }
+
+ updateUserOrGroupPrivs($newgroupid, $node, $newgroupprivs, array(), "group");
+ clearPrivCache();
+ print "addUserGroupPaneHide(); ";
+ print "refreshPerms(); ";
+ dbDisconnect();
+ exit;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJsubmitAddResourcePriv()
+///
+/// \brief processes input for adding privileges to a node for a resource group;
+/// adds the privileges
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJsubmitAddResourcePriv() {
+ global $user;
+ $node = processInputVar("activeNode", ARG_NUMERIC);
+ if(! checkUserHasPriv("resourceGrant", $user["id"], $node)) {
+ $text = "You do not have rights to add new resource groups at this node.";
+ print "addUserGroupPaneHide(); ";
+ print "alert('$text');";
+ dbDisconnect();
+ exit;
+ }
+ $newgroupid = processInputVar("newgroupid", ARG_NUMERIC);
+ # FIXME validate newgroupid
+
+ $perms = explode(':', processInputVar('perms', ARG_STRING));
+ $privtypes = array("block", "cascade", "available", "administer", "manageGroup");
+ $newgroupprivs = array();
+ foreach($privtypes as $type) {
+ if(in_array($type, $perms))
+ array_push($newgroupprivs, $type);
+ }
+ if(empty($newgroupprivs) || (count($newgroupprivs) == 1 &&
+ in_array("cascade", $newgroupprivs))) {
+ $text = "<font color=red>No resource group privileges were specified</font>";
+ print setAttribute('addResourceGroupPrivStatus', 'innerHTML', $text);
+ dbDisconnect();
+ exit;
+ }
+
+ updateResourcePrivs($newgroupid, $node, $newgroupprivs, array());
+ clearPrivCache();
+ print "addResourceGroupPaneHide(); ";
+ print "refreshPerms(); ";
+ dbDisconnect();
+ exit;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn checkUserHasPriv($priv, $uid, $node, $privs,
+/// $cascadePrivs)
+///
+/// \param $priv - privilege to check for
+/// \param $uid - numeric id of user
+/// \param $node - id of node
+/// \param $privs - (optional) privileges at node
+/// \param $cascadePrivs - (optional) privileges cascaded to node
+///
+/// \return 1 if the user has $priv at $node, 0 if not
+///
+/// \brief checks to see if the user has $priv at $node; if $privs
+/// and $cascadePrivs are not passed in, they are looked up for $node
+///
+////////////////////////////////////////////////////////////////////////////////
+function checkUserHasPriv($priv, $uid, $node, $privs=0, $cascadePrivs=0) {
+ global $user;
+ $key = getKey(array($priv, $uid, $node, $privs, $cascadePrivs));
+ if(array_key_exists($key, $_SESSION['userhaspriv']))
+ return $_SESSION['userhaspriv'][$key];
+ if($user["id"] != $uid)
+ $_user = getUserInfo($uid);
+ else
+ $_user = $user;
+ $affilUserid = "{$_user['unityid']}@{$_user['affiliation']}";
+
+ if(! is_array($privs)) {
+ $privs = getNodePrivileges($node, 'users');
+ $privs = getNodePrivileges($node, 'usergroups', $privs);
+ }
+ if(! is_array($cascadePrivs)) {
+ $cascadePrivs = getNodeCascadePrivileges($node, 'users');
+ $cascadePrivs = getNodeCascadePrivileges($node, 'usergroups', $cascadePrivs);
+ }
+ // if user (has $priv at this node) ||
+ # (has cascaded $priv && ! have block at this node) return 1
+ if((array_key_exists($affilUserid, $privs["users"]) &&
+ in_array($priv, $privs["users"][$affilUserid])) ||
+ ((array_key_exists($affilUserid, $cascadePrivs["users"]) &&
+ in_array($priv, $cascadePrivs["users"][$affilUserid])) &&
+ (! array_key_exists($affilUserid, $privs["users"]) ||
+ ! in_array("block", $privs["users"][$affilUserid])))) {
+ $_SESSION['userhaspriv'][$key] = 1;
+ return 1;
+ }
+
+ foreach($_user["groups"] as $groupname) {
+ // if group (has $priv at this node) ||
+ # (has cascaded $priv && ! have block at this node) return 1
+ if((array_key_exists($groupname, $privs["usergroups"]) &&
+ in_array($priv, $privs["usergroups"][$groupname]['privs'])) ||
+ ((array_key_exists($groupname, $cascadePrivs["usergroups"]) &&
+ in_array($priv, $cascadePrivs["usergroups"][$groupname]['privs'])) &&
+ (! array_key_exists($groupname, $privs["usergroups"]) ||
+ ! in_array("block", $privs["usergroups"][$groupname]['privs'])))) {
+ $_SESSION['userhaspriv'][$key] = 1;
+ return 1;
+ }
+ }
+ $_SESSION['userhaspriv'][$key] = 0;
+ return 0;
+}
+
+?>
diff --git a/web/.ht-inc/requests.php b/web/.ht-inc/requests.php
new file mode 100644
index 0000000..6f77a9f
--- /dev/null
+++ b/web/.ht-inc/requests.php
@@ -0,0 +1,4071 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+/**
+ * \file
+ */
+/// signifies an error with the submitted start date
+define("STARTDAYERR", 1);
+/// signifies an error with the submitted start hour
+define("STARTHOURERR", 1 << 1);
+/// signifies an error with the submitted end date
+define("ENDDAYERR", 1 << 2);
+/// signifies an error with the submitted end hour
+define("ENDHOURERR", 1 << 3);
+/// signifies an error with the submitted starting date
+define("STARTDATEERR", 1 << 4);
+/// signifies an error with the submitted endding date and time
+define("ENDDATEERR", 1 << 5);
+/// signifies an error with the selected imageid
+define("IMAGEIDERR", 1 << 6);
+/// signifies an error with the number of block machines
+define("BLOCKCNTERR", 1 << 7);
+/// signifies an error with the selected groupid
+define("USERGROUPIDERR", 1 << 8);
+/// signifies an error with the selected availibility time
+define("AVAILABLEERR", 1 << 9);
+/// signifies an error with the selected week number
+define("WEEKNUMERR", 1 << 10);
+/// signifies an error with the selected day of the week
+define("DAYERR", 1 << 11);
+/// signifies an error with the specified name
+define("BLOCKNAMEERR", 1 << 12);
+/// signifies an error with the selected admin groupid
+define("ADMINGROUPIDERR", 1 << 13);
+
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn newReservation()
+///
+/// \brief prints form for submitting a new reservation
+///
+////////////////////////////////////////////////////////////////////////////////
+function newReservation() {
+ global $submitErr, $user;
+ $timestamp = processInputVar("stamp", ARG_NUMERIC);
+ $imageid = processInputVar("imageid", ARG_STRING, getUsersLastImage($user['id']));
+ $length = processInputVar("length", ARG_NUMERIC);
+ $day = processInputVar("day", ARG_STRING);
+ $hour = processInputVar("hour", ARG_NUMERIC);
+ $minute = processInputVar("minute", ARG_NUMERIC);
+ $meridian = processInputVar("meridian", ARG_STRING);
+
+ if(! $submitErr)
+ print "<H2>New Reservation</H2><br>\n";
+
+ $resources = getUserResources(array("imageAdmin", "imageCheckOut"));
+ $resources["image"] = removeNoCheckout($resources["image"]);
+
+ if((! in_array("imageCheckOut", $user["privileges"]) &&
+ ! in_array("imageAdmin", $user["privileges"])) ||
+ empty($resources['image'])) {
+ print "You don't have access to any environments and, therefore, cannot ";
+ print "make any reservations.<br>\n";
+ return;
+ }
+ print "Please select the environment you want to use from the list:<br>\n";
+
+ $OSs = getOSList();
+
+ $images = getImages();
+ $maxTimes = getUserMaxTimes();
+ print "<script language=javascript>\n";
+ print "var defaultMaxTime = {$maxTimes['initial']};\n";
+ print "var maxTimes = {\n";
+ foreach(array_keys($resources['image']) as $imgid) {
+ if(array_key_exists($imgid, $images))
+ print " $imgid: {$images[$imgid]['maxinitialtime']},\n";
+ }
+ print " 0: 0\n"; // this is because IE doesn't like the last item having a ',' after it
+ print "};\n";
+ print "</script>\n";
+
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ // list of images
+ uasort($resources["image"], "sortKeepIndex");
+ printSelectInput("imageid", $resources["image"], $imageid, 1, 0, 'imagesel', "onChange=\"selectEnvironment();\" tabIndex=1");
+ print "<br><br>\n";
+
+ $imagenotes = getImageNotes($imageid);
+ $desc = '';
+ if(preg_match('/\w/', $imagenotes['description'])) {
+ $desc = preg_replace("/\n/", '<br>', $imagenotes['description']);
+ $desc = preg_replace("/\r/", '', $desc);
+ $desc = "<strong>Image Description</strong>:<br>\n$desc<br><br>\n";
+ }
+ print "<div id=imgdesc>$desc</div>\n";
+
+ print "<fieldset id=whenuse class=whenusefieldset>\n";
+ print "<legend>When would you like to use the application?</legend>\n";
+ print " <INPUT type=radio name=time id=timenow ";
+ print "onclick='updateWaitTime(0);' value=now>Now<br>\n";
+ print " <INPUT type=radio name=time value=future ";
+ print "onclick='updateWaitTime(0);' checked>Later:\n";
+ if($submitErr) {
+ $hour24 = $hour;
+ if($hour24 == 12) {
+ if($meridian == "am") {
+ $hour24 = 0;
+ }
+ }
+ elseif($meridian == "pm") {
+ $hour24 += 12;
+ }
+ list($month, $day, $year) = explode('/', $day);
+ $stamp = datetimeToUnix("$year-$month-$day $hour24:$minute:00");
+ $day = date('l', $stamp);
+ printReserveItems(1, $day, $hour, $minute, $meridian, $length);
+ }
+ elseif(empty($timestamp)) {
+ printReserveItems();
+ }
+ else {
+ $timeArr = explode(',', date('l,g,i,a', $timestamp));
+ printReserveItems(1, $timeArr[0], $timeArr[1], $timeArr[2], $timeArr[3], $length);
+ }
+ print "</fieldset>\n";
+
+ print "<div id=waittime class=hidden></div><br>\n";
+ $cont = addContinuationsEntry('submitRequest');
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "<INPUT id=newsubmit type=submit value=\"Create Reservation\">\n";
+ print "<INPUT type=hidden id=testjavascript value=0>\n";
+ print "</FORM>\n";
+ $cont = addContinuationsEntry('AJupdateWaitTime');
+ print "<INPUT type=hidden name=waitcontinuation id=waitcontinuation value=\"$cont\">\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJupdateWaitTime()
+///
+/// \brief generates html update for ajax call to display estimated wait time
+/// for current selection on new reservation page
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJupdateWaitTime() {
+ global $user, $requestInfo;
+ # proccess length
+ $length = processInputVar('length', ARG_NUMERIC);
+ $times = getUserMaxTimes();
+ if(empty($length) || $length > $times['initial']) {
+ dbDisconnect();
+ exit;
+ }
+ # process imageid
+ $imageid = processInputVar('imageid', ARG_NUMERIC);
+ $resources = getUserResources(array("imageAdmin", "imageCheckOut"));
+ $validImageids = array_keys($resources['image']);
+ if(! in_array($imageid, $validImageids)) {
+ dbDisconnect();
+ exit;
+ }
+
+ $desconly = processInputVar('desconly', ARG_NUMERIC, 1);
+
+ $imagenotes = getImageNotes($imageid);
+ if(preg_match('/\w/', $imagenotes['description'])) {
+ $desc = preg_replace("/\n/", '<br>', $imagenotes['description']);
+ $desc = preg_replace("/\r/", '', $desc);
+ print "dojo.byId('imgdesc').innerHTML = '<strong>Image Description</strong>:<br>";
+ print "$desc<br><br>'; ";
+ }
+
+ if($desconly)
+ return;
+
+ $images = getImages();
+ $now = time();
+ $start = unixFloor15($now);
+ $end = $start + $length * 60;
+ if($start < $now)
+ $end += 15 * 60;
+ $rc = isAvailable($images, $imageid, $start, $end, '');
+ semUnlock();
+ print "dojo.byId('waittime').innerHTML = ";
+ if($rc < 1) {
+ print "'<font color=red>Selection not currently available</font>'; ";
+ print "if(dojo.byId('newsubmit')) dojo.byId('newsubmit').value = 'View Time Table';";
+ }
+ elseif(array_key_exists(0, $requestInfo['loaded']) &&
+ $requestInfo['loaded'][0]) {
+ print "'Estimated load time: < 1 minute';";
+ }
+ else {
+ $loadtime = (int)(getImageLoadEstimate($imageid) / 60);
+ if($loadtime == 0)
+ print "'Estimated load time: < {$images[$imageid]['reloadtime']} minutes';";
+ else
+ printf("'Estimated load time: < %2.0f minutes';", $loadtime + 1);
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitRequest()
+///
+/// \brief checks to see if the request can fit in the schedule; adds it if
+/// it fits; notifies the user either way
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitRequest() {
+ global $submitErr, $user, $viewmode, $HTMLheader, $mode, $printedHTMLheader;
+
+ if($mode == 'submitTestProd') {
+ $data = getContinuationVar();
+ $data["revisionid"] = processInputVar("revisionid", ARG_MULTINUMERIC);
+ # TODO check for valid revisionids for each image
+ if(! empty($data["revisionid"])) {
+ foreach($data['revisionid'] as $key => $val) {
+ if(! is_numeric($val) || $val < 0)
+ unset($data['revisionid']);
+ }
+ }
+ }
+ else
+ $data = processRequestInput(1);
+ if($submitErr) {
+ $printedHTMLheader = 1;
+ print $HTMLheader;
+ print "<H2>New Reservation</H2>\n";
+ newReservation();
+ return;
+ }
+ // FIXME hack to make sure user didn't submit a request for an image he
+ // doesn't have access to
+ $resources = getUserResources(array("imageAdmin", "imageCheckOut"));
+ $validImageids = array_keys($resources['image']);
+ if(! in_array($data['imageid'], $validImageids))
+ $data['imageid'] = array_shift($validImageids);
+
+ $showrevisions = 0;
+ $subimages = 0;
+ $images = getImages();
+ $revcount = count($images[$data['imageid']]['imagerevision']);
+ if($revcount > 1)
+ $showrevisions = 1;
+ if($images[$data['imageid']]['imagemetaid'] != NULL &&
+ count($images[$data['imageid']]['subimages'])) {
+ $subimages = 1;
+ foreach($images[$data['imageid']]['subimages'] as $subimage) {
+ $revcount = count($images[$subimage]['imagerevision']);
+ if($revcount > 1)
+ $showrevisions = 1;
+ }
+ }
+
+ if($data["time"] == "now") {
+ $nowArr = getdate();
+ if($nowArr["minutes"] == 0) {
+ $subtract = 0;
+ $add = 0;
+ }
+ elseif($nowArr["minutes"] < 15) {
+ $subtract = $nowArr["minutes"] * 60;
+ $add = 900;
+ }
+ elseif($nowArr["minutes"] < 30) {
+ $subtract = ($nowArr["minutes"] - 15) * 60;
+ $add = 900;
+ }
+ elseif($nowArr["minutes"] < 45) {
+ $subtract = ($nowArr["minutes"] - 30) * 60;
+ $add = 900;
+ }
+ elseif($nowArr["minutes"] < 60) {
+ $subtract = ($nowArr["minutes"] - 45) * 60;
+ $add = 900;
+ }
+ $start = time() - $subtract;
+ $start -= $start % 60;
+ $nowfuture = "now";
+ }
+ else {
+ $add = 0;
+ $hour = $data["hour"];
+ if($data["hour"] == 12) {
+ if($data["meridian"] == "am") {
+ $hour = 0;
+ }
+ }
+ elseif($data["meridian"] == "pm") {
+ $hour = $data["hour"] + 12;
+ }
+
+ $tmp = explode('/', $data["day"]);
+ $start = mktime($hour, $data["minute"], "0", $tmp[0], $tmp[1], $tmp[2]);
+ if($start < time()) {
+ $printedHTMLheader = 1;
+ print $HTMLheader;
+ print "<H2>New Reservation</H2>\n";
+ print "<font color=\"#ff0000\">The time you requested is in the past.";
+ print " Please select \"Now\" or use a time in the future.</font><br>\n";
+ $submitErr = 1;
+ newReservation();
+ return;
+ }
+ $nowfuture = "future";
+ }
+ if($data["ending"] == "length")
+ $end = $start + $data["length"] * 60 + $add;
+ else {
+ $end = datetimeToUnix($data["enddate"]);
+ if($end % (15 * 60))
+ $end = unixFloor15($end) + (15 * 60);
+ }
+
+ // get semaphore lock
+ if(! semLock())
+ abort(3);
+
+ $max = getMaxOverlap($user['id']);
+ if(checkOverlap($start, $end, $max)) {
+ $printedHTMLheader = 1;
+ print $HTMLheader;
+ print "<H2>New Reservation</H2>\n";
+ if($max == 0) {
+ print "<font color=\"#ff0000\">The time you requested overlaps with ";
+ print "another reservation you currently have. You are only allowed ";
+ print "to have a single reservation at any given time. Please select ";
+ print "another time to use the application. If you are finished with ";
+ print "an active reservation, click \"Current Reservations\", ";
+ print "then click the \"End\" button of your active reservation.";
+ print "</font><br><br>\n";
+ }
+ else {
+ print "<font color=\"#ff0000\">The time you requested overlaps with ";
+ print "another reservation you currently have. You are allowed ";
+ print "to have $max overlapping reservations at any given time. ";
+ print "Please select another time to use the application. If you are ";
+ print "finished with an active reservation, click \"Current ";
+ print "Reservations\", then click the \"End\" button of your active ";
+ print "reservation.</font><br><br>\n";
+ }
+ $submitErr = 1;
+ newReservation();
+ return;
+ }
+ // if user is owner of the image and there is a test version of the image
+ # available, ask user if production or test image desired
+ if($mode != "submitTestProd" && $showrevisions &&
+ $images[$data["imageid"]]["ownerid"] == $user["id"]) {
+ #unset($data["testprod"]);
+ $printedHTMLheader = 1;
+ print $HTMLheader;
+ print "<H2>New Reservation</H2>\n";
+ if($subimages) {
+ print "This is a cluster environment. At least one image in the ";
+ print "cluster has more than one version available. Please select ";
+ print "the version you desire for each image listed below:<br>\n";
+ }
+ else {
+ print "There are multiple versions of this environment available. Please ";
+ print "select the version you would like to check out:<br>\n";
+ }
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post><br>\n";
+ if(! array_key_exists('subimages', $images[$data['imageid']]))
+ $images[$data['imageid']]['subimages'] = array();
+ array_unshift($images[$data['imageid']]['subimages'], $data['imageid']);
+ foreach($images[$data['imageid']]['subimages'] as $subimage) {
+ print "{$images[$subimage]['prettyname']}:<br>\n";
+ print "<table summary=\"lists versions of the selected environment, one must be selected to continue\">\n";
+ print " <TR>\n";
+ print " <TD></TD>\n";
+ print " <TH>Version</TH>\n";
+ print " <TH>Creator</TH>\n";
+ print " <TH>Created</TH>\n";
+ print " <TH>Currently in Production</TH>\n";
+ print " </TR>\n";
+ foreach($images[$subimage]['imagerevision'] as $revision) {
+ print " <TR>\n";
+ if(array_key_exists($subimage, $data['revisionid']) &&
+ $data['revisionid'][$subimage] == $revision['id'])
+ print " <TD align=center><INPUT type=radio name=revisionid[$subimage] value={$revision['id']} checked></TD>\n";
+ elseif($revision['production'])
+ print " <TD align=center><INPUT type=radio name=revisionid[$subimage] value={$revision['id']} checked></TD>\n";
+ else
+ print " <TD align=center><INPUT type=radio name=revisionid[$subimage] value={$revision['id']}></TD>\n";
+ print " <TD align=center>{$revision['revision']}</TD>\n";
+ print " <TD align=center>{$revision['user']}</TD>\n";
+ print " <TD align=center>{$revision['prettydate']}</TD>\n";
+ if($revision['production'])
+ print " <TD align=center>Yes</TD>\n";
+ else
+ print " <TD align=center>No</TD>\n";
+ print " </TR>\n";
+ }
+ print "</table>\n";
+ }
+ $cont = addContinuationsEntry('submitTestProd', $data);
+ print "<br><INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "<INPUT type=submit value=\"Create Reservation\">\n";
+ print "</FORM>\n";
+ return;
+ }
+ $rc = isAvailable($images, $data["imageid"], $start, $end, $data["os"]);
+ if($rc == -1) {
+ $printedHTMLheader = 1;
+ print $HTMLheader;
+ print "<H2>New Reservation</H2>\n";
+ print "You have requested an environment that is limited in the number ";
+ print "of concurrent reservations that can be made. No further ";
+ print "reservations for the environment can be made for the time you ";
+ print "have selected. Please select another time to use the ";
+ print "environment.<br>";
+ addLogEntry($nowfuture, unixToDatetime($start),
+ unixToDatetime($end), 0, $data["imageid"]);
+ }
+ elseif($rc > 0) {
+ $requestid = addRequest(0, $data["revisionid"]);
+ $time = prettyLength($data["length"]);
+ if($data["time"] == "now") {
+ $cdata = array('lengthchanged' => $data['lengthchanged']);
+ $cont = addContinuationsEntry('viewRequests', $cdata);
+ header("Location: " . BASEURL . SCRIPT . "?continuation=$cont");
+ dbDisconnect();
+ exit;
+ }
+ else {
+ if($data["minute"] == 0) {
+ $data["minute"] = "00";
+ }
+ $printedHTMLheader = 1;
+ print $HTMLheader;
+ print "<H2>New Reservation</H2>\n";
+ if($data["ending"] == "length") {
+ if($data['testjavascript'] == 0 && $data['lengthchanged']) {
+ print "<font color=red>NOTE: The maximum allowed reservation ";
+ print "length for this environment is $time, and the length of ";
+ print "this reservation has been adjusted accordingly.</font>\n";
+ print "<br><br>\n";
+ }
+ print "Your request to use <b>" . $images[$data["imageid"]]["prettyname"];
+ print "</b> on " . prettyDatetime($start) . " for $time has been ";
+ print "accepted.<br><br>\n";
+ }
+ else {
+ print "Your request to use <b>" . $images[$data["imageid"]]["prettyname"];
+ print "</b> starting " . prettyDatetime($start) . " and ending ";
+ print prettyDatetime($end) . " has been accepted.<br><br>\n";
+ }
+ print "When your reservation time has been reached, the <strong>";
+ print "Current Reservations</strong> page will have further ";
+ print "instructions on connecting to the reserved computer. If you ";
+ print "would like to modify your reservation, you can do that from ";
+ print "the <b>Current Reservations</b> page as well.<br>\n";
+ }
+ }
+ else {
+ $cdata = array('imageid' => $data['imageid'],
+ 'length' => $data['length'],
+ 'showmessage' => 1);
+ $cont = addContinuationsEntry('selectTimeTable', $cdata);
+ addLogEntry($nowfuture, unixToDatetime($start),
+ unixToDatetime($end), 0, $data["imageid"]);
+ header("Location: " . BASEURL . SCRIPT . "?continuation=$cont");
+ /*print "<H2>New Reservation</H2>\n";
+ print "The reservation you have requested is not available. You may ";
+ print "<a href=\"" . BASEURL . SCRIPT . "?continuation=$cont\">";
+ print "view a timetable</a> of free and reserved times to find ";
+ print "a time that will work for you.<br>\n";*/
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn blockRequest()
+///
+/// \brief prints a page for selecting block request stuff
+///
+////////////////////////////////////////////////////////////////////////////////
+function blockRequest() {
+ print "<H2>Block Reservation</H2>\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry('newBlockRequest');
+ print "<INPUT type=radio id=newblock name=continuation value=\"$cont\">\n";
+ print "<label for=newblock>New Block Reservation</label><br>\n";
+ $cont = addContinuationsEntry('selectEditBlockRequest');
+ print "<INPUT type=radio id=editblock name=continuation value=\"$cont\" checked>\n";
+ print "<label for=editblock>Edit/Delete Block Reservation</label><br>\n";
+ print "<INPUT type=submit value=Submit>\n";
+ print "</FORM>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn newBlockRequest()
+///
+/// \brief prints form for submitting a new block request
+///
+////////////////////////////////////////////////////////////////////////////////
+function newBlockRequest() {
+ global $submitErr, $user, $days;
+ $data = processBlockRequestInput(0);
+
+ if(! $submitErr) {
+ if($data['state'])
+ print "<H2>Edit Block Reservation</H2>\n";
+ else {
+ print "<H2>New Block Reservation</H2>\n";
+ $data['machinecnt'] = '';
+ }
+ }
+ else {
+ foreach($days as $day) {
+ if(in_array($day, $data['wdays']))
+ $data['wdayschecked'][$day] = 'checked';
+ }
+ }
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "Enter a name for the Block Reservation:<br>\n";
+ print "<INPUT type=text name=blockname size=30 value=\"{$data['blockname']}\">";
+ printSubmitErr(BLOCKNAMEERR);
+ print "<br><br>\n";
+ print "Select an environment from the list:<br>\n";
+ printSubmitErr(IMAGEIDERR);
+
+ $resources = getUserResources(array("imageAdmin", "imageCheckOut"));
+ $resources["image"] = removeNoCheckout($resources["image"]);
+ $OSs = getOSList();
+
+ // list of images
+ uasort($resources["image"], "sortKeepIndex");
+ printSelectInput("imageid", $resources["image"], $data['imageid'], 1);
+ print "<br><br>\n";
+
+ print "How many machines do you need for the block request?<br>\n";
+ print "<INPUT type=text name=machinecnt size=3 value={$data['machinecnt']}>";
+ printSubmitErr(BLOCKCNTERR);
+ print "<br><br>\n";
+
+ print "What user group should be allowed to check out machines in this ";
+ print "block request?<br>\n";
+ // FIXME should we limit the course groups that show up?
+ $groups = getUserGroups(0, $user['affiliationid']);
+ if(array_key_exists(82, $groups))
+ unset($groups[82]); # remove None group
+ if(! empty($data['usergroupid']) &&
+ ! array_key_exists($data['usergroupid'], $groups)) {
+ $groups[$data['usergroupid']] =
+ array('name' => getUserGroupName($data['usergroupid'], 1));
+ uasort($groups, "sortKeepIndex");
+ }
+ printSelectInput('usergroupid', $groups, $data['usergroupid']);
+ printSubmitErr(USERGROUPIDERR);
+ print "<br><br>\n";
+
+ print "What user group should be allowed to manage (administer) this ";
+ print "block request?<br>\n";
+ if(! empty($data['admingroupid']) &&
+ ! array_key_exists($data['admingroupid'], $groups)) {
+ $groups[$data['admingroupid']] =
+ array('name' => getUserGroupName($data['admingroupid'], 1));
+ uasort($groups, "sortKeepIndex");
+ }
+ $nonegroups = array_reverse($groups, TRUE);
+ $nonegroups[0] = array('name' => 'None (owner only)');
+ $nonegroups = array_reverse($nonegroups, TRUE);
+ printSelectInput('admingroupid', $nonegroups, $data['admingroupid']);
+ printSubmitErr(ADMINGROUPIDERR);
+ print "<br><br>\n";
+
+ $checked = array('weekly' => '',
+ 'monthly' => '',
+ 'list' => '');
+ if($data['available'] == "weekly")
+ $checked['weekly'] = 'checked';
+ elseif($data['available'] == 'monthly')
+ $checked['monthly'] = 'checked';
+ elseif($data['available'] == 'list')
+ $checked['list'] = 'checked';
+ print "When do you need the block of machines to be available?<br>\n";
+ print "<INPUT type=radio name=available id=rweekly value=\"weekly\"";
+ print "{$checked['weekly']} onclick=javascript:show('weekly');>";
+ print "<label for=rweekly>Repeating Weekly</label>\n";
+ print "<INPUT type=radio name=available id=rmonthly value=\"monthly\"";
+ print "{$checked['monthly']} onclick=javascript:show('monthly');>";
+ print "<label for=rmonthly>Repeating Monthly</label>\n";
+ print "<INPUT type=radio name=available id=rlist value=\"list\"";
+ print "{$checked['list']} onclick=javascript:show('list');>";
+ print "<label for=rlist>List of dates/times</label><br>\n";
+
+ print "<fieldset id=weekly class=shown>\n";
+ print "<legend>Repeating Weekly</legend>\n";
+ print "<table summary=\"\">\n";
+ print " <TR>\n";
+ print " <TH>Day</TH>\n";
+ print " <TH>Time</TH>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TD>\n";
+ foreach($days as $day) {
+ print " <INPUT type=checkbox name=wdays[] value=$day {$data['wdayschecked'][$day]}>$day<br>\n";
+ }
+ printSubmitErr(STARTDAYERR);
+ print " </TD>\n";
+ print " <TD valign=top>\n";
+ print " <table summary=\"\">\n";
+ print " <TR>\n";
+ print " <TH>Start</TH>\n";
+ print " <TD></TD>\n";
+ print " <TH>End</TH>\n";
+ print " </TR>\n";
+ for($i = 0; $i < 4; $i++) {
+ if(count($data['swhour']) < 4) {
+ $data['swhour'][$i] = 1;
+ $data['swminute'][$i] = "zero";
+ $data['swmeridian'][$i] = "am";
+ $data['ewhour'][$i] = 1;
+ $data['ewminute'][$i] = "zero";
+ $data['ewmeridian'][$i] = "am";
+ }
+ print " <TR>\n";
+ print " <TD nowrap>\n";
+ print " Slot" . ($i + 1) . ":\n";
+ printBlockStartEnd($i, 'w', $data['swhour'],
+ $data['swminute'],
+ $data['swmeridian'],
+ $data['ewhour'],
+ $data['ewminute'],
+ $data['ewmeridian']);
+ print " </TD>\n";
+ print " <TD>\n";
+ if($data['available'] == 'weekly') {
+ printSubmitErr(STARTHOURERR, $i);
+ printSubmitErr(ENDHOURERR, $i);
+ }
+ print " </TD>\n";
+ print " </TR>\n";
+ }
+ print " </table>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</table>\n";
+ print "<table summary=\"\">\n";
+ print " <TR>\n";
+ print " <TH>Starting date:</TH>\n";
+ print " <TD><INPUT type=text name=swdate size=10 maxlength=8 value=\"{$data['swdate']}\"></TD>\n";
+ print " <TD><small>(mm/dd/yy) </small>";
+ if($data['available'] == 'weekly')
+ printSubmitErr(STARTDATEERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH>Ending date:</TH>\n";
+ print " <TD><INPUT type=text name=ewdate size=10 maxlength=8 value=\"{$data['ewdate']}\"></TD>\n";
+ print " <TD><small>(mm/dd/yy) </small>";
+ if($data['available'] == 'weekly')
+ printSubmitErr(ENDDATEERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ print "</table>\n";
+ print "</fieldset>\n";
+
+ print "<fieldset id=monthly class=shown>\n";
+ print "<legend>Repeating Monthly</legend>\n";
+ $weeknumArr = array(1 => "1st",
+ 2 => "2nd",
+ 3 => "3rd",
+ 4 => "4th",
+ 5 => "5th");
+ $dayArr = array(1 => "Sunday",
+ 2 => "Monday",
+ 3 => "Tuesday",
+ 4 => "Wednesday",
+ 5 => "Thursday",
+ 6 => "Friday",
+ 7 => "Saturday");
+ printSelectInput('weeknum', $weeknumArr, $data['weeknum']);
+ printSelectInput('day', $dayArr, $data['day']);
+ print " of every month<br>\n";
+ print "<table summary=\"\">\n";
+ print " <TR>\n";
+ print " <TH>Start</TH>\n";
+ print " <TD></TD>\n";
+ print " <TH>End</TH>\n";
+ print " </TR>\n";
+ for($i = 0; $i < 4; $i++) {
+ if(count($data['smhour']) < 4) {
+ $data['smhour'][$i] = 1;
+ $data['smminute'][$i] = "zero";
+ $data['smmeridian'][$i] = "am";
+ $data['emhour'][$i] = 1;
+ $data['emminute'][$i] = "zero";
+ $data['emmeridian'][$i] = "am";
+ }
+ print " <TR>\n";
+ print " <TD nowrap>\n";
+ print " Slot" . ($i + 1) . ":\n";
+ printBlockStartEnd($i, 'm', $data['smhour'],
+ $data['smminute'],
+ $data['smmeridian'],
+ $data['emhour'],
+ $data['emmeridian'],
+ $data['emmeridian']);
+ print " </TD>\n";
+ print " <TD>\n";
+ if($data['available'] == 'monthly') {
+ printSubmitErr(STARTHOURERR, $i);
+ printSubmitErr(ENDHOURERR, $i);
+ }
+ print " </TD>\n";
+ print " </TR>\n";
+ }
+ print "</table>\n";
+ print "<table summary=\"\">\n";
+ print " <TR>\n";
+ print " <TH>Starting date:</TH>\n";
+ print " <TD><INPUT type=text name=smdate size=10 value=\"{$data['smdate']}\"></TD>\n";
+ print " <TD><small>(mm/dd/yy) </small>";
+ if($data['available'] == 'monthly')
+ printSubmitErr(STARTDATEERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH>Ending date:</TH>\n";
+ print " <TD><INPUT type=text name=emdate size=10 value=\"{$data['emdate']}\"></TD>\n";
+ print " <TD><small>(mm/dd/yy) </small>\n";
+ if($data['available'] == 'monthly')
+ printSubmitErr(ENDDATEERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ print "</table>\n";
+ print "</fieldset>\n";
+
+ print "<fieldset id=list class=shown>\n";
+ print "<legend>List of dates/times</legend>\n";
+ print "<table summary=\"\">\n";
+ print " <TR>\n";
+ print " <TH nowrap>Date <small>(mm/dd/yy)</small></TH>\n";
+ print " <TH>Start</TH>\n";
+ print " <TD></TD>\n";
+ print " <TH>End</TH>\n";
+ print " </TR>\n";
+ for($i = 0; $i < 4; $i++) {
+ if(count($data['slhour']) < 4) {
+ $data['slhour'][$i] = 1;
+ $data['slminute'][$i] = "zero";
+ $data['slmeridian'][$i] = "am";
+ $data['elhour'][$i] = 1;
+ $data['elminute'][$i] = "zero";
+ $data['elmeridian'][$i] = "am";
+ $data['date'][$i] = "";
+ }
+ print " <TR>\n";
+ $slot = $i + 1;
+ print " <TD nowrap>Slot $slot:<INPUT type=text name=date[] size=10 value={$data['date'][$i]}></TD>\n";
+ print " <TD nowrap>\n";
+ printBlockStartEnd($i, 'l', $data['slhour'],
+ $data['slminute'],
+ $data['slmeridian'],
+ $data['elhour'],
+ $data['elminute'],
+ $data['elmeridian']);
+ print " </TD>\n";
+ print " <TD>\n";
+ if($data['available'] == 'list') {
+ printSubmitErr(STARTDATEERR, $i);
+ printSubmitErr(STARTHOURERR, $i);
+ printSubmitErr(ENDHOURERR, $i);
+ }
+ print " </TD>\n";
+ print " </TR>\n";
+ }
+ print "</table>\n";
+ print "</fieldset>\n";
+
+ $cdata = array('state' => $data['state'],
+ 'blockRequestid' => $data['blockRequestid']);
+ $cont = addContinuationsEntry('confirmBlockRequest', $cdata, SECINDAY, 0, 1, 1);
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "<INPUT type=submit value=Confirm>\n";
+ print "</FORM>\n";
+ printBlockRequestJavascript($data['available']);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn selectEditBlockRequest()
+///
+/// \brief prints a page with summary info on each block request allowing one
+/// to be select for editing
+///
+////////////////////////////////////////////////////////////////////////////////
+function selectEditBlockRequest() {
+ global $user, $days;
+ $groups = getUserEditGroups($user['id']);
+ $groupids = implode(',', array_keys($groups));
+ $query = "SELECT b.id, "
+ . "b.name AS blockname, "
+ . "b.imageid, "
+ . "i.prettyname AS image, "
+ . "b.numMachines AS machinecnt, "
+ . "b.groupid as usergroupid, "
+ . "CONCAT(g.name, '@', a.name) AS `group`, "
+ . "b.admingroupid as admingroupid, "
+ . "CONCAT(ga.name, '@', aa.name) AS `admingroup`, "
+ . "b.repeating AS available "
+ . "FROM image i, "
+ . "usergroup g, "
+ . "affiliation a, "
+ . "blockRequest b "
+ . "LEFT JOIN usergroup ga ON (b.admingroupid = ga.id) "
+ . "LEFT JOIN affiliation aa ON (ga.affiliationid = aa.id) "
+ . "WHERE (b.ownerid = {$user['id']} ";
+ if(! empty($groupids))
+ $query .= "OR b.admingroupid IN ($groupids) ";
+ $query .= ") AND b.imageid = i.id AND "
+ . "b.groupid = g.id AND "
+ . "g.affiliationid = a.id "
+ . "ORDER BY b.name";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_assoc($qh)) {
+ $blockrequest[$row['id']] = $row;
+ $query2 = "SELECT DATE_FORMAT(start, '%c/%e/%y<br>%l:%i %p') AS start1 "
+ . "FROM blockTimes "
+ . "WHERE blockRequestid = {$row['id']} "
+ . "ORDER BY start "
+ . "LIMIT 1";
+ $qh2 = doQuery($query2, 101);
+ if($row2 = mysql_fetch_assoc($qh2))
+ $blockrequest[$row['id']]['nextstart'] = $row2['start1'];
+ else
+ $blockrequest[$row['id']]['nextstart'] = "none found";
+ }
+ print "<h2>Edit Block Reservation</h2>\n";
+ if(empty($blockrequest)) {
+ print "There are currently no block reservations.<br>\n";
+ return;
+ }
+ foreach($blockrequest as $id => $request) {
+ if($request['available'] == 'weekly') {
+ $query = "SELECT DATE_FORMAT(start, '%m/%d/%y') AS swdate, "
+ . "DATE_FORMAT(end, '%m/%d/%y')AS ewdate, "
+ . "days "
+ . "FROM blockWebDate "
+ . "WHERE blockRequestid = $id";
+ $qh = doQuery($query, 101);
+ if(! $row = mysql_fetch_assoc($qh))
+ abort(101);
+ $blockrequest[$id] = array_merge($request, $row);
+ $wdays = array();
+ for($i = 0; $i < 7; $i++) {
+ if($row['days'] & (1 << $i))
+ array_push($wdays, $days[$i]);
+ }
+ unset($blockrequest[$id]['days']);
+ $blockrequest[$id]['wdays'] = $wdays;
+ $query = "SELECT starthour, "
+ . "startminute, "
+ . "startmeridian, "
+ . "endhour, "
+ . "endminute, "
+ . "endmeridian, "
+ . "`order` "
+ . "FROM blockWebTime "
+ . "WHERE blockRequestid = {$request['id']}";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_assoc($qh)) {
+ $blockrequest[$id]['swhour'][$row['order']] = $row['starthour'];
+ $blockrequest[$id]['swminute'][$row['order']] = $row['startminute'];
+ $blockrequest[$id]['swmeridian'][$row['order']] = $row['startmeridian'];
+ $blockrequest[$id]['ewhour'][$row['order']] = $row['endhour'];
+ $blockrequest[$id]['ewminute'][$row['order']] = $row['endminute'];
+ $blockrequest[$id]['ewmeridian'][$row['order']] = $row['endmeridian'];
+ }
+ }
+ elseif($request['available'] == 'monthly') {
+ $query = "SELECT DATE_FORMAT(start, '%m/%d/%y') AS smdate, "
+ . "DATE_FORMAT(end, '%m/%d/%y')AS emdate, "
+ . "days AS day, "
+ . "weeknum "
+ . "FROM blockWebDate "
+ . "WHERE blockRequestid = $id";
+ $qh = doQuery($query, 101);
+ if(! $row = mysql_fetch_assoc($qh))
+ abort(101);
+ $blockrequest[$id] = array_merge($request, $row);
+ $query = "SELECT starthour, "
+ . "startminute, "
+ . "startmeridian, "
+ . "endhour, "
+ . "endminute, "
+ . "endmeridian, "
+ . "`order` "
+ . "FROM blockWebTime "
+ . "WHERE blockRequestid = {$request['id']}";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_assoc($qh)) {
+ $blockrequest[$id]['smhour'][$row['order']] = $row['starthour'];
+ $blockrequest[$id]['smminute'][$row['order']] = $row['startminute'];
+ $blockrequest[$id]['smmeridian'][$row['order']] = $row['startmeridian'];
+ $blockrequest[$id]['emhour'][$row['order']] = $row['endhour'];
+ $blockrequest[$id]['emminute'][$row['order']] = $row['endminute'];
+ $blockrequest[$id]['emmeridian'][$row['order']] = $row['endmeridian'];
+ }
+ }
+ elseif($request['available'] == 'list') {
+ $query = "SELECT DATE_FORMAT(start, '%m/%d/%y') AS date, "
+ #. "DATE_FORMAT(end, '%m/%d/%y')AS ewdate, "
+ . "days AS `order` "
+ . "FROM blockWebDate "
+ . "WHERE blockRequestid = $id";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_assoc($qh)) {
+ if($row['date'] == '00/00/00')
+ $blockrequest[$id]['date'][$row['order']] = '';
+ else
+ $blockrequest[$id]['date'][$row['order']] = $row['date'];
+ }
+ $query = "SELECT starthour, "
+ . "startminute, "
+ . "startmeridian, "
+ . "endhour, "
+ . "endminute, "
+ . "endmeridian, "
+ . "`order` "
+ . "FROM blockWebTime "
+ . "WHERE blockRequestid = {$request['id']}";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_assoc($qh)) {
+ $blockrequest[$id]['slhour'][$row['order']] = $row['starthour'];
+ $blockrequest[$id]['slminute'][$row['order']] = $row['startminute'];
+ $blockrequest[$id]['slmeridian'][$row['order']] = $row['startmeridian'];
+ $blockrequest[$id]['elhour'][$row['order']] = $row['endhour'];
+ $blockrequest[$id]['elminute'][$row['order']] = $row['endminute'];
+ $blockrequest[$id]['elmeridian'][$row['order']] = $row['endmeridian'];
+ }
+ }
+ }
+ print "Select a block reservation to edit:<br>\n";
+ print "<table summary=\"lists current block reservations\">\n";
+ print " <TR align=center>\n";
+ print " <TD colspan=2></TD>\n";
+ print " <TH>Name</TH>\n";
+ print " <TH>Image</TH>\n";
+ print " <TH>Reserved<br>Machines</TH>\n";
+ print " <TH>Reserved<br>For</TH>\n";
+ print " <TH>Manageable<br>By</TH>\n";
+ print " <TH>Repeating</TH>\n";
+ print " <TH>Next Start Time</TH>\n";
+ print " </TR>\n";
+ foreach($blockrequest as $request) {
+ print " <TR align=center>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <INPUT type=submit value=Edit>\n";
+ $cdata = $request;
+ $cdata['state'] = 1; # 1 = edit
+ $cdata['blockRequestid'] = $request['id'];
+ $cont = addContinuationsEntry('newBlockRequest', $cdata);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <INPUT type=submit value=Delete>\n";
+ $cdata = $request;
+ $cdata['state'] = 2; # 2 = delete
+ $cdata['blockRequestid'] = $request['id'];
+ $cont = addContinuationsEntry('confirmBlockRequest', $cdata);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>{$request['blockname']}</TD>\n";
+ print " <TD>{$request['image']}</TD>\n";
+ print " <TD>{$request['machinecnt']}</TD>\n";
+ print " <TD>{$request['group']}</TD>\n";
+ if(empty($request['admingroup']))
+ print " <TD>None (owner only)</TD>\n";
+ else
+ print " <TD>{$request['admingroup']}</TD>\n";
+ print " <TD>{$request['available']}</TD>\n";
+ print " <TD>{$request['nextstart']}</TD>\n";
+ print " </TR>\n";
+ }
+ print "</table>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn confirmBlockRequest()
+///
+/// \brief prints a confirmation page displaying information on submitted block
+/// request
+///
+////////////////////////////////////////////////////////////////////////////////
+function confirmBlockRequest() {
+ global $submitErr, $user, $days, $mode;
+ $data = processBlockRequestInput();
+ if($submitErr) {
+ newBlockRequest();
+ return;
+ }
+ $images = getImages();
+ // FIXME should we limit the course groups that show up?
+ $groups = getUserGroups(0, $user['affiliationid']);
+ if(! array_key_exists($data['usergroupid'], $groups))
+ $groups[$data['usergroupid']] =
+ array('name' => getUserGroupName($data['usergroupid'], 1));
+ if(! array_key_exists($data['admingroupid'], $groups))
+ $groups[$data['admingroupid']] =
+ array('name' => getUserGroupName($data['admingroupid'], 1));
+ $groups[0] = array('name' => 'None (owner only)');
+ if($data['state'] == 2) {
+ print "<H2>Delete Block Reservation</H2>\n";
+ print "Delete the following block reservation?<br>\n";
+ }
+ elseif($data['state'] == 1) {
+ print "<H2>Edit Block Reservation</H2>\n";
+ print "Modify the following block reservation?<br>\n";
+ }
+ else {
+ print "<H2>New Block Reservation</H2>\n";
+ print "Create the following block reservation?<br>\n";
+ }
+ print "<table summary=\"\">\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>Name:</TH>\n";
+ print " <TD>{$data['blockname']}</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>Image:</TH>\n";
+ print " <TD>{$images[$data['imageid']]['prettyname']}</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>Reserved Machines:</TH>\n";
+ print " <TD>{$data['machinecnt']}</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>Reserved for:</TH>\n";
+ print " <TD>{$groups[$data['usergroupid']]['name']}</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>Manageable by:</TH>\n";
+ print " <TD>{$groups[$data['admingroupid']]['name']}</TD>\n";
+ print " </TR>\n";
+ if($data['available'] == 'weekly') {
+ print " <TR>\n";
+ print " <TH align=right nowrap>Repeating:</TH>\n";
+ print " <TD>Weekly</TD>\n";
+ print " </TR>\n";
+ print " <TR valign='top'>\n";
+ print " <TH valign='top' align=right nowrap>On these days:</TH>\n";
+ print " <TD>";
+ foreach($data['wdays'] as $day) {
+ print "$day<br>";
+ }
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>For these timeslots on<br>each of the above days:</TH>\n";
+ print " <TD>";
+ for($i = 0; $i < 4; $i++) {
+ if($data['stime'][$i] == $data['etime'][$i])
+ continue;
+ if($data['swminute'][$i] == 0)
+ $data['swminute'][$i] = "00";
+ if($data['ewminute'][$i] == 0)
+ $data['ewminute'][$i] = "00";
+ print "{$data['swhour'][$i]}:{$data['swminute'][$i]} {$data['swmeridian'][$i]} - ";
+ print "{$data['ewhour'][$i]}:{$data['ewminute'][$i]} {$data['ewmeridian'][$i]}<br>\n";
+ }
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>Starting:</TH>\n";
+ print " <TD>{$data['swdate']}</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>Ending:</TH>\n";
+ print " <TD>{$data['ewdate']}</TD>\n";
+ print " </TR>\n";
+ }
+ elseif($data['available'] == 'monthly') {
+ $weeknumArr = array(1 => "1st",
+ 2 => "2nd",
+ 3 => "3rd",
+ 4 => "4th",
+ 5 => "5th");
+ print " <TR>\n";
+ print " <TH align=right nowrap>Repeating:</TH>\n";
+ print " <TD>The {$weeknumArr[$data['weeknum']]} {$days[$data['day'] - 1]} of each month</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>For these timeslots on<br>the above day of the month:</TH>\n";
+ print " <TD>";
+ for($i = 0; $i < 4; $i++) {
+ if($data['stime'][$i] == $data['etime'][$i])
+ continue;
+ if($data['smminute'][$i] == 0)
+ $data['smminute'][$i] = "00";
+ if($data['emminute'][$i] == 0)
+ $data['emminute'][$i] = "00";
+ print "{$data['smhour'][$i]}:{$data['smminute'][$i]} {$data['smmeridian'][$i]} - ";
+ print "{$data['emhour'][$i]}:{$data['emminute'][$i]} {$data['emmeridian'][$i]}<br>\n";
+ }
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>Starting:</TH>\n";
+ print " <TD>{$data['smdate']}</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right nowrap>Ending:</TH>\n";
+ print " <TD>{$data['emdate']}</TD>\n";
+ print " </TR>\n";
+ }
+ elseif($data['available'] == 'list') {
+ print " <TR valign=top>\n";
+ print " <TH align=right>For the following dates and times:</TH>\n";
+ print " <TD>\n";
+ for($i = 0; $i < 4; $i++) {
+ if($data['slhour'][$i] == $data['elhour'][$i] &&
+ $data['slminute'][$i] == $data['elminute'][$i] &&
+ $data['slmeridian'][$i] == $data['elmeridian'][$i])
+ continue;
+ if($data['slminute'][$i] == 0)
+ $data['slminute'][$i] = '00';
+ if($data['elminute'][$i] == 0)
+ $data['elminute'][$i] = '00';
+ print "{$data['date'][$i]} {$data['slhour'][$i]}:{$data['slminute'][$i]} {$data['slmeridian'][$i]} to {$data['elhour'][$i]}:{$data['elminute'][$i]} {$data['elmeridian'][$i]}<br>\n";
+ }
+ print " </TD>\n";
+ print " </TR>\n";
+ }
+ print "</table>\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ if($data['state'] == 2) {
+ print "<INPUT type=submit value=Delete>\n";
+ $cont = addContinuationsEntry('submitDeleteBlockRequest', $data, SECINDAY, 0, 0);
+ }
+ else {
+ print "<INPUT type=submit value=Submit>\n";
+ $cont = addContinuationsEntry('submitBlockRequest', $data, SECINDAY, 0, 0);
+ }
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "</FORM>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitBlockRequest()
+///
+/// \brief processes submitted block request information
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitBlockRequest() {
+ global $submitErr, $user, $days;
+ $data = processBlockRequestInput();
+ if($submitErr) {
+ newBlockRequest();
+ return;
+ }
+
+ # FIXME need to handle creation of a block time that we're currently in the
+ # middle of if there wasn't already on we're in the middle of
+ if($data['state'] == 1) {
+ # get blockTime entry for this request if we're in the middle of one
+ $checkCurBlockTime = 0;
+ $query = "SELECT id, "
+ . "start, "
+ . "end "
+ . "FROM blockTimes "
+ . "WHERE start <= NOW() AND "
+ . "end > NOW() AND "
+ . "blockRequestid = {$data['blockRequestid']}";
+ $qh = doQuery($query, 101);
+ if($row = mysql_fetch_assoc($qh)) {
+ $checkCurBlockTime = 1;
+ $curBlockTime = $row;
+ }
+ # delete entries from blockTimes that start later than now
+ $query = "DELETE FROM blockTimes "
+ . "WHERE blockRequestid = {$data['blockRequestid']} AND "
+ . "start > NOW()";
+ doQuery($query, 101);
+ # delete entries from blockWebDate and blockWebTime
+ $query = "DELETE FROM blockWebDate WHERE blockRequestid = {$data['blockRequestid']}";
+ doQuery($query, 101);
+ $query = "DELETE FROM blockWebTime WHERE blockRequestid = {$data['blockRequestid']}";
+ doQuery($query, 101);
+ }
+
+ if($data['available'] == 'weekly') {
+ $daymask = 0;
+ $startarr = split('/', $data['swdate']);
+ $startdate = "20{$startarr[2]}-{$startarr[0]}-{$startarr[1]}";
+ $startts = datetimeToUnix("20{$startarr[2]}-{$startarr[0]}-{$startarr[1]} 00:00:00");
+ $endarr = split('/', $data['ewdate']);
+ $enddt = "20{$endarr[2]}-{$endarr[0]}-{$endarr[1]} 23:59:59";
+ $enddate = "20{$endarr[2]}-{$endarr[0]}-{$endarr[1]}";
+ $endts = datetimeToUnix($enddt);
+ foreach($data['wdays'] as $day) {
+ $key = array_search($day, $days);
+ $daymask |= (1 << $key);
+ }
+ }
+ elseif($data['available'] == 'monthly') {
+ $startarr = split('/', $data['smdate']);
+ $startdate = "20{$startarr[2]}-{$startarr[0]}-{$startarr[1]}";
+ $startts = datetimeToUnix("20{$startarr[2]}-{$startarr[0]}-{$startarr[1]} 00:00:00");
+ $endarr = split('/', $data['emdate']);
+ $enddt = "20{$endarr[2]}-{$endarr[0]}-{$endarr[1]} 23:59:59";
+ $enddate = "20{$endarr[2]}-{$endarr[0]}-{$endarr[1]}";
+ $endts = datetimeToUnix($enddt);
+ $selectedday = $data['day'];
+ }
+ elseif($data['available'] == 'list') {
+ $last = -1;
+ $enddtArr[-1] = '1970-01-01 00:00:00';
+ for($i = 0; $i < 4; $i++) {
+ $data['slhour24'][$i] = hour12to24($data['slhour'][$i], $data['slmeridian'][$i]);
+ $data['elhour24'][$i] = hour12to24($data['elhour'][$i], $data['elmeridian'][$i]);
+ if(empty($data['date'][$i])) {
+ $startdtArr[$i] = "0000-00-00 00:00:00";
+ $enddtArr[$i] = "0000-00-00 00:00:00";
+ }
+ else {
+ $datearr = explode('/', $data['date'][$i]);
+ $startdtArr[$i] = "20{$datearr[2]}-{$datearr[0]}-{$datearr[1]} {$data['slhour24'][$i]}:{$data['slminute'][$i]}:00";
+ $enddtArr[$i] = "20{$datearr[2]}-{$datearr[0]}-{$datearr[1]} {$data['elhour24'][$i]}:{$data['elminute'][$i]}:00";
+ }
+ if($data['stime'][$i] == $data['etime'][$i])
+ continue;
+ if($startdtArr[$i] != $enddtArr[$i] &&
+ datetimeToUnix($enddtArr[$last]) < datetimeToUnix($enddtArr[$i])) {
+ $last = $i;
+ }
+ }
+ unset($enddtArr[-1]);
+ $endts = datetimeToUnix($enddtArr[$last]);
+ $enddt = $enddtArr[$last];
+ }
+
+ if($data['state'] == 1) {
+ $query = "UPDATE blockRequest "
+ . "SET name = '{$data['blockname']}', "
+ . "imageid = {$data['imageid']}, "
+ . "numMachines = {$data['machinecnt']}, "
+ . "groupid = {$data['usergroupid']}, "
+ . "admingroupid = {$data['admingroupid']}, "
+ . "repeating = '{$data['available']}', "
+ . "expireTime = '$enddt' "
+ . "WHERE id = {$data['blockRequestid']}";
+ doQuery($query, 101);
+ $blockreqid = $data['blockRequestid'];
+ }
+ else {
+ $managementnodes = getManagementNodes('future');
+ if(empty($managementnodes))
+ abort(40);
+ $mnid = array_rand($managementnodes);
+ $query = "INSERT INTO blockRequest "
+ . "(name, "
+ . "imageid, "
+ . "numMachines, "
+ . "groupid, "
+ . "repeating, "
+ . "ownerid, "
+ . "admingroupid, "
+ . "managementnodeid, "
+ . "expireTime) "
+ . "VALUES "
+ . "('{$data['blockname']}', "
+ . "{$data['imageid']}, "
+ . "{$data['machinecnt']}, "
+ . "{$data['usergroupid']}, "
+ . "'{$data['available']}', "
+ . "{$user['id']}, "
+ . "{$data['admingroupid']}, "
+ . "$mnid, "
+ . "'$enddt')";
+ doQuery($query, 101);
+ $qh = doQuery("SELECT LAST_INSERT_ID() FROM blockRequest", 101);
+ if(! $row = mysql_fetch_row($qh)) {
+ abort(380);
+ }
+ $blockreqid = $row[0];
+ }
+
+ if($data['available'] == 'weekly') {
+ $query = "INSERT INTO blockWebDate "
+ . "(blockRequestid, "
+ . "start, "
+ . "end, "
+ . "days) "
+ . "VALUES "
+ . "($blockreqid, "
+ . "'$startdate', "
+ . "'$enddate', "
+ . "$daymask)";
+ doQuery($query, 101);
+ for($i = 0; $i < 4; $i++) {
+ $query = "INSERT INTO blockWebTime "
+ . "(blockRequestid, "
+ . "starthour, "
+ . "startminute, "
+ . "startmeridian, "
+ . "endhour, "
+ . "endminute, "
+ . "endmeridian, "
+ . "`order`) "
+ . "VALUES "
+ . "($blockreqid, "
+ . "'{$data['swhour'][$i]}', "
+ . "'{$data['swminute'][$i]}', "
+ . "'{$data['swmeridian'][$i]}', "
+ . "'{$data['ewhour'][$i]}', "
+ . "'{$data['ewminute'][$i]}', "
+ . "'{$data['ewmeridian'][$i]}', "
+ . "$i)";
+ doQuery($query, 101);
+ }
+ for($day = $startts; $day <= $endts; $day += SECINDAY) {
+ if(! in_array(date('l', $day), $data['wdays']))
+ continue;
+ for($i = 0; $i < 4; $i++) {
+ if($data['stime'][$i] == $data['etime'][$i])
+ continue;
+ $data['swhour'][$i] = hour12to24($data['swhour'][$i], $data['swmeridian'][$i]);
+ $data['ewhour'][$i] = hour12to24($data['ewhour'][$i], $data['ewmeridian'][$i]);
+ $start = date("Y-m-d", $day) . " {$data['swhour'][$i]}:{$data['swminute'][$i]}:00";
+ $end = date("Y-m-d", $day) . " {$data['ewhour'][$i]}:{$data['ewminute'][$i]}:00";
+ $query = "INSERT INTO blockTimes "
+ . "(blockRequestid, "
+ . "start, "
+ . "end) "
+ . "VALUES "
+ . "($blockreqid, "
+ . "'$start', "
+ . "'$end')";
+ doQuery($query, 101);
+ }
+ }
+ }
+ elseif($data['available'] == 'monthly') {
+ $query = "INSERT INTO blockWebDate "
+ . "(blockRequestid, "
+ . "start, "
+ . "end, "
+ . "days, "
+ . "weeknum) "
+ . "VALUES "
+ . "($blockreqid, "
+ . "'$startdate', "
+ . "'$enddate', "
+ . "$selectedday, "
+ . "{$data['weeknum']})";
+ doQuery($query, 101);
+ for($i = 0; $i < 4; $i++) {
+ $query = "INSERT INTO blockWebTime "
+ . "(blockRequestid, "
+ . "starthour, "
+ . "startminute, "
+ . "startmeridian, "
+ . "endhour, "
+ . "endminute, "
+ . "endmeridian, "
+ . "`order`) "
+ . "VALUES "
+ . "($blockreqid, "
+ . "'{$data['smhour'][$i]}', "
+ . "'{$data['smminute'][$i]}', "
+ . "'{$data['smmeridian'][$i]}', "
+ . "'{$data['emhour'][$i]}', "
+ . "'{$data['emminute'][$i]}', "
+ . "'{$data['emmeridian'][$i]}', "
+ . "$i)";
+ doQuery($query, 101);
+ }
+ for($day = $startts; $day <= $endts; $day += SECINDAY) {
+ if((date('w', $day) + 1) != $data['day'])
+ continue;
+ $dayofmon = date('j', $day);
+ if(($data['weeknum'] == 1 && ($dayofmon < 8)) ||
+ ($data['weeknum'] == 2 && (7 < $dayofmon) && ($dayofmon < 15)) ||
+ ($data['weeknum'] == 3 && (14 < $dayofmon) && ($dayofmon < 22)) ||
+ ($data['weeknum'] == 4 && (21 < $dayofmon) && ($dayofmon < 29)) ||
+ ($data['weeknum'] == 5 && (28 < $dayofmon) && ($dayofmon < 32))) {
+ $thedate = date("Y-m-d", $day);
+ for($i = 0; $i < 4; $i++) {
+ if($data['stime'][$i] == $data['etime'][$i])
+ continue;
+ $data['smhour'][$i] = hour12to24($data['smhour'][$i], $data['smmeridian'][$i]);
+ $data['emhour'][$i] = hour12to24($data['emhour'][$i], $data['emmeridian'][$i]);
+ $start = "$thedate {$data['smhour'][$i]}:{$data['smminute'][$i]}:00";
+ $end = "$thedate {$data['emhour'][$i]}:{$data['emminute'][$i]}:00";
+ $query = "INSERT INTO blockTimes "
+ . "(blockRequestid, "
+ . "start, "
+ . "end) "
+ . "VALUES "
+ . "($blockreqid, "
+ . "'$start', "
+ . "'$end')";
+ doQuery($query, 101);
+ }
+ }
+ }
+ }
+ elseif($data['available'] == 'list') {
+ for($i = 0; $i < 4; $i++) {
+ $query = "INSERT INTO blockWebDate "
+ . "(blockRequestid, "
+ . "start, "
+ . "end, "
+ . "days) "
+ . "VALUES "
+ . "($blockreqid, "
+ . "'{$startdtArr[$i]}', "
+ . "'{$enddtArr[$i]}', "
+ . "$i)";
+ doQuery($query, 101);
+ $query = "INSERT INTO blockWebTime "
+ . "(blockRequestid, "
+ . "starthour, "
+ . "startminute, "
+ . "startmeridian, "
+ . "endhour, "
+ . "endminute, "
+ . "endmeridian, "
+ . "`order`) "
+ . "VALUES "
+ . "($blockreqid, "
+ . "'{$data['slhour'][$i]}', "
+ . "'{$data['slminute'][$i]}', "
+ . "'{$data['slmeridian'][$i]}', "
+ . "'{$data['elhour'][$i]}', "
+ . "'{$data['elminute'][$i]}', "
+ . "'{$data['elmeridian'][$i]}', "
+ . "$i)";
+ doQuery($query, 101);
+ if($data['stime'][$i] == $data['etime'][$i])
+ continue;
+ $query = "INSERT INTO blockTimes "
+ . "(blockRequestid, "
+ . "start, "
+ . "end) "
+ . "VALUES "
+ . "($blockreqid, "
+ . "'{$startdtArr[$i]}', "
+ . "'{$enddtArr[$i]}')";
+ doQuery($query, 101);
+ }
+ }
+ if($data['state'] == 1) {
+ if($checkCurBlockTime) {
+ $query = "SELECT id, "
+ . "start, "
+ . "end "
+ . "FROM blockTimes "
+ . "WHERE start <= NOW() AND "
+ . "end > NOW() AND "
+ . "blockRequestid = {$data['blockRequestid']} AND "
+ . "id != {$curBlockTime['id']}";
+ $qh = doQuery($query, 101);
+ if($row = mysql_fetch_assoc($qh)) {
+ if($curBlockTime['end'] != $row['end']) {
+ # update old end time
+ $query = "UPDATE blockTimes "
+ . "SET end = '{$row['end']}' "
+ . "WHERE id = {$curBlockTime['id']}";
+ doQuery($query, 101);
+ }
+ # delete $row entry
+ doQuery("DELETE FROM blockTimes WHERE id = {$row['id']}", 101);
+ }
+ else {
+ # the blockTime we were in the middle of was not recreated, so
+ # delete the old one
+ doQuery("DELETE FROM blockTimes WHERE id = {$curBlockTime['id']}", 101);
+ }
+ }
+ print "<H2>Edit Block Reservation</H2>\n";
+ print "Block request has been updated<br>\n";
+ }
+ else {
+ print "<H2>New Block Reservation</H2>\n";
+ print "Block request added to database<br>\n";
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitDeleteBlockRequest()
+///
+/// \brief delete a block request
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitDeleteBlockRequest() {
+ $data = processBlockRequestInput();
+ $query = "DELETE FROM blockRequest WHERE id = {$data['blockRequestid']}";
+ doQuery($query, 101);
+ print "<H2>Delete Block Reservation</H2>\n";
+ print "Block reservation <strong>{$data['blockname']}</strong> has been deleted.<br>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn printBlockStartEnd($cnt, $type, $shour, $sminute, $smeridian, $ehour,
+/// $eminute, $emeridian)
+///
+/// \param $cnt - index number for row
+/// \param $type - 'w', 'm', or 'l' to signify week, month, or list
+/// \param $shour - array of input data
+/// \param $sminute - array of input data
+/// \param $smeridian - array of input data
+/// \param $ehour - array of input data
+/// \param $eminute - array of input data
+/// \param $emeridian - array of input data
+///
+/// \brief prints 4 rows of select boxes for start and end times
+///
+////////////////////////////////////////////////////////////////////////////////
+function printBlockStartEnd($cnt, $type, $shour, $sminute, $smeridian, $ehour, $eminute, $emeridian) {
+ $hrArr = array();
+ for($i = 1; $i < 13; $i++) {
+ $hrArr[$i] = $i;
+ }
+ $minutes = array("zero" => "00",
+ "15" => "15",
+ "30" => "30",
+ "45" => "45");
+ $t_shour = 's' . $type . 'hour[]';
+ $t_sminute = 's' . $type . 'minute[]';
+ $t_smeridian = 's' . $type . 'meridian[]';
+ $t_ehour = 'e' . $type . 'hour[]';
+ $t_eminute = 'e' . $type . 'minute[]';
+ $t_emeridian = 'e' . $type . 'meridian[]';
+ printSelectInput($t_shour, $hrArr, $shour[$cnt]);
+ printSelectInput($t_sminute, $minutes, $sminute[$cnt]);
+ printSelectInput($t_smeridian, array("am" => "am", "pm" => "pm"), $smeridian[$cnt]);
+ print " </TD>\n";
+ print " <TD nowrap width=5px></TD>\n";
+ print " <TD nowrap>\n";
+ printSelectInput($t_ehour, $hrArr, $ehour[$cnt]);
+ printSelectInput($t_eminute, $minutes, $eminute[$cnt]);
+ printSelectInput($t_emeridian, array("am" => "am", "pm" => "pm"), $emeridian[$cnt]);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn printBlockRequestJavascript($show)
+///
+/// \param $show - 'weekly', 'monthly', or 'list'
+///
+/// \brief prints javascript to display the right frameset
+///
+////////////////////////////////////////////////////////////////////////////////
+function printBlockRequestJavascript($show) {
+ print <<<HTMLdone
+<script language="Javascript">
+function show(id) {
+ document.getElementById("weekly").className = "hidden";
+ document.getElementById("monthly").className = "hidden";
+ document.getElementById("list").className = "hidden";
+ document.getElementById(id).className = "shown";
+}
+HTMLdone;
+print "show(\"$show\")\n";
+print "</script>\n";
+
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn viewRequests
+///
+/// \brief prints user's reservations
+///
+////////////////////////////////////////////////////////////////////////////////
+function viewRequests() {
+ global $user, $viewmode, $inContinuation, $mode;
+ if($inContinuation)
+ $lengthchanged = getContinuationVar('lengthchanged', 0);
+ else
+ $lengthchanged = processInputVar('lengthchanged', ARG_NUMERIC, 0);
+ $incPaneDetails = processInputVar('incdetails', ARG_NUMERIC, 0);
+ $refreqid = processInputVar('reqid', ARG_NUMERIC, 0);
+ $requests = getUserRequests("all");
+ $images = getImages();
+ $computers = getComputers();
+
+ if($mode != 'AJviewRequests')
+ print "<div id=subcontent>\n";
+
+ $refresh = 0;
+ $failed = 0;
+ $connect = 0;
+
+ $normal = '';
+ $imaging = '';
+ $long = '';
+ if($count = count($requests)) {
+ $now = time();
+ for($i = 0, $noedit = 0, $text = '';
+ $i < $count;
+ $i++, $noedit = 0, $text = '') {
+ $imageid = $requests[$i]["imageid"];
+ $text .= " <TR valign=top id=reqrow{$requests[$i]['id']}>\n";
+ if(requestIsReady($requests[$i])) {
+ $connect = 1;
+ # request is ready, print Connect! and End buttons
+ $cdata = array('requestid' => $requests[$i]['id']);
+ $text .= " <TD>\n";
+ $text .= " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry('connectRequest', $cdata, SECINDAY);
+ $text .= " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ $text .= " <INPUT type=submit value=\"Connect!\">\n";
+ $text .= " </FORM>\n";
+ $text .= " </TD>\n";
+ if($requests[$i]['forimaging']) {
+ $noedit = 1;
+ $text .= " <TD>\n";
+ $text .= " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry('startImage', $cdata);
+ $text .= " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ $text .= " <INPUT type=submit value=\"Create\nImage\">\n";
+ $text .= " </FORM>\n";
+ $text .= " </TD>\n";
+ $text .= " <TD>\n";
+ $text .= " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('requestid' => $requests[$i]['id']);
+ $cont = addContinuationsEntry('confirmDeleteRequest', $cdata, SECINDAY);
+ $text .= " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ $text .= " <INPUT type=submit value=Cancel>\n";
+ $text .= " </FORM>\n";
+ $text .= " </TD>\n";
+ }
+ else {
+ $text .= " <TD>\n";
+ $text .= " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry('confirmDeleteRequest', $cdata, SECINDAY);
+ $text .= " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ $text .= " <INPUT type=submit value=End>\n";
+ $text .= " </FORM>\n";
+ $text .= " </TD>\n";
+ }
+ $startstamp = datetimeToUnix($requests[$i]["start"]);
+ }
+ elseif($requests[$i]["currstateid"] == 5) {
+ # request has failed
+ $cdata = array('requestid' => $requests[$i]['id']);
+ $text .= " <TD colspan=2 nowrap>\n";
+ $text .= " <span class=scriptonly>\n";
+ $text .= " <span class=compstatelink>";
+ $text .= "<a onClick=\"showResStatusPane({$requests[$i]['id']}); ";
+ $text .= "return false;\" href=\"#\">Reservation failed</a></span>\n";
+ $text .= " </span>\n";
+ $text .= " <noscript>\n";
+ $text .= " <span class=scriptoff>\n";
+ $text .= " <span class=compstatelink>";
+ $text .= "Reservation failed</span>\n";
+ $text .= " </span>\n";
+ $text .= " </noscript>\n";
+ $text .= " </TD>\n";
+ $failed = 1;
+ $noedit = 1;
+ }
+ elseif(datetimeToUnix($requests[$i]["start"]) < $now) {
+ # other cases where the reservation start time has been reached
+ if(($requests[$i]["currstateid"] == 12 &&
+ $requests[$i]['laststateid'] == 11) ||
+ $requests[$i]["currstateid"] == 11 ||
+ ($requests[$i]["currstateid"] == 14 &&
+ $requests[$i]["laststateid"] == 11)) {
+ # request has timed out
+ if($requests[$i]['forimaging'])
+ $text .= " <TD colspan=3>\n";
+ else
+ $text .= " <TD colspan=2>\n";
+ $text .= " <span class=compstatelink>Reservation has ";
+ $text .= "timed out</span>\n";
+ $noedit = 1;
+ $text .= " </TD>\n";
+ }
+ else {
+ # computer is loading, print Pending... and Delete button
+ $remaining = 1;
+ if($requests[$i]['forimaging'])
+ $noedit = 1;
+ if(isComputerLoading($requests[$i], $computers)) {
+ if(datetimeToUnix($requests[$i]["daterequested"]) >=
+ datetimeToUnix($requests[$i]["start"])) {
+ $startload = datetimeToUnix($requests[$i]["daterequested"]);
+ }
+ else {
+ $startload = datetimeToUnix($requests[$i]["start"]);
+ }
+ $imgLoadTime = getImageLoadEstimate($imageid);
+ if($imgLoadTime == 0)
+ $imgLoadTime = $images[$imageid]['reloadtime'] * 60;
+ $tmp = ($imgLoadTime - ($now - $startload)) / 60;
+ $remaining = sprintf("%d", $tmp) + 1;
+ if($remaining < 1) {
+ $remaining = 1;
+ }
+ }
+ # computer is loading, print Pending... and Delete button
+ if($requests[$i]['forimaging'])
+ $text .= " <TD colspan=2>\n";
+ else
+ $text .= " <TD>\n";
+ $text .= " <span class=scriptonly>\n";
+ $text .= " <span class=compstatelink><i>";
+ $text .= "<a onClick=\"showResStatusPane({$requests[$i]['id']}); ";
+ $text .= "return false;\" href=\"#\">Pending...</a></i></span>";
+ $text .= " </span>\n";
+ $text .= " <noscript>\n";
+ $text .= " <span class=scriptoff>\n";
+ $text .= " <span class=compstatelink>";
+ $text .= "<i>Pending...</i></span>\n";
+ $text .= " </span>\n";
+ $text .= " </noscript>\n";
+ $text .= "<br>Est: $remaining min remaining\n";
+ $refresh = 1;
+ $text .= " </TD>\n";
+ $text .= " <TD>\n";
+ $text .= " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('requestid' => $requests[$i]['id']);
+ $cont = addContinuationsEntry('confirmDeleteRequest', $cdata, SECINDAY);
+ $text .= " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ $text .= " <INPUT type=submit value=Delete>\n";
+ $text .= " </FORM>\n";
+ $text .= " </TD>\n";
+ }
+ }
+ else {
+ # reservation is in the future
+ $text .= " <TD></TD>\n";
+ $text .= " <TD>\n";
+ $text .= " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('requestid' => $requests[$i]['id']);
+ $cont = addContinuationsEntry('confirmDeleteRequest', $cdata, SECINDAY);
+ $text .= " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ $text .= " <INPUT type=submit value=Delete>\n";
+ $text .= " </FORM>\n";
+ $text .= " </TD>\n";
+ }
+ if(! $noedit) {
+ # print edit button
+ $text .= " <TD align=right>\n";
+ $text .= " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('requestid' => $requests[$i]['id']);
+ $cont = addContinuationsEntry('editRequest', $cdata);
+ $text .= " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ $text .= " <INPUT type=submit value=Edit>\n";
+ $text .= " </FORM>\n";
+ $text .= " </TD>\n";
+ }
+ elseif($requests[$i]['forimaging'] == 0)
+ $text .= " <TD></TD>\n";
+
+ # print name of image, add (Testing) if it is the test version of an image
+ $text .= " <TD>" . str_replace("'", "'", $requests[$i]["prettyimage"]);
+ if($requests[$i]["test"])
+ $text .= " (Testing)";
+ $text .= "</TD>\n";
+
+ # print start time
+ if(datetimeToUnix($requests[$i]["start"]) <
+ datetimeToUnix($requests[$i]["daterequested"])) {
+ $text .= " <TD>" . prettyDatetime($requests[$i]["daterequested"]) . "</TD>\n";
+ }
+ else {
+ $text .= " <TD>" . prettyDatetime($requests[$i]["start"]) . "</TD>\n";
+ }
+
+ # print end time
+ $text .= " <TD>" . prettyDatetime($requests[$i]["end"]) . "</TD>\n";
+
+ # print date requested
+ $text .= " <TD>" . prettyDatetime($requests[$i]["daterequested"]) . "</TD>\n";
+
+ if($viewmode == ADMIN_DEVELOPER) {
+ $text .= " <TD align=center>" . $requests[$i]["id"] . "</TD>\n";
+ $text .= " <TD align=center>" . $requests[$i]["computerid"] . "</TD>\n";
+ $text .= " <TD>" . $requests[$i]["IPaddress"] . "</TD>\n";
+ $text .= " <TD align=center>" . $requests[$i]["currstateid"];
+ $text .= "</TD>\n";
+ $text .= " <TD align=center>" . $requests[$i]["laststateid"];
+ $text .= "</TD>\n";
+ $text .= " <TD align=center>";
+ $text .= $computers[$requests[$i]["computerid"]]["stateid"] . "</TD>\n";
+ }
+ $text .= " </TR>\n";
+ if($requests[$i]['forimaging'])
+ $imaging .= $text;
+ elseif($requests[$i]['longterm'])
+ $long .= $text;
+ else
+ $normal .= $text;
+ }
+ }
+
+ $text = "<H2>Current Reservations</H2>\n";
+ if(! empty($normal)) {
+ if(! empty($imaging) || ! empty($long))
+ $text .= "You currently have the following <strong>normal</strong> reservations:<br>\n";
+ else
+ $text .= "You currently have the following normal reservations:<br>\n";
+ if($lengthchanged) {
+ $text .= "<font color=red>NOTE: The maximum allowed reservation ";
+ $text .= "length for one of these reservations was less than the ";
+ $text .= "length you submitted, and the length of that reservation ";
+ $text .= "has been adjusted accordingly.</font>\n";
+ }
+ $text .= "<table id=reslisttable summary=\"lists reservations you currently have\" cellpadding=5>\n";
+ $text .= " <TR>\n";
+ $text .= " <TD colspan=3></TD>\n";
+ $text .= " <TH>Environment</TH>\n";
+ $text .= " <TH>Starting</TH>\n";
+ $text .= " <TH>Ending</TH>\n";
+ $text .= " <TH>Initially requested</TH>\n";
+ if($viewmode == ADMIN_DEVELOPER) {
+ $text .= " <TH>Req ID</TH>\n";
+ $text .= " <TH>Comp ID</TH>\n";
+ $text .= " <TH>IP address</TH>\n";
+ $text .= " <TH>Current State</TH>\n";
+ $text .= " <TH>Last State</TH>\n";
+ $text .= " <TH>Computer State</TH>\n";
+ }
+ $text .= " </TR>\n";
+ $text .= $normal;
+ $text .= "</table>\n";
+ }
+ if(! empty($imaging)) {
+ if(! empty($normal))
+ $text .= "<hr>\n";
+ $text .= "You currently have the following <strong>imaging</strong> reservations:<br>\n";
+ $text .= "<table id=imgreslisttable summary=\"lists imaging reservations you currently have\" cellpadding=5>\n";
+ $text .= " <TR>\n";
+ $text .= " <TD colspan=3></TD>\n";
+ $text .= " <TH>Environment</TH>\n";
+ $text .= " <TH>Starting</TH>\n";
+ $text .= " <TH>Ending</TH>\n";
+ $text .= " <TH>Initially requested</TH>\n";
+ $computers = getComputers();
+ if($viewmode == ADMIN_DEVELOPER) {
+ $text .= " <TH>Req ID</TH>\n";
+ $text .= " <TH>Comp ID</TH>\n";
+ $text .= " <TH>IP address</TH>\n";
+ $text .= " <TH>Current State</TH>\n";
+ $text .= " <TH>Last State</TH>\n";
+ $text .= " <TH>Computer State</TH>\n";
+ }
+ $text .= " </TR>\n";
+ $text .= $imaging;
+ $text .= "</table>\n";
+ }
+ if(! empty($long)) {
+ if(! empty($normal) || ! empty($imaging))
+ $text .= "<hr>\n";
+ $text .= "You currently have the following <strong>long term</strong> reservations:<br>\n";
+ $text .= "<table id=\"longreslisttable\" summary=\"lists long term reservations you currently have\" cellpadding=5>\n";
+ $text .= " <TR>\n";
+ $text .= " <TD colspan=3></TD>\n";
+ $text .= " <TH>Environment</TH>\n";
+ $text .= " <TH>Starting</TH>\n";
+ $text .= " <TH>Ending</TH>\n";
+ $text .= " <TH>Initially requested</TH>\n";
+ $computers = getComputers();
+ if($viewmode == ADMIN_DEVELOPER) {
+ $text .= " <TH>Req ID</TH>\n";
+ $text .= " <TH>Comp ID</TH>\n";
+ $text .= " <TH>IP address</TH>\n";
+ $text .= " <TH>Current State</TH>\n";
+ $text .= " <TH>Last State</TH>\n";
+ $text .= " <TH>Computer State</TH>\n";
+ }
+ $text .= " </TR>\n";
+ $text .= $long;
+ $text .= "</table>\n";
+ }
+
+ # connect div
+ if($connect) {
+ $text .= "<br><br>Click the <strong>";
+ $text .= "Connect!</strong> button to get further ";
+ $text .= "information about connecting to the reserved system. You must ";
+ $text .= "click the button from a web browser running on the same computer ";
+ $text .= "from which you will be connecting to the remote computer; ";
+ $text .= "otherwise, you may be denied access to the machine.\n";
+ }
+
+ if($refresh) {
+ $text .= "<br><br>This page will automatically update ";
+ $text .= "every 20 seconds until the <font color=red><i>Pending...</i>";
+ #$text .= "</font> reservation is ready.<br></div>\n";
+ $text .= "</font> reservation is ready.\n";
+ $cont = addContinuationsEntry('AJviewRequests', $cdata, SECINDAY);
+ $text .= "<INPUT type=hidden id=resRefreshCont value=\"$cont\">\n";
+ }
+
+ if($failed) {
+ $text .= "<br><br>An error has occurred that has kept one of your reservations ";
+ $text .= "from being processed. We apologize for any inconvenience ";
+ $text .= "this may have caused.\n";
+ if(! $refresh) {
+ $cont = addContinuationsEntry('AJviewRequests', $cdata, SECINDAY);
+ $text .= "<INPUT type=hidden id=resRefreshCont value=\"$cont\">\n";
+ }
+ }
+
+ if(empty($normal) && empty($imaging) && empty($long))
+ $text .= "You have no current reservations.<br>\n";
+
+ $text .= "</div>\n";
+ if($mode != 'AJviewRequests') {
+ if($refresh || $failed) {
+ $text .= "<div dojoType=FloatingPane\n";
+ $text .= " id=resStatusPane\n";
+ $text .= " constrainToContainer=false\n";
+ $text .= " hasShadow=true\n";
+ $text .= " resizable=true\n";
+ $text .= " windowState=minimized\n";
+ $text .= " displayMinimizeAction=true\n";
+ $text .= " style=\"width: 350px; height: 280px; position: absolute; left: 130; top: 0px;\"\n";
+ $text .= ">\n";
+ $text .= "<div id=resStatusText></div>\n";
+ $text .= "<input type=hidden id=detailreqid value=0>\n";
+ $text .= "</div>\n";
+ $text .= "<script type=\"text/javascript\">\n";
+ $text .= "dojo.addOnLoad(showScriptOnly);\n";
+ $text .= "dojo.byId('resStatusPane').title = \"Detailed Reservation Status\";\n";
+ $text .= "</script>\n";
+ }
+ print $text;
+ }
+ else {
+ $text = str_replace("\n", ' ', $text);
+ if($refresh)
+ print "refresh_timer = setTimeout(resRefresh, 20000);\n";
+ print(setAttribute('subcontent', 'innerHTML', $text));
+ print "AJdojoCreate('subcontent');";
+ if($incPaneDetails) {
+ $text = detailStatusHTML($refreqid);
+ print(setAttribute('resStatusText', 'innerHTML', $text));
+ }
+ dbDisconnect();
+ exit;
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn detailStatusHTML($reqid)
+///
+/// \param $reqid - a request id
+///
+/// \return html text showing detailed status from computerloadlog for specified
+/// request
+///
+/// \brief gathers information about the state flow for $reqid and formats it
+/// nicely for a user to view
+///
+////////////////////////////////////////////////////////////////////////////////
+function detailStatusHTML($reqid) {
+ $requests = getUserRequests("all");
+ $found = 0;
+ foreach($requests as $request) {
+ if($request['id'] == $reqid) {
+ $found = 1;
+ break;
+ }
+ }
+ if(! $found) {
+ $text = "The selected reservation is no longer available. Go to ";
+ $text .= "<a href=" . BASEURL . SCRIPT . "?mode=newRequest>New ";
+ $text .= "Reservations</a> to request a new reservation or ";
+ $text .= "select another one that is available.";
+ return $text;
+ }
+ if($request['imageid'] == $request['compimageid'])
+ $nowreq = 1;
+ else
+ $nowreq = 0;
+ $flow = getCompStateFlow($request['computerid']);
+
+ # cluster reservations not supported here yet
+ if(empty($flow) || count($request['reservations']) > 0) {
+ $noinfo = "No detailed loading information is available for this ";
+ $noinfo .= "reservation.";
+ return $noinfo;
+ }
+
+ $logdata = getCompLoadLog($request['resid']);
+
+ # determine an estimated load time for the image
+ $imgLoadTime = getImageLoadEstimate($request['imageid']);
+ if($imgLoadTime == 0) {
+ $images = getImages(0, $request['imageid']);
+ $imgLoadTime = $images[$request['imageid']]['reloadtime'] * 60;
+ }
+ $time = 0;
+ $now = time();
+ $text = "<table summary=\"displays a list of states the reservation must "
+ . "go through to become ready and how long each state will take or "
+ . "has already taken\">";
+ $text .= "<tr>";
+ $text .= "<th align=right><br>State</th>";
+ $text .= "<th>Est/Act<br>Time</th>";
+ $text .= "<th>Total<br>Time</th>";
+ $text .= "</tr>";
+
+ $slash = "<font color=black>/</font>";
+ $total = 0;
+ $id = "";
+ $last = array();
+ $logstateids = array();
+ $skippedstates = array();
+ # loop through all states in the log data
+ foreach($logdata as $data) {
+ # keep track of the states in the log data
+ array_push($logstateids, $data['loadstateid']);
+ # keep track of any skipped states
+ if(! empty($last) &&
+ $last['loadstateid'] != $flow['repeatid'] &&
+ $data['loadstateid'] != $flow['data'][$last['loadstateid']]['nextstateid']) {
+ array_push($skippedstates, $flow['data'][$last['loadstateid']]['nextstateid']);
+ }
+ // if we reach a repeat state, include a message about having to go back
+ if($data['loadstateid'] == $flow['repeatid']) {
+ if(empty($id))
+ return $noinfo;
+ $text .= "<tr>";
+ $text .= "<td colspan=3><hr>problem at state ";
+ $text .= "\"{$flow['data'][$id]['nextstate']}\"";
+ $query = "SELECT additionalinfo "
+ . "FROM computerloadlog "
+ . "WHERE loadstateid = {$flow['repeatid']} AND "
+ . "reservationid = {$request['resid']} AND "
+ . "timestamp = '" . unixToDatetime($data['ts']) . "'";
+ $qh = doQuery($query, 101);
+ if($row = mysql_fetch_assoc($qh)) {
+ $reason = $row['additionalinfo'];
+ $text .= "<br>retrying at state \"$reason\"";
+ }
+ $text .= "<hr></td></tr>";
+ $total += $data['time'];
+ $last = $data;
+ continue;
+ }
+ $id = $data['loadstateid'];
+ // if in post config state, compute estimated time for the state
+ if($flow['data'][$id]['statename'] == 'loadimagecomplete') {
+ $addtime = 0;
+ foreach($skippedstates as $stateid)
+ $addtime += $flow['data'][$stateid]['statetime'];
+ # this state's time is (avg image load time - all other states time +
+ # state time for any skipped states)
+ $tmp = $imgLoadTime - $flow['totaltime'] + $addtime;
+ if($tmp < 0)
+ $flow['data'][$id]['statetime'] = 0;
+ else
+ $flow['data'][$id]['statetime'] = $tmp;
+ }
+ $total += $data['time'];
+ $text .= "<tr>";
+ $text .= "<td nowrap align=right><font color=green>";
+ $text .= "{$flow['data'][$id]['state']}($id)</font></td>";
+ $text .= "<td nowrap align=center><font color=green>";
+ $text .= secToMinSec($flow['data'][$id]['statetime']) . $slash;
+ $text .= secToMinSec($data['time']) . "</font></td>";
+ $text .= "<td nowrap align=center><font color=green>";
+ $text .= secToMinSec($total) . "</font></td>";
+ $text .= "</tr>";
+ $last = $data;
+ }
+ # $id will be set if there was log data, use the first state in the flow
+ # if it isn't set
+ if(! empty($id))
+ $id = $flow['nextstates'][$id];
+ else
+ $id = $flow['stateids'][0];
+
+ # determine any skipped states
+ $matchingstates = array();
+ foreach($flow['stateids'] as $stateid) {
+ if($stateid == $id)
+ break;
+ array_push($matchingstates, $stateid);
+ }
+ $skippedstates = array_diff($matchingstates, $logstateids);
+ $addtime = 0;
+ foreach($skippedstates as $stateid)
+ $addtime += $flow['data'][$stateid]['statetime'];
+
+ $first = 1;
+ $count = 0;
+ # loop through the states in the flow that haven't been reached yet
+ # $count is included to protect against an infinite loop
+ while(! is_null($id) && $count < 100) {
+ $count++;
+ // if in post config state, compute estimated time for the state
+ if($flow['data'][$id]['statename'] == 'loadimagecomplete') {
+ # this state's time is (avg image load time - all other states time +
+ # state time for any skipped states)
+ $tmp = $imgLoadTime - $flow['totaltime'] + $addtime;
+ if($tmp < 0)
+ $flow['data'][$id]['statetime'] = 0;
+ else
+ $flow['data'][$id]['statetime'] = $tmp;
+ }
+ // if first time through this loop, this is the current state
+ if($first) {
+ // if request has failed, it was during this state, get reason
+ if($request['currstateid'] == 5) {
+ $query = "SELECT additionalInfo, "
+ . "UNIX_TIMESTAMP(timestamp) AS ts "
+ . "FROM computerloadlog "
+ . "WHERE loadstateid = (SELECT id "
+ . "FROM computerloadstate "
+ . "WHERE loadstatename = 'failed') AND "
+ . "reservationid = {$request['resid']} "
+ . "ORDER BY id "
+ . "LIMIT 1";
+ $qh = doQuery($query, 101);
+ if($row = mysql_fetch_assoc($qh)) {
+ $reason = $row['additionalInfo'];
+ if(! empty($data))
+ $currtime = $row['ts'] - $data['ts'];
+ else
+ $currtime = $row['ts'] -
+ datetimeToUnix($request['daterequested']);
+ }
+ else {
+ $text = "No detailed information is available for this ";
+ $text .= "reservation.";
+ return $text;
+ }
+ $text .= "<tr>";
+ $text .= "<td nowrap align=right><font color=red>";
+ $text .= "{$flow['data'][$id]['state']}($id)</font></td>";
+ $text .= "<td nowrap align=center><font color=red>";
+ $text .= secToMinSec($flow['data'][$id]['statetime']);
+ $text .= $slash . secToMinSec($currtime) . "</font></td>";
+ $text .= "<td nowrap align=center><font color=red>";
+ $text .= secToMinSec($total + $currtime) . "</font></td>";
+ $text .= "</tr>";
+ $text .= "</table>";
+ if(strlen($reason))
+ $text .= "<br><font color=red>failed: $reason</font>";
+ return $text;
+ }
+ # otherwise add text about current state
+ else {
+ if(! empty($data))
+ $currtime = $now - $data['ts'];
+ else
+ $currtime = $now - datetimeToUnix($request['daterequested']);
+ $text .= "<td nowrap align=right><font color=#CC8500>";
+ $text .= "{$flow['data'][$id]['state']}($id)</font></td>";
+ $text .= "<td nowrap align=center><font color=#CC8500>";
+ $text .= secToMinSec($flow['data'][$id]['statetime']);
+ $text .= $slash . secToMinSec($currtime) . "</font></td>";
+ $text .= "<td nowrap align=center><font color=#CC8500>";
+ $text .= secToMinSec($total + $currtime) . "</font></td>";
+ $text .= "</tr>";
+ $first = 0;
+ }
+ }
+ # add text about future states
+ else {
+ $text .= "<td nowrap align=right>{$flow['data'][$id]['state']}($id)";
+ $text .= "</td>";
+ $text .= "<td nowrap align=center>";
+ $text .= secToMinSec($flow['data'][$id]['statetime']) . "</td>";
+ $text .= "<td></td>";
+ $text .= "</tr>";
+ }
+ $id = $flow['nextstates'][$id];
+ }
+ $text .= "</table>";
+ return $text;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn viewRequestInfo()
+///
+/// \brief prints a page with information about a specific request
+///
+////////////////////////////////////////////////////////////////////////////////
+function viewRequestInfo() {
+ $requestid = processInputVar("requestid", ARG_NUMERIC);
+ $request = getRequestInfo($requestid);
+ foreach($request["reservations"] as $res) {
+ if($res["forcheckout"]) {
+ $prettyimage = $res["prettyimage"];
+ break;
+ }
+ }
+ $states = getStates();
+ $userinfo = getUserInfo($request["userid"]);
+ print "<DIV align=center>\n";
+ print "<H2>View Reservation</H2>\n";
+ print "<table summary=\"\">\n";
+ print " <TR>\n";
+ print " <TH align=right>Unity ID:</TH>\n";
+ print " <TD>" . $userinfo["unityid"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Requested Image:</TH>\n";
+ print " <TD>$prettyimage</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Start Time:</TH>\n";
+ if(datetimeToUnix($request["start"]) <
+ datetimeToUnix($request["daterequested"])) {
+ print " <TD>" . prettyDatetime($request["daterequested"]) . "</TD>\n";
+ }
+ else {
+ print " <TD>" . prettyDatetime($request["start"]) . "</TD>\n";
+ }
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>End Time:</TH>\n";
+ print " <TD>" . prettyDatetime($request["end"]) . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Current State:</TH>\n";
+ print " <TD>" . $states[$request["stateid"]] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Last State:</TH>\n";
+ print " <TD>";
+ if($request["laststateid"]) {
+ print $states[$request["laststateid"]];
+ }
+ else {
+ print "None";
+ }
+ print "</TD>\n";
+ print " </TR>\n";
+ foreach($request["reservations"] as $res) {
+ print " <TR>\n";
+ print " <TH align=right>Computer ID:</TH>\n";
+ print " <TD>" . $res["computerid"] . "</TD>\n";
+ print " </TR>\n";
+ }
+ print " <TR>\n";
+ print " <TH align=right>Request Time:</TH>\n";
+ print " <TD>" . prettyDatetime($request["daterequested"]) . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Last Modified:</TH>\n";
+ if(! empty($request["datemodified"])) {
+ print " <TD>" . prettyDatetime($request["datemodified"]) . "</TD>\n";
+ }
+ else {
+ print " <TD>Never Modified</TD>\n";
+ }
+ print " </TR>\n";
+ print "</table>\n";
+ print "<table summary=\"\">\n";
+ print " <TR>\n";
+ /*print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <INPUT type=hidden name=mode value=adminEditRequest>\n";
+ print " <INPUT type=hidden name=requestid value=$requestid>\n";
+ print " <INPUT type=submit value=Modify>\n";
+ print " </FORM>\n";
+ print " </TD>\n";*/
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('requestid' => $requestid);
+ $cont = addContinuationsEntry('confirmDeleteRequest', $cdata, SECINDAY);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=\"Delete Reservation\">\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</table>\n";
+ print "</DIV>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn editRequest()
+///
+/// \brief prints a page for a user to edit a previous request
+///
+////////////////////////////////////////////////////////////////////////////////
+function editRequest() {
+ global $submitErr, $user;
+ $requestid = getContinuationVar('requestid', 0);
+ $request = getRequestInfo($requestid);
+ if(! array_key_exists("stateid", $request)) {
+ viewRequests();
+ return;
+ }
+ foreach($request["reservations"] as $res) {
+ if($res["forcheckout"]) {
+ $reservation = $res;
+ break;
+ }
+ }
+ if($submitErr) {
+ $data = processRequestInput(0);
+ }
+ // NCSU code
+ $groupid = getUserGroupID('Specify End Time', 1);
+ $members = getUserGroupMembers($groupid);
+ if(array_key_exists($user['id'], $members))
+ $openend = 1;
+ else
+ $openend = 0;
+ // end NCSU code
+ $unixstart = datetimeToUnix($request["start"]);
+ $unixend = datetimeToUnix($request["end"]);
+ $maxtimes = getUserMaxTimes("initialmaxtime");
+ $timeToNext = timeToNextReservation($request);
+
+ print "<H2>Modify Reservation</H2>\n";
+ $now = time();
+ if($unixstart > $now)
+ $started = 0;
+ else {
+ # \todo if $timeToNext is anything < 30, try moving reservations off until it is >= 30
+ if($timeToNext == 0) {
+ $movedall = 1;
+ foreach($request["reservations"] as $res) {
+ if(! moveReservationsOffComputer($res["computerid"], 1)) {
+ $movedall = 0;
+ break;
+ }
+ }
+ if(! $movedall) {
+ // cannot extend the reservation unless we move the next one to another computer
+ print "The computer you are using has another reservation ";
+ print "immediately following yours. Therefore, you cannot extend ";
+ print "your reservation because it would overlap with the next ";
+ print "one.<br>\n";
+ return;
+ }
+ $timeToNext = timeToNextReservation($request);
+ }
+ $started = 1;
+ print "Because this reservation has already started, you can only ";
+ print "extend the length of the reservation. ";
+ if(! $openend) {
+ print "If there are no reservations following yours, ";
+ print "you can extend your reservation ";
+ print "by up to " . minToHourMin($maxtimes["extend"]) . ", but not ";
+ print "exceeding " . minToHourMin($maxtimes["total"]) . " for your ";
+ print "total reservation time.<br><br>\n";
+ }
+ }
+ print "Modify reservation for <b>" . $reservation["prettyimage"];
+ print "</b> starting ";
+ if(datetimeToUnix($request["start"]) <
+ datetimeToUnix($request["daterequested"])) {
+ print prettyDatetime($request["daterequested"]);
+ }
+ else {
+ print prettyDatetime($request["start"]);
+ }
+ print ":<br><br>\n";
+ $start = date('l,g,i,a', datetimeToUnix($request["start"]));
+ $startArr = explode(',', $start);
+ $len = ($unixend - $unixstart) / 60;
+ $cdata = array();
+ if($started) {
+ $inputday = date('n/j/Y', datetimeToUnix($request["start"]));
+ $cdata['day'] = $inputday;
+ $cdata['hour'] = $startArr[1];
+ $cdata['minute'] = $startArr[2];
+ $cdata['meridian'] = $startArr[3];
+ # determine the current total length of the reservation
+ $reslen = ($unixend - unixFloor15($unixstart)) / 60;
+ $timeval = getdate($unixstart);
+ if(($timeval["minutes"] % 15) != 0) {
+ $reslen -= 15;
+ }
+ if(! $openend && ($reslen >= $maxtimes["total"])) {
+ print "You are only allowed to extend your reservation such that it ";
+ print "has a total length of " . minToHourMin($maxtimes["total"]);
+ print ". This reservation already meets that length. Therefore, ";
+ print "you are not allowed to extend your reservation any further.<br><br>\n";
+ printEditNewUpdate($request, $res);
+ return;
+ }
+ //if have time left to extend it, create an array of lengths based on maxextend that has a cap
+ # so we don't run into another reservation and we can't extend past the totalmax
+ $lengths = array();
+ if($timeToNext == -1) {
+ // there is no following reservation
+ if((($reslen + 15) <= $maxtimes["total"]) && (15 <= $maxtimes["extend"]))
+ $lengths["15"] = "15 minutes";
+ if((($reslen + 30) <= $maxtimes["total"]) && (30 <= $maxtimes["extend"]))
+ $lengths["30"] = "30 minutes";
+ if((($reslen + 60) <= $maxtimes["total"]) && (60 <= $maxtimes["extend"]))
+ $lengths["60"] = "1 hour";
+ for($i = 120;(($reslen + $i) <= $maxtimes["total"]) && ($i <= $maxtimes["extend"]); $i += 60) {
+ $lengths[$i] = $i / 60 . " hours";
+ }
+ }
+ else {
+ if($timeToNext >= 15 && (($reslen + 15) <= $maxtimes["total"]) && (15 <= $maxtimes["extend"]))
+ $lengths["15"] = "15 minutes";
+ if($timeToNext >= 30 && (($reslen + 30) <= $maxtimes["total"]) && (30 <= $maxtimes["extend"]))
+ $lengths["30"] = "30 minutes";
+ if($timeToNext >= 60 && (($reslen + 60) <= $maxtimes["total"]) && (60 <= $maxtimes["extend"]))
+ $lengths["60"] = "1 hour";
+ for($i = 120; ($i <= $timeToNext) && (($reslen + $i) <= $maxtimes["total"]) && ($i <= $maxtimes["extend"]); $i += 60) {
+ $lengths[$i] = $i / 60 . " hours";
+ }
+ }
+ # do we need this?
+ /*if($timeToNext > 60 && (($reslen + $timeToNext) <= $maxtimes["total"]) && ($timeToNext <= $maxtimes["extend"]))
+ if($timeToNext % 60 == 0)
+ $lengths[$timeToNext] = $timeToNext / 60 . " hours";
+ else
+ $lengths[$timeToNext] = sprintf("%.2f hours", $timeToNext / 60);*/
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ if($openend) {
+ if(! empty($lengths)) {
+ if($submitErr && $data['ending'] == 'date') {
+ $chk['length'] = '';
+ $chk['date'] = 'checked';
+ }
+ else {
+ $chk['length'] = 'checked';
+ $chk['date'] = '';
+ }
+ print "<INPUT type=radio name=ending value=length {$chk['length']}>";
+ print "Extend reservation by:\n";
+ if($submitErr)
+ printSelectInput("length", $lengths, $data['length']);
+ else
+ printSelectInput("length", $lengths, 30);
+ print "<br><INPUT type=radio name=ending value=date {$chk['date']}>";
+ }
+ else
+ print "<INPUT type=hidden name=ending value=date>\n";
+ print "Change ending to:\n";
+ $enddate = $request['end'];
+ if($submitErr)
+ $enddate = $data['enddate'];
+ print "<INPUT type=text name=enddate size=20 value=\"$enddate\">(YYYY-MM-DD HH:MM:SS)\n";
+ printSubmitErr(ENDDATEERR);
+ if($timeToNext > -1) {
+ $extend = $unixend + (($timeToNext - 15) * 60);
+ $extend = unixToDatetime($extend);
+ print "<br><font color=red><strong>NOTE:</strong> Due to an upcoming ";
+ print "reservation on the same computer,<br>\n";
+ print "you can only extend this reservation until $extend.</font>\n";
+ }
+ }
+ else {
+ print "Extend reservation by: \n";
+ printSelectInput("length", $lengths, 30);
+ }
+ print "<br>\n";
+ $cdata['started'] = 1;
+ }
+ else {
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ printReserveItems(1, $startArr[0], $startArr[1], $startArr[2], $startArr[3], $len, 1);
+ $cdata['started'] = 0;
+ }
+ print "<br>\n";
+ print "<table summary=\"\">\n";
+ print " <TR valign=top>\n";
+ print " <TD>\n";
+ $cdata['requestid'] = $requestid;
+ $cdata['openend'] = $openend;
+ $cdata['imageid'] = $reservation['imageid'];
+ $cont = addContinuationsEntry('confirmEditRequest', $cdata, SECINDAY, 0, 1, 1);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=\"Confirm Changes\">\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry('viewRequests');
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Cancel>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</table>\n";
+
+ printEditNewUpdate($request, $res);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn printEditNewUpdate($request, $res)
+///
+/// \param $request - array of request data from getRequestInfo
+/// \param $res - reservation part of $request array
+///
+/// \brief prints a form for allowing the user to save the current image as a
+/// new image or update the existing image
+///
+////////////////////////////////////////////////////////////////////////////////
+function printEditNewUpdate($request, $res) {
+ global $user;
+ # do not allow save/update for cluster images
+ if(count($request['reservations']) > 1)
+ return;
+
+ $resources = getUserResources(array("imageAdmin"));
+ if(! array_key_exists($res['imageid'], $resources['image']))
+ return;
+
+ $compid = $request['reservations'][0]['computerid'];
+ $comp = getComputers(0, 0, $compid);
+ if($comp[$compid]['type'] != 'blade')
+ return;
+
+ print "<h2>Save as New Image / Update Image</h2>\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('requestid' => $request['id']);
+ $cont = addContinuationsEntry('newImage', $cdata, SECINDAY, 0);
+ print "<INPUT type=radio name=continuation value=\"$cont\" id=newimage checked>";
+ print "<label for=newimage>Save as New Image</label><br>\n";
+ $imageData = getImages(0, $res['imageid']);
+ if($imageData[$res['imageid']]['ownerid'] != $user['id']) {
+ print "<INPUT type=radio name=continuation value=\"$cont\" ";
+ print "id=updateimage disabled><label for=updateimage><font color=gray>";
+ print "Update Existing Image</font></label>";
+ }
+ else {
+ $cdata['nextmode'] = 'updateExistingImage';
+ $cont = addContinuationsEntry('imageClickThroughAgreement', $cdata, SECINDAY, 0);
+ print "<INPUT type=radio name=continuation value=\"$cont\" ";
+ print "id=updateimage><label for=updateimage>Update Existing Image";
+ print "</label>";
+ }
+ print "<br><br>\n";
+ print "<INPUT type=submit value=\"Save/Update\">\n";
+ print "</FORM>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn adminEditRequest()
+///
+/// \brief prints a page for an admin to edit a user's request
+///
+////////////////////////////////////////////////////////////////////////////////
+/*function adminEditRequest() {
+ $requestid = processInputVar("requestid", ARG_NUMERIC);
+ $request = getRequestInfo($requestid);
+ foreach($request["reservations"] as $res) {
+ if($res["forcheckout"]) {
+ $reservation = $res;
+ break;
+ }
+ }
+ $userinfo = getUserInfo($request["userid"]);
+ $images = getImages();
+ $unixstart = datetimeToUnix($request["start"]);
+ print "<H2>Modify Reservation</H2>\n";
+ if($unixstart > time()) {
+ $started = 0;
+ }
+ else {
+ $started = 1;
+ print "Because this reservation has already started, you can only ";
+ print "modify the end time of the reservation. You will only be able ";
+ print "to extend the length if the computer the reservation is on ";
+ print "has time available before the next reservation.<br><br>\n";
+ }
+ $start = date('n/j/y,g,i,a', datetimeToUnix($request["start"]));
+ $startArr = explode(',', $start);
+
+ $end = date('n/j/y,g,i,a', datetimeToUnix($request["end"]));
+ $endArr = explode(',', $end);
+
+ print "Modify reservation for ";
+ if(! empty($userinfo["preferredname"])) {
+ print $userinfo["preferredname"] . " ";
+ }
+ else {
+ print $userinfo["firstname"] . " ";
+ }
+ print $userinfo["lastname"] . " (" . $userinfo["unityid"] . "):<br>\n";
+ print "<DIV align=center>\n";
+ print "<table summary=\"\" cellpadding=0>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $minArr = array("zero" => "00",
+ "15" => "15",
+ "30" => "30",
+ "45" => "45");
+ if(! $started) {
+ print " <TR>\n";
+ print " <TH align=right>Requested Image:</TH>\n";
+ print " <TD colspan=6>\n";
+ printSelectInput("imageid", $images, $reservation["imageid"]);
+ print " </TD>\n";
+ print " </TR>\n";
+ print " <TR valign=middle>\n";
+ print " <TH align=right>Start Time:</TH>\n";
+ print " <TD>\n";
+ print " <INPUT type=text name=day maxlength=8 size=8 ";
+ print "value=\"" . $startArr[0] . "\">\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <INPUT type=text name=hour maxlength=2 size=2 ";
+ print "value=" . $startArr[1] . ">\n";
+ print " <TD>:</TD>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ printSelectInput("minute", $minArr, $startArr[2]);
+ print " </TD>\n";
+ print " <TD>\n";
+ printSelectInput("meridian", array("am" => "am", "pm" => "pm"), $startArr[3]);
+ print " </TD>\n";
+ print " <TD>\n";
+ printSubmitErr(STARTDAYERR);
+ printSubmitErr(STARTHOURERR);
+ print " </TD>\n";
+ print " </TR>\n";
+ }
+ print " <TR valign=middle>\n";
+ print " <TH align=right>End Time:</TH>\n";
+ print " <TD><INPUT type=text name=endday maxlength=8 size=8 ";
+ print "value=\"" . $endArr[0] . "\"></TD>\n";
+ print " <TD><INPUT type=text name=endhour maxlength=2 size=2 ";
+ print "value=" . $endArr[1] . "></TD>\n";
+ print " <TD>:</TD>\n";
+ print " <TD>\n";
+ printSelectInput("endminute", $minArr, $endArr[2]);
+ print " </TD>\n";
+ print " <TD>\n";
+ printSelectInput("endmeridian", array("am" => "am", "pm" => "pm"), $endArr[3]);
+ print " </TD>\n";
+ print " <TD>\n";
+ printSubmitErr(ENDDAYERR);
+ printSubmitErr(ENDHOURERR);
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</table>\n";
+ print "<table summary=\"\">\n";
+ print " <TR valign=top>\n";
+ print " <TD>\n";
+ print " <INPUT type=hidden name=mode value=confirmAdminEditRequest>\n";
+ print " <INPUT type=hidden name=requestid value=$requestid>\n";
+ print " <INPUT type=hidden name=started value=$started>\n";
+ print " <INPUT type=submit value=\"Confirm Changes\">\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <INPUT type=hidden name=mode value=pickTimeTable>\n";
+ print " <INPUT type=submit value=Cancel>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</table>\n";
+ print "</DIV>\n";
+}*/
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn confirmEditRequest()
+///
+/// \brief prints a page confirming the change the user requested for his
+/// request
+///
+////////////////////////////////////////////////////////////////////////////////
+function confirmEditRequest() {
+ global $submitErr;
+ $data = processRequestInput(1);
+ if($submitErr) {
+ editRequest();
+ return;
+ }
+ $cdata = getContinuationVar();
+ $request = getRequestInfo($cdata["requestid"]);
+ foreach($request["reservations"] as $res) {
+ if($res["forcheckout"]) {
+ $reservation = $res;
+ break;
+ }
+ }
+ print "<H2>Modify Reservation</H2>\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ if($cdata["started"]) {
+ if($cdata['openend'] && $data['ending'] == 'date') {
+ print "Change ending for <b>{$reservation["prettyimage"]}</b> ";
+ print "to {$data['enddate']}?<br><br>\n";
+ }
+ else {
+ print "Extend reservation for <b>{$reservation["prettyimage"]}</b> ";
+ print "by " . prettyLength($data["length"]) . "?<br><br>\n";
+ }
+
+ $unixstart = datetimeToUnix($request["start"]);
+ $curlen = (datetimeToUnix($request["end"]) - $unixstart) / 60;
+ if($unixstart < datetimeToUnix($request["daterequested"])) {
+ $curlen -= 15;
+ }
+ $cdata["extend"] = $data["length"];
+ $cdata["length"] = $curlen + $data["length"];
+ }
+ else {
+ print "Change reservation for <b>" . $reservation["prettyimage"];
+ print "</b> starting ";
+ if(datetimeToUnix($request["start"]) <
+ datetimeToUnix($request["daterequested"])) {
+ print prettyDatetime($request["daterequested"]);
+ }
+ else {
+ print prettyDatetime($request["start"]);
+ }
+ print "<br>\nto ";
+ if($data['ending'] == 'date') {
+ print "start {$data["day"]} at {$data["hour"]}:";
+ if($data["minute"] == 0)
+ print "00";
+ else
+ print $data["minute"];
+ print " {$data["meridian"]} and end ";
+ $tmp = date('n/j/Y-g:i a', datetimeToUnix($data["enddate"]));
+ $tmp = explode('-', $tmp);
+ print "{$tmp[0]} at {$tmp[1]}?<br><br>\n";
+ }
+ else {
+ print "{$data["day"]}, at {$data["hour"]}:";
+ if($data["minute"] == 0)
+ print "00";
+ else
+ print $data["minute"];
+ print " {$data["meridian"]} ";
+ print "for " . prettyLength($data["length"]) . "?<br><br>\n";
+ }
+ }
+ print "<table summary=\"\">\n";
+ print " <TR valign=top>\n";
+ print " <TD>\n";
+ $cdata = array_merge($data, $cdata);
+ $cdata['imageid'] = $reservation['imageid'];
+ $cdata['prettyimage'] = $reservation['prettyimage'];
+ $cdata['os'] = $reservation['OS'];
+ if($submitErr)
+ $cont = addContinuationsEntry('submitEditRequest', $cdata, SECINDAY, 1, 0);
+ else
+ $cont = addContinuationsEntry('submitEditRequest', $cdata, SECINDAY, 0, 0);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Submit>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry('viewRequests');
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Cancel>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</table>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn confirmAdminEditRequest()
+///
+/// \brief prints a page confirming the changes the admin requested for the
+/// request
+///
+////////////////////////////////////////////////////////////////////////////////
+/*function confirmAdminEditRequest() {
+ global $submitErr;
+
+ $data = processRequestInput(1);
+ if($submitErr) {
+ adminEditRequest();
+ return;
+ }
+ $request = getRequestInfo($data["requestid"]);
+ $userinfo = getUserInfo($request["userid"]);
+ $images = getImages();
+
+ print "<H2>Modify Reservation</H2>\n";
+ print "Change reservation for ";
+ if(! empty($userinfo["preferredname"])) {
+ print $userinfo["preferredname"] . " ";
+ }
+ else {
+ print $userinfo["firstname"] . " ";
+ }
+ print $userinfo["lastname"] . " (" . $userinfo["unityid"] . "):<br>\n";
+ print "<table summary=\"\">\n";
+ if(! $data["started"]) {
+ print " <TR>\n";
+ print " <TH align=right>Image:</TH>\n";
+ print " <TD>" . $images[$data["imageid"]]["prettyname"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Start Time:</TH>\n";
+ print " <TD>" . $data["day"] . " " . $data["hour"] . ":";
+ print $data["minute"] . " " . $data["meridian"] . "</TD>\n";
+ print " </TR>\n";
+ }
+ print " <TR>\n";
+ print " <TH align=right>End Time:</TH>\n";
+ print " <TD>" . $data["endday"] . " " . $data["endhour"] . ":";
+ print $data["endminute"] . " " . $data["endmeridian"] . "</TD>\n";
+ print " </TR>\n";
+ print "</table>\n";
+ print "<table summary=\"\">\n";
+ print " <TR valign=top>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <INPUT type=hidden name=mode value=submitAdminEditRequest>\n";
+ printHiddenInputs($data);
+ print " <INPUT type=submit value=Submit>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <INPUT type=hidden name=mode value=pickTimeTable>\n";
+ print " <INPUT type=submit value=Cancel>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</table>\n";
+}*/
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitEditRequest()
+///
+/// \brief submits changes to a request and prints that it has been changed
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitEditRequest() {
+ global $user, $submitErr, $viewmode, $mode;
+ $data = getContinuationVar();
+ $request = getRequestInfo($data["requestid"]);
+
+ print "<H2>Modify Reservation</H2>\n";
+
+ $hour = $data["hour"];
+ if($data["hour"] == 12) {
+ if($data["meridian"] == "am") {
+ $hour = 0;
+ }
+ }
+ elseif($data["meridian"] == "pm") {
+ $hour = $data["hour"] + 12;
+ }
+
+ $tmp = explode('/', $data["day"]);
+ $start = mktime($hour, $data["minute"], "0", $tmp[0], $tmp[1], $tmp[2]);
+ if($data['openend'] && $data['ending'] == 'date')
+ $end = datetimeToUnix($data['enddate']);
+ else {
+ if(datetimeToUnix($request["start"]) < datetimeToUnix($request["daterequested"]))
+ $end = $start + $data["length"] * 60 + 900;
+ else
+ $end = $start + $data["length"] * 60;
+ }
+
+ // get semaphore lock
+ if(! semLock())
+ abort(3);
+
+ $max = getMaxOverlap($user['id']);
+ if(checkOverlap($start, $end, $max, $data["requestid"])) {
+ if($max == 0) {
+ print "<font color=\"#ff0000\">The time you requested overlaps with ";
+ print "another reservation you currently have. You are only allowed ";
+ print "to have a single reservation at any given time. Please select ";
+ print "another time to use the application.</font><br><br>\n";
+ }
+ else {
+ print "<font color=\"#ff0000\">The time you requested overlaps with ";
+ print "another reservation you currently have. You are allowed ";
+ print "to have $max overlapping reservations at any given time. ";
+ print "Please select another time to use the application.</font><br>";
+ print "<br>\n";
+ }
+ $submitErr = 1;
+ editRequest();
+ return;
+ }
+ $rc = isAvailable(getImages(), $data["imageid"], $start, $end, $data["os"], $data["requestid"]);
+ if($rc == -1) {
+ print "You have requested an environment that is limited in the number ";
+ print "of concurrent reservations that can be made. No further ";
+ print "reservations for the environment can be made for the time you ";
+ print "have selected. Please select another time to use the ";
+ print "environment.<br>";
+ addChangeLogEntry($request["logid"], NULL, unixToDatetime($end),
+ unixToDatetime($start), NULL, NULL, 0);
+ }
+ elseif($rc > 0) {
+ updateRequest($data["requestid"]);
+ if($data["started"]) {
+ if($data['openend'] && $data['ending'] == 'date') {
+ print "Your request to change the ending of your reservation for <b>";
+ print "{$data["prettyimage"]}</b> to {$data['enddate']} ";
+ print "has been accepted.<br><br>\n";
+ }
+ else {
+ $remaining = ($end - time()) / 60;
+ print "Your request to extend your reservation for <b>";
+ print "{$data["prettyimage"]}</b> by " . prettyLength($data["extend"]);
+ print " has been accepted.<br><br>\n";
+ print "You now have " . prettyLength($remaining) . " remaining for ";
+ print "your reservation<br>\n";
+ }
+ }
+ else {
+ print "Your request to use <b>" . $data["prettyimage"] . "</b> on ";
+ if(datetimeToUnix($request["start"]) <
+ datetimeToUnix($request["daterequested"])) {
+ print prettyDatetime($request["daterequested"]);
+ }
+ else
+ print prettyDatetime($start);
+ if($data['openend'] && $data['ending'] == 'date')
+ print " until " . prettyDatetime($end);
+ else
+ print " for " . prettyLength($data["length"]);
+ print " has been accepted.<br>\n";
+ }
+ }
+ else {
+ $cdata = array('imageid' => $data['imageid'],
+ 'length' => $data['length'],
+ 'requestid' => $data['requestid']);
+ $cont = addContinuationsEntry('selectTimeTable', $cdata);
+ print "The time you have requested is not available. You may ";
+ print "<a href=\"" . BASEURL . SCRIPT . "?continuation=$cont\">";
+ print "view a timetable</a> of free and reserved times to find ";
+ print "a time that will work for you.<br>\n";
+ addChangeLogEntry($request["logid"], NULL, unixToDatetime($end),
+ unixToDatetime($start), NULL, NULL, 0);
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitAdminEditRequest()
+///
+/// \brief submits changes to a request and prints that it has been changed
+///
+////////////////////////////////////////////////////////////////////////////////
+/*function submitAdminEditRequest() {
+ $data = processRequestInput(0);
+ $request = getRequestInfo($data["requestid"]);
+ $userinfo = getUserInfo($request["userid"]);
+ $images = getImages();
+
+ print "<H2>Modify Reservation</H2>\n";
+
+ $hour = $data["hour"];
+ if($data["hour"] == 12) {
+ if($data["meridian"] == "am") {
+ $hour = 0;
+ }
+ }
+ elseif($data["meridian"] == "pm") {
+ $hour = $data["hour"] + 12;
+ }
+
+ $endhour = $data["endhour"];
+ if($data["endhour"] == 12) {
+ if($data["endmeridian"] == "am") {
+ $endhour = 0;
+ }
+ }
+ elseif($data["endmeridian"] == "pm") {
+ $endhour = $data["endhour"] + 12;
+ }
+
+ $tmp = explode('/', $data["day"]);
+ $start = mktime($hour, $data["minute"], "0", $tmp[0], $tmp[1], $tmp[2]);
+ $tmp = explode('/', $data["endday"]);
+ $end = mktime($endhour, $data["endminute"], "0", $tmp[0], $tmp[1], $tmp[2]);
+
+ $rc = isAvailable($images, $data["imageid"], $start, $end, $data["os"], $data["requestid"]);
+ if($rc == -1) {
+ print "Modified reservation time is not available<br>\n";
+ addChangeLogEntry($request["logid"], NULL, unixToDatetime($end),
+ unixToDatetime($start), NULL, NULL, 0);
+ }
+ elseif($rc > 0) {
+ updateRequest($data["requestid"]);
+ print "Change reservation for ";
+ if(! empty($userinfo["preferredname"])) {
+ print $userinfo["preferredname"] . " ";
+ }
+ else {
+ print $userinfo["firstname"] . " ";
+ }
+ print $userinfo["lastname"] . " (" . $userinfo["unityid"] . "):<br>\n";
+ print "Reservation for " . $userinfo["firstname"] . " ";
+ print $userinfo["lastname"] . "(" . $userinfo["unityid"] . ") has ";
+ print "been updated to start at " . unixToDatetime($start) . " and ";
+ print "end at " . unixToDatetime($end) . " using image ";
+ print $images[$data["imageid"]]["prettyname"] . "<br>\n";
+ }
+ else {
+ print "Modified reservation time is not available<br>\n";
+ addChangeLogEntry($request["logid"], NULL, unixToDatetime($end),
+ unixToDatetime($start), NULL, NULL, 0);
+ }
+}*/
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn confirmDeleteRequest()
+///
+/// \brief prints a confirmation page about deleting a request
+///
+////////////////////////////////////////////////////////////////////////////////
+function confirmDeleteRequest() {
+ $requestid = getContinuationVar('requestid', 0);
+ $request = getRequestInfo($requestid);
+ # FIXME if an imaging reservation for a non-checkout image, this will result
+ # in $reservation not being set
+ foreach($request["reservations"] as $res) {
+ if($res["forcheckout"]) {
+ $reservation = $res;
+ break;
+ }
+ }
+ if(datetimeToUnix($request["start"]) > time()) {
+ $title = "Delete Reservation";
+ $text = "Delete your reservation for <b>" . $reservation["prettyimage"]
+ . "</b> starting " . prettyDatetime($request["start"]) . "?<br>\n";
+ }
+ else {
+ if(! $reservation["production"]) {
+ confirmDeleteRequestProduction($request);
+ return;
+ }
+ else {
+ $title = "End Reservation";
+ $text = "Are you finished with your reservation for <b>"
+ . $reservation["prettyimage"] . "</b> that started ";
+ if(datetimeToUnix($request["start"]) <
+ datetimeToUnix($request["daterequested"])) {
+ $text .= prettyDatetime($request["daterequested"]);
+ }
+ else {
+ $text .= prettyDatetime($request["start"]);
+ }
+ $text .= "?<br>\n";
+ }
+ }
+ print "<H2>$title</H2>\n";
+ print $text;
+ print "<table summary=\"\">\n";
+ print " <TR valign=top>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('requestid' => $requestid);
+ $cont = addContinuationsEntry('submitDeleteRequest', $cdata, SECINDAY, 0, 0);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Yes>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry('viewRequests');
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=No>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</table>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn confirmDeleteRequestProduction($request)
+///
+/// \param $request - a request array as returend from getRequestInfo
+///
+/// \brief prints a page asking if the user is ready to make the image
+/// production or just end this reservation
+///
+////////////////////////////////////////////////////////////////////////////////
+function confirmDeleteRequestProduction($request) {
+ $cdata = array('requestid' => $request['id']);
+ print "<H2>End Reservation/Make Production</H2>\n";
+ print "Are you satisfied that this environment is ready to be made production ";
+ print "and replace the current production version, or would you just like to ";
+ print "end this reservation and test it again later?\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+
+ $cont = addContinuationsEntry('setImageProduction', $cdata, SECINDAY, 0, 1);
+ print "<br> <INPUT type=radio name=continuation ";
+ print "value=\"$cont\">Make this the production version<br>\n";
+
+ $cont = addContinuationsEntry('submitDeleteRequest', $cdata, SECINDAY, 0, 0);
+ print " <INPUT type=radio name=continuation ";
+ print "value=\"$cont\">Just end the reservation<br>\n";
+
+ $cont = addContinuationsEntry('viewRequests');
+ print " <INPUT type=radio name=continuation ";
+ print "value=\"$cont\">Neither, go back to <strong>Current Reservations";
+ print "</strong><br><br>\n";
+
+ print "<INPUT type=submit value=Submit>\n";
+ print "</FORM>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitDeleteRequest()
+///
+/// \brief submits deleting a request and prints that it has been deleted
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitDeleteRequest() {
+ $requestid = getContinuationVar('requestid', 0);
+ $request = getRequestInfo($requestid);
+ foreach($request["reservations"] as $res) {
+ if($res["forcheckout"]) {
+ $reservation = $res;
+ break;
+ }
+ }
+ deleteRequest($request);
+ if(datetimeToUnix($request["start"]) > time()) {
+ print "<H2>Delete Reservation</H2>";
+ print "Your reservation for <b>" . $reservation["prettyimage"];
+ print "</b> starting " . prettyDatetime($request["start"]);
+ print " has been deleted.<br>\n";
+ }
+ else {
+ print "<H2>End Reservation</H2>";
+ print "Your reservation for <b>" . $reservation["prettyimage"];
+ print "</b> starting ";
+ if(datetimeToUnix($request["start"]) <
+ datetimeToUnix($request["daterequested"])) {
+ print prettyDatetime($request["daterequested"]);
+ }
+ else {
+ print prettyDatetime($request["start"]);
+ }
+ print " has been released.<br>\n";
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn printReserveItems($modifystart, $day, $hour, $minute,
+/// $meridian, $length, $oneline, $nolength)
+///
+/// \param $modifystart - (optional) 1 to print form for modifying start time,
+/// 0 not to
+/// \param $day - (optional) initial day of week (Sunday - Saturday)
+/// \param $hour - (optional) initial hour (1-12)
+/// \param $minute - (optional) initial minute (00-59)
+/// \param $meridian - (optional) initial meridian (am/pm)
+/// \param $length - (optional) initial length (in minutes)
+/// \param $oneline - (optional) print all items on one line
+/// \param $nolength - (optional) 0 to print length, 1 not to
+///
+/// \brief prints reserve form data
+///
+////////////////////////////////////////////////////////////////////////////////
+function printReserveItems($modifystart=1, $day=NULL, $hour=NULL, $minute=NULL,
+ $meridian=NULL, $length=60, $oneline=0, $nolength=0) {
+ global $user;
+ $enddate = processInputVar("enddate", ARG_STRING);
+ // NCSU code
+ $groupid = getUserGroupID('Specify End Time', 1);
+ $members = getUserGroupMembers($groupid);
+ if(array_key_exists($user['id'], $members))
+ $openend = 1;
+ else
+ $openend = 0;
+ // end NCSU code
+ /*if($user['adminlevel'] == 'developer')
+ $openend = 1;
+ else
+ $openend = 0;*/
+ $days = array();
+ $inputday = "";
+ for($cur = time(), $end = $cur + DAYSAHEAD * SECINDAY;
+ $cur < $end;
+ $cur += SECINDAY) {
+ $tmp = getdate($cur);
+ $index = $tmp["mon"] . "/" . $tmp["mday"] . "/" . $tmp["year"];
+ $days[$index] = $tmp["weekday"];
+ if($tmp["weekday"] == $day) {
+ $inputday = $index;
+ }
+ }
+
+ if($modifystart) {
+ printSelectInput("day", $days, $inputday);
+ print " At \n";
+ $tmpArr = array();
+ for($i = 1; $i < 13; $i++) {
+ $tmpArr[$i] = $i;
+ }
+ printSelectInput("hour", $tmpArr, $hour);
+
+ $minutes = array("zero" => "00",
+ "15" => "15",
+ "30" => "30",
+ "45" => "45");
+ printSelectInput("minute", $minutes, $minute);
+ printSelectInput("meridian", array("am" => "a.m.", "pm" => "p.m."), $meridian);
+ print "<small>(Eastern Time Zone)</small>";
+ //if(! $oneline)
+ print "<br><br>";
+ /*else
+ print " ";*/
+ if(! $nolength) {
+ if($openend) {
+ print " <INPUT type=radio name=ending ";
+ print "onclick='updateWaitTime(0);' value=length checked>";
+ }
+ print "Duration: \n";
+ }
+ }
+ else {
+ print "<INPUT type=hidden name=day value=$inputday>\n";
+ print "<INPUT type=hidden name=hour value=$hour>\n";
+ print "<INPUT type=hidden name=minute value=$minute>\n";
+ print "<INPUT type=hidden name=meridian value=$meridian>\n";
+ }
+ // check for a "now" reservation that got 15 min added to it
+ if($length % 30) {
+ $length -= 15;
+ }
+
+ // if ! $modifystart, we return at this point because we don't
+ # know enough about the current reservation to determine how
+ # long they can extend it for, the calling function would have
+ # to determine that and print a length dropdown box
+ if(! $modifystart)
+ return;
+
+ # create an array of usage times based on the user's max times
+ $maxtimes = getUserMaxTimes("initialmaxtime");
+ $lengths = array();
+ if($maxtimes["initial"] >= 30)
+ $lengths["30"] = "30 minutes";
+ if($maxtimes["initial"] >= 60)
+ $lengths["60"] = "1 hour";
+ for($i = 120; $i <= $maxtimes["initial"]; $i += 120) {
+ $lengths[$i] = $i / 60 . " hours";
+ }
+
+ if($nolength)
+ print "Reservation will be for 8 hours<br>\n";
+ else {
+ printSelectInput("length", $lengths, $length, 0, 0, 'reqlength', "onChange='updateWaitTime(0);'");
+ print "<br>\n";
+ if($openend) {
+ print " <INPUT type=radio name=ending id=openend ";
+ print "onclick='updateWaitTime(0);' value=date>Until\n";
+ print "<INPUT type=text name=enddate size=20 value=\"$enddate\">(YYYY-MM-DD HH:MM:SS)\n";
+ printSubmitErr(ENDDATEERR);
+ print "<br>\n";
+ }
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn connectRequest()
+///
+/// \brief sets IPaddress for the request; tells the user how to connect
+///
+////////////////////////////////////////////////////////////////////////////////
+function connectRequest() {
+ global $remoteIP, $user, $inContinuation;
+ if($inContinuation)
+ $requestid = getContinuationVar('requestid', 0);
+ else
+ $requestid = processInputVar("requestid", ARG_NUMERIC);
+ $skipwarning = getContinuationVar('skipwarning', 0);
+ # check for using ncsu-guest addr
+ if(! $skipwarning) {
+ $iparr = explode('.', $remoteIP);
+ if($iparr[0] == 204 && $iparr[1] == 84 &&
+ (($iparr[2] == 244) ||
+ ($iparr[2] == 245) ||
+ ($iparr[2] == 246 && $iparr[3] < 128))) {
+ print "<H2 align=center>Connect!</H2>\n";
+ print "<big><strong>WARNING:</strong> It appears as though you are ";
+ print "connected to an <strong>ncsu-guest</strong> wireless access ";
+ print "point. If this is true, you will not be able to connect to ";
+ print "your reservation because ncsu-guest only allows web traffic. ";
+ print "You need to switch to using <strong>ncsu</strong> as your ";
+ print "wireless access point. If you are sure you are not using ";
+ print "ncsu-guest and want to try to connect anyway, you may select ";
+ print "<strong>Ignore this Warning</strong> to continue to the ";
+ print "normal <strong>Connect!</strong> page.</big><br><br>\n";
+ $cdata = array('requestid' => $requestid,
+ 'skipwarning' => 1);
+ $cont = addContinuationsEntry('connectRequest', $cdata);
+ print "<table summary=\"\">\n";
+ print " <tr>\n";
+ print " <td>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=\"Ignore this Warning\">\n";
+ print " </FORM>\n";
+ print " </td>\n";
+ print " <td>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <INPUT type=hidden name=mode value=viewRequests>\n";
+ print " <INPUT type=submit value=\"Cancel\">\n";
+ print " </FORM>\n";
+ print " </td>\n";
+ print " </tr>\n";
+ print "</table>\n";
+ return;
+ }
+ }
+ $requestData = getRequestInfo($requestid);
+ if($requestData['reservations'][0]['remoteIP'] != $remoteIP) {
+ $setback = unixToDatetime(time() - 600);
+ $query = "UPDATE reservation "
+ . "SET remoteIP = '$remoteIP', "
+ . "lastcheck = '$setback' "
+ . "WHERE requestid = $requestid";
+ $qh = doQuery($query, 226);
+
+ addChangeLogEntry($requestData["logid"], $remoteIP);
+ }
+
+ print "<H2 align=center>Connect!</H2>\n";
+ if($requestData['forimaging']) {
+ print "<font color=red><big><strong>NOTICE:</strong> Later in this process, you must accept a
+ <a href=\"" . BASEURL . SCRIPT . "?mode=imageClickThrough\">click-through agreement</a> about software licensing.</big></font><br><br>\n";
+ }
+ if(count($requestData["reservations"]) == 1) {
+ $serverIP = $requestData["reservations"][0]["reservedIP"];
+ $osname = $requestData["reservations"][0]["OS"];
+ $passwd = $requestData["reservations"][0]["password"];
+ if(eregi("windows", $osname)) {
+ print "You will need to use a ";
+ print "<a href=\"http://vcl.ncsu.edu/help/connecting-vcl/how-connect-vcl\">Remote ";
+ print "Desktop program</a> to connect to the ";
+ print "system. If you did not click on the <b>Connect!</b> button from ";
+ print "the computer you will be using to access the VCL system, you ";
+ print "will need to cancel this reservation, request a new one, and ";
+ print "make sure you click the <strong>Connect!</strong> button in ";
+ print "a web browser running on the same computer from which you will ";
+ print "be connecting to the VCL system. Otherwise, you may be denied ";
+ print "access to the remote computer.<br><br>\n";
+ print "Use the following information when you are ready to connect:<br>\n";
+ print "<UL>\n";
+ print "<LI><b>Remote Computer</b>: $serverIP</LI>\n";
+ if($requestData["forimaging"])
+ print "<LI><b>User ID</b>: Administrator</LI>\n";
+ else
+ if(preg_match('/(.*)@(.*)/', $user['unityid'], $matches))
+ print "<LI><b>User ID</b>: " . $matches[1] . "</LI>\n";
+ else
+ print "<LI><b>User ID</b>: " . $user['unityid'] . "</LI>\n";
+ if(strlen($passwd)) {
+ print "<LI><b>Password</b>: $passwd<br></LI>\n";
+ print "</UL>\n";
+ print "<b>NOTE</b>: The given password is for <i>this reservation ";
+ print "only</i>. You will be given a different password for any other ";
+ print "reservations.<br>\n";
+ }
+ else {
+ print "<LI><b>Password</b>: (use your campus password)</LI>\n";
+ print "</UL>\n";
+ }
+ /*print "<br>\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<h3>NEW!</h3>\n";
+ print "Connect to the server using a java applet:<br>\n";
+ print "<INPUT type=submit value=\"Connect with Applet\">\n";
+ print "<INPUT type=hidden name=mode value=connectRDPapplet>\n";
+ print "<INPUT type=hidden name=requestid value=$requestid>\n";
+ print "</FORM><br>\n";*/
+ print "For automatic connection, you can download an RDP file that can ";
+ print "be opened by the Remote Desktop Connection program.<br><br>\n";
+ print "<table summary=\"\">\n";
+ print " <TR>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('requestid' => $requestid);
+ $expire = datetimeToUnix($requestData['end']) -
+ datetimeToUnix($requestData['start']) + 1800; # reservation time plus 30 min
+ $cont = addContinuationsEntry('sendRDPfile', $cdata, $expire);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=\"Get RDP File\">\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD><a href=\"http://vcl.ncsu.edu/help/connecting-vcl/";
+ print "remote-desktop/what-rdp-file\">What is an RDP file?</a></TD>\n";
+ print " </TR>\n";
+ print "</table>\n";
+ }
+ else {
+ print "You will need to have an ";
+ print "<a href=\"http://vcl.ncsu.edu/help/connecting-vcl/how-connect-vcl#sshx\">X server";
+ print "</a> running on your local computer and use an ";
+ print "<a href=\"http://vcl.ncsu.edu/help/connecting-vcl/how-connect-vcl#sshx\">ssh ";
+ print "client</a> to connect to the system. If you did not ";
+ print "click on the <b>Connect!</b> button from the computer you will ";
+ print "need to cancel this reservation, request a new one, and ";
+ print "make sure you click the <strong>Connect!</strong> button in ";
+ print "a web browser running on the same computer from which you will ";
+ print "be connecting to the VCL system. Otherwise, you may be denied ";
+ print "access to the remote computer.<br><br>\n";
+ print "Use the following information when you are ready to connect:<br>\n";
+ print "<UL>\n";
+ print "<LI><b>Remote Computer</b>: $serverIP</LI>\n";
+ if(preg_match('/(.*)@(.*)/', $user['unityid'], $matches))
+ print "<LI><b>User ID</b>: " . $matches[1] . "</LI>\n";
+ else
+ print "<LI><b>User ID</b>: " . $user['unityid'] . "</LI>\n";
+ if(strlen($passwd)) {
+ print "<LI><b>Password</b>: $passwd<br></LI>\n";
+ print "</UL>\n";
+ print "<b>NOTE</b>: The given password is for <i>this reservation ";
+ print "only</i>. You will be given a different password for any other ";
+ print "reservations.<br>\n";
+ }
+ else {
+ print "<LI><b>Password</b>: (use your campus password)</LI>\n";
+ print "</UL>\n";
+ }
+ print "<strong><big>NOTE:</big> You cannot use the Windows Remote ";
+ print "Desktop Connection to connect to this computer. You must use an ";
+ print "<a href=\"http://vcl.ncsu.edu/help/connecting-vcl/how-connect-vcl#sshx\">";
+ print "ssh client</a>.</strong>\n";
+ /*if(eregi("windows", $_SERVER["HTTP_USER_AGENT"])) {
+ print "<br><br><h3>NEW!</h3>\n";
+ print "Connect to the server using a java applet:<br>\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<INPUT type=submit value=\"Connect with Applet\">\n";
+ print "<INPUT type=hidden name=mode value=connectMindterm>\n";
+ print "<INPUT type=hidden name=serverip value=\"$serverIP\">\n";
+ print "</FORM>\n";
+ }*/
+ }
+ }
+ else {
+ print "You will need an ";
+ print "<a href=\"http://vcl.ncsu.edu/help/connecting-vcl/how-connect-vcl#sshx\">ssh ";
+ print "client</a> to connect to any unix systems.<br>\n";
+ print "You will need a ";
+ print "<a href=\"http://vcl.ncsu.edu/help/connecting-vcl/how-connect-vcl\">Remote ";
+ print "Desktop program</a> to connect to any windows systems.<br><br>\n";
+ print "Use the following information when you are ready to connect:<br>\n";
+ $total = count($requestData["reservations"]);
+ $count = 0;
+ foreach($requestData["reservations"] as $key => $res) {
+ $count++;
+ print "<h3>{$res["prettyimage"]}</h3>\n";
+ print "<UL>\n";
+ print "<LI><b>Platform</b>: {$res["OS"]}</LI>\n";
+ print "<LI><b>Remote Computer</b>: {$res["reservedIP"]}</LI>\n";
+ print "<LI><b>User ID</b>: " . $user['unityid'] . "</LI>\n";
+ if(eregi("windows", $res["OS"])) {
+ if(strlen($res['password'])) {
+ print "<LI><b>Password</b>: {$res['password']}<br></LI>\n";
+ print "</UL>\n";
+ print "<b>NOTE</b>: The given password is for <i>this reservation ";
+ print "only</i>. You will be given a different password for any other ";
+ print "reservations.<br>\n";
+ }
+ else {
+ print "<LI><b>Password</b>: (use your campus password)</LI>\n";
+ print "</UL>\n";
+ }
+ /*print "Connect to the server using a java applet:<br>\n";
+ print "<INPUT type=submit value=\"Connect with Applet\">\n";
+ print "<INPUT type=hidden name=mode value=connectRDPapplet>\n";
+ print "<INPUT type=hidden name=requestid value=$requestid>\n";
+ print "<INPUT type=hidden name=reservedIP value=\"{$res["reservedIP"]}\">\n";
+ print "</FORM><br><br>\n";*/
+ print "Automatic connection using an RDP file:<br>\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('requestid' => $requestid,
+ 'reservedIP' => $res['reservedIP']);
+ $expire = datetimeToUnix($requestData['end']) -
+ datetimeToUnix($requestData['start']) + 1800; # reservation time plus 30 min
+ $cont = addContinuationsEntry('sendRDPfile', $cdata, $expire);
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "<INPUT type=submit value=\"Get RDP File\">\n";
+ print "</FORM>\n";
+ }
+ else {
+ if(strlen($res['password'])) {
+ print "<LI><b>Password</b>: {$res['password']}<br></LI>\n";
+ print "</UL>\n";
+ print "<b>NOTE</b>: The given password is for <i>this reservation ";
+ print "only</i>. You will be given a different password for any other ";
+ print "reservations.<br>\n";
+ }
+ else {
+ print "<LI><b>Password</b>: (use your campus password)</LI>\n";
+ print "</UL>\n";
+ }
+ /*if(eregi("windows", $_SERVER["HTTP_USER_AGENT"])) {
+ print "Connect to the server using a java applet:<br>\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<INPUT type=submit value=\"Connect with Applet\">\n";
+ print "<INPUT type=hidden name=mode value=connectMindterm>\n";
+ print "<INPUT type=hidden name=requestid value=$requestid>\n";
+ print "<INPUT type=hidden name=serverip value=\"{$res["reservedIP"]}\">\n";
+ print "</FORM>\n";
+ }*/
+ }
+ if($count < $total)
+ print "<hr>\n";
+ }
+ }
+ foreach($requestData["reservations"] as $res) {
+ if($res["forcheckout"]) {
+ $imageid = $res["imageid"];
+ break;
+ }
+ }
+ $imagenotes = getImageNotes($imageid);
+ if(preg_match('/\w/', $imagenotes['usage'])) {
+ print "<h3>Notes on using this environment:</h3>\n";
+ print "{$imagenotes['usage']}<br><br><br>\n";
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn connectRDPapplet()
+///
+/// \brief prints a page to launch the RDP java applet
+///
+////////////////////////////////////////////////////////////////////////////////
+/*function connectRDPapplet() {
+ global $user;
+ $requestid = processInputVar("requestid", ARG_NUMERIC);
+ $requestData = getRequestInfo($requestid);
+ $server = processInputVar("reservedIP", ARG_STRING, $requestData["reservations"][0]["reservedIP"]);
+ $password = "";
+ foreach($requestData["reservations"] as $res) {
+ if($res["reservedIP"] == $server) {
+ $password = $res["password"];
+ break;
+ }
+ }
+ print "<div align=center>\n";
+ print "<H2>Connect!</H2>\n";
+ print "Launching applet. You will have to grant it any permissions it requests.<br>\n";
+ print "<APPLET CODE=\"net.propero.rdp.applet.RdpApplet.class\"\n";
+ print " ARCHIVE=\"properJavaRDP/properJavaRDP-1.1.jar,properJavaRDP/properJavaRDP14-1.1.jar,properJavaRDP/log4j-java1.1.jar,properJavaRDP/java-getopt-1.0.12.jar\" WIDTH=320 HEIGHT=240>\n";
+ print " <PARAM NAME=\"server\" VALUE=\"$server\">\n";
+ print " <PARAM NAME=\"port\" VALUE=\"3389\">\n";
+ print " <PARAM NAME=\"username\" VALUE=\"{$user["unityid"]}\">\n";
+ print " <PARAM NAME=\"password\" VALUE=\"$password\">\n";
+ print " <PARAM NAME=\"bpp\" VALUE=\"16\">\n";
+ print " <PARAM NAME=\"geometry\" VALUE=\"800x600\">\n";
+ print "</APPLET>\n";
+ print "</div>\n";
+}*/
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn connectMindterm
+///
+/// \brief prints a page with an embedded mindterm client
+///
+////////////////////////////////////////////////////////////////////////////////
+/*function connectMindterm() {
+ global $user;
+ $passwd = processInputVar("passwd", ARG_STRING);
+ $serverIP = processInputVar("serverip", ARG_STRING);
+ $requestid = processInputVar("requestid", ARG_NUMERIC);
+ $requestData = getRequestInfo($requestid);
+ $reserv = "";
+ foreach($requestData["reservations"] as $key => $res) {
+ if($res["reservedIP"] == $serverIP) {
+ $reserv = $res;
+ break;
+ }
+ }
+ print "<H2 align=center>Connect!</H2>\n";
+ print "<h3>{$reserv["prettyimage"]}</h3>\n";
+ print "<UL>\n";
+ print "<LI><b>Platform</b>: {$reserv["OS"]}</LI>\n";
+ print "<LI><b>Remote Computer</b>: {$reserv["reservedIP"]}</LI>\n";
+ print "<LI><b>User ID</b>: " . $user['unityid'] . "</LI>\n";
+ if(strlen($reserv['password']))
+ print "<LI><b>Password</b>: {$reserv['password']}<br></LI>\n";
+ else
+ print "<LI><b>Password</b>: (use your campus password)</LI>\n";
+ print "</UL>\n";
+ print "<APPLET CODE=\"com.mindbright.application.MindTerm.class\"\n";
+ print " ARCHIVE=\"mindterm-3.0/mindterm.jar\" WIDTH=0 HEIGHT=0>\n";
+ print " <PARAM NAME=\"server\" VALUE=\"$serverIP\">\n";
+ print " <PARAM NAME=\"port\" VALUE=\"22\">\n";
+ print " <PARAM NAME=\"username\" VALUE=\"{$user["unityid"]}\">\n";
+ #print " <PARAM NAME=\"password\" VALUE=\"$passwd\">\n";
+ print " <PARAM NAME=\"x11-forward\" VALUE=\"true\">\n";
+ print " <PARAM NAME=\"protocol\" VALUE=\"ssh2\">\n";
+ print " <PARAM NAME=\"sepframe\" VALUE=\"true\">\n";
+ print " <PARAM NAME=\"quiet\" VALUE=\"true\">\n";
+ print "</APPLET>\n";
+}*/
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn removeNoCheckout($images)
+///
+/// \param $images - an array of images
+///
+/// \return an array of images with the images that have forcheckout == 0
+/// removed
+///
+/// \brief removes any images in $images that have forcheckout == 0
+///
+////////////////////////////////////////////////////////////////////////////////
+function removeNoCheckout($images) {
+ $allimages = getImages();
+ foreach(array_keys($images) as $id) {
+ if(array_key_exists($id, $allimages) && ! $allimages[$id]["forcheckout"])
+ unset($images[$id]);
+ }
+ return $images;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn processRequestInput($checks)
+///
+/// \param $checks - (optional) 1 to perform validation, 0 not to
+///
+/// \return an array with the following indexes (some may be empty):\n
+/// requestid, day, hour, minute, meridian, length, started, os, imageid,
+/// prettyimage, time, testjavascript, lengthchanged
+///
+/// \brief validates input from the previous form; if anything was improperly
+/// submitted, sets submitErr and submitErrMsg
+///
+////////////////////////////////////////////////////////////////////////////////
+function processRequestInput($checks=1) {
+ global $submitErr, $submitErrMsg, $mode;
+ $return = array();
+ $return["requestid"] = processInputVar("requestid", ARG_NUMERIC);
+ $return["day"] = preg_replace('[\s]', '', processInputVar("day", ARG_STRING));
+ $return["hour"] = processInputVar("hour", ARG_NUMERIC);
+ $return["minute"] = processInputVar("minute", ARG_STRING);
+ $return["meridian"] = processInputVar("meridian", ARG_STRING);
+ $return["endday"] = preg_replace('[\s]', '', processInputVar("endday", ARG_STRING));
+ $return["endhour"] = processInputVar("endhour", ARG_NUMERIC);
+ $return["endminute"] = processInputVar("endminute", ARG_STRING);
+ $return["endmeridian"] = processInputVar("endmeridian", ARG_STRING);
+ $return["length"] = processInputVar("length", ARG_NUMERIC);
+ $return["started"] = getContinuationVar('started', processInputVar("started", ARG_NUMERIC));
+ $return["os"] = processInputVar("os", ARG_STRING);
+ $return["imageid"] = getContinuationVar('imageid', processInputVar("imageid", ARG_NUMERIC));
+ $return["prettyimage"] = processInputVar("prettyimage", ARG_STRING);
+ $return["time"] = processInputVar("time", ARG_STRING);
+ $return["revisionid"] = processInputVar("revisionid", ARG_MULTINUMERIC);
+ $return["ending"] = processInputVar("ending", ARG_STRING, "length");
+ $return["enddate"] = processInputVar("enddate", ARG_STRING);
+ $return["extend"] = processInputVar("extend", ARG_NUMERIC);
+ $return["testjavascript"] = processInputVar("testjavascript", ARG_NUMERIC, 0);
+ $return['lengthchanged'] = 0;
+
+ if($return["minute"] == 0) {
+ $return["minute"] = "00";
+ }
+ if($return["endminute"] == 0) {
+ $return["endminute"] = "00";
+ }
+
+ if(! $checks) {
+ return $return;
+ }
+
+ if(! $return["started"]) {
+ $checkdateArr = explode('/', $return["day"]);
+ if(! is_numeric($checkdateArr[0]) ||
+ ! is_numeric($checkdateArr[1]) ||
+ ! is_numeric($checkdateArr[2]) ||
+ ! checkdate($checkdateArr[0], $checkdateArr[1], $checkdateArr[2])) {
+ $submitErr |= STARTDAYERR;
+ $submitErrMsg[STARTDAYERR] = "The submitted start date is invalid. ";
+ }
+ if(! ereg('^((0?[1-9])|(1[0-2]))$', $return["hour"], $regs)) {
+ $submitErr |= STARTHOURERR;
+ $submitErrMsg[STARTHOURERR] = "The submitted hour must be from 1 to 12.";
+ }
+ }
+
+ # TODO check for valid revisionids for each image
+ if(! empty($return["revisionid"])) {
+ foreach($return['revisionid'] as $key => $val) {
+ if(! is_numeric($val) || $val < 0)
+ unset($return['revisionid']);
+ }
+ }
+
+ /*if($mode == "confirmAdminEditRequest") {
+ $checkdateArr = explode('/', $return["endday"]);
+ if(! is_numeric($checkdateArr[0]) ||
+ ! is_numeric($checkdateArr[1]) ||
+ ! is_numeric($checkdateArr[2]) ||
+ ! checkdate($checkdateArr[0], $checkdateArr[1], $checkdateArr[2])) {
+ $submitErr |= ENDDAYERR;
+ $submitErrMsg[ENDDAYERR] = "The submitted end date is invalid. ";
+ }
+ if(! ereg('^((0?[1-9])|(1[0-2]))$', $return["endhour"])) {
+ $submitErr |= ENDHOURERR;
+ $submitErrMsg[ENDHOURERR] = "The submitted hour must be from 1 to 12.";
+ }
+ }*/
+
+ // make sure user hasn't submitted something longer than their allowed max length
+ $imageData = getImages(0, $return['imageid']);
+ $maxtimes = getUserMaxTimes();
+ if($maxtimes['initial'] < $return['length']) {
+ $return['lengthchanged'] = 1;
+ $return['length'] = $maxtimes['initial'];
+ }
+ if($imageData[$return['imageid']]['maxinitialtime'] > 0 &&
+ $imageData[$return['imageid']]['maxinitialtime'] < $return['length']) {
+ $return['lengthchanged'] = 1;
+ $return['length'] = $imageData[$return['imageid']]['maxinitialtime'];
+ }
+
+ if($return["ending"] != "length") {
+ if(! ereg('^(20[0-9]{2})-([0-1][0-9])-([0-3][0-9]) (([0-1][0-9])|(2[0-3])):([0-5][0-9]):([0-5][0-9])$', $return["enddate"], $regs)) {
+ $submitErr |= ENDDATEERR;
+ $submitErrMsg[ENDDATEERR] = "The submitted date/time is invalid.";
+ }
+ elseif(! checkdate($regs[2], $regs[3], $regs[1])) {
+ $submitErr |= ENDDATEERR;
+ $submitErrMsg[ENDDATEERR] = "The submitted date/time is invalid.";
+ }
+ }
+
+ if($return["testjavascript"] != 0 && $return['testjavascript'] != 1)
+ $return["testjavascript"] = 0;
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn processBlockRequestInput($checks)
+///
+/// \param $checks - 1 to validate input, 0 to skip validation
+///
+/// \return an array with these keys:\n
+/// \b blockname - name of block request\n
+/// \b imageid - selected image id\n
+/// \b machinecnt - number of machines to allocate\n
+/// \b swhour - array of start hours for weekly available selection\n
+/// \b swminute - array of start minutes for weekly available selection\n
+/// \b swmeridian - array of start meridians for weekly available selection\n
+/// \b ewhour - array of end hours for weekly available selection\n
+/// \b ewminute - array of end minutes for weekly available selection\n
+/// \b ewmeridian - array of end meridians for weekly available selection\n
+/// \b smhour - array of start hours for monthly available selection\n
+/// \b smminute - array of start minutes for monthly available selection\n
+/// \b smmeridian - array of start meridians for monthly available selection\n
+/// \b emhour - array of end hours for weekly monthly selection\n
+/// \b emminute - array of end minutes for weekly monthly selection\n
+/// \b emmeridian - array of end meridians for weekly monthly selection\n
+/// \b slhour - array of start hours for list available selection\n
+/// \b slminute - array of start minutes for list available selection\n
+/// \b slmeridian - array of start meridians for list available selection\n
+/// \b elhour - array of end hours for list available selection\n
+/// \b elminute - array of end minutes for list available selection\n
+/// \b elmeridian - array of end meridians for list available selection\n
+/// \b weeknum - week of the month for monthly available selection\n
+/// \b day - day of the week (1-7) for monthly available selection\n
+/// \b date - array of start dates for list available selection\n
+/// \b available - 'weekly', 'monthly', or 'list'\n
+/// \b usergroupid - user group id\n
+/// \b admingroupid - user group id for group that can edit this request\n
+/// \b swdate - start date for weekly available selection\n
+/// \b ewdate - end date for weekly available selection\n
+/// \b smdate - start date for monthly available selection\n
+/// \b emdate - end date for monthly available selection\n
+/// \b wdays - array of selected days of the week for weekly available selection\n
+/// \b state - 0 if submitted as a new request, 1 for edit, 2 for delete\n
+/// \b blockRequestid - id of the request if editing\n
+/// \b wdayschecked - array to help determine which days of the week should be
+/// checked for weekly available selection if printing the
+/// page with error messages
+///
+/// \brief processes input for blockrequests
+///
+////////////////////////////////////////////////////////////////////////////////
+function processBlockRequestInput($checks=1) {
+ global $submitErr, $submitErrMsg, $mode, $user, $days;
+ $return = array();
+ $return['blockname'] = getContinuationVar("blockname", processInputVar("blockname", ARG_STRING));
+ $return['imageid'] = getContinuationVar("imageid", processInputVar("imageid", ARG_NUMERIC));
+ $return['machinecnt'] = getContinuationVar("machinecnt", processInputVar("machinecnt", ARG_NUMERIC, 0));
+ $return['swhour'] = getContinuationVar("swhour", processInputVar("swhour", ARG_MULTINUMERIC));
+ $return['swminute'] = getContinuationVar("swminute", processInputVar("swminute", ARG_MULTINUMERIC));
+ $return['swmeridian'] = getContinuationVar("swmeridian", processInputVar("swmeridian", ARG_MULTISTRING));
+ $return['ewhour'] = getContinuationVar("ewhour", processInputVar("ewhour", ARG_MULTINUMERIC));
+ $return['ewminute'] = getContinuationVar("ewminute", processInputVar("ewminute", ARG_MULTINUMERIC));
+ $return['ewmeridian'] = getContinuationVar("ewmeridian", processInputVar("ewmeridian", ARG_MULTISTRING));
+ $return['smhour'] = getContinuationVar("smhour", processInputVar("smhour", ARG_MULTINUMERIC));
+ $return['smminute'] = getContinuationVar("smminute", processInputVar("smminute", ARG_MULTINUMERIC));
+ $return['smmeridian'] = getContinuationVar("smmeridian", processInputVar("smmeridian", ARG_MULTISTRING));
+ $return['emhour'] = getContinuationVar("emhour", processInputVar("emhour", ARG_MULTINUMERIC));
+ $return['emminute'] = getContinuationVar("emminute", processInputVar("emminute", ARG_MULTINUMERIC));
+ $return['emmeridian'] = getContinuationVar("emmeridian", processInputVar("emmeridian", ARG_MULTISTRING));
+ $return['slhour'] = getContinuationVar("slhour", processInputVar("slhour", ARG_MULTINUMERIC));
+ $return['slminute'] = getContinuationVar("slminute", processInputVar("slminute", ARG_MULTINUMERIC));
+ $return['slmeridian'] = getContinuationVar("slmeridian", processInputVar("slmeridian", ARG_MULTISTRING));
+ $return['elhour'] = getContinuationVar("elhour", processInputVar("elhour", ARG_MULTINUMERIC));
+ $return['elminute'] = getContinuationVar("elminute", processInputVar("elminute", ARG_MULTINUMERIC));
+ $return['elmeridian'] = getContinuationVar("elmeridian", processInputVar("elmeridian", ARG_MULTISTRING));
+ $return['weeknum'] = getContinuationVar("weeknum", processInputVar("weeknum", ARG_NUMERIC));
+ $return['day'] = getContinuationVar("day", processInputVar("day", ARG_NUMERIC));
+ $return['date'] = getContinuationVar("date", processInputVar("date", ARG_MULTISTRING));
+ $return['available'] = getContinuationVar("available", processInputVar("available", ARG_STRING, 'weekly'));
+ $return['usergroupid'] = getContinuationVar("usergroupid", processInputVar("usergroupid", ARG_NUMERIC));
+ $return['admingroupid'] = getContinuationVar("admingroupid", processInputVar("admingroupid", ARG_NUMERIC));
+ $return['swdate'] = getContinuationVar("swdate", processInputVar("swdate", ARG_STRING));
+ $return['ewdate'] = getContinuationVar("ewdate", processInputVar("ewdate", ARG_STRING));
+ $return['smdate'] = getContinuationVar("smdate", processInputVar("smdate", ARG_STRING));
+ $return['emdate'] = getContinuationVar("emdate", processInputVar("emdate", ARG_STRING));
+ $return['wdays'] = getContinuationVar("wdays", processInputVar("wdays", ARG_MULTISTRING));
+ $return['state'] = getContinuationVar("state", 0);
+ $return['blockRequestid'] = getContinuationVar("blockRequestid", processInputVar("blockRequestid", ARG_NUMERIC));
+
+ $return['wdayschecked'] = array();
+ foreach($days as $day) {
+ if(in_array($day, $return['wdays']))
+ $return['wdayschecked'][$day] = 'checked';
+ else
+ $return['wdayschecked'][$day] = '';
+ }
+ if(! $checks)
+ return $return;
+
+ if(! preg_match('/^([-a-zA-Z0-9\. ]){3,80}$/', $return["blockname"])) {
+ $submitErr |= BLOCKNAMEERR;
+ $submitErrMsg[BLOCKNAMEERR] = "Name can only contain letters, numbers, spaces, dashes(-),<br>and periods(.) and can be from 3 to 80 characters long";
+ }
+
+ $resources = getUserResources(array("imageAdmin", "imageCheckOut"));
+ $resources["image"] = removeNoCheckout($resources["image"]);
+ if(! in_array($return['imageid'], array_keys($resources['image']))) {
+ $submitErr |= IMAGEIDERR;
+ $submitErrMsg[IMAGEIDERR] = "The submitted image is invalid.";
+ }
+
+ if($return['machinecnt'] < MIN_BLOCK_MACHINES) {
+ $submitErr |= BLOCKCNTERR;
+ $submitErrMsg[BLOCKCNTERR] = "You must request at least " . MIN_BLOCK_MACHINES . " machines";
+ }
+ elseif($return['machinecnt'] > MAX_BLOCK_MACHINES) {
+ $submitErr |= BLOCKCNTERR;
+ $submitErrMsg[BLOCKCNTERR] = "You cannot request more than " . MAX_BLOCK_MACHINES . " machines";
+ }
+
+ // FIXME should we limit the course groups that show up?
+ $groups = getUserGroups();
+ if(! array_key_exists($return['usergroupid'], $groups)) {
+ $submitErr |= USERGROUPIDERR;
+ $submitErrMsg[USERGROUPIDERR] = "The submitted user group is invalid.";
+ }
+
+ if(! array_key_exists($return['admingroupid'], $groups) &&
+ $return['admingroupid'] != 0) {
+ $submitErr |= ADMINGROUPIDERR;
+ $submitErrMsg[ADMINGROUPIDERR] = "The submitted user group is invalid.";
+ }
+
+ if($return['available'] == 'weekly') {
+ $keys = array('1' => 'swhour',
+ '2' => 'ewhour',
+ '3' => 'swminute',
+ '4' => 'ewminute',
+ '5' => 'swmeridian',
+ '6' => 'ewmeridian',
+ '7' => 'swdate',
+ '8' => 'ewdate');
+
+ // check days of week
+ foreach($return['wdays'] as $index => $day) {
+ if(! in_array($day, $days))
+ unset($return['wdays'][$index]);
+ }
+ /*foreach($days as $day) {
+ if(in_array($day, $return['wdays']))
+ $return['wdayschecked'][$day] = 'checked';
+ }*/
+ if(! count($return['wdays'])) {
+ $submitErr |= STARTDAYERR;
+ $submitErrMsg[STARTDAYERR] = "You must select at least one day of the week";
+ }
+ }
+ elseif($return['available'] == 'monthly') {
+ $keys = array('1' => 'smhour',
+ '2' => 'emhour',
+ '3' => 'smminute',
+ '4' => 'emminute',
+ '5' => 'smmeridian',
+ '6' => 'emmeridian',
+ '7' => 'smdate',
+ '8' => 'emdate');
+
+ // check weeknum
+ if($return['weeknum'] < 1 || $return['weeknum'] > 5) {
+ $submitErr |= WEEKNUMERR;
+ $submitErrMsg[WEEKNUMERR] = "Invalid week of the month submitted";
+ }
+
+ // check day
+ if($return['day'] < 1 || $return['day'] > 7) {
+ $submitErr |= DAYERR;
+ $submitErrMsg[DAYERR] = "Invalid day of the week submitted";
+ }
+
+ }
+ elseif($return['available'] == 'list') {
+ $keys = array('1' => 'slhour',
+ '2' => 'elhour',
+ '3' => 'slminute',
+ '4' => 'elminute',
+ '5' => 'slmeridian',
+ '6' => 'elmeridian');
+ }
+
+ // check each timeslot
+ for($i = 0; $i < 4; $i++) {
+ $submitErrMsg[STARTHOURERR][$i] = "";
+ $submitErrMsg[ENDHOURERR][$i] = "";
+ // start hour
+ if($return[$keys[1]][$i] < 1 || $return[$keys[1]][$i] > 12) {
+ $submitErr |= STARTHOURERR;
+ $submitErrMsg[STARTHOURERR][$i] = "The start hour must be between 1 and 12.";
+ }
+ // end hour
+ if($return[$keys[2]][$i] < 1 || $return[$keys[2]][$i] > 12) {
+ $submitErr |= ENDHOURERR;
+ $submitErrMsg[ENDHOURERR][$i] = " The end hour must be between 1 and 12.";
+ }
+ // start minute
+ if($return[$keys[3]][$i] < 0 || $return[$keys[3]][$i] > 59) {
+ $submitErr |= STARTHOURERR; // we reuse STARTHOURERR here, it overwrites the last one, but oh well
+ $submitErrMsg[STARTHOURERR][$i] = "The start minute must be between 0 and 59.";
+ }
+ // end minute
+ if($return[$keys[4]][$i] < 0 || $return[$keys[4]][$i] > 59) {
+ $submitErr |= ENDHOURERR;
+ $submitErrMsg[ENDHOURERR][$i] = " The end minute must be between 0 and 59.";
+ }
+ // start meridian
+ if($return[$keys[5]][$i] != 'am' && $return[$keys[5]][$i] != 'pm') {
+ $return[$keys[5]][$i] = 'pm'; // just set it to one of them
+ }
+ // end meridian
+ if($return[$keys[6]][$i] != 'am' && $return[$keys[6]][$i] != 'pm') {
+ $return[$keys[6]][$i] = 'am'; // just set it to one of them
+ }
+ // check that start is before end
+ $return['stime'][$i] = minuteOfDay2("{$return[$keys[1]][$i]}:{$return[$keys[3]][$i]} {$return[$keys[5]][$i]}");
+ $return['etime'][$i] = minuteOfDay2("{$return[$keys[2]][$i]}:{$return[$keys[4]][$i]} {$return[$keys[6]][$i]}");
+ if($return['stime'][$i] > $return['etime'][$i]) {
+ $submitErr |= STARTHOURERR; // we reuse STARTHOURERR here, it overwrites the last one, but oh well
+ $submitErrMsg[STARTHOURERR][$i] = "The start time must be before the end time (or be equal to ignore this slot)";
+ }
+ }
+ if($return['available'] == 'weekly' ||
+ $return['available'] == 'monthly') {
+ // check that timeslots do not overlap
+ if(! ($submitErr & STARTHOURERR) && ! ($submitErr & ENDHOURERR)) {
+ for($i = 0; $i < 4; $i++) {
+ for($j = $i + 1; $j < 4; $j++) {
+ if($return['etime'][$i] > $return['stime'][$j] &&
+ $return['stime'][$i] < $return['etime'][$j]) {
+ $submitErr |= STARTHOURERR;
+ $submitErrMsg[STARTHOURERR][$i] = "This timeslot overlaps with Slot" . ($j + 1);
+ }
+ }
+ }
+ }
+ // check that start date is valid
+ $startarr = split('/', $return[$keys[7]]);
+ if(! preg_match('/^((\d){1,2})\/((\d){1,2})\/(\d){2}$/', $return[$keys[7]])) {
+ $submitErr |= STARTDATEERR;
+ $submitErrMsg[STARTDATEERR] = "The start date must be in the form mm/dd/yy.";
+ }
+ elseif(! checkdate($startarr[0], $startarr[1], $startarr[2])) {
+ $submitErr |= STARTDATEERR;
+ $submitErrMsg[STARTDATEERR] = "This is an invalid date.";
+ }
+ elseif(datetimeToUnix("{$startarr[2]}-{$startarr[0]}-{$startarr[1]} 23:59:59") < time()) {
+ $submitErr |= STARTDATEERR;
+ $submitErrMsg[STARTDATEERR] = "The start date must be today or later.";
+ }
+ // check that end date is valid
+ $endarr = split('/', $return[$keys[8]]);
+ if(! preg_match('/^((\d){1,2})\/((\d){1,2})\/(\d){2}$/', $return[$keys[8]])) {
+ $submitErr |= ENDDATEERR;
+ $submitErrMsg[ENDDATEERR] = "The end date must be in the form mm/dd/yy.";
+ }
+ elseif(! checkdate($endarr[0], $endarr[1], $endarr[2])) {
+ $submitErr |= ENDDATEERR;
+ $submitErrMsg[ENDDATEERR] = "This is an invalid date.";
+ }
+ elseif(datetimeToUnix("{$startarr[2]}-{$startarr[0]}-{$startarr[1]} 00:00:00") >
+ datetimeToUnix("{$endarr[2]}-{$endarr[0]}-{$endarr[1]} 00:00:00")) {
+ $submitErr |= ENDDATEERR;
+ $submitErrMsg[ENDDATEERR] = "The end date must be later than the start date.";
+ }
+ }
+ elseif($return['available'] == 'list') {
+ if(! ($submitErr & STARTHOURERR) && ! ($submitErr & ENDHOURERR)) {
+ // check date[1-n]
+ for($i = 0; $i < 4; $i++) {
+ $submitErrMsg[STARTDATEERR][$i] = "";
+ if($return['stime'][$i] == $return['etime'][$i])
+ continue;
+ $submitErrMsg[STARTDATEERR][$i] = "";
+ $datearr = split('/', $return['date'][$i]);
+ if(! preg_match('/^((\d){1,2})\/((\d){1,2})\/(\d){2}$/', $return['date'][$i])) {
+ $submitErr |= STARTDATEERR;
+ $submitErrMsg[STARTDATEERR][$i] = "The date must be in the form mm/dd/yy.";
+ }
+ elseif(! checkdate($datearr[0], $datearr[1], $datearr[2])) {
+ $submitErr |= STARTDATEERR;
+ $submitErrMsg[STARTDATEERR][$i] = "Invalid date submitted.";
+ }
+ elseif(datetimeToUnix("{$datearr[2]}-{$datearr[0]}-{$datearr[1]} 23:59:59") < time()) {
+ $submitErr |= STARTDATEERR;
+ $submitErrMsg[STARTDATEERR][$i] = "The date must be today or later.";
+ }
+ }
+ }
+ }
+ if(0) {
+ # FIXME
+ $submitErr |= AVAILABLEERR;
+ $submitErrMsg[AVAILABLEERR] = "The submitted availability selection is invalid.";
+ }
+ return $return;
+}
+?>
diff --git a/web/.ht-inc/schedules.php b/web/.ht-inc/schedules.php
new file mode 100644
index 0000000..12532b2
--- /dev/null
+++ b/web/.ht-inc/schedules.php
@@ -0,0 +1,1039 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+/**
+ * \file
+ */
+
+/// signifies an error with the submitted name
+define("SCHNAMEERR", 1);
+/// signifies an error with the submitted owner
+define("SCHOWNERERR", 1 << 1);
+/// signifies an error where 2 submitted time periods overlap
+define("OVERLAPERR", 1 << 2);
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn viewSchedules()
+///
+/// \brief prints a page to view schedule information
+///
+////////////////////////////////////////////////////////////////////////////////
+function viewSchedules() {
+ global $user, $mode;
+ $schedules = getSchedules();
+ $tmp = getUserResources(array("groupAdmin"), array("administer"), 1);
+ $schedulegroups = $tmp["schedule"];
+ $schedulemembership = getResourceGroupMemberships("schedule");
+ $resources = getUserResources(array("scheduleAdmin"), array("administer"));
+ $userScheduleIDs = array_keys($resources["schedule"]);
+
+ print "<H2>Schedules</H2>\n";
+ if($mode == "submitEditSchedule") {
+ print "<font color=\"#008000\">Schedule successfully updated";
+ print "</font><br><br>\n";
+ }
+ if($mode == "submitDeleteSchedule") {
+ print "<font color=\"#008000\">Schedule successfully deleted";
+ print "</font><br><br>\n";
+ }
+ print "<TABLE border=1>\n";
+ print " <TR>\n";
+ print " <TD></TD>\n";
+ print " <TD></TD>\n";
+ print " <TH>Name</TH>\n";
+ print " <TH>Owner</TH>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <TD></TD>\n";
+ print " <TD><INPUT type=submit value=Add></TD>\n";
+ print " <TD><INPUT type=text name=name maxlength=25 size=10></TD>\n";
+ print " <TD><INPUT type=text name=owner size=15 value=\"";
+ print "{$user["unityid"]}@{$user['affiliation']}\"></TD>\n";
+ $cont = addContinuationsEntry('confirmAddSchedule');
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " </FORM>\n";
+ print " </TR>\n";
+
+ foreach(array_keys($schedules) as $id) {
+ if(! in_array($id, $userScheduleIDs))
+ continue;
+ print " <TR>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('scheduleid' => $id);
+ $cont = addContinuationsEntry('confirmDeleteSchedule', $cdata);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <TD>\n";
+ print " <INPUT type=submit value=Delete>\n";
+ print " </TD>\n";
+ print " </FORM>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('scheduleid' => $id);
+ $cont = addContinuationsEntry('editSchedule', $cdata);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <TD>\n";
+ print " <INPUT type=submit value=Edit>\n";
+ print " </TD>\n";
+ print " </FORM>\n";
+ print " <TD>" . $schedules[$id]["name"] . "</TD>\n";
+ print " <TD>" . $schedules[$id]["owner"] . "</TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+
+ $resources = getUserResources(array("scheduleAdmin"),
+ array("manageGroup"));
+ $tmp = getUserResources(array("scheduleAdmin"),
+ array("manageGroup"), 1);
+ $schedulegroups = $tmp["schedule"];
+ uasort($resources["schedule"], "sortKeepIndex");
+ uasort($schedulegroups, "sortKeepIndex");
+ if(count($resources["schedule"])) {
+ print "<br><br>\n";
+ print "<A name=\"grouping\"></a>\n";
+ print "<H2>Schedule Grouping</H2>\n";
+ if($mode == "submitScheduleGroups") {
+ print "<font color=\"#008000\">Schedule groups successfully updated";
+ print "</font><br><br>\n";
+ }
+ print "<FORM action=\"" . BASEURL . SCRIPT . "#grouping\" method=post>\n";
+ print "<TABLE border=1>\n";
+ print " <TR>\n";
+ print " <TH rowspan=2>Schedules</TH>\n";
+ print " <TH colspan=" . count($schedulegroups) . ">Groups</TH>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ foreach($schedulegroups as $group) {
+ print " <TH>$group</TH>\n";
+ }
+ print " </TR>\n";
+ $count = 1;
+ foreach($resources["schedule"] as $scheduleid => $schedule) {
+ if($count % 18 == 0) {
+ print " <TR>\n";
+ print " <TH><img src=images/blank.gif></TH>\n";
+ foreach($schedulegroups as $group) {
+ print " <TH>$group</TH>\n";
+ }
+ print " </TR>\n";
+ }
+ print " <TR>\n";
+ print " <TH align=right>$schedule</TH>\n";
+ foreach(array_keys($schedulegroups) as $groupid) {
+ $name = "schedulegroup[" . $scheduleid . ":" . $groupid . "]";
+ if(array_key_exists($scheduleid, $schedulemembership["schedule"]) &&
+ in_array($groupid, $schedulemembership["schedule"][$scheduleid])) {
+ $checked = "checked";
+ }
+ else {
+ $checked = "";
+ }
+ print " <TD align=center>\n";
+ print " <INPUT type=checkbox name=\"$name\" $checked>\n";
+ print " </TD>\n";
+ }
+ print " </TR>\n";
+ $count++;
+ }
+ print "</TABLE>\n";
+ $cont = addContinuationsEntry('submitScheduleGroups', array(), SECINDAY, 1, 0);
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "<INPUT type=submit value=\"Submit Changes\">\n";
+ print "<INPUT type=reset value=Reset>\n";
+ print "</FORM>\n";
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn editOrAddSchedule($state)
+///
+/// \param $state - 0 for edit, 1 for add
+///
+/// \brief prints a form for editing a schedule
+///
+////////////////////////////////////////////////////////////////////////////////
+function editOrAddSchedule($state) {
+ global $submitErr, $mode, $submitErrMsg;
+
+ $schedules = getSchedules();
+ $days = array("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday",
+ "Friday", "Saturday");
+
+ $newcont = 0;
+ if($submitErr || $mode == "submitScheduleTime" || $mode == "submitAddSchedule") {
+ $data = processScheduleInput(0);
+ $newcont = 1; # continuation to get here was deleted; so, we'll need to set
+ # deletefromself true this time
+ }
+ else {
+ $data["scheduleid"] = getContinuationVar("scheduleid");
+ $id = $data["scheduleid"];
+ $data["name"] = $schedules[$id]["name"];
+ $data["owner"] = $schedules[$id]["owner"];
+ $data["submode"] = processInputVar("submode", ARG_STRING);
+ }
+ $schedules = getSchedules();
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<DIV align=center>\n";
+ if($state) {
+ print "<H2>Add Schedule</H2>\n";
+ }
+ else {
+ print "<H2>Edit Schedule</H2>\n";
+ }
+ if($mode == "submitAddSchedule") {
+ print "<font color=\"#008000\">Schedule successfully added";
+ print "</font><br><br>\n";
+ print "Now you must add start and end times for the schedule<br>\n";
+ }
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TH align=right>Name:</TH>\n";
+ print " <TD><INPUT type=text name=name value=\"" . $data["name"] . "\" ";
+ print "maxlength=25></TD>\n";
+ print " <TD>";
+ if($mode == "confirmAddSchedule" || $mode == "confirmEditSchedule")
+ printSubmitErr(SCHNAMEERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Owner:</TH>\n";
+ print " <TD><INPUT type=text name=owner value=\"";
+ print $data["owner"] . "\"></TD>\n";
+ print " <TD>";
+ if($mode == "confirmAddSchedule" || $mode == "confirmEditSchedule")
+ printSubmitErr(SCHOWNERERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ print "<TABLE>\n";
+ print " <TR valign=top>\n";
+ print " <TD>\n";
+ if($state) {
+ $cont = addContinuationsEntry('confirmAddSchedule', array(), SECINDAY, 0, 1, 1);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=\"Confirm Schedule\">\n";
+ }
+ else {
+ $cdata = array('scheduleid' => $data['scheduleid']);
+ if($newcont)
+ $cont = addContinuationsEntry('confirmEditSchedule', $cdata);
+ else
+ $cont = addContinuationsEntry('confirmEditSchedule', $cdata, SECINDAY, 0, 1, 1);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=\"Confirm Changes\">\n";
+ }
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <INPUT type=hidden name=mode value=viewSchedules>\n";
+ print " <INPUT type=submit value=Cancel>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ if($state)
+ return;
+ print "The start and end day/times are based on a week's time period with ";
+ print "the start/end point being 'Sunday 12:00 am'. i.e. The earliest ";
+ print "start day/time is 'Sunday 12:00 am' and the latest end day/";
+ print "time is 'Sunday 12:00 am'<br><br>\n";
+ if(! $submitErr && $mode == "submitScheduleTime" && $data["submode"] == "Save changes") {
+ print "<font color=green>Changes saved</font><br>\n";
+ }
+ printSubmitErr(OVERLAPERR);
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TD></TD>\n";
+ print " <TH>Start</TH>\n";
+ print " <TD></TD>\n";
+ print " <TH>End</TH>\n";
+ print " <TD></TD>\n";
+ print " </TR>\n";
+ $addrow = 0;
+ if($mode == "submitScheduleTime") {
+ $addrow = 1;
+ }
+ print "<TR><TD colspan=5>";
+ print "</TD></TR>\n";
+ $doaddrow = 0;
+ if($mode == "submitScheduleTime") {
+ if($data["selrow"] == "")
+ $end = $data["count"];
+ elseif($data["submode"] == "Insert before selected row") {
+ $doaddrow = 1;
+ $addrow = $data["selrow"];
+ $end = $data["count"] + 1;
+ }
+ elseif($data["submode"] == "Insert after selected row") {
+ $doaddrow = 1;
+ $addrow = $data["selrow"] + 1;
+ $end = $data["count"] + 1;
+ }
+ else
+ $end = $data["count"];
+ }
+ else
+ $end = count($schedules[$data["scheduleid"]]["times"]);
+ if($end == 0) {
+ $doaddrow = 1;
+ $addrow = 0;
+ $end = 1;
+ }
+ reset($schedules[$data["scheduleid"]]["times"]);
+ $index = 0;
+ for($count = 0; $count < $end; $count++) {
+ // if mode == submitScheduleTime, print submitted times
+ if($mode == "submitScheduleTime") {
+ if($doaddrow && $count == $addrow) {
+ $startday = "";
+ $starttime = "";
+ $endday = "";
+ $endtime = "";
+ $doaddrow = 0;
+ $index--;
+ }
+ else {
+ $startday = $data["startDay"][$index];
+ $starttime = $data["startTime"][$index];
+ $endday = $data["endDay"][$index];
+ $endtime = $data["endTime"][$index];
+ }
+ print " <TR>\n";
+ print " <TD align=right><INPUT type=radio name=selrow value=$count></TD>\n";
+ printStartEndTimeForm2($startday, $starttime, $count, "start");
+ print " <TD> </TD>\n";
+ printStartEndTimeForm2($endday, $endtime, $count, "end");
+ }
+ // otherwise, print times from database
+ else {
+ $time = current($schedules[$data["scheduleid"]]["times"]);
+ print " <TR>\n";
+ print " <TD align=right><INPUT type=radio name=selrow value=$count></TD>\n";
+ printStartEndTimeForm($time["start"], $count, "start");
+ print " <TD> </TD>\n";
+ printStartEndTimeForm($time["end"], $count, "end");
+ next($schedules[$data["scheduleid"]]["times"]);
+ }
+ print " <TD width=70>";
+ if($data["submode"] == "Save changes")
+ printSubmitErr(1 << $count);
+ print "</TD>";
+ print " </TR>\n";
+ $index++;
+ }
+ $colspan = 5;
+ print " <TR>\n";
+ print " <TD align=center colspan=$colspan><INPUT type=submit name=submode value=\"Delete selected row\"></TD>\n";
+ print " <TR>\n";
+ print " </TR>\n";
+ print " <TD align=center colspan=$colspan><INPUT type=submit name=submode value=\"Insert before selected row\"></TD>\n";
+ print " <TR>\n";
+ print " </TR>\n";
+ print " <TD align=center colspan=$colspan><INPUT type=submit name=submode value=\"Insert after selected row\"></TD>\n";
+ print " <TR>\n";
+ print " </TR>\n";
+ print " <TD align=center colspan=$colspan><INPUT type=submit name=submode value=\"Save changes\"></TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ $cdata = array('scheduleid' => $data['scheduleid'],
+ 'count' => $count,
+ 'name' => $data['name'],
+ 'owner' => $data['owner']);
+ if($newcont)
+ $cont = addContinuationsEntry('submitScheduleTime', $cdata, SECINDAY, 1, 0);
+ else
+ $cont = addContinuationsEntry('submitScheduleTime', $cdata, SECINDAY, 0, 0);
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "</FORM>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn confirmEditOrAddSchedule($state)
+///
+/// \param $state - 0 for edit, 1 for add
+///
+/// \brief prints a form for confirming changes to a schedule
+///
+////////////////////////////////////////////////////////////////////////////////
+function confirmEditOrAddSchedule($state) {
+ global $submitErr;
+
+ $data = processScheduleInput();
+
+ if($submitErr) {
+ editOrAddSchedule($state);
+ return;
+ }
+
+ if($state) {
+ $nextmode = "submitAddSchedule";
+ $title = "Add Schedule";
+ $question = "Add the following schedule?";
+ }
+ else {
+ $nextmode = "submitEditSchedule";
+ $title = "Edit Schedule";
+ $question = "Submit changes to the schedule?";
+ }
+
+ $days = array("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday",
+ "Friday", "Saturday");
+
+ print "<DIV align=center>\n";
+ print "<H2>$title</H2>\n";
+ print "$question<br><br>\n";
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TH align=right>Name:</TH>\n";
+ print " <TD>" . $data["name"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Owner:</TH>\n";
+ print " <TD>" . $data["owner"] . "</TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ print "<TABLE>\n";
+ print " <TR valign=top>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('name' => $data['name'],
+ 'owner' => $data['owner']);
+ if(! empty($data['scheduleid']))
+ $cdata['scheduleid'] = $data['scheduleid'];
+ $cont = addContinuationsEntry($nextmode, $cdata, SECINDAY, 0, 0, 1);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Submit>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <INPUT type=hidden name=mode value=viewSchedules>\n";
+ print " <INPUT type=submit value=Cancel>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitEditSchedule()
+///
+/// \brief submits changes to schedule and notifies user
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitEditSchedule() {
+ $data = processScheduleInput(0);
+ updateSchedule($data);
+ viewSchedules();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitAddSchedule()
+///
+/// \brief adds the schedule and notifies user
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitAddSchedule() {
+ $data = processScheduleInput(0);
+ if($id = addSchedule($data)) {
+ $_POST["scheduleid"] = $id;
+ $_SESSION['userresources'] = array();
+ editOrAddSchedule(0);
+ }
+ else {
+ abort(10);
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn confirmDeleteSchedule()
+///
+/// \brief prints a form to confirm the deletion of a schedule
+///
+////////////////////////////////////////////////////////////////////////////////
+function confirmDeleteSchedule() {
+ $scheduleid = getContinuationVar("scheduleid");
+ $schedules = getSchedules();
+ $days = array("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday",
+ "Friday", "Saturday");
+
+ $name = $schedules[$scheduleid]["name"];
+ $owner = $schedules[$scheduleid]["owner"];
+
+ print "<DIV align=center>\n";
+ print "<H2>Delete Schedule</H2>\n";
+ print "Delete the following schedule?<br><br>\n";
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TH align=right>Name:</TH>\n";
+ print " <TD>$name</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Owner:</TH>\n";
+ print " <TD>$owner</TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ if(count($schedules[$scheduleid]["times"])) {
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TH>Start</TH>\n";
+ print " <TD> </TD>\n";
+ print " <TH>End</TH>\n";
+ print " <TR>\n";
+ foreach($schedules[$scheduleid]["times"] as $time) {
+ print " <TR>\n";
+ print " <TD>" . minToDaytime($time["start"]) . "</TD>\n";
+ print " <TD> </TD>\n";
+ print " <TD>" . minToDaytime($time["end"]) . "</TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+ }
+ print "<TABLE>\n";
+ print " <TR valign=top>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('scheduleid' => $scheduleid);
+ $cont = addContinuationsEntry('submitDeleteSchedule', $cdata, SECINDAY, 0, 0);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Submit>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <INPUT type=hidden name=mode value=viewSchedules>\n";
+ print " <INPUT type=submit value=Cancel>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitDeleteSchedule()
+///
+/// \brief deletes a schedule from the database and notifies the user
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitDeleteSchedule() {
+ $scheduleid = getContinuationVar("scheduleid");
+ doQuery("DELETE FROM schedule WHERE id = $scheduleid", 210);
+ doQuery("DELETE FROM scheduletimes WHERE scheduleid = $scheduleid", 210);
+ doQuery("DELETE FROM resource WHERE resourcetypeid = 15 AND subid = $scheduleid", 210);
+ $_SESSION['userresources'] = array();
+ $_SESSION['usersessiondata'] = array();
+ viewSchedules();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitScheduleGroups()
+///
+/// \brief updates schedule groupings
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitScheduleGroups() {
+ $groupinput = processInputVar("schedulegroup", ARG_MULTINUMERIC);
+
+ $schedules = getSchedules();
+
+ # build an array of memberships currently in the db
+ $tmp = getUserResources(array("groupAdmin"), array("administer"), 1);
+ $schedulegroupsIDs = array_keys($tmp["schedule"]); // ids of groups that user can administer
+ $resources = getUserResources(array("scheduleAdmin"),
+ array("administer"), 0, 0);
+ $userScheduleIDs = array_keys($resources["schedule"]); // ids of schedules that user can administer
+ $schedulemembership = getResourceGroupMemberships("schedule");
+ $baseschedulegroups = $schedulemembership["schedule"]; // all schedule group memberships
+ $schedulegroups = array();
+ foreach(array_keys($baseschedulegroups) as $scheduleid) {
+ if(in_array($scheduleid, $userScheduleIDs)) {
+ foreach($baseschedulegroups[$scheduleid] as $grpid) {
+ if(in_array($grpid, $schedulegroupsIDs)) {
+ if(array_key_exists($scheduleid, $schedulegroups))
+ array_push($schedulegroups[$scheduleid], $grpid);
+ else
+ $schedulegroups[$scheduleid] = array($grpid);
+ }
+ }
+ }
+ }
+
+ # build an array of posted in memberships
+ $newmembers = array();
+ foreach(array_keys($groupinput) as $key) {
+ list($scheduleid, $grpid) = explode(':', $key);
+ if(array_key_exists($scheduleid, $newmembers)) {
+ array_push($newmembers[$scheduleid], $grpid);
+ }
+ else {
+ $newmembers[$scheduleid] = array($grpid);
+ }
+ }
+
+ $adds = array();
+ $removes = array();
+ foreach(array_keys($schedules) as $scheduleid) {
+ $id = $schedules[$scheduleid]["resourceid"];
+ // if $scheduleids not in $userScheduleIds, don't bother with it
+ if(! in_array($scheduleid, $userScheduleIDs))
+ continue;
+ // if $scheduleid is not in $newmembers or $schedulegroups, do nothing
+ if(! array_key_exists($scheduleid, $newmembers) &&
+ ! array_key_exists($scheduleid, $schedulegroups)) {
+ continue;
+ }
+ // check that $scheduleid is in $newmembers, if not, remove it from all groups
+ if(! array_key_exists($scheduleid, $newmembers)) {
+ $removes[$id] = $schedulegroups[$scheduleid];
+ continue;
+ }
+ // check that $scheduleid is in $schedulegroups, if not, add all groups in
+ // $newmembers
+ if(! array_key_exists($scheduleid, $schedulegroups)) {
+ $adds[$id] = $newmembers[$scheduleid];
+ continue;
+ }
+ // adds are groupids that are in $newmembers, but not in $schedulegroups
+ $adds[$id] = array_diff($newmembers[$scheduleid], $schedulegroups[$scheduleid]);
+ if(count($adds[$id]) == 0) {
+ unset($adds[$id]);
+ }
+ // removes are groupids that are in $schedulegroups, but not in $newmembers
+ $removes[$id] = array_diff($schedulegroups[$scheduleid], $newmembers[$scheduleid]);
+ if(count($removes[$id]) == 0) {
+ unset($removes[$id]);
+ }
+ }
+
+ foreach(array_keys($adds) as $scheduleid) {
+ foreach($adds[$scheduleid] as $grpid) {
+ $query = "INSERT INTO resourcegroupmembers "
+ . "(resourceid, resourcegroupid) "
+ . "VALUES ($scheduleid, $grpid)";
+ doQuery($query, 291);
+ }
+ }
+
+ foreach(array_keys($removes) as $scheduleid) {
+ foreach($removes[$scheduleid] as $grpid) {
+ $query = "DELETE FROM resourcegroupmembers "
+ . "WHERE resourceid = $scheduleid AND "
+ . "resourcegroupid = $grpid";
+ doQuery($query, 292);
+ }
+ }
+
+ viewSchedules();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn processScheduleInput($checks)
+///
+/// \param $checks - (optional) 1 to perform validation, 0 not to
+///
+/// \return an array with the following indexes:\n
+/// scheduleid, name, owner, start[0] - start[6], end[0] - end[6]
+///
+/// \brief validates input from the previous form; if anything was improperly
+/// submitted, sets submitErr and submitErrMsg
+///
+////////////////////////////////////////////////////////////////////////////////
+function processScheduleInput($checks=1) {
+ global $submitErr, $submitErrMsg;
+ $return = array();
+ $return["start"] = array();
+ $return["end"] = array();
+
+ $return["scheduleid"] = getContinuationVar("scheduleid", processInputVar("scheduleid" , ARG_NUMERIC));
+ $return["name"] = getContinuationVar("name", processInputVar("name", ARG_STRING));
+ $return["owner"] = getContinuationVar("owner", processInputVar("owner", ARG_STRING));
+ $return["submode"] = processInputVar("submode", ARG_STRING);
+ $return["selrow"] = processInputVar("selrow", ARG_NUMERIC);
+ $return["count"] = getContinuationVar("count", processInputVar("count", ARG_NUMERIC, 0));
+ $return["startDay"] = processInputVar("startDay", ARG_MULTINUMERIC);
+ $return["startTime"] = processInputVar("startTime", ARG_MULTISTRING);
+ $return["endDay"] = processInputVar("endDay", ARG_MULTINUMERIC);
+ $return["endTime"] = processInputVar("endTime", ARG_MULTISTRING);
+
+ if(! $checks) {
+ return $return;
+ }
+
+ if(strlen($return["name"]) > 25 || strlen($return["name"]) < 2) {
+ $submitErr |= SCHNAMEERR;
+ $submitErrMsg[SCHNAMEERR] = "Name must be from 2 to 30 characters";
+ }
+ if(! ($submitErr & SCHNAMEERR) &&
+ checkForScheduleName($return["name"], $return["scheduleid"])) {
+ $submitErr |= SCHNAMEERR;
+ $submitErrMsg[SCHNAMEERR] = "A schedule already exists with this name.";
+ }
+ if(! validateUserid($return["owner"])) {
+ $submitErr |= SCHOWNERERR;
+ $submitErrMsg[SCHOWNERERR] = "The submitted unity ID is invalid.";
+ }
+ for($i = 0; $i < $return["count"]; $i++) {
+ if((! ereg('^((0?[1-9])|(1[0-2])):([0-5][0-9]) (am|pm)$', $return["startTime"][$i])) ||
+ (! ereg('^((0?[1-9])|(1[0-2])):([0-5][0-9]) (am|pm)$', $return["endTime"][$i]))) {
+ $submitErr |= (1 << $i);
+ $submitErrMsg[1 << $i] = "Time must be of the form [H]H:MM am/pm";
+ }
+ elseif(daytimeToMin($return["startDay"][$i], $return["startTime"][$i], "start") >=
+ daytimeToMin($return["endDay"][$i], $return["endTime"][$i], "end")) {
+ $submitErr |= (1 << $i);
+ $submitErrMsg[1 << $i] = "The start day/time must be before the end day/time";
+ }
+ }
+ for($i = 0; $i < $return["count"] - 1; $i++) {
+ for($j = $i + 1; $j < $return["count"]; $j++) {
+ if(daytimeToMin($return["startDay"][$i], $return["startTime"][$i], "start") <
+ daytimeToMin($return["endDay"][$j], $return["endTime"][$j], "end") &&
+ daytimeToMin($return["endDay"][$i], $return["endTime"][$i], "end") >
+ daytimeToMin($return["startDay"][$j], $return["startTime"][$j], "start")) {
+ $submitErr |= OVERLAPERR;
+ $submitErrMsg[OVERLAPERR] = "At least 2 of the time periods overlap. Please combine them into a single entry.";
+ break(2);
+ }
+ }
+ }
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn checkForScheduleName($name, $id)
+///
+/// \param $name - the name of a schedule
+/// \param $id - id of a schedule to ignore
+///
+/// \return 1 if $name is already in the schedule table, 0 if not
+///
+/// \brief checks for $name being in the schedule table except for $id
+///
+////////////////////////////////////////////////////////////////////////////////
+function checkForScheduleName($name, $id) {
+ $query = "SELECT id FROM schedule "
+ . "WHERE name = '$name'";
+
+ if(! empty($id))
+ $query .= " AND id != $id";
+ $qh = doQuery($query, 101);
+ if(mysql_num_rows($qh))
+ return 1;
+ return 0;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn updateSchedule($data)
+///
+/// \param $data - an array returned from processScheduleInput
+///
+/// \return number of rows affected by the update\n
+/// \b NOTE: mysql reports that no rows were affected if none of the fields
+/// were actually changed even if the update matched a row
+///
+/// \brief performs a query to update the schedule with data from $data
+///
+////////////////////////////////////////////////////////////////////////////////
+function updateSchedule($data) {
+ $ownerid = getUserlistID($data["owner"]);
+ $query = "UPDATE schedule "
+ . "SET name = '" . $data["name"] . "', "
+ . "ownerid = $ownerid "
+ . "WHERE id = " . $data["scheduleid"];
+ $qh = doQuery($query, 215);
+ return mysql_affected_rows($GLOBALS["mysql_link_vcl"]);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn addSchedule($data)
+///
+/// \param $data - an array returned from processScheduleInput
+///
+/// \return number of rows affected by the insert\n
+///
+/// \brief performs a query to insert the schedule with data from $data
+///
+////////////////////////////////////////////////////////////////////////////////
+function addSchedule($data) {
+ $ownerid = getUserlistID($data["owner"]);
+ $query = "INSERT INTO schedule "
+ . "(name, "
+ . "ownerid) "
+ . "VALUES ('" . $data["name"] . "', "
+ . "$ownerid)";
+ doQuery($query, 220);
+ $affectedrows = mysql_affected_rows($GLOBALS["mysql_link_vcl"]);
+
+ $qh = doQuery("SELECT LAST_INSERT_ID() FROM schedule", 221);
+ if(! $row = mysql_fetch_row($qh)) {
+ abort(222);
+ }
+ $query = "INSERT INTO resource "
+ . "(resourcetypeid, "
+ . "subid) "
+ . "VALUES (15, "
+ . $row[0] . ")";
+ doQuery($query, 223);
+ return $row[0];
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn printStartEndTimeForm($min, $count, $startend)
+///
+/// \param $min - minute in the week, pass empty string to get an empty text
+/// entry field
+/// \param $count - counter value - used to keep track of which row this is
+/// \param $startend - "start" or "end"
+///
+/// \brief prints a select input for the day of week and a text entry field
+/// for the time to be entered
+///
+////////////////////////////////////////////////////////////////////////////////
+function printStartEndTimeForm($min, $count, $startend) {
+ $days = array("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday",
+ "Friday", "Saturday");
+ if($min == "") {
+ print " <TD>\n";
+ printSelectInput("$startend" . "Day[$count]", $days);
+ $name = $startend . "Time[$count]";
+ print " <INPUT type=text name=$name size=8 mazlength=8>\n";
+ print " </TD>\n";
+ return;
+ }
+ $time = minuteToTime($min % 1440);
+ if((int)($min / 1440) == 0) {
+ $day = 0;
+ }
+ elseif((int)($min / 1440) == 1) {
+ $day = 1;
+ }
+ elseif((int)($min / 1440) == 2) {
+ $day = 2;
+ }
+ elseif((int)($min / 1440) == 3) {
+ $day = 3;
+ }
+ elseif((int)($min / 1440) == 4) {
+ $day = 4;
+ }
+ elseif((int)($min / 1440) == 5) {
+ $day = 5;
+ }
+ elseif((int)($min / 1440) == 6) {
+ $day = 6;
+ }
+ elseif((int)($min / 1440) > 6) {
+ $day = 0;
+ }
+ print " <TD>\n";
+ printSelectInput("$startend" . "Day[$count]", $days, $day);
+ $name = $startend . "Time[$count]";
+ print " <INPUT type=text name=$name value=\"$time\" size=8 maxlength=8>\n";
+ print " </TD>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn printStartEndTimeForm2($day, $time, $count, $startend)
+///
+/// \param $day - numeric day of week with Sunday being 0
+/// \param $time - time of day in string format HH:MM am/pm
+/// \param $count - counter value - used to keep track of which row this is
+/// \param $startend - "start" or "end"
+///
+/// \brief prints a select input for the day of week and a text entry field
+/// for the time to be entered
+///
+////////////////////////////////////////////////////////////////////////////////
+function printStartEndTimeForm2($day, $time, $count, $startend) {
+ $days = array("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday",
+ "Friday", "Saturday");
+ print " <TD>\n";
+ printSelectInput("$startend" . "Day[$count]", $days, $day);
+ $name = $startend . "Time[$count]";
+ print " <INPUT type=text name=$name value=\"$time\" size=8 maxlength=8>\n";
+ print " </TD>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitScheduleTime()
+///
+/// \brief handles submitting date/time form for schedule times and calls
+/// editOrAddSchedule(0) again
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitScheduleTime() {
+ global $submitErr, $contdata;
+
+ if($_POST["submode"] == "Save changes") {
+ $data = processScheduleInput(1);
+ if($submitErr) {
+ editOrAddSchedule(0);
+ return;
+ }
+ }
+ else {
+ $data = processScheduleInput(0);
+ if($data["selrow"] == "") {
+ editOrAddSchedule(0);
+ return;
+ }
+ }
+
+ if($data["submode"] == "Delete selected row") {
+ // delete entry from db
+ $start = daytimeToMin($data["startDay"][$data["selrow"]], $data["startTime"][$data["selrow"]], "start");
+ $end = daytimeToMin($data["endDay"][$data["selrow"]], $data["endTime"][$data["selrow"]], "end");
+ $query = "DELETE FROM scheduletimes "
+ . "WHERE scheduleid = {$data["scheduleid"]} AND "
+ . "start = $start AND "
+ . "end = $end";
+ doQuery($query, 101);
+ // decrease all values by 1 that are > deleted row
+ for($i = 0; $i < $data["count"] - 1; $i++) {
+ if($i >= $data["selrow"]) {
+ $_POST["startDay"][$i] = $_POST["startDay"][$i + 1];
+ $_POST["startTime"][$i] = $_POST["startTime"][$i + 1];
+ $_POST["endDay"][$i] = $_POST["endDay"][$i + 1];
+ $_POST["endTime"][$i] = $_POST["endTime"][$i + 1];
+ }
+ }
+ unset($_POST["startDay"][$i]);
+ unset($_POST["startTime"][$i]);
+ unset($_POST["endDay"][$i]);
+ unset($_POST["endTime"][$i]);
+ $contdata["count"]--;
+ editOrAddSchedule(0);
+ }
+ elseif($data["submode"] == "Insert before selected row") {
+ editOrAddSchedule(0);
+ }
+ elseif($data["submode"] == "Insert after selected row") {
+ editOrAddSchedule(0);
+ }
+ elseif($data["submode"] == "Save changes") {
+ $query = "DELETE FROM scheduletimes WHERE scheduleid = {$data["scheduleid"]}";
+ doQuery($query, 101);
+ for($i = 0; $i < $data["count"]; $i++) {
+ $start = daytimeToMin($data["startDay"][$i], $data["startTime"][$i], "start");
+ $end = daytimeToMin($data["endDay"][$i], $data["endTime"][$i], "end");
+ $query = "INSERT INTO scheduletimes "
+ . "(scheduleid, "
+ . "start, "
+ . "end) "
+ . "VALUES ({$data["scheduleid"]}, "
+ . "$start, "
+ . "$end)";
+ doQuery($query, 101);
+ }
+ editOrAddSchedule(0);
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn daytimeToMin($day, $time, $startend)
+///
+/// \param $day - number of day of week (0-6) with 0 being Sunday
+/// \param $time - time of day in 'HH:MM mm' format
+/// \param $startend - "start" or "end" - neede to know if 12:00 am on Sunday
+/// is a the beginning of the week or end of the week
+///
+/// \return minute of the week
+///
+/// \brief computes minute of the week from the input params - if Sunday at
+/// 12:00 am, return 0 if $startend == "start" or 10080 if $startend == "end"
+///
+////////////////////////////////////////////////////////////////////////////////
+function daytimeToMin($day, $time, $startend) {
+ if(! ereg('^(((0)?([1-9]))|(1([0-2]))):([0-5][0-9]) ((am)|(pm))', $time))
+ return -1;
+ list($hour, $other) = explode(':', $time);
+ list($min, $meridian) = explode(' ', $other);
+ if($meridian == "am" && $hour == 12) {
+ if($startend == "end" && $day == 0)
+ $day = 7;
+ $hour = 0;
+ }
+ elseif($meridian == "pm" && $hour != 12) {
+ $hour += 12;
+ }
+ return (($hour * 60) + $min) + ($day * 1440);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn minToDaytime($min)
+///
+/// \param $min - minute of the week
+///
+/// \return day of week and time of day
+///
+/// \brief calculates day of week and time of day from $min and returns a
+/// nicely formatted string of "Weekday HH:MM am/pm"
+///
+////////////////////////////////////////////////////////////////////////////////
+function minToDaytime($min) {
+ $days = array("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday",
+ "Friday", "Saturday");
+ $time = minuteToTime($min % 1440);
+ if((int)($min / 1440) == 0) {
+ $day = 0;
+ }
+ elseif((int)($min / 1440) == 1) {
+ $day = 1;
+ }
+ elseif((int)($min / 1440) == 2) {
+ $day = 2;
+ }
+ elseif((int)($min / 1440) == 3) {
+ $day = 3;
+ }
+ elseif((int)($min / 1440) == 4) {
+ $day = 4;
+ }
+ elseif((int)($min / 1440) == 5) {
+ $day = 5;
+ }
+ elseif((int)($min / 1440) == 6) {
+ $day = 6;
+ }
+ elseif((int)($min / 1440) > 6) {
+ $day = 0;
+ }
+ return $days[$day] . " $time";
+}
+
+?>
diff --git a/web/.ht-inc/secrets.php b/web/.ht-inc/secrets.php
new file mode 100644
index 0000000..65adf5c
--- /dev/null
+++ b/web/.ht-inc/secrets.php
@@ -0,0 +1,28 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+$vclhost = 'localhost'; # name of mysql server
+$vcldb = 'vcl'; # name of mysql database
+$vclusername = ''; # username to access database
+$vclpassword = ''; # password to access database
+
+$mcryptkey = ''; # random password - won't ever have to type it so make it long
+$mcryptiv = '12345678'; // must be 8 hex chars
+
+$pemkey = ''; # random passphrase - same as given to genkeys.sh - should be long
+?>
diff --git a/web/.ht-inc/states.php b/web/.ht-inc/states.php
new file mode 100644
index 0000000..1f39388
--- /dev/null
+++ b/web/.ht-inc/states.php
@@ -0,0 +1,587 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+/**
+ * \file
+ */
+
+$actions['mode'] = array();
+$actions['args'] = array();
+$actions["pages"] = array();
+$actions["nextmodes"] = array();
+
+$actions["entry"] = array('main',
+ 'newRequest',
+ 'viewRequests',
+ 'blockRequest',
+ 'userpreferences',
+ 'viewGroups',
+ 'selectImageOption',
+ 'viewSchedules',
+ 'selectComputers',
+ 'selectMgmtnodeOption',
+ 'pickTimeTable',
+ 'viewNodes',
+ 'userLookup',
+ 'selectstats',
+ 'helpform',
+ 'viewdocs',
+ 'logout',
+ 'xmlrpccall',
+ 'selectauth',
+ 'xmlrpcaffiliations',
+ 'submitLogin',
+ 'imageClickThrough',
+ 'clearCache',
+ 'errorrpt',
+ 'auth',
+ 'editVMInfo',
+ 'continuationsError',
+);
+
+$noHTMLwrappers = array('sendRDPfile',
+ 'vcldquery',
+ 'xmlrpccall',
+ 'xmlrpcaffiliations',
+ 'selectNode',
+ 'AJsubmitAddUserPriv',
+ 'AJsubmitAddUserGroupPriv',
+ 'AJsubmitAddResourcePriv',
+ 'AJchangeUserPrivs',
+ 'AJchangeUserGroupPrivs',
+ 'AJchangeResourcePrivs',
+ 'AJsubmitAddChildNode',
+ 'AJsubmitDeleteNode',
+ 'AJupdateWaitTime',
+ 'AJviewRequests',
+ 'submitRequest',
+ 'submitTestProd',
+ 'selectauth',
+ 'submitCreateImage',
+ 'submitCreateTestProd',
+ 'submitLogin',
+ 'submitgeneralprefs',
+ 'AJupdateImage',
+ 'jsonImageGroupingImages',
+ 'jsonImageGroupingGroups',
+ 'jsonImageMapCompGroups',
+ 'jsonImageMapImgGroups',
+ 'AJaddImageToGroup',
+ 'AJremImageFromGroup',
+ 'AJaddGroupToImage',
+ 'AJremGroupFromImage',
+ 'imageGroupingGrid',
+ 'AJaddCompGrpToImgGrp',
+ 'AJremCompGrpFromImgGrp',
+ 'AJaddImgGrpToCompGrp',
+ 'AJremImgGrpFromCompGrp',
+ 'imageMappingGrid',
+ 'jsonGetGroupInfo',
+ 'jsonCompGroupingComps',
+ 'jsonCompGroupingGroups',
+ 'compGroupingGrid',
+ 'AJaddCompToGroup',
+ 'AJremCompFromGroup',
+ 'AJaddGroupToComp',
+ 'AJremGroupFromComp',
+ 'generateDHCP',
+ 'errorrpt',
+ 'vmhostdata',
+ 'updateVMlimit',
+ 'AJvmToHost',
+ 'AJvmFromHost',
+ 'AJvmFromHostDelayed',
+ 'AJchangeVMprofile',
+ 'AJcancelVMmove',
+ 'AJprofiledata',
+ 'AJupdateVMprofileItem',
+ 'AJnewProfile',
+ 'AJdelProfile',
+ 'AJupdateRevisionProduction',
+ 'AJupdateRevisionComments',
+ 'AJdeleteRevisions',
+);
+
+# main
+$actions['mode']['main'] = "main"; # entry
+$actions['pages']['main'] = "main";
+
+# new reservations
+$actions['mode']['newRequest'] = "newReservation"; # entry
+$actions['mode']['submitRequest'] = "submitRequest";
+$actions['mode']['AJupdateWaitTime'] = "AJupdateWaitTime";
+$actions['mode']['submitTestProd'] = "submitRequest";
+$actions['mode']['selectTimeTable'] = "showTimeTable";
+$actions['args']['selectTimeTable'] = 1;
+$actions['pages']['newRequest'] = "newReservations";
+$actions['pages']['submitRequest'] = "newReservations";
+$actions['pages']['AJupdateWaitTime'] = "newReservations";
+$actions['pages']['submitTestProd'] = "newReservations";
+$actions['pages']['selectTimeTable'] = "newReservations";
+$actions['nextmodes']['newRequest'] = array();
+
+# current reservations
+$actions['mode']['viewRequests'] = "viewRequests"; # entry
+$actions['mode']['AJviewRequests'] = "viewRequests"; # entry
+$actions['mode']['editRequest'] = "editRequest";
+$actions['mode']['confirmEditRequest'] = "confirmEditRequest";
+$actions['mode']['submitEditRequest'] = "submitEditRequest";
+$actions['mode']['confirmDeleteRequest'] = "confirmDeleteRequest";
+$actions['mode']['submitDeleteRequest'] = "submitDeleteRequest";
+$actions['mode']['connectRequest'] = "connectRequest";
+$actions['mode']['sendRDPfile'] = "sendRDPfile";
+#$actions['mode']['connectMindterm'] = "connectMindterm";
+#$actions['mode']['connectRDPapplet'] = "connectRDPapplet";
+$actions['pages']['viewRequests'] = "currentReservations";
+$actions['pages']['AJviewRequests'] = "currentReservations";
+$actions['pages']['editRequest'] = "currentReservations";
+$actions['pages']['confirmEditRequest'] = "currentReservations";
+$actions['pages']['submitEditRequest'] = "currentReservations";
+$actions['pages']['confirmDeleteRequest'] = "currentReservations";
+$actions['pages']['submitDeleteRequest'] = "currentReservations";
+$actions['pages']['connectRequest'] = "currentReservations";
+$actions['pages']['sendRDPfile'] = "currentReservations";
+#$actions['pages']['connectMindterm'] = "currentReservations";
+#$actions['pages']['connectRDPapplet'] = "currentReservations";
+
+# block reservations
+$actions['mode']['blockRequest'] = "blockRequest"; # entry
+$actions['mode']['newBlockRequest'] = "newBlockRequest";
+$actions['mode']['confirmBlockRequest'] = "confirmBlockRequest";
+$actions['mode']['submitBlockRequest'] = "submitBlockRequest";
+$actions['mode']['selectEditBlockRequest'] = "selectEditBlockRequest";
+$actions['mode']['editBlockRequest'] = "editBlockRequest";
+$actions['mode']['submitDeleteBlockRequest'] = "submitDeleteBlockRequest";
+$actions['pages']['blockRequest'] = "blockReservations";
+$actions['pages']['newBlockRequest'] = "blockReservations";
+$actions['pages']['confirmBlockRequest'] = "blockReservations";
+$actions['pages']['submitBlockRequest'] = "blockReservations";
+$actions['pages']['selectEditBlockRequest'] = "blockReservations";
+$actions['pages']['editBlockRequest'] = "blockReservations";
+$actions['pages']['submitDeleteBlockRequest'] = "blockReservations";
+
+# user preferences
+$actions['mode']['userpreferences'] = "userpreferences"; # entry
+$actions['mode']['confirmpersonalprefs'] = "confirmUserPrefs";
+$actions['args']['confirmpersonalprefs'] = 0;
+$actions['mode']['confirmrdpprefs'] = "confirmUserPrefs";
+$actions['args']['confirmrdpprefs'] = 1;
+$actions['mode']['submituserprefs'] = "submitUserPrefs";
+$actions['mode']['submitgeneralprefs'] = "submitGeneralPreferences";
+$actions['pages']['userpreferences'] = "userPreferences";
+$actions['pages']['confirmpersonalprefs'] = "userPreferences";
+$actions['pages']['confirmrdpprefs'] = "userPreferences";
+$actions['pages']['submituserprefs'] = "userPreferences";
+$actions['pages']['submitgeneralprefs'] = "userPreferences";
+
+# manage groups
+$actions['mode']['viewGroups'] = "viewGroups"; # entry
+$actions['mode']['editGroup'] = "editOrAddGroup";
+$actions['args']['editGroup'] = 0;
+$actions['mode']['confirmEditGroup'] = "confirmEditOrAddGroup";
+$actions['args']['confirmEditGroup'] = 0;
+$actions['mode']['submitEditGroup'] = "submitEditGroup";
+$actions['mode']['confirmAddGroup'] = "confirmEditOrAddGroup";
+$actions['args']['confirmAddGroup'] = 1;
+$actions['mode']['submitAddGroup'] = "submitAddGroup";
+$actions['mode']['confirmDeleteGroup'] = "confirmDeleteGroup";
+$actions['mode']['submitDeleteGroup'] = "submitDeleteGroup";
+$actions['mode']['addGroupUser'] = "addGroupUser";
+$actions['mode']['deleteGroupUser'] = "deleteGroupUser";
+$actions['mode']['jsonGetGroupInfo'] = "jsonGetGroupInfo";
+$actions['pages']['viewGroups'] = "manageGroups";
+$actions['pages']['editGroup'] = "manageGroups";
+$actions['pages']['confirmEditGroup'] = "manageGroups";
+$actions['pages']['submitEditGroup'] = "manageGroups";
+$actions['pages']['confirmAddGroup'] = "manageGroups";
+$actions['pages']['submitAddGroup'] = "manageGroups";
+$actions['pages']['confirmDeleteGroup'] = "manageGroups";
+$actions['pages']['submitDeleteGroup'] = "manageGroups";
+$actions['pages']['addGroupUser'] = "manageGroups";
+$actions['pages']['deleteGroupUser'] = "manageGroups";
+$actions['pages']['jsonGetGroupInfo'] = "manageGroups";
+
+# manage images
+$actions['mode']['selectImageOption'] = "selectImageOption"; # entry
+$actions['mode']['viewImages'] = "viewImages";
+$actions['mode']['viewImageGrouping'] = "viewImageGrouping";
+$actions['mode']['viewImageMapping'] = "viewImageMapping";
+$actions['mode']['createSelectImage'] = "createSelectImage";
+$actions['mode']['submitCreateImage'] = "submitCreateImage";
+$actions['mode']['submitCreateTestProd'] = "submitCreateImage";
+$actions['mode']['newImage'] = "editOrAddImage";
+$actions['args']['newImage'] = "1";
+$actions['mode']['startImage'] = "startImage";
+$actions['mode']['updateExistingImageComments'] = "updateExistingImageComments";
+$actions['mode']['updateExistingImage'] = "updateExistingImage";
+$actions['mode']['setImageProduction'] = "setImageProduction";
+$actions['mode']['submitSetImageProduction'] = "submitSetImageProduction";
+$actions['mode']['submitImageButton'] = "submitImageButton";
+$actions['mode']['submitEditImage'] = "submitEditImage";
+$actions['mode']['AJupdateImage'] = "AJupdateImage";
+$actions['mode']['submitEditImageButtons'] = "submitEditImageButtons";
+$actions['mode']['imageClickThroughAgreement'] = "imageClickThroughAgreement";
+$actions['mode']['submitAddImage'] = "submitAddImage";
+$actions['mode']['submitAddSubimage'] = "submitAddSubimage";
+$actions['mode']['submitImageGroups'] = "submitImageGroups";
+$actions['mode']['submitImageMapping'] = "submitImageMapping";
+$actions['mode']['submitDeleteImage'] = "submitDeleteImage";
+$actions['mode']['imageClickThrough'] = "imageClickThrough";
+$actions['mode']['jsonImageGroupingImages'] = "jsonImageGroupingImages";
+$actions['mode']['jsonImageGroupingGroups'] = "jsonImageGroupingGroups";
+$actions['mode']['AJaddImageToGroup'] = "AJaddImageToGroup";
+$actions['mode']['AJremImageFromGroup'] = "AJremImageFromGroup";
+$actions['mode']['AJaddGroupToImage'] = "AJaddGroupToImage";
+$actions['mode']['AJremGroupFromImage'] = "AJremGroupFromImage";
+$actions['mode']['imageGroupingGrid'] = "imageGroupingGrid";
+$actions['mode']['jsonImageMapCompGroups'] = "jsonImageMapCompGroups";
+$actions['mode']['AJaddCompGrpToImgGrp'] = "AJaddCompGrpToImgGrp";
+$actions['mode']['AJremCompGrpFromImgGrp'] = "AJremCompGrpFromImgGrp";
+$actions['mode']['jsonImageMapImgGroups'] = "jsonImageMapImgGroups";
+$actions['mode']['AJaddImgGrpToCompGrp'] = "AJaddImgGrpToCompGrp";
+$actions['mode']['AJremImgGrpFromCompGrp'] = "AJremImgGrpFromCompGrp";
+$actions['mode']['imageMappingGrid'] = "imageMappingGrid";
+$actions['mode']['AJupdateRevisionProduction'] = "AJupdateRevisionProduction";
+$actions['mode']['AJupdateRevisionComments'] = "AJupdateRevisionComments";
+$actions['mode']['AJdeleteRevisions'] = "AJdeleteRevisions";
+$actions['pages']['selectImageOption'] = "manageImages";
+$actions['pages']['viewImages'] = "manageImages";
+$actions['pages']['viewImageGrouping'] = "manageImages";
+$actions['pages']['viewImageMapping'] = "manageImages";
+$actions['pages']['createSelectImage'] = "manageImages";
+$actions['pages']['submitCreateImage'] = "manageImages";
+$actions['pages']['submitCreateTestProd'] = "manageImages";
+$actions['pages']['newImage'] = "manageImages";
+$actions['pages']['startImage'] = "manageImages";
+$actions['pages']['updateExistingImageComments'] = "manageImages";
+$actions['pages']['updateExistingImage'] = "manageImages";
+$actions['pages']['setImageProduction'] = "manageImages";
+$actions['pages']['submitSetImageProduction'] = "manageImages";
+$actions['pages']['submitImageButton'] = "manageImages";
+$actions['pages']['submitEditImage'] = "manageImages";
+$actions['pages']['submitEditImageButtons'] = "manageImages";
+$actions['pages']['imageClickThroughAgreement'] = "manageImages";
+$actions['pages']['submitAddImage'] = "manageImages";
+$actions['pages']['submitAddSubimage'] = "manageImages";
+$actions['pages']['submitImageGroups'] = "manageImages";
+$actions['pages']['submitImageMapping'] = "manageImages";
+$actions['pages']['submitDeleteImage'] = "manageImages";
+$actions['pages']['imageClickThrough'] = "manageImages";
+$actions['pages']['AJupdateImage'] = "manageImages";
+$actions['pages']['jsonImageGroupingImages'] = "manageImages";
+$actions['pages']['jsonImageGroupingGroups'] = "manageImages";
+$actions['pages']['AJaddImageToGroup'] = "manageImages";
+$actions['pages']['AJremImageFromGroup'] = "manageImages";
+$actions['pages']['AJaddGroupToImage'] = "manageImages";
+$actions['pages']['AJremGroupFromImage'] = "manageImages";
+$actions['pages']['imageGroupingGrid'] = "manageImages";
+$actions['pages']['jsonImageMapCompGroups'] = "manageImages";
+$actions['pages']['AJaddCompGrpToImgGrp'] = "manageImages";
+$actions['pages']['AJremCompGrpFromImgGrp'] = "manageImages";
+$actions['pages']['jsonImageMapImgGroups'] = "manageImages";
+$actions['pages']['AJaddImgGrpToCompGrp'] = "manageImages";
+$actions['pages']['AJremImgGrpFromCompGrp'] = "manageImages";
+$actions['pages']['imageMappingGrid'] = "manageImages";
+$actions['pages']['AJupdateRevisionProduction'] = "manageImages";
+$actions['pages']['AJupdateRevisionComments'] = "manageImages";
+$actions['pages']['AJdeleteRevisions'] = "manageImages";
+
+# manage schedules
+$actions['mode']['viewSchedules'] = "viewSchedules"; # entry
+$actions['mode']['editSchedule'] = "editOrAddSchedule";
+$actions['args']['editSchedule'] = 0;
+$actions['mode']['confirmEditSchedule'] = "confirmEditOrAddSchedule";
+$actions['args']['confirmEditSchedule'] = 0;
+$actions['mode']['submitEditSchedule'] = "submitEditSchedule";
+$actions['mode']['confirmAddSchedule'] = "confirmEditOrAddSchedule";
+$actions['args']['confirmAddSchedule'] = 1;
+$actions['mode']['submitAddSchedule'] = "submitAddSchedule";
+$actions['mode']['confirmDeleteSchedule'] = "confirmDeleteSchedule";
+$actions['mode']['submitDeleteSchedule'] = "submitDeleteSchedule";
+$actions['mode']['submitScheduleGroups'] = "submitScheduleGroups";
+$actions['mode']['submitScheduleTime'] = "submitScheduleTime";
+$actions['pages']['viewSchedules'] = "manageSchedules";
+$actions['pages']['editSchedule'] = "manageSchedules";
+$actions['pages']['confirmEditSchedule'] = "manageSchedules";
+$actions['pages']['submitEditSchedule'] = "manageSchedules";
+$actions['pages']['confirmAddSchedule'] = "manageSchedules";
+$actions['pages']['submitAddSchedule'] = "manageSchedules";
+$actions['pages']['confirmDeleteSchedule'] = "manageSchedules";
+$actions['pages']['submitDeleteSchedule'] = "manageSchedules";
+$actions['pages']['submitScheduleGroups'] = "manageSchedules";
+$actions['pages']['submitScheduleTime'] = "manageSchedules";
+
+# manage computers
+$actions['mode']['selectComputers'] = "selectComputers"; # entry
+$actions['mode']['viewComputers'] = "viewComputers";
+$actions['mode']['viewComputerGroups'] = "viewComputerGroups";
+$actions['mode']['computerUtilities'] = "computerUtilities";
+$actions['mode']['reloadComputers'] = "reloadComputers";
+$actions['mode']['submitReloadComputers'] = "submitReloadComputers";
+$actions['mode']['compStateChange'] = "compStateChange";
+$actions['mode']['submitCompStateChange'] = "submitCompStateChange";
+$actions['mode']['compScheduleChange'] = "compScheduleChange";
+$actions['mode']['submitCompScheduleChange'] = "submitCompScheduleChange";
+$actions['mode']['editComputer'] = "editOrAddComputer";
+$actions['args']['editComputer'] = 0;
+$actions['mode']['addComputer'] = "editOrAddComputer";
+$actions['args']['addComputer'] = 1;
+$actions['mode']['confirmEditComputer'] = "confirmEditOrAddComputer";
+$actions['args']['confirmEditComputer'] = 0;
+$actions['mode']['confirmAddComputer'] = "confirmEditOrAddComputer";
+$actions['args']['confirmAddComputer'] = 1;
+$actions['mode']['submitEditComputer'] = "submitEditComputer";
+$actions['mode']['computerAddMaintenanceNote'] = "computerAddMaintenanceNote";
+$actions['mode']['submitAddComputer'] = "submitAddComputer";
+$actions['mode']['submitComputerGroups'] = "submitComputerGroups";
+$actions['mode']['confirmDeleteComputer'] = "confirmDeleteComputer";
+$actions['mode']['submitDeleteComputer'] = "submitDeleteComputer";
+$actions['mode']['bulkAddComputer'] = "bulkAddComputer";
+$actions['mode']['confirmAddBulkComputers'] = "confirmAddBulkComputers";
+$actions['mode']['submitAddBulkComputers'] = "submitAddBulkComputers";
+$actions['mode']['jsonCompGroupingComps'] = "jsonCompGroupingComps";
+$actions['mode']['jsonCompGroupingGroups'] = "jsonCompGroupingGroups";
+$actions['mode']['compGroupingGrid'] = "compGroupingGrid";
+$actions['mode']['AJaddCompToGroup'] = "AJaddCompToGroup";
+$actions['mode']['AJremCompFromGroup'] = "AJremCompFromGroup";
+$actions['mode']['AJaddGroupToComp'] = "AJaddGroupToComp";
+$actions['mode']['AJremGroupFromComp'] = "AJremGroupFromComp";
+$actions['mode']['generateDHCP'] = "generateDHCP";
+$actions['pages']['selectComputers'] = "manageComputers";
+$actions['pages']['viewComputers'] = "manageComputers";
+$actions['pages']['viewComputerGroups'] = "manageComputers";
+$actions['pages']['computerUtilities'] = "manageComputers";
+$actions['pages']['reloadComputers'] = "manageComputers";
+$actions['pages']['submitReloadComputers'] = "manageComputers";
+$actions['pages']['compStateChange'] = "manageComputers";
+$actions['pages']['submitCompStateChange'] = "manageComputers";
+$actions['pages']['compScheduleChange'] = "manageComputers";
+$actions['pages']['submitCompScheduleChange'] = "manageComputers";
+$actions['pages']['editComputer'] = "manageComputers";
+$actions['pages']['addComputer'] = "manageComputers";
+$actions['pages']['confirmEditComputer'] = "manageComputers";
+$actions['pages']['confirmAddComputer'] = "manageComputers";
+$actions['pages']['submitEditComputer'] = "manageComputers";
+$actions['pages']['computerAddMaintenanceNote'] = "manageComputers";
+$actions['pages']['computerAddedMaintenceNote'] = "manageComputers";
+$actions['pages']['submitAddComputer'] = "manageComputers";
+$actions['pages']['submitComputerGroups'] = "manageComputers";
+$actions['pages']['confirmDeleteComputer'] = "manageComputers";
+$actions['pages']['submitDeleteComputer'] = "manageComputers";
+$actions['pages']['bulkAddComputer'] = "manageComputers";
+$actions['pages']['confirmAddBulkComputers'] = "manageComputers";
+$actions['pages']['submitAddBulkComputers'] = "manageComputers";
+$actions['pages']['jsonCompGroupingComps'] = "manageComputers";
+$actions['pages']['jsonCompGroupingGroups'] = "manageComputers";
+$actions['pages']['compGroupingGrid'] = "manageComputers";
+$actions['pages']['AJaddCompToGroup'] = "manageComputers";
+$actions['pages']['AJremCompFromGroup'] = "manageComputers";
+$actions['pages']['AJaddGroupToComp'] = "manageComputers";
+$actions['pages']['AJremGroupFromComp'] = "manageComputers";
+$actions['pages']['generateDHCP'] = "manageComputers";
+
+# management nodes
+$actions['mode']['selectMgmtnodeOption'] = "selectMgmtnodeOption"; # entry
+$actions['mode']['viewMgmtnodes'] = "viewMgmtnodes";
+$actions['mode']['editMgmtNode'] = "editOrAddMgmtnode";
+$actions['args']['editMgmtNode'] = "0";
+$actions['mode']['addMgmtNode'] = "editOrAddMgmtnode";
+$actions['args']['addMgmtNode'] = "1";
+$actions['mode']['confirmEditMgmtnode'] = "confirmEditOrAddMgmtnode";
+$actions['args']['confirmEditMgmtnode'] = "0";
+$actions['mode']['confirmAddMgmtnode'] = "confirmEditOrAddMgmtnode";
+$actions['args']['confirmAddMgmtnode'] = "1";
+$actions['mode']['submitEditMgmtnode'] = "submitEditMgmtnode";
+$actions['mode']['submitAddMgmtnode'] = "submitAddMgmtnode";
+$actions['mode']['confirmDeleteMgmtnode'] = "confirmDeleteMgmtnode";
+$actions['mode']['submitDeleteMgmtnode'] = "submitDeleteMgmtnode";
+$actions['mode']['viewMgmtnodeGrouping'] = "viewMgmtnodeGrouping";
+$actions['mode']['submitMgmtnodeGroups'] = "submitMgmtnodeGroups";
+$actions['mode']['viewMgmtnodeMapping'] = "viewMgmtnodeMapping";
+$actions['mode']['submitMgmtnodeMapping'] = "submitMgmtnodeMapping";
+$actions['pages']['selectMgmtnodeOption'] = "managementNodes";
+$actions['pages']['viewMgmtnodes'] = "managementNodes";
+$actions['pages']['editMgmtNode'] = "managementNodes";
+$actions['pages']['addMgmtNode'] = "managementNodes";
+$actions['pages']['confirmEditMgmtnode'] = "managementNodes";
+$actions['pages']['confirmAddMgmtnode'] = "managementNodes";
+$actions['pages']['submitEditMgmtnode'] = "managementNodes";
+$actions['pages']['submitAddMgmtnode'] = "managementNodes";
+$actions['pages']['confirmDeleteMgmtnode'] = "managementNodes";
+$actions['pages']['submitDeleteMgmtnode'] = "managementNodes";
+$actions['pages']['viewMgmtnodeGrouping'] = "managementNodes";
+$actions['pages']['submitMgmtnodeGroups'] = "managementNodes";
+$actions['pages']['viewMgmtnodeMapping'] = "managementNodes";
+$actions['pages']['submitMgmtnodeMapping'] = "managementNodes";
+
+# time table
+# TODO a few of these belong to new reservation
+$actions['mode']['pickTimeTable'] = "pickTimeTable"; # entry
+$actions['mode']['showTimeTable'] = "showTimeTable";
+$actions['args']['showTimeTable'] = 0;
+$actions['mode']['viewRequestInfo'] = "viewRequestInfo";
+#$actions['mode']['adminEditRequest'] = "adminEditRequest";
+#$actions['mode']['confirmAdminEditRequest'] = "confirmAdminEditRequest";
+$actions['mode']['submitAdminEditRequest'] = "submitAdminEditRequest";
+$actions['pages']['pickTimeTable'] = "timeTable";
+$actions['pages']['showTimeTable'] = "timeTable";
+$actions['pages']['viewRequestInfo'] = "timeTable";
+#$actions['pages']['adminEditRequest'] = "timeTable";
+#$actions['pages']['confirmAdminEditRequest'] = "timeTable";
+$actions['pages']['submitAdminEditRequest'] = "timeTable";
+
+# privileges
+$actions['mode']['viewNodes'] = "viewNodes"; # entry
+$actions['mode']['addChildNode'] = "addChildNode";
+$actions['mode']['submitAddChildNode'] = "submitAddChildNode";
+$actions['mode']['AJsubmitAddChildNode'] = "AJsubmitAddChildNode";
+$actions['mode']['deleteNode'] = "deleteNode";
+$actions['mode']['submitDeleteNode'] = "submitDeleteNode";
+$actions['mode']['AJsubmitDeleteNode'] = "AJsubmitDeleteNode";
+$actions['mode']['viewNodePrivs'] = "viewNodePrivs";
+$actions['mode']['selectNode'] = "selectNode";
+$actions['mode']['changeUserPrivs'] = "changeUserPrivs";
+$actions['mode']['AJchangeUserPrivs'] = "AJchangeUserPrivs";
+$actions['mode']['addUserPriv'] = "addUserPriv";
+$actions['mode']['submitAddUserPriv'] = "submitAddUserPriv";
+$actions['mode']['AJsubmitAddUserPriv'] = "AJsubmitAddUserPriv";
+$actions['mode']['changeUserGroupPrivs'] = "changeUserGroupPrivs";
+$actions['mode']['AJchangeUserGroupPrivs'] = "AJchangeUserGroupPrivs";
+$actions['mode']['addUserGroupPriv'] = "addUserGroupPriv";
+$actions['mode']['submitAddUserGroupPriv'] = "submitAddUserGroupPriv";
+$actions['mode']['AJsubmitAddUserGroupPriv'] = "AJsubmitAddUserGroupPriv";
+$actions['mode']['addResourcePriv'] = "addResourcePriv";
+$actions['mode']['submitAddResourcePriv'] = "submitAddResourcePriv";
+$actions['mode']['AJsubmitAddResourcePriv'] = "AJsubmitAddResourcePriv";
+$actions['mode']['changeResourcePrivs'] = "changeResourcePrivs";
+$actions['mode']['AJchangeResourcePrivs'] = "AJchangeResourcePrivs";
+$actions['pages']['viewNodes'] = "privileges";
+$actions['pages']['addChildNode'] = "privileges";
+$actions['pages']['submitAddChildNode'] = "privileges";
+$actions['pages']['AJsubmitAddChildNode'] = "privileges";
+$actions['pages']['deleteNode'] = "privileges";
+$actions['pages']['submitDeleteNode'] = "privileges";
+$actions['pages']['AJsubmitDeleteNode'] = "privileges";
+$actions['pages']['viewNodePrivs'] = "privileges";
+$actions['pages']['selectNode'] = "privileges";
+$actions['pages']['changeUserPrivs'] = "privileges";
+$actions['pages']['AJchangeUserPrivs'] = "privileges";
+$actions['pages']['addUserPriv'] = "privileges";
+$actions['pages']['submitAddUserPriv'] = "privileges";
+$actions['pages']['AJsubmitAddUserPriv'] = "privileges";
+$actions['pages']['changeUserGroupPrivs'] = "privileges";
+$actions['pages']['AJchangeUserGroupPrivs'] = "privileges";
+$actions['pages']['addUserGroupPriv'] = "privileges";
+$actions['pages']['submitAddUserGroupPriv'] = "privileges";
+$actions['pages']['AJsubmitAddUserGroupPriv'] = "privileges";
+$actions['pages']['addResourcePriv'] = "privileges";
+$actions['pages']['submitAddResourcePriv'] = "privileges";
+$actions['pages']['AJsubmitAddResourcePriv'] = "privileges";
+$actions['pages']['changeResourcePrivs'] = "privileges";
+$actions['pages']['AJchangeResourcePrivs'] = "privileges";
+
+# user lookup
+$actions['mode']['userLookup'] = "userLookup"; # entry
+$actions['mode']['submitUserLookup'] = "userLookup";
+$actions['pages']['userLookup'] = "userLookup";
+$actions['pages']['submitUserLookup'] = "userLookup";
+
+# statistics
+# TODO might need the statgraph modes to be entry modes
+$actions['mode']['selectstats'] = "selectStatistics"; # entry
+$actions['mode']['viewstats'] = "viewStatistics";
+$actions['mode']['statgraphday'] = "sendStatGraphDay";
+$actions['mode']['statgraphhour'] = "sendStatGraphHour";
+$actions['mode']['statgraphdayconcuruser'] = "sendStatGraphDayConUsers";
+$actions['mode']['statgraphdayconcurblade'] = "sendStatGraphConBladeUser";
+$actions['pages']['selectstats'] = "statistics";
+$actions['pages']['viewstats'] = "statistics";
+$actions['pages']['statgraphday'] = "statistics";
+$actions['pages']['statgraphhour'] = "statistics";
+$actions['pages']['statgraphdayconcuruser'] = "statistics";
+$actions['pages']['statgraphdayconcurblade'] = "statistics";
+
+# help
+$actions['mode']['helpform'] = "printHelpForm"; # entry
+$actions['mode']['submitHelpForm'] = "submitHelpForm";
+$actions['pages']['helpform'] = "help";
+$actions['pages']['submitHelpForm'] = "help";
+
+# code documentation
+$actions['mode']['viewdocs'] = "viewDocs"; # entry
+$actions['mode']['editdoc'] = "editDoc";
+$actions['mode']['confirmeditdoc'] = "confirmEditDoc";
+$actions['mode']['submiteditdoc'] = "submitEditDoc";
+$actions['mode']['confirmdeletedoc'] = "confirmDeleteDoc";
+$actions['mode']['submitdeletedoc'] = "submitDeleteDoc";
+$actions['pages']['viewdocs'] = "codeDocumentation";
+$actions['pages']['editdoc'] = "codeDocumentation";
+$actions['pages']['confirmeditdoc'] = "codeDocumentation";
+$actions['pages']['submiteditdoc'] = "codeDocumentation";
+$actions['pages']['confirmdeletedoc'] = "codeDocumentation";
+$actions['pages']['submitdeletedoc'] = "codeDocumentation";
+
+# authentication
+$actions['mode']['selectauth'] = "selectAuth";
+$actions['mode']['submitLogin'] = "submitLogin";
+$actions['pages']['selectauth'] = "authentication";
+$actions['pages']['submitLogin'] = "authentication";
+
+# vm stuff
+$actions['mode']['editVMInfo'] = "editVMInfo";
+$actions['mode']['vmhostdata'] = "vmhostdata";
+$actions['mode']['updateVMlimit'] = "updateVMlimit";
+$actions['mode']['AJvmToHost'] = "AJvmToHost";
+$actions['mode']['AJvmFromHost'] = "AJvmFromHost";
+$actions['mode']['AJvmFromHostDelayed'] = "AJvmFromHostDelayed";
+$actions['mode']['AJchangeVMprofile'] = "AJchangeVMprofile";
+$actions['mode']['AJcancelVMmove'] = "AJcancelVMmove";
+$actions['mode']['AJprofiledata'] = "AJprofileData";
+$actions['mode']['AJupdateVMprofileItem'] = "AJupdateVMprofileItem";
+$actions['mode']['AJnewProfile'] = "AJnewProfile";
+$actions['mode']['AJdelProfile'] = "AJdelProfile";
+$actions['pages']['editVMInfo'] = "vm";
+$actions['pages']['vmhostdata'] = "vm";
+$actions['pages']['updateVMlimit'] = "vm";
+$actions['pages']['AJvmToHost'] = "vm";
+$actions['pages']['AJvmFromHost'] = "vm";
+$actions['pages']['AJvmFromHostDelayed'] = "vm";
+$actions['pages']['AJchangeVMprofile'] = "vm";
+$actions['pages']['AJcancelVMmove'] = "vm";
+$actions['pages']['AJprofiledata'] = "vm";
+$actions['pages']['AJupdateVMprofileItem'] = "vm";
+$actions['pages']['AJnewProfile'] = "vm";
+$actions['pages']['AJdelProfile'] = "vm";
+
+# RPC
+$actions['mode']['vcldquery'] = "vcldquery";
+$actions['mode']['xmlrpccall'] = "xmlrpccall";
+$actions['mode']['xmlrpcaffiliations'] = "xmlrpcgetaffiliations";
+$actions['pages']['vcldquery'] = "RPC";
+$actions['pages']['xmlrpccall'] = "RPC";
+$actions['pages']['xmlrpcaffiliations'] = "RPC";
+
+# misc
+$actions['mode']['continuationsError'] = "continuationsError";
+$actions['mode']['clearCache'] = "clearPrivCache";
+$actions['mode']['errorrpt'] = "errorrpt";
+$actions['pages']['continuationsError'] = "misc";
+$actions['pages']['clearCache'] = "misc";
+$actions['pages']['errorrpt'] = "misc";
+
+?>
diff --git a/web/.ht-inc/statistics.php b/web/.ht-inc/statistics.php
new file mode 100644
index 0000000..f47cf51
--- /dev/null
+++ b/web/.ht-inc/statistics.php
@@ -0,0 +1,1015 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+if($phpVer == 5) {
+require_once(".ht-inc/jpgraph/jpgraph.php");
+require_once(".ht-inc/jpgraph/jpgraph_bar.php");
+require_once(".ht-inc/jpgraph/jpgraph_line.php");
+}
+else {
+require_once(".ht-inc/jpgraph.old/jpgraph.php");
+require_once(".ht-inc/jpgraph.old/jpgraph_bar.php");
+require_once(".ht-inc/jpgraph.old/jpgraph_line.php");
+}
+
+/**
+ * \file
+ */
+
+/// global array for x axis labels
+$xaxislabels = array();
+/// signifies an error with the submitted start date
+define("STARTERR", 1);
+/// signifies an error with the submitted end date
+define("ENDERR", 1 << 1);
+/// signifies an error with the start date being after the end date
+define("ORDERERR", 1 << 2);
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn selectStatistics()
+///
+/// \brief prints a form for getting statistics
+///
+////////////////////////////////////////////////////////////////////////////////
+function selectStatistics() {
+ global $submitErr, $viewmode, $user;
+ list($month1, $day1, $year1) = explode(',', date('F,j,Y', time() -
+ (SECINDAY * 6)));
+ list($month2, $day2, $year2) = explode(',', date('F,j,Y', time()));
+ print "<H2>Statistic Information</H2>\n";
+ if($submitErr) {
+ printSubmitErr(STARTERR);
+ printSubmitErr(ENDERR);
+ printSubmitErr(ORDERERR);
+ $monthkey1 = processInputVar("month1", ARG_NUMERIC);
+ $daykey1 = processInputVar("day1", ARG_NUMERIC);
+ $yearkey1 = processInputVar("year1", ARG_NUMERIC);
+ $monthkey2 = processInputVar("month2", ARG_NUMERIC);
+ $daykey2 = processInputVar("day2", ARG_NUMERIC);
+ $yearkey2 = processInputVar("year2", ARG_NUMERIC);
+ $affilid = processInputVar("affilid", ARG_NUMERIC);
+ }
+ else
+ $affilid = $user['affiliationid'];
+ print "Select a starting date:<br>\n";
+ $months = array("",
+ "January",
+ "February",
+ "March",
+ "April",
+ "May",
+ "June",
+ "July",
+ "August",
+ "September",
+ "October",
+ "November",
+ "December");
+ unset($months[0]);
+ $days = array();
+ for($i = 0; $i < 32; $i++) {
+ array_push($days, $i);
+ }
+ unset($days[0]);
+ $years = array();
+ for($i = 2004; $i <= $year2; $i++) {
+ $years[$i] = $i;
+ }
+ if(! $submitErr) {
+ $monthkey1 = array_search($month1, $months);
+ $daykey1 = array_search($day1, $days);
+ $yearkey1 = array_search($year1, $years);
+ }
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ printSelectInput("month1", $months, $monthkey1);
+ printSelectInput("day1", $days, $daykey1);
+ printSelectInput("year1", $years, $yearkey1);
+ print "<br>\n";
+ print "Select a ending date:<br>\n";
+ if(! $submitErr) {
+ $monthkey2 = array_search($month2, $months);
+ $daykey2 = array_search($day2, $days);
+ $yearkey2 = array_search($year2, $years);
+ }
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ printSelectInput("month2", $months, $monthkey2);
+ printSelectInput("day2", $days, $daykey2);
+ printSelectInput("year2", $years, $yearkey2);
+ print "<br>\n";
+ if($viewmode >= ADMIN_FULL) {
+ print "Select an affiliation:<br>\n";
+ $affils = getAffiliations();
+ if(! array_key_exists($affilid, $affils))
+ $affilid = $user['affiliationid'];
+ $affils = array_reverse($affils, TRUE);
+ $affils[0] = "All";
+ $affils = array_reverse($affils, TRUE);
+ printSelectInput("affilid", $affils, $affilid);
+ print "<br>\n";
+ }
+ $cont = addContinuationsEntry('viewstats');
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "<INPUT type=submit value=Submit>\n";
+ print "</FORM>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn viewStatistics
+///
+/// \brief prints statistic information
+///
+////////////////////////////////////////////////////////////////////////////////
+function viewStatistics() {
+ global $submitErr, $submitErrMsg, $user, $viewmode;
+ define("30MIN", 1800);
+ define("1HOUR", 3600);
+ define("2HOURS", 7200);
+ define("4HOURS", 14400);
+ $month1 = processInputVar("month1", ARG_NUMERIC);
+ $day1 = processInputVar("day1", ARG_NUMERIC);
+ $year1 = processInputVar("year1", ARG_NUMERIC);
+ $month2 = processInputVar("month2", ARG_NUMERIC);
+ $day2 = processInputVar("day2", ARG_NUMERIC);
+ $year2 = processInputVar("year2", ARG_NUMERIC);
+ $affilid = processInputVar("affilid", ARG_NUMERIC, $user['affiliationid']);
+
+ $affils = getAffiliations();
+ if($viewmode < ADMIN_FULL ||
+ ($affilid != 0 && ! array_key_exists($affilid, $affils)))
+ $affilid = $user['affiliationid'];
+
+ $start = "$year1-$month1-$day1 00:00:00";
+ $end = "$year2-$month2-$day2 23:59:59";
+ if(! checkdate($month1, $day1, $year1)) {
+ $submitErr |= STARTERR;
+ $submitErrMsg[STARTERR] = "The selected start date is not valid. Please "
+ . "select a valid date.<br>\n";
+ }
+ if(! checkdate($month2, $day2, $year2)) {
+ $submitErr |= ENDERR;
+ $submitErrMsg[ENDERR] = "The selected end date is not valid. Please "
+ . "select a valid date.<br>\n";
+ }
+ if(datetimeToUnix($start) > datetimeToUnix($end)) {
+ $submitErr |= ORDERERR;
+ $submitErrMsg[ORDERERR] = "The selected end date is before the selected "
+ . "start date. Please select an end date equal "
+ . "to or greater than the start date.<br>\n";
+ }
+ if($submitErr) {
+ selectStatistics();
+ return;
+ }
+
+ $timestart = microtime(1);
+ print "<H2>Statistic Information</H2>\n";
+ print "<H3>Reservation information between $month1/$day1/$year1 and ";
+ print "$month2/$day2/$year2:\n";
+ print "</H3>\n";
+ $reloadid = getUserlistID('vclreload');
+ $query = "SELECT l.userid, "
+ . "l.nowfuture, "
+ . "UNIX_TIMESTAMP(l.start) AS start, "
+ . "(UNIX_TIMESTAMP(l.loaded) - UNIX_TIMESTAMP(l.start)) AS loadtime, "
+ . "UNIX_TIMESTAMP(l.finalend) AS finalend, "
+ . "l.wasavailable, "
+ . "l.ending, "
+ . "i.prettyname, "
+ . "o.prettyname AS OS "
+ . "FROM log l, "
+ . "image i, "
+ . "user u, "
+ . "OS o "
+ . "WHERE l.start >= '$start' AND "
+ . "l.finalend <= '$end' AND "
+ . "i.id = l.imageid AND "
+ . "i.OSid = o.id AND "
+ . "l.userid != $reloadid AND ";
+ if($affilid != 0)
+ $query .= "u.affiliationid = $affilid AND ";
+ $query .= "l.userid = u.id "
+ . "ORDER BY i.prettyname";
+ $qh = doQuery($query, 275);
+
+ $totalreservations = 0;
+ $users = array();
+ $nows = 0;
+ $futures = 0;
+ $notavailable = 0;
+ $loadtimes = array("2less" => 0, "2more" => 0);
+ $ending = array("deleted" => 0,
+ "released" => 0,
+ "failed" => 0,
+ "noack" => 0,
+ "nologin" => 0,
+ "timeout" => 0,
+ "EOR" => 0,
+ "none" => 0);
+ $imagecount = array();
+ $imageusers = array();
+ $imagehours = array();
+ $imageload2less = array();
+ $imageload2more = array();
+ $lengths = array("30min" => 0,
+ "1hour" => 0,
+ "2hours" => 0,
+ "4hours" => 0,
+ "4hrsplus" => 0);
+ $totalhours = 0;
+ $osusers = array();
+ while($row = mysql_fetch_assoc($qh)) {
+ if(! array_key_exists($row["prettyname"], $imageload2less))
+ $imageload2less[$row["prettyname"]] = 0;
+ if(! array_key_exists($row["prettyname"], $imageload2more))
+ $imageload2more[$row["prettyname"]] = 0;
+
+ # notavailable
+ if($row["wasavailable"] == 0) {
+ $notavailable++;
+ }
+ else {
+ $totalreservations++;
+
+ # load times
+ if($row['loadtime'] < 120) {
+ $loadtimes['2less']++;
+ # imageload2less
+ $imageload2less[$row['prettyname']]++;
+ }
+ else {
+ $loadtimes['2more']++;
+ # imageload2more
+ $imageload2more[$row['prettyname']]++;
+ }
+ }
+
+ # users
+ $users[$row['userid']] = 1;
+
+ # nowfuture
+ if($row["nowfuture"] == "now")
+ $nows++;
+ else
+ $futures++;
+
+ # ending
+ $ending[$row["ending"]]++;
+
+ # imagecount
+ if(! array_key_exists($row["prettyname"], $imagecount))
+ $imagecount[$row["prettyname"]] = 0;
+ $imagecount[$row["prettyname"]]++;
+
+ # imageusers
+ if(! array_key_exists($row["prettyname"], $imageusers))
+ $imageusers[$row["prettyname"]] = array();
+ $imageusers[$row['prettyname']][$row['userid']] = 1;
+
+ # lengths
+ $length = $row["finalend"] - $row["start"];
+ if($length <= 1800)
+ $lengths["30min"]++;
+ elseif($length <= 3600)
+ $lengths["1hour"]++;
+ elseif($length <= 7200)
+ $lengths["2hours"]++;
+ elseif($length <= 14400)
+ $lengths["4hours"]++;
+ else
+ $lengths["4hrsplus"]++;
+
+ # imagehours
+ if(! array_key_exists($row["prettyname"], $imagehours))
+ $imagehours[$row["prettyname"]] = 0;
+ $imagehours[$row["prettyname"]] += ($length / 3600);
+
+ # total hours
+ $totalhours += ($length / 3600);
+
+ # osusers
+ if(! array_key_exists($row["OS"], $osusers))
+ $osusers[$row["OS"]] = array();
+ $osusers[$row['OS']][$row['userid']] = 1;
+ }
+ print "<DIV align=center>\n";
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TH align=right>Total Reservations:</TH>\n";
+ print " <TD>$totalreservations</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Total Hours Used:</TH>\n";
+ print " <TD>" . (int)$totalhours . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>\"Now\" Reservations:</TH>\n";
+ print " <TD>$nows</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>\"Later\" Reservations:</TH>\n";
+ print " <TD>$futures</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Unavailable:</TH>\n";
+ print " <TD>$notavailable</TD>\n";
+ print " </TR>\n";
+ if($viewmode >= ADMIN_FULL) {
+ print " <TR>\n";
+ print " <TH align=right>Load times < 2 minutes:</TH>\n";
+ print " <TD>{$loadtimes['2less']}</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Load times >= 2 minutes:</TH>\n";
+ print " <TD>{$loadtimes['2more']}</TD>\n";
+ print " </TR>\n";
+ }
+ print " <TR>\n";
+ print " <TH align=right>Total Unique Users:</TH>\n";
+ print " <TD>" . count($users) . "</TD>\n";
+ print " </TR>\n";
+ foreach(array_keys($osusers) as $key) {
+ print " <TR>\n";
+ print " <TH align=right>Unique Users of $key:</TH>\n";
+ print " <TD>" . count($osusers[$key]) . "</TD>\n";
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TD></TD>\n";
+ print " <TH>Reservations</TH>\n";
+ print " <TH>Unique Users</TH>\n";
+ print " <TH>Hours Used</TH>\n";
+ if($viewmode >= ADMIN_FULL) {
+ print " <TH>< 2 min load time</TH>\n";
+ print " <TH>>= 2 min load time</TH>\n";
+ }
+ print " </TR>\n";
+ foreach($imagecount as $key => $value) {
+ print " <TR>\n";
+ print " <TH align=right>$key:</TH>\n";
+ print " <TD align=center>$value</TD>\n";
+ print " <TD align=center>" . count($imageusers[$key]) . "</TD>\n";
+ if(((int)$imagehours[$key]) == 0)
+ print " <TD align=center>1</TD>\n";
+ else
+ print " <TD align=center>" . (int)$imagehours[$key] . "</TD>\n";
+ if($viewmode >= ADMIN_FULL) {
+ print " <TD align=center>{$imageload2less[$key]}</TD>\n";
+ print " <TD align=center>{$imageload2more[$key]}</TD>\n";
+ }
+ print " </TR>\n";
+ }
+ print "</TABLE>\n";
+
+ print "<H3>Durations:</H3>\n";
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TH align=right>0 - 30 Min:</TH>\n";
+ print " <TD>" . $lengths["30min"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>30 Min - 1 Hour:</TH>\n";
+ print " <TD>" . $lengths["1hour"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>1 Hour - 2 Hours:</TH>\n";
+ print " <TD>" . $lengths["2hours"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>2 Hours - 4 Hours:</TH>\n";
+ print " <TD>" . $lengths["4hours"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>> 4 Hours:</TH>\n";
+ print " <TD>" . $lengths["4hrsplus"] . "</TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+
+ print "<H3>Ending information:</H3>\n";
+ print "<TABLE>\n";
+ print " <TR>\n";
+ print " <TH align=right>Deleted:</TH>\n";
+ print " <TD>" . $ending["deleted"] . "</TD>\n";
+ print " <TD rowspan=7><img src=\"images/blank.gif\" width=5></TD>\n";
+ print " <TD>(Future reservation deleted before start time reached)</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Released:</TH>\n";
+ print " <TD>" . $ending["released"] . "</TD>\n";
+ print " <TD>(Reservation released before end time reached)</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Not Acknowledged:</TH>\n";
+ print " <TD>" . $ending["noack"] . "</TD>\n";
+ print " <TD>(\"Connect!\" button never clicked)</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>No Login:</TH>\n";
+ print " <TD>" . $ending["nologin"] . "</TD>\n";
+ print " <TD>(User never logged in)</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>End of Reservation:</TH>\n";
+ print " <TD>" . $ending["EOR"] . "</TD>\n";
+ print " <TD>(End of reservation reached)</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Timed Out:</TH>\n";
+ print " <TD>" . $ending["timeout"] . "</TD>\n";
+ print " <TD>(Disconnect and no reconnection within 15 minutes)</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Failed:</TH>\n";
+ print " <TD>" . $ending["failed"] . "</TD>\n";
+ print " <TD>(Reserved computer failed to get prepared for user)</TD>\n";
+ print " </TR>\n";
+ print "</TABLE>\n";
+ print "<br>\n";
+
+ $unixstart = datetimeToUnix($start);
+ $unixend = datetimeToUnix($end);
+ $start = date('Y-m-d', $unixstart);
+ $end = date('Y-m-d', $unixend);
+ $cdata = array('start' => $start,
+ 'end' => $end,
+ 'affilid' => $affilid);
+ print "<H2>Reservations by Day</H2>\n";
+ $cont = addContinuationsEntry('statgraphday', $cdata);
+ print "<img src=" . BASEURL . SCRIPT . "?continuation=$cont>";
+
+ print "<H2>Max Concurrent Reservations By Day</H2>\n";
+ if($unixend - $unixstart > SECINMONTH)
+ print "(this graph only available for up to a month of data)<br>\n";
+ else {
+ $cont = addContinuationsEntry('statgraphdayconcuruser', $cdata);
+ print "<img src=" . BASEURL . SCRIPT . "?continuation=$cont>";
+ }
+
+ print "<H2>Max Concurrent Blade Reservations By Day</H2>\n";
+ if($unixend - $unixstart > SECINMONTH)
+ print "(this graph only available for up to a month of data)<br>\n";
+ else {
+ $cont = addContinuationsEntry('statgraphdayconcurblade', $cdata);
+ print "<img src=" . BASEURL . SCRIPT . "?continuation=$cont>";
+ }
+
+ print "<H2>Reservations by Hour</H2>\n";
+ print "(Averaged over the time period)<br><br>\n";
+ $cont = addContinuationsEntry('statgraphhour', $cdata);
+ print "<img src=" . BASEURL . SCRIPT . "?continuation=$cont>";
+ print "</div>\n";
+
+ $endtime = microtime(1);
+ $end = $endtime - $timestart;
+ #print "running time: $endtime - $timestart = $end<br>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn sendStatGraphDay()
+///
+/// \brief sends a graph image
+///
+////////////////////////////////////////////////////////////////////////////////
+function sendStatGraphDay() {
+ global $xaxislabels, $inContinuation;
+ if(! $inContinuation)
+ return;
+ $start = getContinuationVar("start");
+ $end = getContinuationVar("end");
+ $affilid = getContinuationVar("affilid");
+ $graphdata = getStatGraphDayData($start, $end, $affilid);
+ $count = count($graphdata["labels"]);
+ if($count < 8)
+ $labelinterval = 1;
+ else
+ $labelinterval = $count / 7;
+ $xaxislabels = $graphdata["labels"];
+ $graph = new Graph(300, 300, "auto");
+ $graph->SetScale("textlin");
+ $plot = new BarPlot($graphdata["points"]);
+ $graph->Add($plot);
+ $graph->xaxis->SetLabelFormatCallback('statXaxisDayCallback');
+ $graph->xaxis->SetLabelAngle(90);
+ $graph->xaxis->SetTextLabelInterval($labelinterval);
+ $graph->yaxis->SetTitle('Reservations with start time on given day',
+ 'high');
+ $graph->SetMargin(40,40,20,80);
+ $graph->Stroke();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getStatGraphDayData($start, $end, $affilid)
+///
+/// \param $start - starting day in YYYY-MM-DD format
+/// \param $end - ending day in YYYY-MM-DD format
+/// \param $affilid - affiliationid of data to gather
+///
+/// \return an array whose keys are the days (in YYYY-MM-DD format) between
+/// $start and $end, inclusive, and whose values are the number of reservations
+/// on each day
+///
+/// \brief queries the log table to get reservations between $start and $end
+/// and creates an array with the number of reservations on each day
+///
+////////////////////////////////////////////////////////////////////////////////
+function getStatGraphDayData($start, $end, $affilid) {
+ $startunix = datetimeToUnix($start . " 00:00:00");
+ $endunix = datetimeToUnix($end . " 23:59:59");
+
+ $data = array();
+ $data["points"] = array();
+ $data["labels"] = array();
+ $reloadid = getUserlistID('vclreload');
+ for($i = $startunix; $i < $endunix; $i += SECINDAY) {
+ array_push($data["labels"], date('Y-m-d', $i));
+ $startdt = unixToDatetime($i);
+ $enddt = unixToDatetime($i + SECINDAY);
+ if($affilid != 0) {
+ $query = "SELECT count(l.id) "
+ . "FROM log l, "
+ . "user u "
+ . "WHERE l.start >= '$startdt' AND "
+ . "l.start < '$enddt' AND "
+ . "l.userid != $reloadid AND "
+ . "l.wasavailable = 1 AND "
+ . "l.userid = u.id AND "
+ . "u.affiliationid = $affilid";
+ }
+ else {
+ $query = "SELECT count(l.id) "
+ . "FROM log l "
+ . "WHERE l.start >= '$startdt' AND "
+ . "l.start < '$enddt' AND "
+ . "l.userid != $reloadid AND "
+ . "l.wasavailable = 1";
+ }
+ $qh = doQuery($query, 295);
+ if($row = mysql_fetch_row($qh))
+ array_push($data["points"], $row[0]);
+ else
+ array_push($data["points"], 0);
+ }
+ return($data);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn statXaxisDayCallback($val)
+///
+/// \param $val - value passed in by SetLabelFormatCallback
+///
+/// \return day of week
+///
+/// \brief formats $val into day of week
+///
+////////////////////////////////////////////////////////////////////////////////
+function statXaxisDayCallback($val) {
+ global $xaxislabels;
+ if(array_key_exists((int)$val, $xaxislabels)) {
+ return date('n/d/Y', datetimeToUnix($xaxislabels[$val] . " 00:00:00")) . " ";
+ }
+ else {
+ return $val;
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn sendStatGraphHour()
+///
+/// \brief sends a graph image
+///
+////////////////////////////////////////////////////////////////////////////////
+function sendStatGraphHour() {
+ global $xaxislabels, $inContinuation;
+ if(! $inContinuation)
+ return;
+ $start = getContinuationVar("start");
+ $end = getContinuationVar("end");
+ $affilid = getContinuationVar("affilid");
+ $graphdata = getStatGraphHourData($start, $end, $affilid);
+ $graph = new Graph(300, 300, "auto");
+ $graph->SetScale("textlin");
+ $plot = new LinePlot($graphdata["points"]);
+ $graph->Add($plot);
+ $graph->xaxis->SetLabelFormatCallback('statXaxisHourCallback');
+ $graph->xaxis->SetLabelAngle(90);
+ $graph->xaxis->SetTextLabelInterval(2);
+ $graph->yaxis->SetTitle('Active reservations during given hour', 'high');
+ $graph->SetMargin(40,40,20,80);
+ $graph->Stroke();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getStatGraphHourData($start, $end, $affilid)
+///
+/// \param $start - starting day in YYYY-MM-DD format
+/// \param $end - ending day in YYYY-MM-DD format
+/// \param $affilid - affiliationid of data to gather
+///
+/// \return an array whose keys are the days (in YYYY-MM-DD format) between
+/// $start and $end, inclusive, and whose values are the number of reservations
+/// on each day
+///
+/// \brief queries the log table to get reservations between $start and $end
+/// and creates an array with the number of reservations on each day
+///
+////////////////////////////////////////////////////////////////////////////////
+function getStatGraphHourData($start, $end, $affilid) {
+ $startdt = $start . " 00:00:00";
+ $enddt = $end . " 23:59:59";
+ $startunix = datetimeToUnix($startdt);
+ $endunix = datetimeToUnix($enddt) + 1;
+ $enddt = unixToDatetime($endunix);
+ $days = ($endunix - $startunix) / SECINDAY;
+
+ $data = array();
+ $data["points"] = array();
+ for($i = 0; $i < 24; $i++) {
+ $data["points"][$i] = 0;
+ }
+
+ $reloadid = getUserlistID('vclreload');
+ if($affilid != 0) {
+ $query = "SELECT DATE_FORMAT(l.start, '%k') AS shour, "
+ . "DATE_FORMAT(l.start, '%i') AS smin, "
+ . "DATE_FORMAT(l.finalend, '%k') AS ehour, "
+ . "DATE_FORMAT(l.finalend, '%i') AS emin "
+ . "FROM log l, "
+ . "user u "
+ . "WHERE l.start < '$enddt' AND "
+ . "l.finalend > '$startdt' AND "
+ . "l.userid != $reloadid AND "
+ . "l.userid = u.id AND "
+ . "l.wasavailable = 1 AND "
+ . "u.affiliationid = $affilid";
+ }
+ else {
+ $query = "SELECT DATE_FORMAT(l.start, '%k') AS shour, "
+ . "DATE_FORMAT(l.start, '%i') AS smin, "
+ . "DATE_FORMAT(l.finalend, '%k') AS ehour, "
+ . "DATE_FORMAT(l.finalend, '%i') AS emin "
+ . "FROM log l "
+ . "WHERE l.start < '$enddt' AND "
+ . "l.finalend > '$startdt' AND "
+ . "l.userid != $reloadid AND "
+ . "l.wasavailable = 1";
+ }
+ $qh = doQuery($query, 296);
+ $count = 0;
+ while($row = mysql_fetch_assoc($qh)) {
+ $startmin = ($row['shour'] * 60) + $row['smin'];
+ $endmin = ($row['ehour'] * 60) + $row['emin'];
+
+ for($binstart = 0, $binend = 60, $binindex = 0;
+ $binend <= 1440;
+ $binstart += 60, $binend += 60, $binindex++) {
+ if($binend <= $startmin)
+ continue;
+ elseif($startmin < $binend &&
+ $endmin > $binstart) {
+ $data["points"][$binindex]++;
+ }
+ elseif($binstart >= $endmin)
+ break;
+ }
+ }
+
+ # comment this to change graph to be aggregate instead of average
+ foreach($data["points"] as $key => $val)
+ $data["points"][$key] = $val / $days;
+
+ return($data);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn statXaxisHourCallback($val)
+///
+/// \param $val - value passed in by SetLabelFormatCallback
+///
+/// \return day of week
+///
+/// \brief formats $val into day of week
+///
+////////////////////////////////////////////////////////////////////////////////
+function statXaxisHourCallback($val) {
+ if($val == 0) {
+ return "12 am ";
+ }
+ elseif($val < 12) {
+ return "$val am ";
+ }
+ elseif($val == 12) {
+ return "$val pm ";
+ }
+ else {
+ return $val - 12 . " pm ";
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn sendStatGraphDayConUsers()
+///
+/// \brief sends a graph image
+///
+////////////////////////////////////////////////////////////////////////////////
+function sendStatGraphDayConUsers() {
+ global $xaxislabels, $inContinuation;
+ if(! $inContinuation)
+ return;
+ $start = getContinuationVar("start");
+ $end = getContinuationVar("end");
+ $affilid = getContinuationVar("affilid");
+ $graphdata = getStatGraphDayConUsersData($start, $end, $affilid);
+ $count = count($graphdata["labels"]);
+ if($count < 8)
+ $labelinterval = 1;
+ else
+ $labelinterval = $count / 7;
+ $xaxislabels = $graphdata["labels"];
+ $graph = new Graph(300, 300, "auto");
+ $graph->SetScale("textlin");
+ $plot = new BarPlot($graphdata["points"]);
+ $graph->Add($plot);
+ $graph->xaxis->SetLabelFormatCallback('statXaxisDayConUsersCallback');
+ $graph->xaxis->SetLabelAngle(90);
+ $graph->xaxis->SetTextLabelInterval($labelinterval);
+ $graph->yaxis->SetTitle('Maximum concurrent reservations per day',
+ 'high');
+ $graph->SetMargin(40,40,20,80);
+ $graph->Stroke();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getStatGraphDayConUsersData($start, $end, $affilid)
+///
+/// \param $start - starting day in YYYY-MM-DD format
+/// \param $end - ending day in YYYY-MM-DD format
+/// \param $affilid - affiliationid of data to gather
+///
+/// \return an array whose keys are the days (in YYYY-MM-DD format) between
+/// $start and $end, inclusive, and whose values are the max concurrent users
+/// on each day
+///
+/// \brief queries the log table to get reservations between $start and $end
+/// and creates an array with the max concurrent users per day
+///
+////////////////////////////////////////////////////////////////////////////////
+function getStatGraphDayConUsersData($start, $end, $affilid) {
+ $startdt = $start . " 00:00:00";
+ $enddt = $end . " 23:59:59";
+ $startunix = datetimeToUnix($startdt);
+ $endunix = datetimeToUnix($enddt) + 1;
+ $days = ($endunix - $startunix) / SECINDAY;
+
+ $data = array();
+ $data["points"] = array();
+ $data["labels"] = array();
+
+ $reloadid = getUserlistID('vclreload');
+ for($daystart = $startunix; $daystart < $endunix; $daystart += SECINDAY) {
+ array_push($data["labels"], date('Y-m-d', $daystart));
+ $count = array();
+ for($j = 0; $j < 24; $j++) {
+ $count[$j] = 0;
+ }
+
+ $startdt = unixToDatetime($daystart);
+ $enddt = unixToDatetime($daystart + SECINDAY);
+ if($affilid != 0) {
+ $query = "SELECT UNIX_TIMESTAMP(l.start) AS start, "
+ . "UNIX_TIMESTAMP(l.finalend) AS end "
+ . "FROM log l, "
+ . "user u "
+ . "WHERE l.start < '$enddt' AND "
+ . "l.finalend > '$startdt' AND "
+ . "l.userid != $reloadid AND "
+ . "l.userid = u.id AND "
+ . "u.affiliationid = $affilid";
+ }
+ else {
+ $query = "SELECT UNIX_TIMESTAMP(l.start) AS start, "
+ . "UNIX_TIMESTAMP(l.finalend) AS end "
+ . "FROM log l "
+ . "WHERE l.start < '$enddt' AND "
+ . "l.finalend > '$startdt' AND "
+ . "l.userid != $reloadid";
+ }
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_assoc($qh)) {
+ $unixstart = $row["start"];
+ $unixend = $row["end"];
+ for($binstart = $daystart, $binend = $daystart + 3600, $binindex = 0;
+ $binstart <= $unixend && $binend <= ($daystart + SECINDAY);
+ $binstart += 3600, $binend += 3600, $binindex++) {
+ if($binend <= $unixstart) {
+ continue;
+ }
+ elseif($unixstart < $binend &&
+ $unixend > $binstart) {
+ $count[$binindex]++;
+ }
+ elseif($binstart >= $unixend) {
+ break;
+ }
+ }
+ }
+ rsort($count);
+ array_push($data["points"], $count[0]);
+ }
+ return($data);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn statXaxisDayConUsersCallback($val)
+///
+/// \param $val - value passed in by SetLabelFormatCallback
+///
+/// \return day of week
+///
+/// \brief formats $val into day of week
+///
+////////////////////////////////////////////////////////////////////////////////
+function statXaxisDayConUsersCallback($val) {
+ global $xaxislabels;
+ if(array_key_exists((int)$val, $xaxislabels)) {
+ return date('n/d/Y', datetimeToUnix($xaxislabels[$val] . " 00:00:00")) . " ";
+ }
+ else {
+ return $val;
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn sendStatGraphConBladeUser()
+///
+/// \brief sends a graph image of max concurrent users of blades per day
+///
+////////////////////////////////////////////////////////////////////////////////
+function sendStatGraphConBladeUser() {
+ global $xaxislabels, $inContinuation;
+ if(! $inContinuation)
+ return;
+ $start = getContinuationVar("start");
+ $end = getContinuationVar("end");
+ $affilid = getContinuationVar("affilid");
+ $graphdata = getStatGraphConBladeUserData($start, $end, $affilid);
+ $count = count($graphdata["labels"]);
+ if($count < 8)
+ $labelinterval = 1;
+ else
+ $labelinterval = $count / 7;
+ $xaxislabels = $graphdata["labels"];
+ $graph = new Graph(300, 300, "auto");
+ $graph->SetScale("textlin");
+ $plot = new BarPlot($graphdata["points"]);
+ $graph->Add($plot);
+ $graph->xaxis->SetLabelFormatCallback('statXaxisDayConUsersCallback');
+ $graph->xaxis->SetLabelAngle(90);
+ $graph->xaxis->SetTextLabelInterval($labelinterval);
+ $graph->yaxis->SetTitle('Maximum concurrent reservations per day',
+ 'high');
+ $graph->SetMargin(40,40,20,80);
+ $graph->Stroke();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getStatGraphConBladeUserData($start, $end, $affilid)
+///
+/// \param $start - starting day in YYYY-MM-DD format
+/// \param $end - ending day in YYYY-MM-DD format
+/// \param $affilid - affiliationid of data to gather
+///
+/// \return an array whose keys are the days (in YYYY-MM-DD format) between
+/// $start and $end, inclusive, and whose values are the max concurrent users
+/// of blades on each day
+///
+/// \brief queries the log table to get reservations between $start and $end
+/// and creates an array with the max concurrent users of blades per day
+///
+////////////////////////////////////////////////////////////////////////////////
+function getStatGraphConBladeUserData($start, $end, $affilid) {
+ $startdt = $start . " 00:00:00";
+ $enddt = $end . " 23:59:59";
+ $startunix = datetimeToUnix($startdt);
+ $endunix = datetimeToUnix($enddt) + 1;
+ $days = ($endunix - $startunix) / SECINDAY;
+
+ $data = array();
+ $data["points"] = array();
+ $data["labels"] = array();
+
+ $reloadid = getUserlistID('vclreload');
+ for($daystart = $startunix; $daystart < $endunix; $daystart += SECINDAY) {
+ array_push($data["labels"], date('Y-m-d', $daystart));
+ $count = array();
+ for($j = 0; $j < 24; $j++) {
+ $count[$j] = 0;
+ }
+ $startdt = unixToDatetime($daystart);
+ $enddt = unixToDatetime($daystart + SECINDAY);
+ if($affilid != 0) {
+ $query = "SELECT l.start AS start, "
+ . "l.finalend AS end "
+ . "FROM log l, "
+ . "sublog s, "
+ . "computer c, "
+ . "user u "
+ . "WHERE l.userid = u.id AND "
+ . "l.start < '$enddt' AND "
+ . "l.finalend > '$startdt' AND "
+ . "s.logid = l.id AND "
+ . "s.computerid = c.id AND "
+ . "l.wasavailable = 1 AND "
+ . "c.type = 'blade' AND "
+ . "l.userid != $reloadid AND "
+ . "u.affiliationid = $affilid";
+ }
+ else {
+ $query = "SELECT l.start AS start, "
+ . "l.finalend AS end "
+ . "FROM log l, "
+ . "sublog s, "
+ . "computer c "
+ . "WHERE l.start < '$enddt' AND "
+ . "l.finalend > '$startdt' AND "
+ . "s.logid = l.id AND "
+ . "s.computerid = c.id AND "
+ . "l.wasavailable = 1 AND "
+ . "c.type = 'blade' AND "
+ . "l.userid != $reloadid";
+ }
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_assoc($qh)) {
+ $unixstart = datetimeToUnix($row["start"]);
+ $unixend = datetimeToUnix($row["end"]);
+ for($binstart = $daystart, $binend = $daystart + 3600, $binindex = 0;
+ $binstart <= $unixend && $binend <= ($daystart + SECINDAY);
+ $binstart += 3600, $binend += 3600, $binindex++) {
+ if($binend <= $unixstart) {
+ continue;
+ }
+ elseif($unixstart < $binend &&
+ $unixend > $binstart) {
+ $count[$binindex]++;
+ }
+ elseif($binstart >= $unixend) {
+ break;
+ }
+ }
+ }
+ rsort($count);
+ array_push($data["points"], $count[0]);
+ }
+ return($data);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn statXaxisConBladeUserCallback($val)
+///
+/// \param $val - value passed in by SetLabelFormatCallback
+///
+/// \return day of week
+///
+/// \brief formats $val into day of week
+///
+////////////////////////////////////////////////////////////////////////////////
+function statXaxisConBladeUserCallback($val) {
+ global $xaxislabels;
+ if(array_key_exists((int)$val, $xaxislabels)) {
+ return date('n/d/Y', datetimeToUnix($xaxislabels[$val] . " 00:00:00")) . " ";
+ }
+ else {
+ return $val;
+ }
+}
+?>
diff --git a/web/.ht-inc/userpreferences.php b/web/.ht-inc/userpreferences.php
new file mode 100644
index 0000000..e341519
--- /dev/null
+++ b/web/.ht-inc/userpreferences.php
@@ -0,0 +1,564 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+/**
+ * \file
+ */
+
+/// signifies an error with submitted preferred name
+define("PREFNAMEERR", 1);
+/// signifies an error with submitted width
+define("WIDTHERR", 1 << 1);
+/// signifies an error with submitted height
+define("HEIGHTERR", 1 << 2);
+/// signifies an error with submitted viewasuser id
+define("VIEWASUSERERR", 1 << 3);
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn userpreferences()
+///
+/// \brief prints a page for a user to edit his preferences
+///
+////////////////////////////////////////////////////////////////////////////////
+function userpreferences() {
+ global $user, $submitErr, $viewmode, $mode;
+ if($submitErr) {
+ $data = processUserPrefsInput(0);
+ $data['affiliation'] = $user['affiliation'];
+ }
+ else {
+ $data = $user;
+ if($data["width"] == 0)
+ $data["resolution"] = "Full Screen";
+ else
+ $data["resolution"] = $user["width"] . "x" . $user["height"];
+ }
+
+ $adminleveldeveloper = 0;
+ if(array_key_exists('WRAP_USERID', $_SERVER)) {
+ $testid = getAffiliationID("NCSU");
+ if(! empty($testid)) {
+ $testuser = getUserInfo("{$_SERVER['WRAP_USERID']}@NCSU");
+ if($testuser['adminlevelid'] == ADMIN_DEVELOPER)
+ $adminleveldeveloper = 1;
+ }
+ }
+
+
+ print "<H2 align=center>User Preferences</H2>\n";
+ print "<div align=center id=status class=visible>\n";
+ if($mode == "submituserprefs") {
+ print "<font color=green>User preferences successfully updated</font><br>\n";
+ }
+ print "</div>\n";
+ print "<table id=layouttable summary=\"\">\n";
+ print " <TR>\n";
+ print " <TD>\n";
+ print " <div id=preflinks class=hidden>\n";
+ print " <ul class=preferenceslist>\n";
+ print " <li><a href=#personal onclick=\"";
+ print "show('personal'); return false;\">Personal Information</a>";
+ print "</li>\n";
+ print " <li><a href=#rdpfile onclick=\"";
+ print "show('rdpfile'); return false;\">RDP File Preferences</a>";
+ print "</li>\n";
+ print " <li><a href=#uiprefs onclick=\"javascript:show('uiprefs'); ";
+ print "return false\">General Preferences</a></li>\n";
+ if($adminleveldeveloper) {
+ print " <li><a href=#viewmode onclick=\"javascript:";
+ print "show('viewmode'); return false\">View Mode</a></li>\n";
+ }
+ print " </ul>\n";
+ print " </div>\n";
+ print " </TD>\n";
+ print " <TD rowspan=2 width=50px></TD>\n";
+ print " <TD rowspan=2>\n";
+ print " <fieldset id=personal class=shown>\n";
+ print " <legend>Personal</legend>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <table summary=\"displays your personal information\">\n";
+ print " <TR>\n";
+ print " <TH align=right>First Name<a href=#updateinfo>*</a>:</TH>\n";
+ print " <TD>" . $user["firstname"] . "</TD>\n";
+ print " <TD></TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Middle Name<a href=#updateinfo>*</a>:</TH>\n";
+ print " <TD>" . $user["middlename"] . "</TD>\n";
+ print " <TD></TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Last Name<a href=#updateinfo>*</a>:</TH>\n";
+ print " <TD>" . $user["lastname"] . "</TD>\n";
+ print " <TD></TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Preferred Name:</TH>\n";
+ print " <TD><label class=hidden for=preferredname>Preferred Name</label>\n";
+ print " <INPUT type=text name=preferredname maxlength=100 ";
+ print "size=15 value=\"" . $data["preferredname"] . "\"></TD>\n";
+ print " <TD>";
+ printSubmitErr(PREFNAMEERR);
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Email Address<a href=#updateinfo>*</a>:</TH>\n";
+ print " <TD>" . $user["email"] . "</TD>\n";
+ print " <TD></TD>\n";
+ print " </TR>\n";
+ print " </table>\n";
+ $updateText = getAffiliationDataUpdateText($user['affiliationid']);
+ print "<a name=updateinfo></a>{$updateText[$user['affiliationid']]}";
+ print "<br><br>\n";
+ $cont = addContinuationsEntry('confirmpersonalprefs', array(), SECINDAY, 1, 1, 1);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <div align=center>\n";
+ print " <INPUT type=submit value=\"Submit Changes\">\n";
+ print " </div>\n";
+ print " </FORM>\n";
+ print " </fieldset>\n";
+
+ print " <fieldset id=rdpfile class=visible>\n";
+ print " <legend>RDP</legend>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print " <table summary=\"lists adjustable preferences for the RDP ";
+ print "file that is sent when you click the Get RDP File button on the ";
+ print "Connect! page\">\n";
+ print " <TR>\n";
+ print " <TD colspan=3><small>Try decreasing <em>Resolution</em> or <em>";
+ print "Color Depth</em> to<br>speed up your connection if things seem ";
+ print "slow<br>when connected to a remote computer.</small></TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Resolution:</TH>\n";
+ $resolutionArray = array("Full Screen" => "Full Screen",
+ "1920x1440" => "1920x1440",
+ "1600x1200" => "1600x1200",
+ "1280x1024" => "1280x1024",
+ "1152x864" => "1152x864",
+ "1024x768" => "1024x768",
+ "800x600" => "800x600",
+ "640x480" => "640x480",
+ "1680x1050" => "1680x1050",
+ "1600x1024" => "1600x1024",
+ "1440x900" => "1440x900",
+ "1280x854" => "1280x854",
+ "1280x768" => "1280x768",
+ "1024x576" => "1024x576");
+ print " <TD>\n";
+ printSelectInput("resolution", $resolutionArray, $data["resolution"]);
+ print " </TD>\n";
+ print " <TD></TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Color Depth:</TH>\n";
+ print " <TD>\n";
+ #$colordepth = array("8" => "8", "16" => "16", "24" => "24");
+ $colordepth = array("8" => "8", "16" => "16", "24" => "24", "32" => "32 (Vista only)");
+ printSelectInput("bpp", $colordepth, $data["bpp"]);
+ print " </TD>\n";
+ print " <TD></TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Audio:</TH>\n";
+ print " <TD>\n";
+ $audio = array("none" => "None", "local" => "Use my speakers");
+ printSelectInput("audiomode", $audio, $data["audiomode"]);
+ print " </TD>\n";
+ print " <TD></TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Map Local Drives:</TH>\n";
+ print " <TD>\n";
+ $yesno = array(1 => "Yes", 0 => "No");
+ printSelectInput("mapdrives", $yesno, $data["mapdrives"]);
+ print " </TD>\n";
+ print " <TD></TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Map Local Printers:</TH>\n";
+ print " <TD>\n";
+ printSelectInput("mapprinters", $yesno, $data["mapprinters"]);
+ print " </TD>\n";
+ print " <TD></TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Map Local Serial Ports:</TH>\n";
+ print " <TD>\n";
+ printSelectInput("mapserial", $yesno, $data["mapserial"]);
+ print " </TD>\n";
+ print " <TD></TD>\n";
+ print " </TR>\n";
+ print " </table>\n";
+ $cont = addContinuationsEntry('confirmrdpprefs', array(), SECINDAY, 1, 1, 1);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <div align=center>\n";
+ print " <INPUT type=submit value=\"Submit Changes\">\n";
+ print " </div>\n";
+ print " </FORM>\n";
+ print " </fieldset>\n";
+
+ print " <div id=uiprefs class=visible>\n";
+ print " <fieldset>\n";
+ print " <legend>General Preferences</legend>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array();
+ if(in_array("userGrant", $user["privileges"])) {
+ if($user['showallgroups']) {
+ $selected['affiliation'] = '';
+ $selected['allgroups'] = 'checked';
+ }
+ else {
+ $selected['affiliation'] = 'checked';
+ $selected['allgroups'] = '';
+ }
+ print " <p>View User Groups:<br>\n";
+ print " <INPUT type=radio id=r1 name=groupview value=affiliation ";
+ print "{$selected['affiliation']}><label for=r1>matching my affiliation";
+ print "</label><br>\n";
+ print " <INPUT type=radio id=r2 name=groupview value=allgroups ";
+ print "{$selected['allgroups']}><label for=r2>from all affiliations";
+ print "</label></p>\n";
+ }
+ else
+ $cdata['groupview'] = 'affiliation';
+ if($user['emailnotices']) {
+ $selected['enabled'] = 'checked';
+ $selected['disabled'] = '';
+ }
+ else {
+ $selected['enabled'] = '';
+ $selected['disabled'] = 'checked';
+ }
+ print " <p>Send email notifications about reservations:<br>\n";
+ print " <INPUT type=radio id=r3 name=emailnotify value=2 ";
+ print "{$selected['enabled']}><label for=r3>Enabled";
+ print "</label><br>\n";
+ print " <INPUT type=radio id=r4 name=emailnotify value=1 ";
+ print "{$selected['disabled']}><label for=r4>Disabled";
+ print "</label></p>\n";
+ $cont = addContinuationsEntry('submitgeneralprefs', $cdata, SECINDAY, 1, 0);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=\"Submit General Preferences\">\n";
+ print " </FORM>\n";
+ print " </fieldset>\n";
+ print " </div>\n";
+ print " <div id=viewmode class=visible>\n";
+ if($adminleveldeveloper) {
+ print " <fieldset>\n";
+ print " <legend>View Mode</legend>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ if($viewmode == ADMIN_FULL) {
+ $selected[ADMIN_NONE] = "";
+ $selected[ADMIN_FULL] = "checked";
+ $selected[ADMIN_DEVELOPER] = "";
+ }
+ elseif($viewmode == ADMIN_DEVELOPER) {
+ $selected[ADMIN_NONE] = "";
+ $selected[ADMIN_FULL] = "";
+ $selected[ADMIN_DEVELOPER] = "checked";
+ }
+ else {
+ $selected[ADMIN_NONE] = "checked";
+ $selected[ADMIN_FULL] = "";
+ $selected[ADMIN_DEVELOPER] = "";
+ }
+ if($user["adminlevelid"] != ADMIN_NONE) {
+ print " <p>View site as:<br>\n";
+ print " <INPUT type=radio name=viewmode value=" . ADMIN_NONE . " ";
+ print $selected[ADMIN_NONE] . ">Normal User<br>\n";
+ if($user["adminlevel"] == "full" || $user["adminlevel"] == "developer") {
+ print " <INPUT type=radio name=viewmode value=" . ADMIN_FULL . " ";
+ print $selected[ADMIN_FULL] . ">Admin Level<br>\n";
+ }
+ if($user["adminlevel"] == "developer") {
+ print " <INPUT type=radio name=viewmode value=" . ADMIN_DEVELOPER . " ";
+ print $selected[ADMIN_DEVELOPER] . ">Developer Level<br>\n";
+ }
+ print " </p>\n";
+ }
+ print " View As User: <INPUT type=text name=viewasuser ";
+ if(! array_key_exists('unityid', $data))
+ print "size=20 value=\"{$user["unityid"]}@{$user['affiliation']}\">\n";
+ else
+ print "size=20 value=\"{$data["unityid"]}@{$data['affiliation']}\">\n";
+ printSubmitErr(VIEWASUSERERR);
+ print "<br>\n";
+ $cont = addContinuationsEntry('submitviewmode', array(), SECINDAY, 1, 0);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=\"Submit View Mode\">\n";
+ print " </FORM>\n";
+ print " </fieldset>\n";
+ }
+ print " </div>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</table>\n";
+ printUserprefJavascript();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn confirmUserPrefs($type)
+///
+/// \param $type - 0 for personal prefs, 1 for rdp prefs
+///
+/// \brief prints a page for user to confirm changes to preferences
+///
+////////////////////////////////////////////////////////////////////////////////
+function confirmUserPrefs($type) {
+ global $submitErr;
+
+ $data = processUserPrefsInput(1);
+
+ if($submitErr) {
+ userpreferences();
+ return;
+ }
+
+ if($data["audiomode"] == "none")
+ $audio = "None";
+ else
+ $audio = "Use my speakers";
+ if($data["mapdrives"] == 0)
+ $drives = "No";
+ else
+ $drives = "Yes";
+ if($data["mapprinters"] == 0)
+ $printers = "No";
+ else
+ $printers = "Yes";
+ if($data["mapserial"] == 0)
+ $serial = "No";
+ else
+ $serial = "Yes";
+
+ print "<DIV align=center>\n";
+ if($type == 0) {
+ print "<H2>Personal Information</H2>\n";
+ print "<H3>Submit the following changes?</H3>\n";
+ print "<table>\n";
+ print " <TR>\n";
+ print " <TH align=right>Preferred Name:</TH>\n";
+ print " <TD>" . $data["preferredname"] . "</TD>\n";
+ print " </TR>\n";
+ print "</table>\n";
+ }
+ elseif($type == 1) {
+ print "<H2>RDP File Preferences</H2>\n";
+ print "<H3>Submit the following changes?</H3>\n";
+ print "<table>\n";
+ print " <TR>\n";
+ print " <TH align=right>Resolution:</TH>\n";
+ print " <TD>" . $data["resolution"] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Color Depth:</TH>\n";
+ $colordepth = array("8" => "8", "16" => "16", "24" => "24", "32" => "32 (Vista only)");
+ print " <TD>" . $colordepth[$data["bpp"]] . "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Audio:</TH>\n";
+ print " <TD>$audio</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Map Local Drives:</TH>\n";
+ print " <TD>$drives</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Map Local Printers:</TH>\n";
+ print " <TD>$printers</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TH align=right>Map Local Serial Ports:</TH>\n";
+ print " <TD>$serial</TD>\n";
+ print " </TR>\n";
+ print "</table>\n";
+ }
+ print "<table>\n";
+ print " <TR>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry('submituserprefs', $data, SECINWEEK, 0, 0);
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Submit>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " <TD>\n";
+ print " <FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry('userpreferences');
+ print " <INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print " <INPUT type=submit value=Cancel>\n";
+ print " </FORM>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</table>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitUserPrefs()
+///
+/// \brief updates user prefs and prints a page informing the user of success
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitUserPrefs() {
+ global $user;
+ $data = getContinuationVar();
+ if($data["resolution"] == "Full Screen") {
+ $width = 0;
+ $height = 0;
+ }
+ else
+ list($width, $height) = explode('x', $data["resolution"]);
+ if(updateUserPrefs($user['id'], $data["preferredname"], $width, $height,
+ $data["bpp"], $data["audiomode"], $data["mapdrives"],
+ $data["mapprinters"], $data["mapserial"])) {
+ }
+ $user = getUserInfo($user["id"]);
+ $_SESSION['user'] = $user;
+ userpreferences();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitGeneralPreferences()
+///
+/// \brief updates user general preferences and calls userpreferences
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitGeneralPreferences() {
+ global $user, $HTMLheader, $printedHTMLheader, $mode, $viewmode;
+ $groupview = getContinuationVar('groupview', processInputVar('groupview', ARG_STRING));
+ $emailnotify = processInputVar('emailnotify', ARG_NUMERIC);
+ if($groupview != 'affiliation' && $groupview != 'allgroups') {
+ $printedHTMLheader = 1;
+ print $HTMLheader;
+ userpreferences();
+ return;
+ }
+ if($emailnotify != 1 && $emailnotify != 2) {
+ $printedHTMLheader = 1;
+ print $HTMLheader;
+ userpreferences();
+ return;
+ }
+ if(($groupview == 'allgroups' && $user['showallgroups'] == 0) ||
+ ($groupview == 'affiliation' && $user['showallgroups'] == 1)) {
+ if($groupview == 'allgroups')
+ $value = 1;
+ else
+ $value = 0;
+ $query = "UPDATE user SET showallgroups = $value WHERE id = {$user['id']}";
+ doQuery($query, 101);
+ $_SESSION['user']['showallgroups'] = $value;
+ $user['showallgroups'] = $value;
+ }
+ if(($user['emailnotices'] == 1 && $emailnotify == 1) ||
+ ($user['emailnotices'] == 0 && $emailnotify == 2)) {
+ $newval = $emailnotify - 1;
+ $query = "UPDATE user SET emailnotices = $newval WHERE id = {$user['id']}";
+ doQuery($query, 101);
+ $_SESSION['user']['emailnotices'] = $newval;
+ $user['emailnotices'] = $newval;
+ }
+ print $HTMLheader;
+ $printedHTMLheader = 1;
+ $mode = 'submituserprefs';
+ # FIXME might need to clear some cache items for cached lists of groups
+ userpreferences();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn processUserPrefsInput($checks)
+///
+/// \param $checks - (optional) 1 to perform validation, 0 not to
+///
+/// \return an array with the following indexes:\n
+/// preferredname, resolution, bpp, audiomode, mapdrives, mapprinters,
+/// mapserial, unityid
+///
+/// \brief validates input from the previous form; if anything was improperly
+/// submitted, sets submitErr and submitErrMsg
+///
+////////////////////////////////////////////////////////////////////////////////
+function processUserPrefsInput($checks=1) {
+ global $submitErr, $submitErrMsg, $user;
+ $return = array();
+
+ $defaultres = $user["width"] . 'x' . $user["height"];
+ $return["preferredname"] = processInputVar("preferredname" , ARG_STRING, $user["preferredname"]);
+ $return["resolution"] = processInputVar("resolution" , ARG_STRING, $defaultres);
+ $return["bpp"] = processInputVar("bpp" , ARG_NUMERIC, $user["bpp"]);
+ $return["audiomode"] = processInputVar("audiomode" , ARG_STRING, $user["audiomode"]);
+ $return["mapdrives"] = processInputVar("mapdrives" , ARG_NUMERIC, $user["mapdrives"]);
+ $return["mapprinters"] = processInputVar("mapprinters" , ARG_NUMERIC, $user["mapprinters"]);
+ $return["mapserial"] = processInputVar("mapserial" , ARG_NUMERIC, $user["mapserial"]);
+ if(array_key_exists('WRAP_USERID', $_SERVER) && ($user['unityid'] != $_SERVER["WRAP_USERID"]))
+ $return["unityid"] = processInputVar("viewasuser" , ARG_STRING, "{$user["unityid"]}@{$user['affiliation']}");
+ else
+ $return['unityid'] = "{$user['unityid']}@{$user['affiliation']}";
+
+ if(! $checks) {
+ return $return;
+ }
+
+ if(strlen($return["preferredname"]) > 25) {
+ $submitErr |= PREFNAMEERR;
+ $submitErrMsg[PREFNAMEERR] = "Preferred name can only be up to 25 characters";
+ }
+ if(! ereg('^[a-zA-Z ]*$', $return["preferredname"])) {
+ $submitErr |= PREFNAMEERR;
+ $submitErrMsg[PREFNAMEERR] = "Preferred name can only contain letters and spaces";
+ }
+ if(array_key_exists('unityid', $return) &&
+ ! validateUserid($return['unityid'])) {
+ $submitErr |= VIEWASUSERERR;
+ $submitErrMsg[VIEWASUSERERR] = "Invalid user id";
+ }
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn printUserprefJavascript()
+///
+/// \brief prints javascript used in user preferences page
+///
+////////////////////////////////////////////////////////////////////////////////
+function printUserprefJavascript() {
+ print <<<HTMLdone
+<script type="text/javascript">
+function show(id) {
+ document.getElementById("personal").className = "hidden";
+ document.getElementById("rdpfile").className = "hidden";
+ document.getElementById("uiprefs").className = "hidden";
+ document.getElementById("viewmode").className = "hidden";
+ document.getElementById("status").className = "hidden";
+ document.getElementById(id).className = "shown";
+}
+show("personal");
+document.getElementById("preflinks").className = "shown";
+document.getElementById("status").className = "visible";
+</script>
+
+HTMLdone;
+}
+?>
diff --git a/web/.ht-inc/utils.php b/web/.ht-inc/utils.php
new file mode 100644
index 0000000..6d07388
--- /dev/null
+++ b/web/.ht-inc/utils.php
@@ -0,0 +1,8893 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+require_once(".ht-inc/secrets.php");
+@include_once("itecsauth/itecsauth.php");
+require_once(".ht-inc/authentication.php");
+if(file_exists(".ht-inc/vcldocs.php"))
+ require_once(".ht-inc/vcldocs.php");
+
+/**
+ * \file
+ */
+
+/// used for processInputVar, means the input variable should be numeric
+define("ARG_NUMERIC", 1);
+/// used for processInputVar, means the input variable should be a string
+define("ARG_STRING", 1 << 1);
+/// used for processInputVar, means the input variable should be an array of numbers
+define("ARG_MULTINUMERIC", 1 << 2);
+/// used for processInputVar, means the input variable should be an array of strings
+define("ARG_MULTISTRING", 1 << 3);
+/// define adminlevel developer
+define("ADMIN_DEVELOPER", 3);
+/// define adminlevel full
+define("ADMIN_FULL", 2);
+/// define adminlevel none
+define("ADMIN_NONE", 1);
+/// define semaphore key
+define("SEMKEY", 192365819256598);
+
+
+/// global array used to hold request information between calling isAvailable
+/// and addRequest
+$requestInfo = array();
+#$requestInfo["freeComputerids"] = array();
+#$requestInfo["imageids"] = array();
+
+/// global array to cache arrays of node parents for getNodeParents
+$nodeparents = array();
+/// global array to cache arrays of node children for getNodeChildren
+$nodechildren = array();
+/// global variable to store what needs to be printed in printHTMLHeader
+$HTMLheader = "";
+/// global variable to store if header has been printed
+$printedHTMLheader = 0;
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn initGlobals()
+///
+/// \brief this is where globals get initialized
+///
+////////////////////////////////////////////////////////////////////////////////
+function initGlobals() {
+ global $mode, $user, $remoteIP, $authed, $oldmode, $viewmode, $semid;
+ global $semislocked, $days, $phpVer, $keys, $pemkey, $AUTHERROR;
+ global $passwdArray, $skin, $contdata, $lastmode, $inContinuation;
+ global $totalQueries, $ERRORS, $queryTimes, $actions;
+
+ define("SECINDAY", 86400);
+ define("SECINWEEK", 604800);
+ define("SECINMONTH", 2678400);
+ define("SECINYEAR", 31536000);
+ $mode = processInputVar("mode", ARG_STRING, 'main');
+ $totalQueries = 0;
+ $inContinuation = 0;
+ $contdata = array();
+ $queryTimes = array();
+ $contuserid = '';
+ $continuation = processInputVar('continuation', ARG_STRING);
+ if(! empty($continuation)) {
+ # TODO handle AJ errors
+ $tmp = getContinuationsData($continuation);
+ if(empty($tmp))
+ abort(11);
+ elseif(array_key_exists('error', $tmp)) {
+ $mode = "continuationsError";
+ $contdata = $tmp;
+ }
+ else {
+ $inContinuation = 1;
+ $contuserid = $tmp['userid'];
+ $lastmode = $tmp['frommode'];
+ $mode = $tmp['nextmode'];
+ $contdata = $tmp['data'];
+ }
+ }
+ $submitErr = 0;
+ $submitErrMsg = array();
+ $remoteIP = $_SERVER["REMOTE_ADDR"];
+ $days = array('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday');
+ $phpVerArr = explode('.', phpversion());
+ $phpVer = $phpVerArr[0];
+ if($phpVer == 5)
+ require_once(".ht-inc/php5extras.php");
+
+ $passwdArray = array('A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K',
+ 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V',
+ 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd', 'e', 'f', 'g',
+ 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r',
+ 's', 't', 'u', 'v', 'w', 'x', 'y', 'z', '1', '2', '3',
+ '4', '5', '6', '7', '8', '9', '0');
+
+ if(array_key_exists('VCLAUTH', $_COOKIE) || $mode == 'submitLogin') {
+ // open keys
+ $fp = fopen(".ht-inc/keys.pem", "r");
+ $key = fread($fp, 8192);
+ fclose($fp);
+ $keys["private"] = openssl_pkey_get_private($key, $pemkey);
+ if(! $keys['private'])
+ abort(6);
+ $fp = fopen(".ht-inc/pubkey.pem", "r");
+ $key = fread($fp, 8192);
+ fclose($fp);
+ $keys["public"] = openssl_pkey_get_public($key);
+ if(! $keys['public'])
+ abort(7);
+ }
+
+ # USING A SINGLE USER WITHOUT LOGGING IN:
+ # to automatically log in to vcl with the same user
+ # every time, comment out from this comment block to
+ # the 'end auth check' comment, then, right after
+ # that, set $authed = 1 and $userid to the id from
+ # the user table corresponding to the user you want
+ # logged in
+
+ $authed = 0;
+ # check for being logged in to WRAP or ITECSAUTH
+ if/*(array_key_exists("WRAP_AFFIL", $_SERVER) &&
+ $_SERVER["WRAP_AFFIL"] == "ncsu.edu" &&
+ $_SERVER['WRAP_USERID'] != 'Guest') {
+ $authed = 1;
+ $userid = "{$_SERVER["WRAP_USERID"]}@NCSU";
+ }
+ elseif(array_key_exists("ITECSAUTH", $_COOKIE)) {
+ $authdata = authUser();
+ if(! ($error = getAuthError())) {
+ $authed = 1;
+ $userid = "{$authdata["email"]}@ITECS";
+ }
+ }
+ elseif*/(array_key_exists("VCLAUTH", $_COOKIE)) {
+ $userid = readAuthCookie();
+ if(! is_null($userid))
+ $authed = 1;
+ }
+ # end auth check
+
+ if($authed && $mode == 'selectauth')
+ $mode = 'home';
+
+ if(! $authed) {
+ # set $skin based on cookie (so it gets set before user logs in
+ # later, we set it by affiliation (helps with 'view as user')
+ if(preg_match('/^152\.9\./', $_SERVER['REMOTE_ADDR']) ||
+ (array_key_exists('VCLSKIN', $_COOKIE) && $_COOKIE['VCLSKIN'] == 'EXAMPLE1')) {
+ $skin = 'example1';
+ }
+ elseif(array_key_exists('VCLSKIN', $_COOKIE)) {
+ switch($_COOKIE['VCLSKIN']) {
+ case 'EXAMPLE2':
+ $skin = 'example2';
+ break;
+ default:
+ $skin = 'default';
+ break;
+ }
+ }
+ else
+ $skin = 'default';
+ if($mode != 'selectauth' && $mode != 'submitLogin')
+ require_once("themes/$skin/page.php");
+
+ require_once(".ht-inc/requests.php");
+ if($mode != "logout" &&
+ $mode != "vcldquery" &&
+ $mode != "xmlrpccall" &&
+ $mode != "xmlrpcaffiliations" &&
+ $mode != "selectauth" &&
+ $mode != "submitLogin") {
+ $oldmode = $mode;
+ $mode = "auth";
+ }
+ if($mode == "vcldquery" || $mode == 'xmlrpccall' || $mode == 'xmlrpcaffiliations') {
+ // get the semaphore id
+ if(! ($semid = sem_get(SEMKEY, 1, 0666, 1)))
+ abort(2);
+ $semislocked = 0;
+ require_once(".ht-inc/xmlrpcWrappers.php");
+ require_once(".ht-inc/requests.php");
+ setupSession();
+ }
+ return;
+ }
+ setupSession();
+ if(array_key_exists('user', $_SESSION)) {
+ $user = $_SESSION['user'];
+ if(! empty($contuserid) &&
+ $user['id'] != $contuserid)
+ abort(51);
+ }
+ else {
+ # get info about user
+ if(! $user = getUserInfo($userid)) {
+ $ERRORS[1] = "Failed to get user info from database. userid was $userid";
+ abort(1);
+ }
+ if($user['adminlevel'] == 'developer' &&
+ array_key_exists('VCLTESTUSER', $_COOKIE)) {
+ $userid = $_COOKIE['VCLTESTUSER'];
+ if($userid != "{$user['unityid']}@{$user['affiliation']}") {
+ if($testuser = getUserInfo($userid))
+ $user = $testuser;
+ }
+ }
+ if(! empty($contuserid) &&
+ $user['id'] != $contuserid)
+ abort(51);
+ $_SESSION['user'] = $user;
+ }
+ $viewmode = getViewMode($user);
+
+ $affil = $user['affiliation'];
+
+ # setskin
+ switch($affil) {
+ case 'EXAMPLE1':
+ $skin = 'example1';
+ require_once('themes/example1/page.php');
+ break;
+
+ case 'EXAMPLE2':
+ $skin = 'example1';
+ require_once('themes/example2/page.php');
+ break;
+
+ default:
+ $skin = 'default';
+ require_once('themes/default/page.php');
+ break;
+
+ }
+ $_SESSION['mode'] = $mode;
+
+ // check for and possibly clear dirty permission cache
+ $dontClearModes = array('AJchangeUserPrivs', 'AJchangeUserGroupPrivs', 'AJchangeResourcePrivs');
+ if(! in_array($mode, $dontClearModes) &&
+ array_key_exists('dirtyprivs', $_SESSION) &&
+ $_SESSION['dirtyprivs']) {
+ clearPrivCache();
+ $_SESSION['dirtyprivs'] = 0;
+ }
+
+ // get the semaphore id
+ if(! ($semid = sem_get(SEMKEY, 1, 0666, 1)))
+ abort(2);
+ $semislocked = 0;
+
+ # include appropriate files
+ switch($actions['pages'][$mode]) {
+ case 'manageComputers':
+ require_once(".ht-inc/computers.php");
+ break;
+ case 'managementNodes':
+ require_once(".ht-inc/managementnodes.php");
+ break;
+ case 'manageImages':
+ require_once(".ht-inc/images.php");
+ require_once(".ht-inc/requests.php");
+ break;
+ case 'manageSchedules':
+ require_once(".ht-inc/schedules.php");
+ break;
+ case 'help':
+ require_once(".ht-inc/help.php");
+ break;
+ case 'userPreferences':
+ require_once(".ht-inc/userpreferences.php");
+ break;
+ case 'statistics':
+ require_once(".ht-inc/statistics.php");
+ break;
+ case 'manageGroups':
+ require_once(".ht-inc/groups.php");
+ break;
+ case 'privileges':
+ case 'userLookup':
+ require_once(".ht-inc/privileges.php");
+ break;
+ case 'vm':
+ require_once(".ht-inc/vm.php");
+ break;
+ default:
+ require_once(".ht-inc/requests.php");
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn checkAccess()
+///
+/// \brief gets the user's access level to the locker from the ptsowner_admin
+/// table
+///
+////////////////////////////////////////////////////////////////////////////////
+function checkAccess() {
+ global $mode, $user, $viewmode, $actionFunction, $vcldquerykey, $authMechs;
+ global $itecsauthkey, $ENABLE_ITECSAUTH, $actions, $noHTMLwrappers;
+ global $inContinuation, $docreaders, $userlookupUsers;
+ if($mode == "vcldquery") {
+ $key = processInputVar("key", ARG_STRING);
+ if($key != $vcldquerykey) {
+ print "Access denied\n";
+ dbDisconnect();
+ exit;
+ }
+ }
+ elseif($mode == 'xmlrpccall') {
+ // double check for SSL
+ if(! isset($_SERVER['HTTPS']) || $_SERVER['HTTPS'] != "on") {
+ printXMLRPCerror(4); # must have SSL enabled
+ dbDisconnect();
+ exit;
+ }
+ $xmluser = processInputData($_SERVER['HTTP_X_USER'], ARG_STRING, 1);
+ if(! $user = getUserInfo($xmluser)) {
+ printXMLRPCerror(3); # access denied
+ dbDisconnect();
+ exit;
+ }
+ $xmlpass = processInputData($_SERVER['HTTP_X_PASS'], ARG_STRING, 1);
+ $apiver = processInputData($_SERVER['HTTP_X_APIVERSION'], ARG_NUMERIC, 1);
+ if($apiver == 1) {
+ $query = "SELECT x.id "
+ . "FROM xmlrpcKey x, "
+ . "user u "
+ . "WHERE x.ownerid = u.id AND "
+ . "u.unityid = '$xmluser' AND "
+ . "x.key = '$xmlpass' AND "
+ . "x.active = 1";
+ $qh = doQuery($query, 101);
+ if(! (mysql_num_rows($qh) == 1)) {
+ printXMLRPCerror(3); # access denied
+ dbDisconnect();
+ exit;
+ }
+ $row = mysql_fetch_assoc($qh);
+ $user['xmlrpckeyid'] = $row['id'];
+ }
+ elseif($apiver == 2) {
+ $authtype = "";
+ foreach($authMechs as $key => $authmech) {
+ /*if($key == "NCSU WRAP")
+ continue;*/
+ if($authmech['affiliationid'] == $user['affiliationid']) {
+ $authtype = $key;
+ break;
+ }
+ }
+ /*if(empty($authtype)) {
+ print "No authentication mechanism found for passed in X-User";
+ dbDisconnect();
+ exit;
+ }*/
+ if($authMechs[$authtype]['type'] == 'ldap') {
+ $ds = ldap_connect("ldaps://{$authMechs[$authtype]['server']}/");
+ if(! $ds) {
+ printXMLRPCerror(5); # failed to connect to auth server
+ dbDisconnect();
+ exit;
+ }
+ ldap_set_option($ds, LDAP_OPT_PROTOCOL_VERSION, 3);
+ $ldapuser = sprintf($authMechs[$authtype]['userid'], $user['unityid']);
+ $res = ldap_bind($ds, $ldapuser, $xmlpass);
+ if(! $res) {
+ printXMLRPCerror(3); # access denied
+ dbDisconnect();
+ exit;
+ }
+ }
+ elseif($ENABLE_ITECSAUTH &&
+ $authMechs[$authtype]['affiliationid'] == getAffiliationID('ITECS')) {
+ $rc = ITECSAUTH_validateUser($itecsauthkey, $user['unityid'], $xmlpass);
+ if(empty($rc) || $rc['passfail'] == 'fail') {
+ printXMLRPCerror(3); # access denied
+ dbDisconnect();
+ exit;
+ }
+ }
+ elseif($authMechs[$authtype]['type'] == 'local') {
+ if(! validateLocalAccount($user['unityid'], $xmlpass)) {
+ printXMLRPCerror(3); # access denied
+ dbDisconnect();
+ exit;
+ }
+ }
+ else {
+ printXMLRPCerror(6); # unable to auth passed in X-User
+ dbDisconnect();
+ exit;
+ }
+ }
+ else {
+ printXMLRPCerror(7); # unknown API version
+ dbDisconnect();
+ exit;
+ }
+ }
+ elseif($mode == 'xmlrpcaffiliations') {
+ // double check for SSL, not really required for this mode, but it keeps things consistant
+ if(! isset($_SERVER['HTTPS']) || $_SERVER['HTTPS'] != "on") {
+ printXMLRPCerror(4); # must have SSL enabled
+ dbDisconnect();
+ exit;
+ }
+ $apiver = processInputData($_SERVER['HTTP_X_APIVERSION'], ARG_NUMERIC, 1);
+ if($apiver != 1 && $apiver != 2) {
+ printXMLRPCerror(7); # unknown API version
+ dbDisconnect();
+ exit;
+ }
+ }
+ # this protects against an attacker submitting data without coming from
+ # our index.php page
+ elseif(! empty($mode)) {
+ /*if(empty($_SERVER["HTTP_REFERER"])) {
+ # when firefox auto-reloads a page, it doesn't set HTTP_REFERER
+ # since we are auto-reloading the 'Current Reservations' page if
+ # there is a pending request, we can't abort
+ if(in_array($mode, $actions['entry']) ||
+ $mode == "viewRequests" ||
+ $mode == "statgraphday" ||
+ $mode == "statgraphdayconcuruser" ||
+ $mode == "statgraphdayconcurblade" ||
+ $mode == "statgraphhour" ||
+ $mode == "selectauth" ||
+ $mode == "selectNode" ||
+ $mode == "AJsubmitAddUserPriv" ||
+ $mode == "AJsubmitAddUserGroupPriv" ||
+ $mode == "AJchangeUserPrivs" ||
+ $mode == "AJchangeUserGroupPrivs" ||
+ $mode == "AJsubmitAddChildNode" ||
+ $mode == "AJsubmitDeleteNode" ||
+ $mode == "AJupdateWaitTime" ||
+ $mode == "clearCache" ||
+ $mode == "jsonImageInformation" ||
+ $mode == "helpform" ||
+ $mode == "auth") {
+ return;
+ }
+ $mode = "";
+ $actionFunction = "main";
+ #$user["adminlevel"] = "none";
+ #$viewmode = ADMIN_NONE;
+ #abort(20);
+ return;
+ }
+ $urlArray = explode('?', $_SERVER["HTTP_REFERER"]);
+ #print "urlArray[0] - " . $urlArray[0] . "<BR>\n";
+ #print "correct URL - " . BASEURL . "/<br>\n";
+ if(($urlArray[0] != BASEURL . SCRIPT) &&
+ ($urlArray[0] != BASEURL . "/") &&
+ ($urlArray[0] != "https://webauth.ncsu.edu/wrap-bin/was16.cgi") &&
+ ($urlArray[0] != "http://vcl.ncsu.edu/index.php") &&
+ ($urlArray[0] != "http://vcl.ncsu.edu/") &&
+ ($urlArray[0] != "http://vcl.ncsu.edu/site/pages/help/vcl-help" &&
+ $urlArray[0] != "http://vcl.ncsu.edu/site/pages/help/default" &&
+ $urlArray[0] != "http://vcl.ncsu.edu/site/pages/default/default" &&
+ $urlArray[0] != "http://vcl.ncsu.edu/site.php" &&
+ $urlArray[0] != "http://vcl.ncsu.edu/site" &&
+ $urlArray[0] != "https://vcl.ncsu.edu/" &&
+ $urlArray[0] != "https://vcl.ncsu.edu/email-vcl-help-support" &&
+ $urlArray[0] != "http://vcl.ncsu.edu/email-vcl-help-support" &&
+ $mode == "helpform") &&
+ (($urlArray[0] != "http://vcl.ncsu.edu/site" &&
+ $urlArray[0] != "http://vcl.ncsu.edu/site/pages/default/default" &&
+ $urlArray[0] != "http://vcl.ncsu.edu/site/index/default") ||
+ $mode != "viewRequests")) {*/
+ if(! in_array($mode, $actions['entry']) &&
+ ! $inContinuation) {
+ $mode = "main";
+ $actionFunction = "main";
+ return;
+ #$user["adminlevel"] = "none";
+ #$viewmode = ADMIN_NONE;
+ #abort(20);
+ }
+ else {
+ if(! $inContinuation) {
+ # check that user has access to this area
+ switch($mode) {
+ case 'viewRequests':
+ if(! in_array("imageCheckOut", $user["privileges"]) &&
+ ! in_array("imageAdmin", $user["privileges"])) {
+ $mode = "";
+ $actionFunction = "main";
+ return;
+ }
+ break;
+ case 'blockRequest':
+ if($viewmode != ADMIN_DEVELOPER) {
+ $mode = "";
+ $actionFunction = "main";
+ return;
+ }
+ break;
+ case 'viewGroups':
+ if(! in_array("groupAdmin", $user["privileges"])) {
+ $mode = "";
+ $actionFunction = "main";
+ return;
+ }
+ break;
+ case 'selectImageOption':
+ if(! in_array("imageAdmin", $user["privileges"])) {
+ $mode = "";
+ $actionFunction = "main";
+ return;
+ }
+ break;
+ case 'viewSchedules':
+ if(! in_array("scheduleAdmin", $user["privileges"])) {
+ $mode = "";
+ $actionFunction = "main";
+ return;
+ }
+ break;
+ case 'selectComputers':
+ if(! in_array("computerAdmin", $user["privileges"])) {
+ $mode = "";
+ $actionFunction = "main";
+ return;
+ }
+ break;
+ case 'selectMgmtnodeOption':
+ if(! in_array("mgmtNodeAdmin", $user["privileges"])) {
+ $mode = "";
+ $actionFunction = "main";
+ return;
+ }
+ break;
+ case 'pickTimeTable':
+ $computermetadata = getUserComputerMetaData();
+ if(! count($computermetadata["platforms"]) ||
+ ! count($computermetadata["schedules"])) {
+ $mode = "";
+ $actionFunction = "main";
+ return;
+ }
+ break;
+ case 'viewNodes':
+ if(! in_array("userGrant", $user["privileges"]) &&
+ ! in_array("resourceGrant", $user["privileges"]) &&
+ ! in_array("nodeAdmin", $user["privileges"])) {
+ $mode = "";
+ $actionFunction = "main";
+ return;
+ }
+ break;
+ case 'userLookup':
+ if($viewmode != ADMIN_DEVELOPER &&
+ ! in_array($user['id'], $userlookupUsers)) {
+ $mode = "";
+ $actionFunction = "main";
+ return;
+ }
+ break;
+ case 'editVMInfo':
+ if(! in_array("computerAdmin", $user["privileges"])) {
+ $mode = "";
+ $actionFunction = "main";
+ return;
+ }
+ break;
+ case 'viewdocs':
+ if(! in_array("userGrant", $user["privileges"]) &&
+ ! in_array("resourceGrant", $user["privileges"]) &&
+ ! in_array("nodeAdmin", $user["privileges"]) &&
+ ! in_array($user['id'], $docreaders)) {
+ $mode = "";
+ $actionFunction = "main";
+ return;
+ }
+ break;
+ }
+ }
+ }
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn clearPrivCache()
+///
+/// \brief sets userresources, nodeprivileges, cascadenodeprivileges, and
+/// userhaspriv keys of $_SESSION array to empty arrays
+///
+////////////////////////////////////////////////////////////////////////////////
+function clearPrivCache() {
+ $_SESSION['userresources'] = array();
+ $_SESSION['nodeprivileges'] = array();
+ $_SESSION['cascadenodeprivileges'] = array();
+ $_SESSION['userhaspriv'] = array();
+ $_SESSION['compstateflow'] = array();
+ $_SESSION['usersessiondata'] = array();
+ unset($_SESSION['user']);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJclearPermCache()
+///
+/// \brief ajax wrapper for clearPrivCache
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJclearPermCache() {
+ clearPrivCache();
+ print "alert('Permission cache cleared');";
+ dbDisconnect();
+ exit;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn setupSession()
+///
+/// \brief starts php session and initializes useful variables
+///
+////////////////////////////////////////////////////////////////////////////////
+function setupSession() {
+ global $mode;
+ if($mode == 'xmlrpccall')
+ $_SESSION = array();
+ else
+ session_start();
+ if(! array_key_exists('cachetimestamp', $_SESSION))
+ $_SESSION['cachetimestamp'] = time();
+ else {
+ if(($_SESSION['cachetimestamp'] + (PRIV_CACHE_TIMEOUT * 60)) < time()) {
+ clearPrivCache();
+ $_SESSION['cachetimestamp'] = time();
+ return;
+ }
+ }
+ if(! array_key_exists('userresources', $_SESSION))
+ $_SESSION['userresources'] = array();
+ if(! array_key_exists('nodeprivileges', $_SESSION))
+ $_SESSION['nodeprivileges'] = array();
+ if(! array_key_exists('cascadenodeprivileges', $_SESSION))
+ $_SESSION['cascadenodeprivileges'] = array();
+ if(! array_key_exists('userhaspriv', $_SESSION))
+ $_SESSION['userhaspriv'] = array();
+ if(! array_key_exists('compstateflow', $_SESSION))
+ $_SESSION['compstateflow'] = array();
+ if(! array_key_exists('usersessiondata', $_SESSION))
+ $_SESSION['usersessiondata'] = array();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn stopSession()
+///
+/// \brief ends the user's session and prints info to notify the user
+///
+////////////////////////////////////////////////////////////////////////////////
+function stopSession() {
+ $_SESSION = array();
+ if(isset($_COOKIE[session_name()]))
+ setcookie(session_name(), "", time()-42000, '/');
+ session_destroy();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getViewMode($user)
+///
+/// \param $user - an array as returned from getUserInfo
+///
+/// \return user's viewmode level
+///
+/// \brief determines viewmode based on $_COOKIE["VCLVIEWMODE"] and user's
+/// adminlevel
+///
+////////////////////////////////////////////////////////////////////////////////
+function getViewMode($user) {
+ if($user["adminlevelid"] == 1) {
+ return 1;
+ }
+ if(empty($_COOKIE["VCLVIEWMODE"])) {
+ return $user["adminlevelid"];
+ }
+ $tmpviewmode = $_COOKIE["VCLVIEWMODE"];
+ if($user["adminlevel"] == "developer") {
+ return $tmpviewmode;
+ }
+ elseif($user["adminlevel"] == "full") {
+ if($tmpviewmode <= ADMIN_FULL) {
+ return $tmpviewmode;
+ }
+ else {
+ return ADMIN_FULL;
+ }
+ }
+ return 1;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn main()
+///
+/// \brief prints a welcome screen
+///
+////////////////////////////////////////////////////////////////////////////////
+function main() {
+ global $user, $authed, $mode, $skin;
+ print "<H2>Welcome to the Virtual Computing Lab</H2>\n";
+ if($authed) {
+ print "Hello ";
+ if(! empty($user["preferredname"])) {
+ print $user["preferredname"] . " ";
+ }
+ else {
+ print $user["firstname"] . " ";
+ }
+ print $user["lastname"] . "<br><br>\n";
+ $tmp = array_values($user['groups']);
+ if(count($tmp) == 1 && $tmp[0] == 'nodemo') {
+ print "Your account is a demo account that has expired. ";
+ print "You cannot make any more reservations. Please contact <a href=\"";
+ print "mailto:" . HELPEMAIL . "\">" . HELPEMAIL . "</a> if you need ";
+ print "further access to VCL.<br>\n";
+ return;
+ }
+ $requests = getUserRequests("all", $user["id"]);
+ if($num = count($requests)) {
+ if($num == 1) {
+ print "You currently have $num reservation</a>.<br>\n";
+ }
+ else {
+ print "You currently have $num reservations</a>.<br>\n";
+ }
+ }
+ else {
+ print "You do not have any current reservations.<br>\n";
+ }
+ print "Please make a selection from the menu on the left to continue.<br>\n";
+ }
+ else {
+ print "Click the <b>Log in to VCL</b> button at the top right part of ";
+ print "the page to start using the VCL system<br>\n";
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn abort($errcode, $query)
+///
+/// \param $errcode - error code
+/// \param $query - a myql query
+///
+/// \brief prints out error message(s), closes db connection, prints footer
+/// and exits
+///
+////////////////////////////////////////////////////////////////////////////////
+function abort($errcode, $query="") {
+ global $mysql_link_vcl, $mysql_link_acct, $ERRORS, $user, $mode;
+ global $ENABLE_ITECSAUTH, $requestInfo;
+ if($mode == 'xmlrpccall')
+ xmlRPCabort($errcode, $query);
+ if(ONLINEDEBUG && $user["adminlevel"] == "developer") {
+ if($errcode >= 100 && $errcode < 400) {
+ print "<font color=red>" . mysql_error($mysql_link_vcl) . "</font><br>\n";
+ if($ENABLE_ITECSAUTH)
+ print "<font color=red>" . mysql_error($mysql_link_acct) . "</font><br>\n";
+ print "$query<br>\n";
+ }
+ print "ERROR($errcode): " . $ERRORS["$errcode"] . "<BR>\n";
+ print "<pre>\n";
+ print getBacktraceString(FALSE);
+ print "</pre>\n";
+ }
+ else {
+ $message = "";
+ if($errcode >= 100 && $errcode < 400) {
+ $message .= mysql_error($mysql_link_vcl) . "\n";
+ $message .= mysql_error($mysql_link_acct) . "\n";
+ $message .= $query . "\n";
+ }
+ $message .= "ERROR($errcode): " . $ERRORS["$errcode"] . "\n";
+ $message .= "Logged in user was " . $user["unityid"] . "\n";
+ $message .= "Mode was $mode\n\n";
+ if($errcode == 20) {
+ $urlArray = explode('?', $_SERVER["HTTP_REFERER"]);
+ $message .= "HTTP_REFERER URL - " . $urlArray[0] . "\n";
+ $message .= "correct URL - " . BASEURL . SCRIPT . "\n";
+ }
+ if($errcode == 40) {
+ $message .= "One of the following computers didn't get a mgmt node:\n";
+ foreach($requestInfo["images"] as $key => $imageid) {
+ $message .= "imageid: $imageid\n";
+ $message .= "compid: {$requestInfo['computers'][$key]}\n";
+ }
+ }
+ $message .= getBacktraceString(FALSE);
+ $mailParams = "-f" . ENVELOPESENDER;
+ mail(ERROREMAIL, "Error with VCL pages ($errcode)", $message, '', $mailParams);
+ print "An error has occurred. If this problem persists, please email ";
+ print "<a href=\"mailto:" . HELPEMAIL . "?Subject=Problem%20With%20VCL\">";
+ print HELPEMAIL . "</a> for further assistance. Please include the ";
+ print "steps you took that led up to this problem in your email message.";
+ }
+ dbDisconnect();
+ printHTMLFooter();
+ // release semaphore lock
+ semUnlock();
+ exit;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn errorrpt()
+///
+/// \brief takes input from ajax call and emails error to ERROREMAIL
+///
+////////////////////////////////////////////////////////////////////////////////
+function errorrpt() {
+ $mailParams = "-f" . ENVELOPESENDER;
+ mail(ERROREMAIL, "Error with VCL pages (ajax sent html wrappers)", $_POST['data'], '', $mailParams);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn ldapUIDLookup($uid, &$userInfo, $doMerge)
+///
+/// \param $uid - userid to lookup
+/// \param $userInfo - the following fields get populated if they are received
+/// from the LDAP server:\n
+/// \b uid - userid\n
+/// \b info->has_account - TRUE/FALSE\n
+/// \b info->is_employee - TRUE/FALSE\n
+/// \b info->is_student - TRUE/FALSE\n
+/// \b cn - full name\n
+/// \b sn - surname\n
+/// \b employeeType - SPA/EPA/GRAD/??\n
+/// \b givenName - first name\n
+/// \b ncsuMiddleName - middle name\n
+/// \b initials \n
+/// \b title \n
+/// \b ncsuPreferredName \n
+/// \b displayName \n
+/// \b employeeNumber \n
+/// \b departmentNumber \n
+/// \b ncsuAffiliation - ??\n
+/// \b mail - preferred email address\n
+/// \b registeredAddress \n
+/// \b telephoneNumber \n
+/// \b facsimileTelephoneNumber \n
+/// \b ou - department \n
+/// \b gecos - ??\n
+/// \b loginShell - preferred unix shell \n
+/// \b uidNumber - numeric unix id \n
+/// \b gidNumber - numeric unix groud id \n
+/// \b homeDirectory \n
+/// \b mailHost \n
+/// \b ncsuMUAprotocol - POP/IMAP (not current??)\n
+/// \b memberNisNetgroup - array of hesiod groups\n
+/// \param $doMerge - (optional) ??
+///
+/// \return TRUE or FALSE
+///
+/// \brief looks up a userid on the LDAP server, populates $userInfo, returns
+/// TRUE or FALSE
+///
+////////////////////////////////////////////////////////////////////////////////
+function ldapUIDLookup($uid, &$userInfo, $doMerge=TRUE) {
+ global $ldaprdn, $ldappass, $error;
+ $userInfo = array("uid" => "",
+ "cn" => "",
+ "sn" => "",
+ "employeeType" => "",
+ "givenName" => "",
+ "initials" => "",
+ "title" => "",
+ "ncsuPreferredName" => "",
+ "displayName" => "",
+ "employeeNumber" => "",
+ "departmentNumber" => "",
+ "ncsuAffiliation" => "",
+ "mail" => "",
+ "registeredAddress" => "",
+ "telephoneNumber" => "",
+ "facsimileTelephoneNumber" => "",
+ "ou" => "",
+ "gecos" => "",
+ "loginShell" => "",
+ "uidNumber" => "",
+ "gidNumber" => "",
+ "homeDirectory" => "",
+ "mailHost" => "",
+ "ncsuMUAprotocol" => "",
+ "ncsuMiddleName" => "",
+ "memberNisNetgroup" => array());
+
+ $ldapConnect = ldap_connect("ldaps://ldap.ncsu.edu/");
+ if(!$ldapConnect) {
+ $error['op'] = "ldapUIDLookup";
+ $error['shortmsg'] = "Could not connect to LDAP server: ";
+ $error['shortmsg'] .= "ldap.ncsu.edu";
+ return FALSE;
+ }
+
+ $result = ldap_bind($ldapConnect, $ldaprdn, $ldappass);
+ if(!$result) {
+ $error['op'] = "ldapUIDLookup";
+ $error['shortmsg'] = "Could not create LDAP binding";
+ $error['syscode'] = ldap_errno($ldapConnect);
+ $error['sysmsg'] = ldap_err2str($error['syscode']);
+ ldap_close($ldapConnect);
+ return FALSE;
+ }
+
+ $context = "dc=ncsu,dc=edu";
+ $searchstring = "uid=".$uid;
+ $searchResult =
+ ldap_search($ldapConnect,$context,$searchstring,array("*","+"));
+ if(!$searchResult) {
+ $error['op'] = "ldapUIDLookup";
+ $error['shortmsg'] = "Could not execute LDAP search ";
+ $error['shortmsg'] .= "($context => $searchstring)";
+ $error['context'] = $context;
+ $error['search'] = $searchstring;
+ $error['syscode'] = ldap_errno($ldapConnect);
+ $error['sysmsg'] = ldap_err2str($error['syscode']);
+ ldap_close($ldapConnect);
+ return FALSE;
+ }
+
+ if(ldap_count_entries($ldapConnect,$searchResult) == 0) {
+ $error['op'] = "ldapUIDLookup";
+ $error['shortmsg'] = "Specified uid: $uid not found";
+ ldap_close($ldapConnect);
+ return FALSE;
+ }
+
+
+ // basic information
+ $haveuser = FALSE;
+ $userInfo['uid'] = $uid;
+ $userInfo['info']['has_account'] = FALSE;
+ $accountInfo = array();
+ $userInfo['info']['is_employee'] = FALSE;
+ $employeeInfo = array();
+ $userInfo['info']['is_student'] = FALSE;
+ $studentInfo = array();
+
+ for($entryID = ldap_first_entry($ldapConnect,$searchResult);
+ $entryID != FALSE;
+ $entryID = ldap_next_entry($ldapConnect,$entryID)) {
+ $thisEntry = array();
+ $thisDN = '';
+ $thisDN = ldap_get_dn($ldapConnect,$entryID);
+ $thisEntry = ldap_get_attributes($ldapConnect,$entryID);
+
+ if(!(isset($thisEntry))) continue;
+
+ // parse dn
+ $dnarray = explode(',',$thisDN);
+ $checkou = $dnarray[1];
+ switch($checkou) {
+
+ case "ou=accounts":
+ $haveuser = TRUE;
+ $userInfo['info']['has_account'] = TRUE;
+ $dataInfo = &$accountInfo;
+ break;
+
+ case "ou=employees":
+ $haveuser = TRUE;
+ $userInfo['info']['is_employee'] = TRUE;
+ $dataInfo = &$employeeInfo;
+ break;
+
+ case "ou=students":
+ $haveuser = TRUE;
+ $userInfo['info']['is_student'] = TRUE;
+ $dataInfo = &$studentInfo;
+ break;
+
+ // not dealing with a group/printer/host/other
+ // somehow (don't know how) keyed by identifier uid=$uid...
+ default:
+ continue 2;
+ }
+
+ foreach($thisEntry as $attribute => $value) {
+ if(!(is_array($value))) continue;
+ if($attribute == "uid") continue;
+ if($attribute == "count") continue;
+
+ if($value['count'] > 1) {
+ $dataInfo[$attribute] = $value;
+ unset($dataInfo[$attribute]['count']);
+ }
+ else {
+ $dataInfo[$attribute] = $value[0];
+ }
+ }
+ }
+
+ if(!($haveuser)) {
+ $error['op'] = "ldapUIDLookup";
+ $error['shortmsg'] = "Specified uid: $uid is not a user account";
+ ldap_close($ldapConnect);
+ return FALSE;
+ }
+
+ // merge information student, then employee, then account
+
+ if($userInfo['info']['is_student']) {
+ if($doMerge) $userInfo = array_merge($userInfo,$studentInfo);
+ $userInfo['info']['student'] = $studentInfo;
+ }
+
+ if($userInfo['info']['is_employee']) {
+ if($doMerge) $userInfo = array_merge($userInfo,$employeeInfo);
+ $userInfo['info']['employee'] = $employeeInfo;
+ }
+
+ if($userInfo['info']['has_account']) {
+ if($doMerge) $userInfo = array_merge($userInfo,$accountInfo);
+ $userInfo['info']['account'] = $accountInfo;
+ }
+
+ if($doMerge) {
+ // merged values we don't care about:
+ $noMergeAttribs = array('objectClass',
+ 'structuralObjectClass',
+ 'entryUUID',
+ 'creatorsName',
+ 'createTimestamp',
+ 'modifyTimestamp',
+ 'subschemaSubentry',
+ 'hasSubordinates',
+ 'modifiersName',
+ 'entryCSN');
+
+ foreach($noMergeAttribs as $attribute) {
+ unset($userInfo[$attribute]);
+ }
+ }
+
+ if(! $userInfo["info"]["is_employee"] && ! $userInfo["info"]["is_student"] &&
+ $userInfo["info"]["has_account"]) {
+ if(array_key_exists("gecos", $userInfo["info"]["account"])) {
+ $name = explode(' ', $userInfo["info"]["account"]["gecos"]);
+ if(count($name) == 3) {
+ $userInfo["givenName"] = $name[0];
+ $userInfo["ncsuMiddleName"] = $name[1];
+ $userInfo["sn"] = $name[2];
+ }
+ elseif(count($name) == 2) {
+ $userInfo["givenName"] = $name[0];
+ $userInfo["sn"] = $name[1];
+ }
+ elseif(count($name) == 1) {
+ $userInfo["sn"] = $name[0];
+ }
+ }
+ $userInfo["mail"] = $userInfo["uid"] . "@ncsu.edu";
+ }
+
+ return TRUE;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn validateUserid($loginid)
+///
+/// \param $loginid - a submitted loginid
+///
+/// \return 0 if the loginid is not found in one of the authentications
+/// systems, 1 if it is
+///
+/// \brief checks to see if $loginid is found in one of the authentication
+/// systems
+///
+////////////////////////////////////////////////////////////////////////////////
+function validateUserid($loginid) {
+ global $affilValFuncArgs, $affilValFunc;
+ if(empty($loginid))
+ return 0;
+
+ getAffilidAndLogin($loginid, $affilid);
+
+ if(empty($affilid))
+ return 0;
+
+ $query = "SELECT id "
+ . "FROM user "
+ . "WHERE unityid = '$loginid' AND "
+ . "affiliationid = $affilid";
+ $qh = doQuery($query, 101);
+ if(mysql_num_rows($qh))
+ return 1;
+
+ $valfunc = $affilValFunc[$affilid];
+ if(array_key_exists($affilid, $affilValFuncArgs))
+ return $valfunc($affilValFuncArgs[$affilid], $loginid);
+ else
+ return $valfunc($loginid);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getAffilidAndLogin(&$login, &$affilid)
+///
+/// \param $login - login for user, may include \@affiliation
+/// \param $affilid - variable in which to stick the affiliation id
+///
+/// \return 1 if $affilid set by a registered function, 0 if set to default
+///
+/// \brief tries registered affiliation lookup functions to determine the
+/// affiliation id of the user; if it finds it, sticks the affiliationid in
+/// $affilid and sets $login to not include \@affiliation if it did
+///
+////////////////////////////////////////////////////////////////////////////////
+function getAffilidAndLogin(&$login, &$affilid) {
+ global $findAffilFuncs;
+ foreach($findAffilFuncs as $func) {
+ if($func($login, $affilid))
+ return 1;
+ }
+ $affilid = DEFAULT_AFFILID;
+ return 0;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn mysql_connect_plus($host, $user, $pwd)
+///
+/// \param $host - mysql host
+/// \param $user - userid to use for connection
+/// \param $pwd - password to use for connection
+///
+/// \return mysql resource identifier, 0 if failure to connect
+///
+/// \brief opens a socket connection to $host, if it is not established in 5
+/// seconds, returns an error, otherwise, opens a connection to the database
+/// and returns the identifier
+///
+////////////////////////////////////////////////////////////////////////////////
+function mysql_connect_plus($host, $user, $pwd) {
+ $timeout = 5; /* timeout in seconds */
+
+ if($fp = @fsockopen($host, 3306, $errno, $errstr, $timeout)) {
+ fclose($fp);
+ return $link = mysql_connect($host, $user, $pwd);
+ } else {
+ #print "ERROR: socket timeout<BR>\n";
+ return 0;
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn dbConnect()
+///
+/// \brief opens connections to database, the resource identifiers are\n
+/// \b $mysql_link_vcl - for vcl database\n
+/// \b $mysql_link_acct - for accounts database\n
+///
+////////////////////////////////////////////////////////////////////////////////
+function dbConnect() {
+ global $vclhost, $vcldb, $vclusername, $vclpassword, $mysql_link_vcl;
+ global $accthost, $acctusername, $acctpassword, $mysql_link_acct;
+ global $ENABLE_ITECSAUTH;
+
+ // open a connection to mysql server for vcl
+ if(! $mysql_link_vcl = mysql_connect_plus($vclhost, $vclusername, $vclpassword)) {
+ die("Error connecting to $vclhost.<br>\n");
+ }
+ // select the vcl database
+ mysql_select_db($vcldb, $mysql_link_vcl) or abort(104);
+
+ if($ENABLE_ITECSAUTH) {
+ // open a connection to mysql server for accounts
+ if(! $mysql_link_acct = mysql_connect_plus($accthost, $acctusername, $acctpassword)) {
+ $ENABLE_ITECSAUTH = 0;
+ return;
+ }
+ // select the accounts database
+ mysql_select_db("accounts", $mysql_link_acct);# or safeExit($RC["ERROR"], "Failed to select vcl database");
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn dbDisconnect()
+///
+/// \brief closes connections to the database
+///
+////////////////////////////////////////////////////////////////////////////////
+function dbDisconnect() {
+ global $mysql_link_vcl, $mysql_link_acct, $ENABLE_ITECSAUTH;
+ mysql_close($mysql_link_vcl);
+ if($ENABLE_ITECSAUTH)
+ mysql_close($mysql_link_acct);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn doQuery($query, $errcode, $db, $nolog)
+///
+/// \param $query - SQL statement
+/// \param $errcode - error code
+/// \param $db - (optional, defaul=vcl), database to query against
+/// \param $nolog - (optional, defaul=0), don't log to queryLog table
+///
+/// \return $qh - query handle
+///
+/// \brief performs the query and returns $qh or aborts on error
+///
+////////////////////////////////////////////////////////////////////////////////
+function doQuery($query, $errcode, $db="vcl", $nolog=0) {
+ global $mysql_link_vcl, $mysql_link_acct, $user, $mode, $ENABLE_ITECSAUTH;
+ global $totalQueries, $queryTimes;
+ $totalQueries++;
+ if($db == "vcl") {
+ if((! $nolog) && ereg('^(UPDATE|INSERT|DELETE)', $query)) {
+ $logquery = str_replace("'", "\'", $query);
+ $logquery = str_replace('"', '\"', $logquery);
+ $q = "INSERT INTO querylog "
+ . "(userid, "
+ . "timestamp, "
+ . "mode, "
+ . "query) "
+ . "VALUES "
+ . "(" . $user["id"] . ", "
+ . "NOW(), "
+ . "'$mode', "
+ . "'$logquery')";
+ mysql_query($q, $mysql_link_vcl);
+ }
+ $qh = mysql_query($query, $mysql_link_vcl) or abort($errcode, $query);
+ }
+ elseif($db == "accounts") {
+ if($ENABLE_ITECSAUTH)
+ $qh = mysql_query($query, $mysql_link_acct) or abort($errcode, $query);
+ else
+ $qh = NULL;
+ }
+ return $qh;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getOSList()
+///
+/// \return $oslist - array of OSs
+///
+/// \brief builds an array of OSs
+///
+////////////////////////////////////////////////////////////////////////////////
+function getOSList() {
+ $qh = doQuery("SELECT id, name, prettyname, type FROM OS", "115");
+ $oslist = array();
+ while($row = mysql_fetch_assoc($qh))
+ $oslist[$row['id']] = $row;
+ return $oslist;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getImages($includedeleted=0, $imageid=0)
+///
+/// \param $includedeleted = (optional) 1 to show deleted images, 0 not to
+/// \param $imageid = (optional) only get data for this image, defaults
+/// to getting data for all images
+///
+/// \return $imagelist - array of images with the following elements:\n
+/// \b name - name of image\n
+/// \b prettyname - pretty name of image\n
+/// \b deptid - dept id image belongs to\n
+/// \b ownerid - userid of owner\n
+/// \b owner - unity id of owner\n
+/// \b platformid - platformid for the platform the image if for\n
+/// \b platform - platform the image is for\n
+/// \b osid - osid for the os on the image\n
+/// \b os - os the image contains\n
+/// \b minram - minimum amount of RAM needed for image\n
+/// \b minprocnumber - minimum number of processors needed for image\n
+/// \b minprocspeed - minimum speed of processor(s) needed for image\n
+/// \b minnetwork - minimum speed of network needed for image\n
+/// \b maxconcurrent - maximum concurrent usage of this iamge\n
+/// \b reloadtime - time in minutes for image to loaded\n
+/// \b deleted - 'yes' or 'no'; whether or not this image has been deleted\n
+/// \b test - 0 or 1; whether or not there is a test version of this image\n
+/// \b resourceid - image's resource id from the resource table\n
+/// \b lastupdate - datetime image was last updated\n
+/// \b forcheckout - 0 or 1; whether or not the image is allowed to be directly
+/// checked out\n
+/// \b maxinitialtime - maximum time (in minutes) to be shown when requesting
+/// a reservation that the image can reserved for\n
+/// \b imagemetaid - NULL or corresponding id from imagemeta table and the
+/// following additional information:\n
+/// \b checkuser - whether or not vcld should check for a logged in user\n
+/// \b usergroupid - id of user group to use when creating local accounts\n
+/// \b usergroup - user group to use when creating local accounts\n
+/// \b sysprep - whether or not to use sysprep on creation of the image\n
+/// \b subimages - an array of subimages to be loaded along with selected
+/// image\n
+/// \b imagerevision - an array of revision info about the image, it has these
+/// keys: id, revision, userid, user, datecreated, prettydate, production,
+/// imagename
+///
+/// \brief generates an array of images
+///
+////////////////////////////////////////////////////////////////////////////////
+function getImages($includedeleted=0, $imageid=0) {
+ $query = "SELECT i.id AS id,"
+ . "i.name AS name, "
+ . "i.prettyname AS prettyname, "
+ . "i.deptid AS deptid, "
+ . "i.ownerid AS ownerid, "
+ . "CONCAT(u.unityid, '@', a.name) AS owner, "
+ . "i.platformid AS platformid, "
+ . "p.name AS platform, "
+ . "i.OSid AS osid, "
+ . "o.name AS os, "
+ . "i.minram AS minram, "
+ . "i.minprocnumber AS minprocnumber, "
+ . "i.minprocspeed AS minprocspeed, "
+ . "i.minnetwork AS minnetwork, "
+ . "i.maxconcurrent AS maxconcurrent, "
+ . "i.reloadtime AS reloadtime, "
+ . "i.deleted AS deleted, "
+ . "i.test AS test, "
+ . "r.id AS resourceid, "
+ . "i.lastupdate, "
+ . "i.forcheckout, "
+ . "i.maxinitialtime, "
+ . "i.imagemetaid "
+ . "FROM image i, "
+ . "platform p, "
+ . "OS o, "
+ . "resource r, "
+ . "resourcetype t, "
+ . "user u, "
+ . "affiliation a "
+ . "WHERE i.platformid = p.id AND "
+ . "r.resourcetypeid = t.id AND "
+ . "t.name = 'image' AND "
+ . "r.subid = i.id AND "
+ . "i.OSid = o.id AND "
+ . "i.ownerid = u.id AND "
+ . "u.affiliationid = a.id ";
+ if($imageid)
+ $query .= "AND i.id = $imageid ";
+ if(! $includedeleted) {
+ $query .= "AND i.deleted = 0 ";
+ }
+ $query .= "ORDER BY i.prettyname";
+ $qh = doQuery($query, 120);
+ $imagelist = array();
+ while($row = mysql_fetch_assoc($qh)) {
+ $imagelist[$row["id"]] = $row;
+ if($row["imagemetaid"] != NULL) {
+ $query2 = "SELECT i.checkuser, "
+ . "i.subimages, "
+ . "i.usergroupid, "
+ . "u.name AS usergroup, "
+ . "a.name AS affiliation, "
+ . "i.sysprep "
+ . "FROM imagemeta i "
+ . "LEFT JOIN usergroup u ON (i.usergroupid = u.id) "
+ . "LEFT JOIN affiliation a ON (u.affiliationid = a.id) "
+ . "WHERE i.id = {$row["imagemetaid"]}";
+ $qh2 = doQuery($query2, 101);
+ $row2 = mysql_fetch_assoc($qh2);
+ $imagelist[$row["id"]]["checkuser"] = $row2["checkuser"];
+ $imagelist[$row["id"]]["usergroupid"] = $row2["usergroupid"];
+ if(! empty($row2['affiliation']))
+ $imagelist[$row["id"]]["usergroup"] = "{$row2["usergroup"]}@{$row2['affiliation']}";
+ else
+ $imagelist[$row["id"]]["usergroup"] = $row2["usergroup"];
+ $imagelist[$row['id']]['sysprep'] = $row2['sysprep'];
+ $imagelist[$row["id"]]["subimages"] = array();
+ if($row2["subimages"]) {
+ $query2 = "SELECT imageid "
+ . "FROM subimages "
+ . "WHERE imagemetaid = {$row["imagemetaid"]}";
+ $qh2 = doQuery($query2, 101);
+ while($row2 = mysql_fetch_assoc($qh2)) {
+ array_push($imagelist[$row["id"]]["subimages"], $row2["imageid"]);
+ }
+ }
+ }
+ $query3 = "SELECT i.id, "
+ . "i.revision, "
+ . "i.userid, "
+ . "CONCAT(u.unityid, '@', a.name) AS user, "
+ . "i.datecreated, "
+ . "DATE_FORMAT(i.datecreated, '%c/%d/%y %l:%i %p') AS prettydate, "
+ . "i.production, "
+ . "i.imagename "
+ . "FROM imagerevision i, "
+ . "affiliation a, "
+ . "user u "
+ . "WHERE i.imageid = {$row['id']} AND "
+ . "i.deleted = 0 AND "
+ . "i.userid = u.id AND "
+ . "u.affiliationid = a.id";
+ $qh3 = doQuery($query3, 101);
+ while($row3 = mysql_fetch_assoc($qh3))
+ $imagelist[$row['id']]['imagerevision'][$row3['id']] = $row3;
+ }
+ return $imagelist;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getImageRevisions($imageid, $incdeleted)
+///
+/// \param $imageid - id of an image
+/// \param $incdeleted - (optional, defaults to 0) 1 to include deleted images
+///
+/// \return an array where each key is the id of the image revision and each
+/// element has these values:\n
+/// \b id - id of revision\n
+/// \b revision - revision number\n
+/// \b creatorid - user id of person that created the revision\n
+/// \b creator - user@affiliation\n
+/// \b datecreated - datetime of when revision was created\n
+/// \b deleted - 1 if deleted, 0 if not\n
+/// \b production - 1 if production revision, 0 if not\n
+/// \b comments - comments about the revision\n
+/// \b imagename - name for files related to revision
+///
+/// \brief gets image revision data related to $imageid
+///
+////////////////////////////////////////////////////////////////////////////////
+function getImageRevisions($imageid, $incdeleted=0) {
+ $query = "SELECT i.id, "
+ . "i.revision, "
+ . "i.userid AS creatorid, "
+ . "CONCAT(u.unityid, '@', a.name) AS creator, "
+ . "i.datecreated, "
+ . "i.deleted, "
+ . "i.production, "
+ . "i.comments, "
+ . "i.imagename "
+ . "FROM imagerevision i, "
+ . "user u, "
+ . "affiliation a "
+ . "WHERE i.userid = u.id "
+ . "AND u.affiliationid = a.id "
+ . "AND i.imageid = $imageid";
+ if(! $incdeleted)
+ $query .= " AND i.deleted = 0";
+ $query .= " ORDER BY revision";
+ $qh = doQuery($query, 101);
+ $return = array();
+ while($row = mysql_fetch_assoc($qh))
+ $return[$row['id']] = $row;
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getImageNotes($imageid)
+///
+/// \param $imageid - id of an image
+/// \param $revisionid - image revision id
+///
+/// \return an array with these keys:\n
+/// \b description - description of image\n
+/// \b usage - notes on using the image
+///
+/// \brief gets data from the imageinfo table for $imageid and $revisionid
+///
+////////////////////////////////////////////////////////////////////////////////
+function getImageNotes($imageid) {
+ if(empty($imageid))
+ $imageid = 0;
+ $query = "SELECT description, "
+ . "`usage` "
+ . "FROM image "
+ . "WHERE id = $imageid";
+ $qh = doQuery($query, 101);
+ if($row = mysql_fetch_assoc($qh))
+ return $row;
+ else
+ return array('description' => '', 'usage' => '');
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getProductionRevisionid($imageid)
+///
+/// \param $imageid
+///
+/// \return the production revision id for $imageid
+///
+/// \brief gets the production revision id for $imageid from the imagerevision
+/// table
+///
+////////////////////////////////////////////////////////////////////////////////
+function getProductionRevisionid($imageid) {
+ $query = "SELECT id "
+ . "FROM imagerevision "
+ . "WHERE imageid = $imageid AND "
+ . "production = 1";
+ $qh = doQuery($query, 101);
+ $row = mysql_fetch_assoc($qh);
+ return $row['id'];
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getUserResources($userprivs, $resourceprivs, $onlygroups,
+/// $includedeleted, $userid)
+///
+/// \param $userprivs - array of privileges to look for (such as
+/// imageAdmin, imageCheckOut, etc) - this is an OR list; don't include 'block' or 'cascade'
+/// \param $resourceprivs - array of privileges to look for (such as
+/// available, administer, manageGroup) - this is an OR list; don't include 'block' or 'cascade'
+/// \param $onlygroups - (optional) if 1, return the resource groups instead
+/// of the resources
+/// \param $includedeleted - (optional) included deleted resources if 1,
+/// don't if 0
+/// \param $userid - (optional) id from the user table, if not given, use the
+/// id of the currently logged in user
+///
+/// \return an array of 2 arrays where the first indexes are resource types
+/// and each one's arrays are a list of resources available to the user where
+/// the index of each item is the id and the value is the name of the
+/// resource\n
+/// if $onlygroups == 1:\n
+/// {[computer] => {[groupid] => "groupname",\n
+/// [groupid] => "groupname"},\n
+/// [image] => {[groupid] => "groupname",\n
+/// [groupid] => "groupname"},\n
+/// ...}\n
+/// if $onlygroups == 0:\n
+/// {[computer] => {[compid] => "hostname",\n
+/// [compid] => "hosename"},\n
+/// [image] => {[imageid] => "prettyname",\n
+/// [imageid] => "prettyname"},\n
+/// ...}
+///
+/// \brief builds a list of resources a user has access to and returns it
+///
+////////////////////////////////////////////////////////////////////////////////
+function getUserResources($userprivs, $resourceprivs=array("available"),
+ $onlygroups=0, $includedeleted=0, $userid=0) {
+ global $user, $viewmode;
+ $key = getKey(array($userprivs, $resourceprivs, $onlygroups, $includedeleted, $userid));
+ if(array_key_exists($key, $_SESSION['userresources']))
+ return $_SESSION['userresources'][$key];
+ #FIXME this whole function could be much more efficient
+ if(! $userid)
+ $userid = $user["id"];
+ $return = array();
+
+ $nodeprivs = array();
+ $startnodes = array();
+ # build a list of nodes where user is granted $userprivs
+ $inlist = "'" . implode("','", $userprivs) . "'";
+ $query = "SELECT u.privnodeid "
+ . "FROM userpriv u, "
+ . "userprivtype t "
+ . "WHERE u.userprivtypeid = t.id AND "
+ . "t.name IN ($inlist) AND "
+ . "(u.userid = $userid OR "
+ . "u.usergroupid IN (SELECT usergroupid "
+ . "FROM usergroupmembers "
+ . "WHERE userid = $userid))";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_assoc($qh)) {
+ array_push($startnodes, $row["privnodeid"]);
+ }
+ # travel up tree looking at privileges granted at parent nodes
+ foreach($startnodes as $nodeid) {
+ getUserResourcesUp($nodeprivs, $nodeid, $userid, $userprivs);
+ }
+ # travel down tree looking at privileges granted at child nodes if cascade privs at this node
+ foreach($startnodes as $nodeid) {
+ getUserResourcesDown($nodeprivs, $nodeid, $userid, $userprivs);
+ }
+ $nodeprivs = simplifyNodePrivs($nodeprivs, $userprivs); // call this before calling addUserResources
+ addUserResources($nodeprivs, $userid);
+
+ # build a list of resource groups user has access to
+ $resourcegroups = array();
+ $types = getTypes("resources");
+ foreach($types["resources"] as $type) {
+ $resourcegroups[$type] = array();
+ }
+ foreach(array_keys($nodeprivs) as $nodeid) {
+ // if user doesn't have privs at this node, no need to look
+ // at any resource groups here
+ $haspriv = 0;
+ foreach($userprivs as $priv) {
+ if($nodeprivs[$nodeid][$priv])
+ $haspriv = 1;
+ }
+ if(! $haspriv)
+ continue;
+ # check to see if resource groups has any of $resourceprivs at this node
+ foreach(array_keys($nodeprivs[$nodeid]["resources"]) as $resourceid) {
+ foreach($resourceprivs as $priv) {
+ if(in_array($priv, $nodeprivs[$nodeid]["resources"][$resourceid])) {
+ list($type, $name, $id) = split('/', $resourceid);
+ if(! array_key_exists($type, $resourcegroups))
+ $resourcegroups[$type] = array();
+ if(! in_array($name, $resourcegroups[$type]))
+ $resourcegroups[$type][$id] = $name;
+ }
+ }
+ }
+ # check to see if resource groups has any of $resourceprivs cascaded to this node
+ foreach(array_keys($nodeprivs[$nodeid]["cascaderesources"]) as $resourceid) {
+ foreach($resourceprivs as $priv) {
+ if(in_array($priv, $nodeprivs[$nodeid]["cascaderesources"][$resourceid]) &&
+ ! (array_key_exists($resourceid, $nodeprivs[$nodeid]["resources"]) &&
+ in_array("block", $nodeprivs[$nodeid]["resources"][$resourceid]))) {
+ list($type, $name, $id) = split('/', $resourceid);
+ if(! array_key_exists($type, $resourcegroups))
+ $resourcegroups[$type] = array();
+ if(! in_array($name, $resourcegroups[$type]))
+ $resourcegroups[$type][$id] = $name;
+ }
+ }
+ }
+ }
+
+ addOwnedResourceGroups($resourcegroups, $userid);
+ if($onlygroups) {
+ foreach(array_keys($resourcegroups) as $type)
+ uasort($resourcegroups[$type], "sortKeepIndex");
+ $_SESSION['userresources'][$key] = $resourcegroups;
+ return $resourcegroups;
+ }
+
+ $resources = array();
+ foreach(array_keys($resourcegroups) as $type) {
+ $resources[$type] =
+ getResourcesFromGroups($resourcegroups[$type], $type, $includedeleted);
+ }
+ addOwnedResources($resources, $includedeleted, $userid);
+ $_SESSION['userresources'][$key] = $resources;
+ return $resources;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getUserResourcesUp(&$nodeprivs, $nodeid, $userid,
+/// $resourceprivs)
+///
+/// \param $nodeprivs - node privilege array used in getUserResources
+/// \param $nodeid - an id from the nodepriv table
+/// \param $userid - an id from the user table
+/// \param $resourceprivs - array of privileges to look for (such as
+/// imageAdmin, imageCheckOut, etc); don't include 'block' or 'cascade'
+///
+/// \return modifies $nodeprivs, but doesn't return anything
+///
+/// \brief adds resource privileges to $nodeprivs for the parents of $nodeid
+///
+////////////////////////////////////////////////////////////////////////////////
+function getUserResourcesUp(&$nodeprivs, $nodeid, $userid,
+ $resourceprivs) {
+ # build list of parent nodes
+ # starting at top, get images available at that node and user privs there and
+ # walk down to $nodeid
+ $nodelist = getParentNodes($nodeid);
+ array_unshift($nodelist, $nodeid);
+ $lastid = 0;
+ while(count($nodelist)) {
+ $id = array_pop($nodelist);
+ if(array_key_exists($id, $nodeprivs))
+ continue;
+
+ addNodeUserResourcePrivs($nodeprivs, $id, $lastid, $userid, $resourceprivs);
+ $lastid = $id;
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getUserResourcesDown(&$nodeprivs, $nodeid, $userid,
+/// $resourceprivs)
+///
+/// \param $nodeprivs - node privilege array used in getUserResources
+/// \param $nodeid - an id from the nodepriv table
+/// \param $userid - an id from the user table
+/// \param $resourceprivs - array of privileges to look for (such as
+/// imageAdmin, imageCheckOut, etc); don't include 'block' or 'cascade'
+///
+/// \return modifies $nodeprivs, but doesn't return anything
+///
+/// \brief recursively adds resource privileges to $nodeprivs for any children
+/// of $nodeid
+///
+////////////////////////////////////////////////////////////////////////////////
+function getUserResourcesDown(&$nodeprivs, $nodeid, $userid,
+ $resourceprivs) {
+ # FIXME can we check for cascading and if not there, don't descend?
+ $children = getChildNodes($nodeid);
+ foreach(array_keys($children) as $id) {
+ addNodeUserResourcePrivs($nodeprivs, $id, $nodeid, $userid, $resourceprivs);
+ getUserResourcesDown($nodeprivs, $id, $userid, $resourceprivs);
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn addNodeUserResourcePrivs(&$nodeprivs, $id, $lastid, $userid,
+/// $resourceprivs)
+///
+/// \param $nodeprivs - node privilege array used in getUserResources
+/// \param $id - an id from the nodepriv table
+/// \param $lastid - $id's parent, 0 if at the root
+/// \param $userid - an id from the user table
+/// \param $resourceprivs - array of privileges to look for (such as
+/// imageAdmin, imageCheckOut, etc); don't include 'block' or 'cascade'
+///
+/// \return modifies $nodeprivs, but doesn't return anything
+///
+/// \brief for $id, gets privileges and cascaded privileges the user and any
+/// groups the user is and adds them to $nodeprivs
+///
+////////////////////////////////////////////////////////////////////////////////
+function addNodeUserResourcePrivs(&$nodeprivs, $id, $lastid, $userid,
+ $resourceprivs) {
+ $nodeprivs[$id]["user"] = array("cascade" => 0);
+ foreach($resourceprivs as $priv) {
+ $nodeprivs[$id]["user"][$priv] = 0;
+ }
+
+ # add permissions for user
+ $inlist = "'" . implode("','", $resourceprivs) . "'";
+ $query = "SELECT t.name "
+ . "FROM userprivtype t, "
+ . "userpriv u "
+ . "WHERE u.userprivtypeid = t.id AND "
+ . "u.privnodeid = $id AND "
+ . "u.userid IS NOT NULL AND "
+ . "u.userid = $userid AND "
+ . "t.name IN ('block','cascade',$inlist)";
+ $qh = doQuery($query, 101);
+ $block = 0;
+ while($row = mysql_fetch_assoc($qh)) {
+ if($row["name"] != "block")
+ $nodeprivs[$id]["user"][$row["name"]] = 1;
+ else
+ $block = 1;
+ }
+ // if don't have anything in $resourceprivs, set cascade = 0
+ if($nodeprivs[$id]["user"]["cascade"]) {
+ $noprivs = 1;
+ foreach($resourceprivs as $priv) {
+ if($nodeprivs[$id]["user"][$priv])
+ $noprivs = 0;
+ }
+ if($noprivs)
+ $nodeprivs[$id]["user"]["cascade"] = 0;
+ }
+ // if not blocking at this node, and previous node had cascade
+ if($lastid && ! $block && $nodeprivs[$lastid]["user"]["cascade"]) {
+ # set cascade = 1
+ $nodeprivs[$id]["user"]["cascade"] = 1;
+ # set each priv in $resourceprivs = 1
+ foreach($resourceprivs as $priv) {
+ if($nodeprivs[$lastid]["user"][$priv])
+ $nodeprivs[$id]["user"][$priv] = 1;
+ }
+ }
+
+ # add permissions for user's groups
+ $query = "SELECT t.name, "
+ . "u.usergroupid "
+ . "FROM userprivtype t, "
+ . "userpriv u "
+ . "WHERE u.userprivtypeid = t.id AND "
+ . "u.privnodeid = $id AND "
+ . "u.usergroupid IS NOT NULL AND "
+ . "u.usergroupid IN (SELECT usergroupid "
+ . "FROM usergroupmembers "
+ . "WHERE userid = $userid) AND "
+ . "t.name IN ('block','cascade',$inlist) "
+ . "ORDER BY u.usergroupid";
+ $qh = doQuery($query, 101);
+ $basearray = array("cascade" => 0,
+ "block" => 0);
+ foreach($resourceprivs as $priv) {
+ $basearray[$priv] = 0;
+ }
+ while($row = mysql_fetch_assoc($qh)) {
+ if(! array_key_exists($row["usergroupid"], $nodeprivs[$id]))
+ $nodeprivs[$id][$row["usergroupid"]] = $basearray;
+ $nodeprivs[$id][$row["usergroupid"]][$row["name"]] = 1;
+ }
+ # add groups from $lastid if it is not 0
+ $groupkeys = array_keys($nodeprivs[$id]);
+ if($lastid) {
+ foreach(array_keys($nodeprivs[$lastid]) as $groupid) {
+ if(in_array($groupid, $groupkeys))
+ continue;
+ $nodeprivs[$id][$groupid] = $basearray;
+ }
+ }
+ foreach(array_keys($nodeprivs[$id]) as $groupid) {
+ if(! is_numeric($groupid))
+ continue;
+ // if don't have anything in $resourceprivs, set cascade = 0
+ if($nodeprivs[$id][$groupid]["cascade"]) {
+ $noprivs = 1;
+ foreach($resourceprivs as $priv) {
+ if($nodeprivs[$id][$groupid][$priv])
+ $noprivs = 0;
+ }
+ if($noprivs)
+ $nodeprivs[$id][$groupid]["cascade"] = 0;
+ }
+ // if group not blocking at this node, and group had cascade at previous
+ # node
+ if($lastid && ! $nodeprivs[$id][$groupid]["block"] &&
+ array_key_exists($groupid, $nodeprivs[$lastid]) &&
+ $nodeprivs[$lastid][$groupid]["cascade"]) {
+ # set cascade = 1
+ $nodeprivs[$id][$groupid]["cascade"] = 1;
+ # set each priv in $resourceprivs = 1
+ foreach($resourceprivs as $priv) {
+ if($nodeprivs[$lastid][$groupid][$priv])
+ $nodeprivs[$id][$groupid][$priv] = 1;
+ }
+ }
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn simplifyNodePrivs($nodeprivs, $resourceprivs)
+///
+/// \param $nodeprivs - node privilege array used in getUserResources
+/// \param $resourceprivs - array of privileges to look for (such as
+/// imageAdmin, imageCheckOut, etc); don't include 'block' or 'cascade'
+///
+/// \return a simplified version of $nodeprivs
+///
+/// \brief checks the user and group privileges for each node in $nodeprivs and
+/// creates a new privilege array that just shows if the user has that
+/// permission (either directly or from a group)
+///
+////////////////////////////////////////////////////////////////////////////////
+function simplifyNodePrivs($nodeprivs, $resourceprivs) {
+ $return = array();
+ $basearray = array();
+ foreach($resourceprivs as $priv) {
+ $basearray[$priv] = 0;
+ }
+ foreach(array_keys($nodeprivs) as $nodeid) {
+ $return[$nodeid] = $basearray;
+ foreach(array_keys($nodeprivs[$nodeid]) as $key) {
+ foreach($resourceprivs as $priv) {
+ if($nodeprivs[$nodeid][$key][$priv])
+ $return[$nodeid][$priv] = 1;
+ }
+ }
+ }
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn addUserResources(&$nodeprivs, $userid)
+///
+/// \param $nodeprivs - node privilege array used in getUserResources
+/// \param $userid - an id from the user table
+///
+/// \return modifies $nodeprivs, but doesn't return anything
+///
+/// \brief for each node in $nodeprivs, adds any resources that are available
+/// to $nodeprivs
+///
+////////////////////////////////////////////////////////////////////////////////
+function addUserResources(&$nodeprivs, $userid) {
+ require_once(".ht-inc/privileges.php");
+ foreach(array_keys($nodeprivs) as $nodeid) {
+ $privs = getNodePrivileges($nodeid, "resources");
+ $nodeprivs[$nodeid]["resources"] = $privs["resources"];
+ $privs = getNodeCascadePrivileges($nodeid, "resources");
+ $nodeprivs[$nodeid]["cascaderesources"] = $privs["resources"];
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn addOwnedResources(&$resources, $includedeleted, $userid)
+///
+/// \param $resources - array of resources from getUserResources
+/// \param $includedeleted - 1 to include deleted resources, 0 not to
+/// \param $userid - id from user table
+///
+/// \return modifies $resources, but doesn't return anything
+///
+/// \brief adds resources that the user owns
+///
+////////////////////////////////////////////////////////////////////////////////
+function addOwnedResources(&$resources, $includedeleted, $userid) {
+ foreach(array_keys($resources) as $type) {
+ if($type == "image")
+ $field = "prettyname";
+ elseif($type == "computer")
+ $field = "hostname";
+ elseif($type == "schedule")
+ $field = "name";
+ elseif($type == "managementnode")
+ $field = "hostname";
+ else
+ continue;
+ $query = "SELECT id, "
+ . "$field "
+ . "FROM $type "
+ . "WHERE ownerid = $userid";
+ if(! $includedeleted && ($type == "image" || $type == "computer"))
+ $query .= " AND deleted = 0";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_assoc($qh)) {
+ if(! array_key_exists($row["id"], $resources[$type]))
+ $resources[$type][$row["id"]] = $row[$field];
+ }
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn addOwnedResourceGroups(&$resourcegroups, $userid)
+///
+/// \param $resourcegroups - array of resources from getUserResources
+/// \param $userid - id from user table
+///
+/// \return modifies $resources, but doesn't return anything
+///
+/// \brief adds resources that the user owns
+///
+////////////////////////////////////////////////////////////////////////////////
+function addOwnedResourceGroups(&$resourcegroups, $userid) {
+ $user = getUserInfo($userid);
+ $userid = $user["id"];
+ $groupids = implode(',', array_keys($user["groups"]));
+ if(empty($groupids))
+ $groupids = "''";
+ $query = "SELECT g.id AS id, "
+ . "g.name AS name, "
+ . "t.name AS type "
+ . "FROM resourcegroup g, "
+ . "resourcetype t "
+ . "WHERE g.resourcetypeid = t.id AND "
+ . "g.ownerusergroupid IN ($groupids)";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_assoc($qh)) {
+ if(! array_key_exists($row["id"], $resourcegroups[$row["type"]]))
+ $resourcegroups[$row["type"]][$row["id"]] = $row["name"];
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getResourcesFromGroups($groups, $type, $includedeleted)
+///
+/// \param $groups - an array of group names
+/// \param $type - the type of the groups (from resourcetype table)
+/// \param $includedeleted - 1 to include deleted resources, 0 not to
+///
+/// \return an array of resources where the index is the id of the resource and
+/// the value is the name of the resource
+///
+/// \brief builds an array of resources from $groups
+///
+////////////////////////////////////////////////////////////////////////////////
+function getResourcesFromGroups($groups, $type, $includedeleted) {
+ $return = array();
+ if($type == "image")
+ $field = "prettyname";
+ elseif($type == "computer")
+ $field = "hostname";
+ elseif($type == "schedule")
+ $field = "name";
+ elseif($type == "managementnode")
+ $field = "hostname";
+ else
+ return array();
+
+ $groups = implode("','", $groups);
+ $inlist = "'$groups'";
+
+ /*$query = "SELECT t.$field AS name, "
+ . "r.subid AS id "
+ . "FROM $type t, "
+ . "resource r, "
+ . "resourcetype rt "
+ . "WHERE r.id IN (SELECT m.resourceid "
+ . "FROM resourcegroupmembers m, "
+ . "resourcegroup g, "
+ . "resourcetype t "
+ . "WHERE m.resourcegroupid = g.id AND "
+ . "g.name IN ($inlist) AND "
+ . "g.resourcetypeid = t.id AND "
+ . "t.name = '$type') AND "
+ . "r.subid = t.id ";*/
+ $query = "SELECT DISTINCT(r.subid) AS id, "
+ . "t.$field AS name "
+ . "FROM $type t, "
+ . "resource r, "
+ . "resourcegroupmembers m, "
+ . "resourcegroup g, "
+ . "resourcetype rt "
+ . "WHERE r.subid = t.id AND "
+ . "r.id = m.resourceid AND "
+ . "m.resourcegroupid = g.id AND "
+ . "g.name IN ($inlist) AND "
+ . "g.resourcetypeid = rt.id AND "
+ . "rt.name = '$type'";
+ if(! $includedeleted && ($type == "image" || $type == "computer")) {
+ $query .= "AND deleted = 0 ";
+ }
+ /*if($type == "image")
+ $query .= "AND test = 0 ";*/
+ $query .= "ORDER BY t.$field";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_assoc($qh)) {
+ $return[$row["id"]] = $row["name"];
+ }
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn updateUserOrGroupPrivs($name, $node, $adds, $removes, $mode)
+///
+/// \param $name - unityid, user id, user group name, or user group id
+/// \param $node - id of the node
+/// \param $adds - array of privs (the name, not the id) to add
+/// \param $removes - array of privs (the name, not the id) to remove
+/// \param $mode - "user" or "group"
+///
+/// \brief adds/removes $adds/$removes privs for $unityid to/from $node
+///
+////////////////////////////////////////////////////////////////////////////////
+function updateUserOrGroupPrivs($name, $node, $adds, $removes, $mode) {
+ if(! (count($adds) || count($removes))) {
+ return;
+ }
+ if($mode == "user") {
+ $field = "userid";
+ if(is_numeric($name))
+ $id = $name;
+ else {
+ $id = getUserlistID($name);
+ if(! $id)
+ $id = addUser($name);
+ }
+ }
+ else {
+ $field = "usergroupid";
+ if(is_numeric($name))
+ $id = $name;
+ else
+ $id = getUserGroupID($name);
+ }
+ foreach($adds as $type) {
+ $typeid = getUserPrivTypeID($type);
+ $query = "INSERT IGNORE INTO userpriv ("
+ . "$field, "
+ . "privnodeid, "
+ . "userprivtypeid) "
+ . "VALUES ("
+ . "$id, "
+ . "$node, "
+ . "$typeid)";
+ doQuery($query, 375);
+ }
+ foreach($removes as $type) {
+ $typeid = getUserPrivTypeID($type);
+ $query = "DELETE FROM userpriv "
+ . "WHERE $field = $id AND "
+ . "privnodeid = $node AND "
+ . "userprivtypeid = $typeid";
+ doQuery($query, 376);
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn updateResourcePrivs($group, $node, $adds, $removes)
+///
+/// \param $group - id from resourcegroup table, or group name of the form
+/// type/name
+/// \param $node - id of the node
+/// \param $adds - array of privs (the name, not the id) to add
+/// \param $removes - array of privs (the name, not the id) to remove
+///
+/// \brief adds/removes $adds/$removes privs for $name to/from $node
+///
+////////////////////////////////////////////////////////////////////////////////
+function updateResourcePrivs($group, $node, $adds, $removes) {
+ if(! (count($adds) || count($removes))) {
+ return;
+ }
+ if(is_numeric($group))
+ $groupid = $group;
+ else
+ $groupid = getResourceGroupID($group);
+ foreach($adds as $type) {
+ $query = "INSERT IGNORE INTO resourcepriv ("
+ . "resourcegroupid, "
+ . "privnodeid, "
+ . "type) "
+ . "VALUES ("
+ . "$groupid, "
+ . "$node, "
+ . "'$type')";
+ doQuery($query, 377);
+ }
+ foreach($removes as $type) {
+ $query = "DELETE FROM resourcepriv "
+ . "WHERE resourcegroupid = $groupid AND "
+ . "privnodeid = $node AND "
+ . "type = '$type'";
+ doQuery($query, 378);
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getKey($data)
+///
+/// \param $data - an array
+///
+/// \return an md5 string that is unique for $data
+///
+/// \brief generates an md5sum for $data
+///
+////////////////////////////////////////////////////////////////////////////////
+function getKey($data) {
+ $newdata = array();
+ foreach($data as $arr)
+ if(is_array($arr))
+ $newdata = array_merge_recursive($newdata, $arr);
+ else
+ array_push($newdata, $arr);
+ $rc = '';
+ foreach($newdata as $key => $val)
+ $rc = md5("$rc$key$val");
+ return $rc;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn encryptData($data)
+///
+/// \param $data - a string
+///
+/// \return an encrypted form of the string that has been base64 encoded
+///
+/// \brief encrypts $data with blowfish and base64 encodes it
+///
+////////////////////////////////////////////////////////////////////////////////
+function encryptData($data) {
+ global $mcryptkey, $mcryptiv;
+ if(! $data)
+ return false;
+
+ $cryptdata = mcrypt_encrypt(MCRYPT_BLOWFISH, $mcryptkey, $data, MCRYPT_MODE_CBC, $mcryptiv);
+ return trim(base64_encode($cryptdata));
+ #return base64_encode($cryptdata);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn decryptData($data)
+///
+/// \param $data - a string
+///
+/// \return decrypted form of $data
+///
+/// \brief base64 decodes $data and decrypts it
+///
+////////////////////////////////////////////////////////////////////////////////
+function decryptData($data) {
+ global $mcryptkey, $mcryptiv;
+ if(! $data)
+ return false;
+
+ $cryptdata = base64_decode($data);
+ $decryptdata = mcrypt_decrypt(MCRYPT_BLOWFISH, $mcryptkey, $cryptdata, MCRYPT_MODE_CBC, $mcryptiv);
+ return trim($decryptdata);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getParentNodes($node)
+///
+/// \param $node - a privnode id
+///
+/// \return an array of parents of $node
+///
+/// \brief build array of node's parents with 0th index being immediate parent
+///
+////////////////////////////////////////////////////////////////////////////////
+function getParentNodes($node) {
+ global $nodeparents;
+ if(array_key_exists($node, $nodeparents))
+ return $nodeparents[$node];
+
+ $nodelist = array();
+ while($node != 1) {
+ $nodeinfo = getNodeInfo($node);
+ $node = $nodeinfo["parent"];
+ if($node == NULL)
+ break;
+ array_push($nodelist, $node);
+ }
+ $nodeparents[$node] = $nodelist;
+ return $nodelist;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getChildNodes($parent)
+///
+/// \param parent - (optional) the parent of all the children; defaults to 2
+/// (the root node)
+///
+/// \return an array of nodes
+///
+/// \brief gets all children for $parent
+///
+////////////////////////////////////////////////////////////////////////////////
+function getChildNodes($parent=DEFAULT_PRIVNODE) {
+ global $nodechildren;
+ if(array_key_exists($parent, $nodechildren))
+ return $nodechildren[$parent];
+
+ $query = "SELECT * FROM privnode WHERE parent = $parent ORDER BY name";
+ $qh = doQuery($query, 325);
+ $children = array();
+ while($row = mysql_fetch_assoc($qh)) {
+ if($row["name"] == "Root")
+ continue;
+ $children[$row["id"]]["parent"] = $row["parent"];
+ $children[$row["id"]]["name"] = $row["name"];
+ }
+ $nodechildren[$parent] = $children;
+ return $children;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getUserGroups($groupType, $affiliationid)
+///
+/// \param $groupType - (optional, default = 0) 0 for all groups, 1 for custom
+/// groups, 2 for courseroll groups
+/// \param $affiliationid - (optional, default = 0) 0 for groups of any
+/// affiliation, or the id of an affiliation for only groups with that
+/// affiliation
+///
+/// \return an array where each index is an id from usergroup and the values
+/// are arrays with the indexes:\n
+/// name\n
+/// ownerid\n
+/// owner\n
+/// custom\n
+/// initialmaxtime\n
+/// totalmaxtime\n
+/// maxextendtime\n
+/// overlapResCount
+///
+/// \brief builds list of user groups\n
+///
+////////////////////////////////////////////////////////////////////////////////
+function getUserGroups($groupType=0, $affiliationid=0) {
+ global $user;
+ $return = array();
+ $query = "SELECT ug.id, "
+ . "ug.name, "
+ . "ga.name AS groupaffiliation, "
+ . "ug.affiliationid AS groupaffiliationid, "
+ . "ug.ownerid, "
+ . "u.unityid AS owner, "
+ . "a.name AS affiliation, "
+ . "ug.editusergroupid AS editgroupid, "
+ . "eug.name AS editgroup, "
+ . "eug.affiliationid AS editgroupaffiliationid, "
+ . "euga.name AS editgroupaffiliation, "
+ . "ug.custom, "
+ . "ug.courseroll, "
+ . "ug.initialmaxtime, "
+ . "ug.totalmaxtime, "
+ . "ug.maxextendtime, "
+ . "ug.overlapResCount "
+ . "FROM usergroup ug "
+ . "LEFT JOIN user u ON (ug.ownerid = u.id) "
+ . "LEFT JOIN usergroup eug ON (ug.editusergroupid = eug.id) "
+ . "LEFT JOIN affiliation a ON (u.affiliationid = a.id) "
+ . "LEFT JOIN affiliation ga ON (ug.affiliationid = ga.id) "
+ . "LEFT JOIN affiliation euga ON (eug.affiliationid = euga.id) "
+ . "WHERE 1 ";
+ if($groupType == 1)
+ $query .= "AND ug.custom = 1 ";
+ elseif($groupType == 2)
+ $query .= "AND ug.courseroll = 1 ";
+ if(! $user['showallgroups'] && $affiliationid)
+ $query .= "AND ug.affiliationid = $affiliationid ";
+ $query .= "ORDER BY name";
+ $qh = doQuery($query, 280);
+ while($row = mysql_fetch_assoc($qh)) {
+ if(! empty($row["owner"]) && ! empty($row['affiliation']))
+ $row['owner'] = "{$row['owner']}@{$row['affiliation']}";
+ if($user['showallgroups'] || $affiliationid == 0)
+ $row['name'] = "{$row['name']}@{$row['groupaffiliation']}";
+ $return[$row["id"]] = $row;
+ }
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getUserEditGroups($id)
+///
+/// \param $id - user id (string or numeric)
+///
+/// \return an array of groups where each key is the group id
+///
+/// \brief builds an array of groups for which $id can edit the membership
+///
+////////////////////////////////////////////////////////////////////////////////
+function getUserEditGroups($id) {
+ global $user;
+ if(! is_numeric($id))
+ $id = getUserlistID($id);
+ if($user['showallgroups']) {
+ $query = "SELECT DISTINCT(u.id), "
+ . "CONCAT(u.name, '@', a.name) AS name "
+ . "FROM `usergroup` u, "
+ . "`usergroupmembers` m, "
+ . "affiliation a "
+ . "WHERE u.editusergroupid = m.usergroupid AND "
+ . "u.affiliationid = a.id AND "
+ . "(u.ownerid = $id OR m.userid = $id)";
+ }
+ else {
+ $query = "SELECT DISTINCT(u.id), "
+ . "u.name "
+ . "FROM `usergroup` u, "
+ . "`usergroupmembers` m "
+ . "WHERE u.editusergroupid = m.usergroupid AND "
+ . "(u.ownerid = $id OR m.userid = $id) AND "
+ . "u.affiliationid = {$user['affiliationid']}";
+ }
+ $qh = doQuery($query, 101);
+ $groups = array();
+ while($row = mysql_fetch_assoc($qh)) {
+ $groups[$row['id']] = $row['name'];
+ }
+ return $groups;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getResourceGroups($type)
+///
+/// \param $type - (optional) a name from the resourcetype table, defaults to
+/// be empty
+///
+/// \return an array of resource group names whose index values are the ids;
+/// the names are the resource type and group name combined as 'type/name'
+///
+/// \brief builds list of resource groups
+///
+////////////////////////////////////////////////////////////////////////////////
+function getResourceGroups($type="") {
+ $return = array();
+ $query = "SELECT g.id AS id, "
+ . "g.name AS name, "
+ . "t.name AS type, "
+ . "g.ownerusergroupid AS ownerid, "
+ . "CONCAT(u.name, '@', a.name) AS owner "
+ . "FROM resourcegroup g, "
+ . "resourcetype t, "
+ . "usergroup u, "
+ . "affiliation a "
+ . "WHERE g.resourcetypeid = t.id AND "
+ . "g.ownerusergroupid = u.id AND "
+ . "u.affiliationid = a.id ";
+
+ if(! empty($type))
+ $query .= "AND t.name = '$type' ";
+
+ $query .= "ORDER BY t.name, g.name";
+ $qh = doQuery($query, 281);
+ while($row = mysql_fetch_assoc($qh)) {
+ if(empty($type))
+ $return[$row["id"]]["name"] = $row["type"] . "/" . $row["name"];
+ else
+ $return[$row["id"]]["name"] = $row["name"];
+ $return[$row["id"]]["ownerid"] = $row["ownerid"];
+ $return[$row["id"]]["owner"] = $row["owner"];
+ }
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getResourceGroupMemberships($type)
+///
+/// \param $type - (optional) a name from the resourcetype table, defaults to
+/// "all"
+///
+/// \return an array where each index is a resource type and the values are
+/// arrays where each index is a resource id and its values are an array of
+/// resource group ids that it is a member of
+///
+/// \brief builds an array of group memberships for resources
+///
+////////////////////////////////////////////////////////////////////////////////
+function getResourceGroupMemberships($type="all") {
+ $return = array();
+
+ if($type == "all")
+ $types = getTypes("resources");
+ else
+ $types = array("resources" => array($type));
+
+ foreach($types["resources"] as $type) {
+ $return[$type] = array();
+ $query = "SELECT r.subid AS id, "
+ . "gm.resourcegroupid AS groupid "
+ . "FROM resource r, "
+ . "resourcegroupmembers gm, "
+ . "resourcetype t "
+ . "where t.name = '$type' AND "
+ . "gm.resourceid = r.id AND "
+ . "r.resourcetypeid = t.id";
+ $qh = doQuery($query, 282);
+ while($row = mysql_fetch_assoc($qh)) {
+ if(array_key_exists($row["id"], $return[$type])) {
+ array_push($return[$type][$row["id"]], $row["groupid"]);
+ }
+ else {
+ $return[$type][$row["id"]] = array($row["groupid"]);
+ }
+ }
+ }
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getResourceGroupMembers($type)
+///
+/// \param $type - (optional) a name from the resourcetype table, defaults to
+/// "all"
+///
+/// \return an array where each index is a resource type and the values are
+/// arrays where each index is a resourcegroup id and its values are an array of
+/// resource ids that are each an array, resulting in this:\n
+/// Array {\n
+/// [resourcetype] => Array {\n
+/// [resourcegroupid] => Array {\n
+/// [resourceid] => Array {\n
+/// [subid] => resource sub id\n
+/// [name] => name of resource\n
+/// }\n
+/// }\n
+/// }\n
+/// }
+///
+/// \brief builds an array of resource group members that don't have the deleted
+/// flag set
+///
+////////////////////////////////////////////////////////////////////////////////
+function getResourceGroupMembers($type="all") {
+ $key = getKey(array('getResourceGroupMembers', $type));
+ if(array_key_exists($key, $_SESSION['userresources']))
+ return $_SESSION['userresources'][$key];
+ $return = array();
+
+ if($type == "computer") {
+ $names = "c.hostname AS computer, c.deleted ";
+ $joins = "LEFT JOIN computer c ON (r.subid = c.id AND r.resourcetypeid = 12) ";
+ $orders = "c.hostname";
+ $types = "'computer'";
+ }
+ elseif($type == "image") {
+ $names = "i.prettyname AS image, i.deleted ";
+ $joins = "LEFT JOIN image i ON (r.subid = i.id AND r.resourcetypeid = 13) ";
+ $orders = "i.prettyname";
+ $types = "'image'";
+ }
+ elseif($type == "schedule") {
+ $names = "s.name AS schedule ";
+ $joins = "LEFT JOIN schedule s ON (r.subid = s.id AND r.resourcetypeid = 15) ";
+ $orders = "s.name";
+ $types = "'schedule'";
+ }
+ elseif($type == "managementnode") {
+ $names = "m.hostname AS managementnode ";
+ $joins = "LEFT JOIN managementnode m ON (r.subid = m.id AND r.resourcetypeid = 16) ";
+ $orders = "m.hostname";
+ $types = "'managementnode'";
+ }
+ else {
+ $names = "c.hostname AS computer, "
+ . "c.deleted, "
+ . "i.prettyname AS image, "
+ . "i.deleted AS deleted2, "
+ . "s.name AS schedule, "
+ . "m.hostname AS managementnode ";
+ $joins = "LEFT JOIN computer c ON (r.subid = c.id AND r.resourcetypeid = 12) "
+ . "LEFT JOIN image i ON (r.subid = i.id AND r.resourcetypeid = 13) "
+ . "LEFT JOIN schedule s ON (r.subid = s.id AND r.resourcetypeid = 15) "
+ . "LEFT JOIN managementnode m ON (r.subid = m.id AND r.resourcetypeid = 16) ";
+ $orders = "c.hostname, "
+ . "i.prettyname, "
+ . "s.name, "
+ . "m.hostname";
+ $types = "'computer','image','schedule','managementnode'";
+ }
+
+ $query = "SELECT rgm.resourcegroupid, "
+ . "rgm.resourceid, "
+ . "rt.name AS resourcetype, "
+ . "r.subid, "
+ . $names
+ . "FROM resourcegroupmembers rgm, "
+ . "resourcetype rt, "
+ . "resource r "
+ . $joins
+ . "WHERE rgm.resourceid = r.id AND "
+ . "r.resourcetypeid = rt.id AND "
+ . "rt.name in ($types) "
+ . "ORDER BY rt.name, "
+ . "rgm.resourcegroupid, "
+ . $orders;
+ $qh = doQuery($query, 282);
+ while($row = mysql_fetch_assoc($qh)) {
+ if(array_key_exists('deleted', $row) && $row['deleted'] == 1)
+ continue;
+ if(array_key_exists('deleted2', $row) && $row['deleted2'] == 1)
+ continue;
+ if(! array_key_exists($row['resourcetype'], $return))
+ $return[$row['resourcetype']] = array();
+ if(! array_key_exists($row['resourcegroupid'], $return[$row['resourcetype']]))
+ $return[$row['resourcetype']][$row['resourcegroupid']] = array();
+ $return[$row['resourcetype']][$row['resourcegroupid']][$row['resourceid']] =
+ array('subid' => $row['subid'],
+ 'name' => $row[$row['resourcetype']]);
+ }
+ $_SESSION['userresources'][$key] = $return;
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getUserGroupMembers($groupid)
+///
+/// \param $groupid - a usergroup id
+///
+/// \return an array of unityids where the index is the userid
+///
+/// \brief builds an array of user group memberships
+///
+////////////////////////////////////////////////////////////////////////////////
+function getUserGroupMembers($groupid) {
+ $return = array();
+
+ $query = "SELECT m.userid AS id, "
+ . "CONCAT(u.unityid, '@', a.name) AS user "
+ . "FROM usergroupmembers m, "
+ . "affiliation a, "
+ . "user u "
+ . "WHERE m.usergroupid = $groupid AND "
+ . "m.userid = u.id AND "
+ . "u.affiliationid = a.id "
+ . "ORDER BY u.unityid";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_assoc($qh)) {
+ $return[$row["id"]] = $row['user'];
+ }
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn addUserGroupMember($unityid, $groupid)
+///
+/// \param $unityid - a user's unityid
+/// \param $groupid - a usergroup id
+///
+/// \brief adds an entry to usergroupmembers for $unityid and $groupid
+///
+////////////////////////////////////////////////////////////////////////////////
+function addUserGroupMember($unityid, $groupid) {
+ $userid = getUserlistID($unityid);
+ $groups = getUsersGroups($userid);
+
+ if(in_array($groupid, array_keys($groups)))
+ return;
+
+ //$userid = getUserlistID($unityid);
+ $query = "INSERT INTO usergroupmembers "
+ . "(userid, "
+ . "usergroupid) "
+ . "VALUES "
+ . "($userid, "
+ . "$groupid)";
+ doQuery($query, 101);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn deleteUserGroupMember($userid, $groupid)
+///
+/// \param $userid - a userid
+/// \param $groupid - a usergroup id
+///
+/// \brief deletes an entry from usergroupmembers for $userid and $groupid
+///
+////////////////////////////////////////////////////////////////////////////////
+function deleteUserGroupMember($userid, $groupid) {
+ $query = "DELETE FROM usergroupmembers "
+ . "WHERE userid = $userid AND "
+ . "usergroupid = $groupid";
+ doQuery($query, 101);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getUserlistID($loginid)
+///
+/// \param $loginid - login ID
+///
+/// \return id from userlist table for the user
+///
+/// \brief gets id field from userlist table for $loginid; if it does not exist,
+/// calls addUser to add it to the table
+///
+////////////////////////////////////////////////////////////////////////////////
+function getUserlistID($loginid) {
+ $_loginid = $loginid;
+ getAffilidAndLogin($loginid, $affilid);
+
+ if(empty($affilid))
+ abort(11);
+
+ $query = "SELECT id "
+ . "FROM user "
+ . "WHERE unityid = '$loginid' AND "
+ . "affiliationid = $affilid";
+ $qh = doQuery($query, 140);
+ if(mysql_num_rows($qh)) {
+ $row = mysql_fetch_row($qh);
+ return $row[0];
+ }
+ return addUser($_loginid);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getUsersLastImage($userid)
+///
+/// \param $userid - a numeric user id
+///
+/// \return id of user's last used image or NULL if user has no entries in the
+/// log table
+///
+/// \brief gets the user's last used image from the log table
+///
+////////////////////////////////////////////////////////////////////////////////
+function getUsersLastImage($userid) {
+ $query = "SELECT imageid "
+ . "FROM log "
+ . "WHERE userid = $userid "
+ . "ORDER BY start DESC "
+ . "LIMIT 1";
+ $qh = doQuery($query, 101);
+ if($row = mysql_fetch_assoc($qh))
+ return $row['imageid'];
+ return NULL;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getAffiliations()
+///
+/// \return an array of affiliations where each index is the id of the
+/// affiliation
+///
+/// \brief gets a list of all affiliations
+///
+////////////////////////////////////////////////////////////////////////////////
+function getAffiliations() {
+ $query = "SELECT id, name FROM affiliation ORDER BY name";
+ $qh = doQuery($query, 101);
+ $return = array();
+ while($row = mysql_fetch_assoc($qh))
+ $return[$row['id']] = $row['name'];
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getUserUnityID($userid)
+///
+/// \param $userid - an id from the user table
+///
+/// \return unityid for $userid or NULL if $userid not found
+///
+/// \brief gets the unityid for $userid
+///
+////////////////////////////////////////////////////////////////////////////////
+function getUserUnityID($userid) {
+ global $cache;
+ if(array_key_exists($userid, $cache['unityids']))
+ return $cache['unityids'][$userid];
+ $query = "SELECT unityid FROM user WHERE id = $userid";
+ $qh = doQuery($query, 101);
+ if(mysql_num_rows($qh)) {
+ $row = mysql_fetch_row($qh);
+ $cache['unityids'][$userid] = $row[0];
+ return $row[0];
+ }
+ return NULL;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getAffiliationID($affil)
+///
+/// \param $affil - name of an affiliation
+///
+/// \return id from affiliation table
+///
+/// \brief gets id field from affiliation table for $affil
+///
+////////////////////////////////////////////////////////////////////////////////
+function getAffiliationID($affil) {
+ $query = "SELECT id FROM affiliation WHERE name = '$affil'";
+ $qh = doQuery($query, 101);
+ if(mysql_num_rows($qh)) {
+ $row = mysql_fetch_row($qh);
+ return $row[0];
+ }
+ return NULL;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getAffiliationName($affilid)
+///
+/// \param $affilid - id of an affiliation
+///
+/// \return name from affiliation table
+///
+/// \brief gets name field from affiliation table for $affilid
+///
+////////////////////////////////////////////////////////////////////////////////
+function getAffiliationName($affilid) {
+ $query = "SELECT name FROM affiliation WHERE id = $affilid";
+ $qh = doQuery($query, 101);
+ if(mysql_num_rows($qh)) {
+ $row = mysql_fetch_row($qh);
+ return $row[0];
+ }
+ return NULL;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getAffiliationDataUpdateText($affilid)
+///
+/// \param $affilid - (optional) specify an affiliation id to get only the text
+/// for that id
+///
+/// \return an array of the html text to display for updating user information
+/// that is displayed on the User Preferences page
+///
+/// \brief gets dataUpdateText from affiliation table
+///
+////////////////////////////////////////////////////////////////////////////////
+function getAffiliationDataUpdateText($affilid=0) {
+ $query = "SELECT id, dataUpdateText FROM affiliation";
+ if($affilid)
+ $query .= " WHERE id = $affilid";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_assoc($qh))
+ $return[$row['id']] = $row['dataUpdateText'];
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn processInputVar($vartag, $type, $defaultvalue)
+///
+/// \param $vartag - name of GET or POST variable
+/// \param $type - tag type:\n
+/// \b ARG_NUMERIC - numeric\n
+/// \b ARG_STRING - string\n
+/// \b ARG_MULTINUMERIC - an array of numbers
+/// \param $defaultvalue - default value for the variable (NULL if not passed in)
+///
+/// \return safe value for the GET or POST variable
+///
+/// \brief checks for $vartag in the $_POST array, then the $_GET array; then
+/// sanitizes the variable to make sure it doesn't contain anything malicious
+///
+////////////////////////////////////////////////////////////////////////////////
+function processInputVar($vartag, $type, $defaultvalue=NULL) {
+ if((array_key_exists($vartag, $_POST) &&
+ strncmp("$_POST[$vartag]", "0", 1) == 0 &&
+ $type == ARG_NUMERIC &&
+ strncmp("$_POST[$vartag]", "0x0", 3) != 0) ||
+ (array_key_exists($vartag, $_GET) &&
+ strncmp("$_GET[$vartag]", "0", 1) == 0 &&
+ $type == ARG_NUMERIC &&
+ strncmp("$_GET[$vartag]", "0x0", 3) != 0)) {
+ $_POST[$vartag] = "zero";
+ }
+ if(!empty($_POST[$vartag])) {
+ $return = $_POST[$vartag];
+ }
+ elseif(!empty($_GET[$vartag])) {
+ $return = $_GET[$vartag];
+ }
+ else {
+ if($type == ARG_MULTINUMERIC || $type == ARG_MULTISTRING) {
+ $return = array();
+ }
+ else {
+ $return = $defaultvalue;
+ }
+ }
+ if($return == "zero") {
+ $return = "0";
+ }
+
+ if($type == ARG_MULTINUMERIC) {
+ foreach($return as $index => $value) {
+ $return[$index] = strip_tags($value);
+ if($return[$index] == 'zero')
+ $return[$index] = '0';
+ }
+ }
+ elseif($type == ARG_MULTISTRING) {
+ foreach($return as $index => $value) {
+ $return[$index] = strip_tags($value);
+ }
+ }
+ else {
+ $return = strip_tags($return);
+ }
+
+ if(! empty($return) && $type == ARG_NUMERIC) {
+ if(! is_numeric($return)) {
+ return preg_replace('([^\d])', '', $return);
+ }
+ }
+ elseif(! empty($return) && $type == ARG_STRING) {
+ if(! is_string($return)) {
+ print "ERROR (code:3)<br>\n";
+ printHTMLFooter();
+ semUnlock();
+ exit();
+ }
+ #print "before - $return<br>\n";
+ #$return = addslashes($return);
+ #$return = str_replace("\'", "", $return);
+ #$return = str_replace("\"", "", $return);
+ #print "after - $return<br>\n";
+ }
+ elseif(! empty($return) && $type == ARG_MULTINUMERIC) {
+ foreach($return as $index => $value) {
+ if(! is_numeric($value)) {
+ $return[$index] = preg_replace('([^\d])', '', $value);
+ }
+ }
+ return $return;
+ }
+ elseif(! empty($return) && $type == ARG_MULTISTRING) {
+ foreach($return as $index => $value) {
+ if(! is_string($value)) {
+ print "ERROR (code:3)<br>\n";
+ printHTMLFooter();
+ semUnlock();
+ exit();
+ }
+ }
+ return $return;
+ }
+
+ if(is_string($return)) {
+ if(strlen($return) == 0) {
+ $return = $defaultvalue;
+ }
+ }
+
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getContinuationVar($name, $defaultval)
+///
+/// \param $name (optional, default=NULL)- key of value to return from
+/// $contdata or omit to get all of $contdata
+/// \param $defaultval (optional, default=NULL) - default value in case $name
+/// does not exist in $contdata
+///
+/// \return if $name is passed, $contdata[$name] or $defaultval; if $name is
+/// omitted, $contdata
+///
+/// \brief returns the requested value from $contdata or a default value if
+/// $name does not exist in $contdata; if both args are omitted, just return all
+/// of $contdata
+///
+////////////////////////////////////////////////////////////////////////////////
+function getContinuationVar($name=NULL, $defaultval=NULL) {
+ global $contdata, $inContinuation;
+ if($name === NULL) {
+ return $contdata;
+ }
+ if(! $inContinuation)
+ return $defaultval;
+ if(array_key_exists($name, $contdata)) {
+ if($contdata[$name] == 'zero')
+ return 0;
+ return $contdata[$name];
+ }
+ return $defaultval;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn processInputData($data, $type, $addslashes, $defaultvalue)
+///
+/// \param $data - data to sanitize
+/// \param $type - tag type:\n
+/// \b ARG_NUMERIC - numeric\n
+/// \b ARG_STRING - string\n
+/// \b ARG_MULTINUMERIC - an array of numbers
+/// \param $addslashes - (optional, defaults to 0) set to 1 if values should
+/// have addslashes called to escape things
+/// \param $defaultvalue - (optional, defaults to NULL) default value for the
+/// variable
+///
+/// \return a sanitized version of $data
+///
+/// \brief sanitizes $data to keep bad stuff from being passed in
+///
+////////////////////////////////////////////////////////////////////////////////
+function processInputData($data, $type, $addslashes=0, $defaultvalue=NULL) {
+ if(strncmp("$data", "0", 1) == 0 &&
+ $type == ARG_NUMERIC &&
+ strncmp("$data", "0x0", 3) != 0) {
+ $data = "zero";
+ }
+ if(!empty($data))
+ $return = $data;
+ else {
+ if($type == ARG_MULTINUMERIC || $type == ARG_MULTISTRING)
+ $return = array();
+ else
+ $return = $defaultvalue;
+ }
+ if($return == "zero")
+ $return = "0";
+
+ if($type == ARG_MULTINUMERIC) {
+ foreach($return as $index => $value) {
+ $return[$index] = strip_tags($value);
+ if($return[$index] == 'zero')
+ $return[$index] = '0';
+ }
+ }
+ elseif($type == ARG_MULTISTRING) {
+ foreach($return as $index => $value) {
+ $return[$index] = strip_tags($value);
+ }
+ }
+ else
+ $return = strip_tags($return);
+
+ if(! empty($return) && $type == ARG_NUMERIC) {
+ if(! is_numeric($return)) {
+ return preg_replace('([^\d])', '', $return);
+ }
+ }
+ elseif(! empty($return) && $type == ARG_STRING) {
+ if(! is_string($return))
+ $return = $defaultvalue;
+ }
+ elseif(! empty($return) && $type == ARG_MULTINUMERIC) {
+ foreach($return as $index => $value) {
+ if(! is_numeric($value)) {
+ $return[$index] = preg_replace('([^\d])', '', $value);
+ }
+ }
+ return $return;
+ }
+ elseif(! empty($return) && $type == ARG_MULTISTRING) {
+ foreach($return as $index => $value) {
+ if(! is_string($value))
+ $return[$index] = $defaultvalue;
+ elseif($addslashes)
+ $return[$index] = addslashes($value);
+ }
+ return $return;
+ }
+
+ if(is_string($return)) {
+ if(strlen($return) == 0)
+ $return = $defaultvalue;
+ elseif($addslashes)
+ $return = addslashes($return);
+ }
+
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getUserInfo($id)
+///
+/// \param $id - unity ID for the user or user's id from database
+///
+/// \return 0 if fail to fetch data or $user - an array with these elements:\n
+/// \b unityid - unity ID for the user\n
+/// \b affiliationid - affiliation id of user\n
+/// \b affiliation - affiliation of user\n
+/// \b login - login ID for the user (unity ID or part before \@sign)\n
+/// \b curriculum - curriculum user is in\n
+/// \b firstname - user's first name\n
+/// \b middlename - user's middle name\n
+/// \b lastname - user's last name\n
+/// \b preferredname - user's preferred name\n
+/// \b email - user's preferred email address\n
+/// \b emailnotices - bool for sending email notices to user\n
+/// \b IMtype - user's preferred IM protocol\n
+/// \b IMid - user's IM id\n
+/// \b id - user's id from database\n
+/// \b adminlevel - user's admin level (= 'none' if no admin access)\n
+/// \b adminlevelid - id for user's adminlevel\n
+/// \b width - pixel width for rdp files\n
+/// \b height - pixel height for rdp files\n
+/// \b bpp - color depth for rdp files\n
+/// \b audiomode - 'none' or 'local' - audio mode for rdp files\n
+/// \b mapdrives - 0 or 1 - map drives for rdp files; 1 means to map\n
+/// \b mapprinters - 0 or 1 - map printers for rdp files; 1 means to map\n
+/// \b mapserial - 0 or 1 - map serial ports for rdp files; 1 means to map\n
+/// \b showallgroups - 0 or 1 - show only user groups matching user's
+/// affiliation or show all user groups\n
+/// \b lastupdated - datetime the information was last updated\n
+/// \b groups - array of groups user is a member of where the index is the id
+/// of the group and the value is the name of the group\n
+/// \b privileges - array of privileges that the user has
+///
+/// \brief gets the user's information from the db and puts it into an array;
+/// if the user is not in the db, query ldap and add them; if the user changed
+/// their name and unity id; fix information in db based on numeric unity id
+///
+////////////////////////////////////////////////////////////////////////////////
+function getUserInfo($id) {
+ $affilid = DEFAULT_AFFILID;
+ if(! is_numeric($id))
+ getAffilidAndLogin($id, $affilid);
+
+ $user = array();
+ $query = "SELECT u.unityid AS unityid, "
+ . "u.affiliationid, "
+ . "af.name AS affiliation, "
+ . "c.name AS curriculum, "
+ . "u.firstname AS firstname, "
+ . "u.middlename AS middlename, "
+ . "u.lastname AS lastname, "
+ . "u.preferredname AS preferredname, "
+ . "u.email AS email, "
+ . "u.emailnotices, "
+ . "i.name AS IMtype, "
+ . "u.IMid AS IMid, "
+ . "u.id AS id, "
+ . "a.name AS adminlevel, "
+ . "a.id AS adminlevelid, "
+ . "u.width AS width, "
+ . "u.height AS height, "
+ . "u.bpp AS bpp, "
+ . "u.audiomode AS audiomode, "
+ . "u.mapdrives AS mapdrives, "
+ . "u.mapprinters AS mapprinters, "
+ . "u.mapserial AS mapserial, "
+ . "u.showallgroups, "
+ . "u.lastupdated AS lastupdated "
+ . "FROM user u, "
+ . "curriculum c, "
+ . "IMtype i, "
+ . "affiliation af, "
+ . "adminlevel a "
+ . "WHERE u.curriculumid = c.id AND "
+ . "u.IMtypeid = i.id AND "
+ . "u.adminlevelid = a.id AND "
+ . "u.affiliationid = af.id AND ";
+ if(is_numeric($id))
+ $query .= "u.id = $id";
+ else
+ $query .= "u.unityid = '$id' AND af.id = $affilid";
+
+ $qh = doQuery($query, "105");
+ if($user = mysql_fetch_assoc($qh)) {
+ if((datetimeToUnix($user["lastupdated"]) > time() - SECINDAY) ||
+ $user['unityid'] == 'vclreload' ||
+ $user['affiliation'] == 'Local') {
+ # get user's groups
+ $user["groups"] = getUsersGroups($user["id"], 1);
+
+ checkExpiredDemoUser($user['id'], $user['groups']);
+
+ # get user's privileges
+ $user["privileges"] = getOverallUserPrivs($user["id"]);
+
+ if(preg_match('/@/', $user['unityid'])) {
+ $tmparr = explode('@', $user['unityid']);
+ $user['login'] = $tmparr[0];
+ }
+ else
+ $user['login'] = $user['unityid'];
+
+ return $user;
+ }
+ }
+ if(is_numeric($id))
+ return updateUserData($id, "numeric");
+ return updateUserData($id, "loginid", $affilid);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getUsersGroups($userid, $includeowned)
+///
+/// \param $userid - an id from the user table
+/// \param $includeowned - include groups the user owns but is not in
+///
+/// \return an array of the user's groups where the index is the id of the
+/// group
+///
+/// \brief builds a array of the groups the user is member of
+///
+////////////////////////////////////////////////////////////////////////////////
+function getUsersGroups($userid, $includeowned=0) {
+ $query = "SELECT m.usergroupid, "
+ . "g.name "
+ . "FROM usergroupmembers m, "
+ . "usergroup g "
+ . "WHERE m.userid = $userid AND "
+ . "m.usergroupid = g.id";
+ $qh = doQuery($query, "101");
+ $groups = array();
+ while($row = mysql_fetch_assoc($qh)) {
+ $groups[$row["usergroupid"]] = $row["name"];
+ }
+ if($includeowned) {
+ $query = "SELECT id AS usergroupid, "
+ . "name "
+ . "FROM usergroup "
+ . "WHERE ownerid = $userid";
+ $qh = doQuery($query, "101");
+ while($row = mysql_fetch_assoc($qh)) {
+ $groups[$row["usergroupid"]] = $row["name"];
+ }
+ }
+ uasort($groups, "sortKeepIndex");
+ return $groups;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn updateUserData($id, $type, $affilid)
+///
+/// \param $id - user's unity id or id from user table
+/// \param $type - (optional, default=loginid) - numericid or loginid
+/// numericid is the user's numeric id; loginid is the other form (ie a unity
+/// id)
+/// \param $affilid - (optional, default=DEFAULT_AFFILID) - affiliation id
+///
+/// \return 0 if fail to update data or an array with these elements:\n
+/// \b id - user's numeric unity id\n
+/// \b unityid - unity ID for the user\n
+/// \b affiliation - user's affiliation\n
+/// \b affiliationid - user's affiliation id\n
+/// \b curriculum - curriculum user is in\n
+/// \b firstname - user's first name\n
+/// \b middlename - user's middle name\n
+/// \b lastname - user's last name\n
+/// \b email - user's preferred email address\n
+/// \b IMtype - user's preferred IM protocol\n
+/// \b IMid - user's IM id\n
+/// \b adminlevel - user's admin level (= 'none' if no admin access)\n
+/// \b lastupdated - datetime the information was last updated
+///
+/// \brief looks up the logged in user's info in ldap and updates it in the db
+/// or adds it to the db
+///
+////////////////////////////////////////////////////////////////////////////////
+function updateUserData($id, $type="loginid", $affilid=DEFAULT_AFFILID) {
+ global $updateUserFunc, $updateUserFuncArgs;
+ if($type == 'numeric') {
+ $query = "SELECT unityid, "
+ . "affiliationid "
+ . "FROM user "
+ . "WHERE id = $id";
+ $qh = doQuery($query, 101);
+ if($row = mysql_fetch_assoc($qh)) {
+ $id = $row['unityid'];
+ $type = 'loginid';
+ $affilid = $row['affiliationid'];
+ }
+ else
+ abort(1);
+ }
+ $updateFunc = $updateUserFunc[$affilid];
+ if(array_key_exists($affilid, $updateUserFuncArgs))
+ return $updateFunc($updateUserFuncArgs[$affilid], $id);
+ else
+ return $updateFunc($id);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn addUser($loginid)
+///
+/// \param $loginid - a login id
+///
+/// \return id from userlist table for the user, NULL if userid not in table
+///
+/// \brief looks up the user via LDAP and adds to DB
+///
+////////////////////////////////////////////////////////////////////////////////
+function addUser($loginid) {
+ global $addUserFuncArgs, $addUserFunc;
+ getAffilidAndLogin($loginid, $affilid);
+ if(empty($affilid))
+ abort(11);
+ $addfunc = $addUserFunc[$affilid];
+ if(array_key_exists($affilid, $addUserFuncArgs))
+ return $addfunc($addUserFuncArgs[$affilid], $loginid);
+ else
+ return $addfunc($loginid);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn updateUserPrefs($userid, $preferredname, $width, $height, $bpp,
+/// $audio, $mapdrives, $mapprinters, $mapserial)
+///
+/// \param $userid - id from user table
+/// \param $preferredname - user's preferred name
+/// \param $width - pixel width for rdp files
+/// \param $height - pixel height for rdp files
+/// \param $bpp - color depth for rdp files
+/// \param $audio - 'none' or 'local' - audio preference for rdp files
+/// \param $mapdrives - 0 or 1 - 1 to map local drives in rdp files
+/// \param $mapprinters - 0 or 1 - 1 to map printers in rdp files
+/// \param $mapserial - 0 or 1 - 1 to map serial ports in rdp files
+///
+/// \return number of rows affected by update (\b NOTE: this may be 0 if none
+/// of the values were actually changes
+///
+/// \brief updates the preferences for the user
+///
+////////////////////////////////////////////////////////////////////////////////
+function updateUserPrefs($userid, $preferredname, $width, $height,
+ $bpp, $audio, $mapdrives, $mapprinters, $mapserial) {
+ global $mysql_link_vcl;
+ $query = "UPDATE user SET "
+ . "preferredname = '$preferredname', "
+ . "width = '$width', "
+ . "height = '$height', "
+ . "bpp = $bpp, "
+ . "audiomode = '$audio', "
+ . "mapdrives = $mapdrives, "
+ . "mapprinters = $mapprinters, "
+ . "mapserial = $mapserial "
+ . "WHERE id = $userid";
+ doQuery($query, 270);
+ return mysql_affected_rows($mysql_link_vcl);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getOverallUserPrivs($userid)
+///
+/// \param $userid - an id from the user table
+///
+/// \return an array of privileges types that the user has somewhere in the
+/// privilege tree
+///
+/// \brief get the privilege types that the user has somewhere in the
+/// privilege tree
+///
+////////////////////////////////////////////////////////////////////////////////
+function getOverallUserPrivs($userid) {
+ $query = "SELECT DISTINCT t.name "
+ . "FROM userprivtype t, "
+ . "userpriv u "
+ . "WHERE u.userprivtypeid = t.id AND "
+ . "(u.userid = $userid OR "
+ . "u.usergroupid IN (SELECT usergroupid "
+ . "FROM usergroupmembers "
+ . "WHERE userid = $userid) OR "
+ . "u.usergroupid IN (SELECT id "
+ . "FROM usergroup "
+ . "WHERE ownerid = $userid))";
+ $qh = doQuery($query, 107);
+ $privileges = array();
+ while($row = mysql_fetch_row($qh)) {
+ array_push($privileges, $row[0]);
+ }
+ return $privileges;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn isAvailable($images, $imageid, $start, $end, $os, $requestid,
+/// $userid)
+///
+/// \param $images - array as returned from getImages
+/// \param $imageid - imageid from the image table
+/// \param $start - unix timestamp for start of reservation
+/// \param $end - unix timestamp for end of reservation
+/// \param $os - preferred OS that matches a name entry in the OS table
+/// \param $requestid - (optional) a requestid; if checking for an available
+/// timeslot to update a request, pass the request id that will be updated;
+/// otherwise, don't pass this argument
+/// \param $userid - (optional) id from user table
+///
+/// \return -1 if $imageid is limited in the number of concurrent reservations
+/// available, and the limit has been reached
+/// 0 if combination is not available\n
+/// an integer >0 if it is available
+///
+/// \brief checks that the passed in arguments constitute an available request
+///
+////////////////////////////////////////////////////////////////////////////////
+function isAvailable($images, $imageid, $start, $end, $os, $requestid=0,
+ $userid=0) {
+ global $requestInfo;
+ $requestInfo["start"] = $start;
+ $requestInfo["end"] = $end;
+ $requestInfo["imageid"] = $imageid;
+ $allocatedcompids = array(0);
+
+ if($requestInfo["start"] <= time()) {
+ $now = 1;
+ $nowfuture = 'now';
+ }
+ else {
+ $now = 0;
+ $nowfuture = 'future';
+ }
+
+ # get list of schedules
+ $starttime = minuteOfWeek($start);
+ $endtime = minuteOfWeek($end);
+
+ # request is within a single week
+ if(weekOfYear($start) == weekOfYear($end)) {
+ $query = "SELECT scheduleid "
+ . "FROM scheduletimes "
+ . "WHERE start <= $starttime AND "
+ . "end >= $endtime";
+ }
+ # request covers at least a week's worth of time
+ elseif($end - $start >= SECINDAY * 7) {
+ $query = "SELECT scheduleid "
+ . "FROM scheduletimes "
+ . "WHERE start = 0 AND "
+ . "end = 10080";
+ }
+ # request starts in one week and ends in the following week
+ else {
+ $query = "SELECT s1.scheduleid "
+ . "FROM scheduletimes s1, "
+ . "scheduletimes s2 "
+ . "WHERE s1.scheduleid = s2.scheduleid AND "
+ . "s1.start <= $starttime AND "
+ . "s1.end = 10080 AND "
+ . "s2.start = 0 AND "
+ . "s2.end >= $endtime";
+ }
+
+ $scheduleids = array();
+ $qh = doQuery($query, 127);
+ while($row = mysql_fetch_row($qh)) {
+ array_push($scheduleids, $row[0]);
+ }
+
+ $requestInfo["computers"] = array();
+ $requestInfo["computers"][0] = 0;
+ $requestInfo["images"][0] = $imageid;
+
+ # loop to check for available computers for all needed images
+ if($images[$imageid]["imagemetaid"] != NULL) {
+ $count = 1;
+ foreach($images[$imageid]["subimages"] as $imgid) {
+ $requestInfo['computers'][$count] = 0;
+ $requestInfo['images'][$count] = $imgid;
+ $count++;
+ }
+ }
+
+ // get semaphore lock
+ if(! semLock())
+ abort(3);
+
+ if($requestid)
+ $requestData = getRequestInfo($requestid);
+ $startstamp = unixToDatetime($start);
+ $endstamp = unixToDatetime($end + 900);
+ foreach($requestInfo["images"] as $key => $imageid) {
+ #$osid = getOSid($os);
+ # check for max concurrent usage of image
+ if($images[$imageid]['maxconcurrent'] != NULL) {
+ $query = "SELECT COUNT(rs.imageid) AS currentusage "
+ . "FROM reservation rs, "
+ . "request rq "
+ . "WHERE '$startstamp' < (rq.end + INTERVAL 900 SECOND) AND "
+ . "'$endstamp' > rq.start AND "
+ . "rs.requestid = rq.id AND "
+ . "rs.imageid = $imageid AND "
+ . "rq.stateid NOT IN (1,5,11,12,16,17)";
+ $qh = doQuery($query, 101);
+ if(! $row = mysql_fetch_assoc($qh)) {
+ semUnlock();
+ return 0;
+ }
+ if($row['currentusage'] >= $images[$imageid]['maxconcurrent']) {
+ semUnlock();
+ return -1;
+ }
+ }
+
+ # get platformid that matches $imageid
+ $query = "SELECT platformid FROM image WHERE id = $imageid";
+ $qh = doQuery($query, 125);
+ if(! $row = mysql_fetch_row($qh)) {
+ semUnlock();
+ return 0;
+ }
+ $platformid = $row[0];
+
+ # get computers $imageid maps to
+ $tmp = getMappedResources($imageid, "image", "computer");
+ if(! count($tmp)) {
+ semUnlock();
+ return 0;
+ }
+ $mappedcomputers = implode(',', $tmp);
+
+ #get computers for available schedules and platforms
+ $computerids = array();
+ $currentids = array();
+ $blockids = array();
+ $skipRemoveUsedBlock = 0;
+ // if we are modifying a request and it is after the start time, only allow
+ // the scheduled computer(s) to be modified
+ if($requestid && datetimeToUnix($requestData["start"]) <= time()) {
+ $skipRemoveUsedBlock = 1;
+ foreach($requestData["reservations"] as $key2 => $res) {
+ if($res["imageid"] == $imageid) {
+ $compid = $res["computerid"];
+ unset($requestData['reservations'][$key2]);
+ break;
+ }
+ }
+ array_push($computerids, $compid);
+ array_push($currentids, $compid);
+ $query = "SELECT scheduleid "
+ . "FROM computer "
+ . "WHERE id = $compid";
+ $qh = doQuery($query, 128);
+ $row = mysql_fetch_row($qh);
+ if(! in_array($row[0], $scheduleids)) {
+ semUnlock();
+ return 0;
+ }
+ }
+ // otherwise, build a list of computers
+ else {
+ # get list of available computers
+ $resources = getUserResources(array("imageAdmin", "imageCheckOut"),
+ array("available"), 0, 0, $userid);
+ $computers = implode("','", array_keys($resources["computer"]));
+ $computers = "'$computers'";
+ $alloccompids = implode(",", $allocatedcompids);
+
+ $schedules = implode(',', $scheduleids);
+
+ $query = "SELECT DISTINCT c.id, "
+ . "c.currentimageid "
+ . "FROM computer c, "
+ . "image i, "
+ . "state s "
+ . "WHERE c.scheduleid IN ($schedules) AND "
+ . "c.platformid = $platformid AND "
+ . "c.stateid = s.id AND "
+ . "s.name != 'maintenance' AND "
+ . "s.name != 'vmhostinuse' AND "
+ . "s.name != 'hpc' AND "
+ . "s.name != 'failed' AND ";
+ if($now)
+ $query .= "s.name != 'reloading' AND "
+ . "s.name != 'reload' AND "
+ . "s.name != 'timeout' AND "
+ . "s.name != 'inuse' AND ";
+ $query .= "i.id = $imageid AND "
+ . "c.RAM >= i.minram AND "
+ . "c.procnumber >= i.minprocnumber AND "
+ . "c.procspeed >= i.minprocspeed AND "
+ . "c.network >= i.minnetwork AND "
+ . "c.id IN ($computers) AND "
+ . "c.id IN ($mappedcomputers) AND "
+ . "c.id NOT IN ($alloccompids) "
+ . "ORDER BY (c.procspeed * c.procnumber) DESC, "
+ . "RAM DESC, "
+ . "network DESC";
+ $qh = doQuery($query, 129);
+ while($row = mysql_fetch_assoc($qh)) {
+ array_push($computerids, $row['id']);
+ if($row['currentimageid'] == $imageid) {
+ array_push($currentids, $row['id']);
+ }
+ }
+ # get computer ids available from block reservations
+ $blockids = getAvailableBlockComputerids($imageid, $start, $end);
+ }
+
+ #remove computers from list that are already scheduled
+ $usedComputerids = array();
+ $query = "SELECT DISTINCT rs.computerid "
+ . "FROM reservation rs, "
+ . "request rq, "
+ . "user u "
+ . "WHERE '$startstamp' < (rq.end + INTERVAL 900 SECOND) AND "
+ . "'$endstamp' > rq.start AND "
+ . "rq.id != $requestid AND "
+ . "rs.requestid = rq.id AND "
+ . "rq.stateid != 1 AND "
+ . "rq.stateid != 5 AND "
+ . "rq.stateid != 12 AND "
+ . "rq.userid = u.id AND "
+ . "u.unityid != 'vclreload'";
+ $qh = doQuery($query, 130);
+ while($row = mysql_fetch_row($qh)) {
+ array_push($usedComputerids, $row[0]);
+ }
+
+ $computerids = array_diff($computerids, $usedComputerids);
+ $currentids = array_diff($currentids, $usedComputerids);
+ $blockids = array_diff($blockids, $usedComputerids);
+
+ # remove computers from list that are allocated to block reservations
+ if(! count($blockids) && ! $skipRemoveUsedBlock) {
+ $usedBlockCompids = getUsedBlockComputerids($start, $end);
+ $computerids = array_diff($computerids, $usedBlockCompids);
+ $currentids = array_diff($currentids, $usedBlockCompids);
+ }
+
+ $comparr = allocComputer($blockids, $currentids, $computerids,
+ $startstamp, $nowfuture);
+ if(empty($comparr)) {
+ semUnlock();
+ return 0;
+ }
+ $requestInfo["computers"][$key] = $comparr['compid'];
+ $requestInfo["mgmtnodes"][$key] = $comparr['mgmtid'];
+ $requestInfo["loaded"][$key] = $comparr['loaded'];
+ array_push($allocatedcompids, $comparr['compid']);
+ }
+
+ return 1;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn RPCisAvailable($imageid, $start, $end, $userid)
+///
+/// \param $imageid - imageid from the image table
+/// \param $start - unix timestamp for start of reservation
+/// \param $end - unix timestamp for end of reservation
+/// \param $userid - id from user table
+///
+/// \return a computer id
+///
+/// \brief checks that the passed in arguments constitute an available request
+///
+////////////////////////////////////////////////////////////////////////////////
+function RPCisAvailable($imageid, $start, $end, $userid) {
+ #FIXME this function doesn't properly handle cluster reservations
+ global $requestInfo;
+ $images = getImages();
+
+ $requestInfo["start"] = $start;
+ $requestInfo["end"] = $end;
+ $requestInfo["imageid"] = $imageid;
+ $allocatedcompids = array(0);
+
+ if($requestInfo["start"] <= time())
+ $now = 1;
+ else
+ $now = 0;
+
+ # get list of schedules
+ $starttime = minuteOfWeek($start);
+ $endtime = minuteOfWeek($end);
+
+ # request is within a single week
+ if(weekOfYear($start) == weekOfYear($end)) {
+ $query = "SELECT scheduleid "
+ . "FROM scheduletimes "
+ . "WHERE start <= $starttime AND "
+ . "end >= $endtime";
+ }
+ # request covers at least a week's worth of time
+ elseif($end - $start >= SECINDAY * 7) {
+ $query = "SELECT scheduleid "
+ . "FROM scheduletimes "
+ . "WHERE start = 0 AND "
+ . "end = 10080";
+ }
+ # request starts in one week and ends in the following week
+ else {
+ $query = "SELECT s1.scheduleid "
+ . "FROM scheduletimes s1, "
+ . "scheduletimes s2 "
+ . "WHERE s1.scheduleid = s2.scheduleid AND "
+ . "s1.start <= $starttime AND "
+ . "s1.end = 10080 AND "
+ . "s2.start = 0 AND "
+ . "s2.end >= $endtime";
+ }
+
+ $scheduleids = array();
+ $qh = doQuery($query, 127);
+ while($row = mysql_fetch_row($qh)) {
+ array_push($scheduleids, $row[0]);
+ }
+
+ $requestInfo["computers"] = array();
+ $requestInfo["computers"][0] = 0;
+ $requestInfo["images"][0] = $imageid;
+
+ # loop to check for available computers for all needed images
+ if($images[$imageid]["imagemetaid"] != NULL) {
+ $count = 1;
+ foreach($images[$imageid]["subimages"] as $imgid) {
+ $requestInfo['computers'][$count] = 0;
+ $requestInfo['images'][$count] = $imgid;
+ $count++;
+ }
+ }
+
+ // get semaphore lock
+ if(! semLock())
+ abort(3);
+
+ $startstamp = unixToDatetime($start);
+ $endstamp = unixToDatetime($end + 900);
+ foreach($requestInfo["images"] as $key => $imageid) {
+ #$osid = getOSid($os);
+ # check for max concurrent usage of image
+ if($images[$imageid]['maxconcurrent'] != NULL) {
+ $query = "SELECT COUNT(rs.imageid) AS currentusage "
+ . "FROM reservation rs, "
+ . "request rq "
+ . "WHERE '$startstamp' < rq.end AND "
+ . "'$endstamp' > (rq.start - INTERVAL 900 SECOND) AND "
+ . "rs.requestid = rq.id AND "
+ . "rs.imageid = $imageid AND "
+ . "rq.stateid NOT IN (1,5,11,12,16,17)";
+ $qh = doQuery($query, 101);
+ if(! $row = mysql_fetch_assoc($qh)) {
+ semUnlock();
+ return 0;
+ }
+ if($row['currentusage'] >= $images[$imageid]['maxconcurrent']) {
+ semUnlock();
+ return -1;
+ }
+ }
+
+ # get platformid that matches $imageid
+ $query = "SELECT platformid FROM image WHERE id = $imageid";
+ $qh = doQuery($query, 125);
+ if(! $row = mysql_fetch_row($qh)) {
+ semUnlock();
+ return 0;
+ }
+ $platformid = $row[0];
+
+ # get computers $imageid maps to
+ $tmp = getMappedResources($imageid, "image", "computer");
+ if(! count($tmp)) {
+ semUnlock();
+ return 0;
+ }
+ $mappedcomputers = implode(',', $tmp);
+
+ # get computers for available schedules and platforms
+ $computerids = array();
+ $currentids = array();
+ $blockids = array();
+ # get list of available computers
+ $resources = getUserResources(array("imageAdmin", "imageCheckOut"),
+ array("available"), 0, 0, $userid);
+ $computers = implode("','", array_keys($resources["computer"]));
+ $computers = "'$computers'";
+ $alloccompids = implode(",", $allocatedcompids);
+
+ $schedules = implode(',', $scheduleids);
+
+ $query = "SELECT DISTINCT c.id, "
+ . "c.currentimageid "
+ . "FROM computer c, "
+ . "image i, "
+ . "state s "
+ . "WHERE c.scheduleid IN ($schedules) AND "
+ . "c.platformid = $platformid AND "
+ . "c.stateid = s.id AND "
+ . "s.name != 'maintenance' AND "
+ . "s.name != 'vmhostinuse' AND "
+ . "s.name != 'hpc' AND "
+ . "s.name != 'failed' AND ";
+ if($now)
+ $query .= "s.name != 'reloading' AND "
+ . "s.name != 'timeout' AND "
+ . "s.name != 'inuse' AND ";
+ $query .= "i.id = $imageid AND "
+ . "c.RAM >= i.minram AND "
+ . "c.procnumber >= i.minprocnumber AND "
+ . "c.procspeed >= i.minprocspeed AND "
+ . "c.network >= i.minnetwork AND "
+ . "c.id IN ($computers) AND "
+ . "c.id IN ($mappedcomputers) AND "
+ . "c.id NOT IN ($alloccompids) "
+ . "ORDER BY (c.procspeed * c.procnumber) DESC, "
+ . "RAM DESC, "
+ . "network DESC";
+ $qh = doQuery($query, 129);
+ while($row = mysql_fetch_assoc($qh)) {
+ array_push($computerids, $row['id']);
+ if($row['currentimageid'] == $imageid) {
+ array_push($currentids, $row['id']);
+ }
+ }
+ # get computer ids available from block reservations
+ $blockids = getAvailableBlockComputerids($imageid, $start, $end);
+
+ # remove computers from list that are already scheduled
+ $usedComputerids = array();
+ $query = "SELECT DISTINCT rs.computerid "
+ . "FROM reservation rs, "
+ . "request rq, "
+ . "user u "
+ . "WHERE '$startstamp' < rq.end AND "
+ . "'$endstamp' > (rq.start - INTERVAL 900 SECOND) AND "
+ . "rs.requestid = rq.id AND "
+ . "rq.stateid != 1 AND "
+ . "rq.stateid != 5 AND "
+ . "rq.stateid != 12 AND "
+ . "rq.userid = u.id AND "
+ . "u.unityid != 'vclreload'";
+ $qh = doQuery($query, 130);
+ while($row = mysql_fetch_row($qh)) {
+ array_push($usedComputerids, $row[0]);
+ }
+
+ $computerids = array_diff($computerids, $usedComputerids);
+ $currentids = array_diff($currentids, $usedComputerids);
+ $blockids = array_diff($blockids, $usedComputerids);
+
+ if(count($currentids))
+ $return = array_shift($currentids);
+ elseif(count($computerids))
+ $return = array_shift($computerids);
+ else {
+ $return = 0;
+ }
+ }
+ semUnlock();
+
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn allocComputer($blockids, $currentids, $computerids, $start,
+/// $nowfuture)
+///
+/// \param $blockids - array of computer ids
+/// \param $currentids - array of computer ids
+/// \param $computerids - array of computer ids
+/// \param $start - start time in datetime format
+/// \param $nowfuture - "now" or "future"
+///
+/// \return empty array if failed to allocate a computer; array with these keys
+/// on success:\n
+/// \b compid - id of computer\n
+/// \b mgmtid - id of management node for computer\n
+/// \b loaded - 0 or 1 - whether or not computer is loaded with desired image
+///
+/// \brief determines a computer to use from $blockids, $currentids,
+/// $preferredids, and $computerids, looking at the arrays in that order and
+/// tries to allocate a management node for it
+///
+////////////////////////////////////////////////////////////////////////////////
+function allocComputer($blockids, $currentids, $computerids, $start,
+ $nowfuture) {
+ $ret = array();
+ foreach($blockids as $compid) {
+ $mgmtnodeid = findManagementNode($compid, $start, $nowfuture);
+ if($mgmtnodeid == 0)
+ continue;
+ $ret['compid'] = $compid;
+ $ret['mgmtid'] = $mgmtnodeid;
+ $ret['loaded'] = 1;
+ return $ret;
+ }
+ foreach($currentids as $compid) {
+ $mgmtnodeid = findManagementNode($compid, $start, $nowfuture);
+ if($mgmtnodeid == 0)
+ continue;
+ $ret['compid'] = $compid;
+ $ret['mgmtid'] = $mgmtnodeid;
+ $ret['loaded'] = 1;
+ return $ret;
+ }
+ foreach($computerids as $compid) {
+ $mgmtnodeid = findManagementNode($compid, $start, $nowfuture);
+ if($mgmtnodeid == 0)
+ continue;
+ $ret['compid'] = $compid;
+ $ret['mgmtid'] = $mgmtnodeid;
+ $ret['loaded'] = 0;
+ return $ret;
+ }
+ return $ret;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getMappedResources($resourcesubid, $resourcetype1,
+/// $resourcetype2)
+///
+/// \param $resourcesubid - id of a resource from its table (ie an imageid)
+/// \param $resourcetype1 - type of $resourcesubid (name or id)
+/// \param $resourcetype2 - type of resource $resourcesubid maps to
+///
+/// \return an array of resource ids of type $resourcetype2
+///
+/// \brief gets a list of resources of type $resourcetype2 that $resourcesubid
+/// of type $resourcetype1 maps to based on the resourcemap table
+///
+////////////////////////////////////////////////////////////////////////////////
+function getMappedResources($resourcesubid, $resourcetype1, $resourcetype2) {
+ if(! is_numeric($resourcetype1))
+ $resourcetype1 = getResourceTypeID($resourcetype1);
+ if(! is_numeric($resourcetype2))
+ $resourcetype2 = getResourceTypeID($resourcetype2);
+
+ # get $resourcesubid's resource id
+ $query = "SELECT id "
+ . "FROM resource "
+ . "WHERE subid = $resourcesubid AND "
+ . "resourcetypeid = $resourcetype1";
+ $qh = doQuery($query, 101);
+ $row = mysql_fetch_row($qh);
+ $resourceid = $row[0];
+
+ # get groups $resourceid is in
+ $resourcegroupids = array();
+ $query = "SELECT resourcegroupid "
+ . "FROM resourcegroupmembers "
+ . "WHERE resourceid = $resourceid";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_row($qh)) {
+ array_push($resourcegroupids, $row[0]);
+ }
+
+ # get $resourcetype2 groups that $resourcegroupids map to
+ if(! count($resourcegroupids))
+ return array();
+ $inlist = implode(',', $resourcegroupids);
+ $type2groupids = array();
+
+ # get all mappings from resourcemap table where $resourcetype1 ==
+ # resourcemap.resourcetypeid1
+ $query = "SELECT resourcegroupid2 "
+ . "FROM resourcemap "
+ . "WHERE resourcegroupid1 IN ($inlist) AND "
+ . "resourcetypeid1 = $resourcetype1 AND "
+ . "resourcetypeid2 = $resourcetype2";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_row($qh)) {
+ array_push($type2groupids, $row[0]);
+ }
+
+ # get all mappings from resourcemap table where $resourcetype1 ==
+ # resourcemap.resourcetypeid2
+ $query = "SELECT resourcegroupid1 "
+ . "FROM resourcemap "
+ . "WHERE resourcegroupid2 IN ($inlist) AND "
+ . "resourcetypeid2 = $resourcetype1 AND "
+ . "resourcetypeid1 = $resourcetype2";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_row($qh)) {
+ array_push($type2groupids, $row[0]);
+ }
+
+ # get $resourcetype2 items in $type2groupids groups
+ if(! count($type2groupids))
+ return array();
+ $inlist = implode(',', $type2groupids);
+ $mappedresources = array();
+ $query = "SELECT r.subid "
+ . "FROM resource r, "
+ . "resourcegroupmembers m "
+ . "WHERE m.resourcegroupid IN ($inlist) AND "
+ . "m.resourceid = r.id";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_row($qh)) {
+ array_push($mappedresources, $row[0]);
+ }
+ return $mappedresources;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn checkOverlap($start, $end, $max, $requestid)
+///
+/// \param $start - unix timestamp for start of reservation
+/// \param $end - unix timestamp for end of reservation
+/// \param $max - max allowed overlapping reservations
+/// \param $requestid - (optional) a requestid to ignore when checking for an
+/// overlap; use this when changing an existing request
+///
+/// \return 0 if user doesn't have a reservation overlapping the time period
+/// between $start and $end; 1 if the user does
+///
+/// \brief checks for a user having an overlapping reservation with the
+/// specified time period
+///
+////////////////////////////////////////////////////////////////////////////////
+function checkOverlap($start, $end, $max, $requestid=0) {
+ global $user;
+ $requests = getUserRequests("all");
+ $count = 0;
+ if($max > 0)
+ $max--;
+ foreach(array_keys($requests) as $id) {
+ if(! (($requests[$id]["currstateid"] == 12 ||
+ $requests[$id]["currstateid"] == 14) &&
+ $requests[$id]["laststateid"] == 11) &&
+ $requests[$id]["currstateid"] != 5 &&
+ $requests[$id]["id"] != $requestid &&
+ ($start < datetimeToUnix($requests[$id]["end"]) &&
+ $end > datetimeToUnix($requests[$id]["start"]))) {
+ $count++;
+ if($count > $max)
+ return 1;
+ }
+ }
+ return 0;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getReloadStartTime()
+///
+/// \return unix timestamp
+///
+/// \brief determines the nearest 15 minute increment of an hour that is less
+/// than the current time
+///
+////////////////////////////////////////////////////////////////////////////////
+function getReloadStartTime() {
+ $nowArr = getdate();
+ if($nowArr["minutes"] == 0)
+ $subtract = 0;
+ elseif($nowArr["minutes"] < 15)
+ $subtract = $nowArr["minutes"] * 60;
+ elseif($nowArr["minutes"] < 30)
+ $subtract = ($nowArr["minutes"] - 15) * 60;
+ elseif($nowArr["minutes"] < 45)
+ $subtract = ($nowArr["minutes"] - 30) * 60;
+ elseif($nowArr["minutes"] < 60)
+ $subtract = ($nowArr["minutes"] - 45) * 60;
+ $start = time() - $subtract;
+ $start -= $start % 60;
+ return $start;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getMaxOverlap($userid)
+///
+/// \param $userid - id from user table
+///
+/// \return max number of allowed overlapping reservations for user
+///
+/// \brief determines how many overlapping reservations $user can have based on
+/// the groups $user is a member of
+///
+////////////////////////////////////////////////////////////////////////////////
+function getMaxOverlap($userid) {
+ $query = "SELECT u.overlapResCount "
+ . "FROM usergroup u, "
+ . "usergroupmembers m "
+ . "WHERE m.usergroupid = u.id AND "
+ . "m.userid = $userid "
+ . "ORDER BY u.overlapResCount DESC "
+ . "LIMIT 1";
+ $qh = doQuery($query, 101);
+ if($row = mysql_fetch_assoc($qh))
+ return $row['overlapResCount'];
+ else
+ return 1;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn addRequest($forimaging, $revisionid)
+///
+/// \param $forimaging - (optional) 0 if a normal request, 1 if a request for
+/// creating a new image
+/// \param $revisionid - (optional) desired revision id of the image
+///
+/// \return id from request table that corresponds to the added entry
+///
+/// \brief adds an entry to the request and reservation tables
+///
+////////////////////////////////////////////////////////////////////////////////
+function addRequest($forimaging=0, $revisionid=array()) {
+ global $requestInfo, $user;
+ $startstamp = unixToDatetime($requestInfo["start"]);
+ $endstamp = unixToDatetime($requestInfo["end"]);
+ $now = time();
+
+ if($requestInfo["start"] <= $now) {
+ $start = unixToDatetime($now);
+ $nowfuture = "now";
+ }
+ else {
+ $start = $startstamp;
+ $nowfuture = "future";
+ }
+
+ addLogEntry($nowfuture, $start, $endstamp, 1, $requestInfo["imageid"]);
+
+ $qh = doQuery("SELECT LAST_INSERT_ID() FROM log", 131);
+ if(! $row = mysql_fetch_row($qh)) {
+ abort(132);
+ }
+ $logid = $row[0];
+
+ $query = "INSERT INTO changelog "
+ . "(logid, "
+ . "start, "
+ . "end, "
+ . "timestamp) "
+ . "VALUES "
+ . "($logid, "
+ . "'$start', "
+ . "'$endstamp', "
+ . "NOW())";
+ doQuery($query, 136);
+
+ # add single entry to request table
+ $query = "INSERT INTO request "
+ . "(stateid, "
+ . "userid, "
+ . "laststateid, "
+ . "logid, "
+ . "forimaging, "
+ . "start, "
+ . "end, "
+ . "daterequested) "
+ . "VALUES "
+ . "(13, "
+ . "{$user['id']}, "
+ . "13, "
+ . "$logid, "
+ . "$forimaging, "
+ . "'$startstamp', "
+ . "'$endstamp', "
+ . "NOW())";
+ $qh = doQuery($query, 136);
+
+ $qh = doQuery("SELECT LAST_INSERT_ID() FROM request", 134);
+ if(! $row = mysql_fetch_row($qh)) {
+ abort(135);
+ }
+ $requestid = $row[0];
+
+ # add requestid to log entry
+ $query = "UPDATE log "
+ . "SET requestid = $requestid "
+ . "WHERE id = $logid";
+ doQuery($query, 101);
+
+ # add an entry to the reservation table for each image
+ # NOTE: make sure parent image is the first entry we add
+ # so that it has the lowest reservationid
+ foreach($requestInfo["images"] as $key => $imageid) {
+ if(array_key_exists($imageid, $revisionid) &&
+ ! empty($revisionid[$imageid]))
+ $imagerevisionid = $revisionid[$imageid];
+ else
+ $imagerevisionid = getProductionRevisionid($imageid);
+ $computerid = $requestInfo["computers"][$key];
+
+ $mgmtnodeid = $requestInfo['mgmtnodes'][$key];
+
+ $query = "INSERT INTO reservation "
+ . "(requestid, "
+ . "computerid, "
+ . "imageid, "
+ . "imagerevisionid, "
+ . "managementnodeid) "
+ . "VALUES "
+ . "($requestid, "
+ . "$computerid, "
+ . "$imageid, "
+ . "$imagerevisionid, "
+ . "$mgmtnodeid)";
+ doQuery($query, 133);
+ addSublogEntry($logid, $imageid, $imagerevisionid, $computerid, $mgmtnodeid);
+ }
+ // release semaphore lock
+ semUnlock();
+
+ return $requestid;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn simpleAddRequest($compid, $imageid, $revisionid, $start, $end,
+/// $stateid, $userid) {
+///
+/// \param $compid - a computer id
+/// \param $imageid - an iamge id
+/// \param $revisionid - revisionid for $imageid
+/// \param $start - starting time in datetime format
+/// \param $end - ending time in datetime format
+/// \param $stateid - state for request
+/// \param $userid - userid for request
+///
+/// \return id for the request or 0 on failure
+///
+/// \brief adds an entry to the request and reservation tables
+///
+////////////////////////////////////////////////////////////////////////////////
+function simpleAddRequest($compid, $imageid, $revisionid, $start, $end,
+ $stateid, $userid) {
+ $mgmtnodeid = findManagementNode($compid, $start, 'now');
+ if($mgmtnodeid == 0)
+ return 0;
+
+ $query = "INSERT INTO request "
+ . "(stateid, "
+ . "userid, "
+ . "laststateid, "
+ . "start, "
+ . "end, "
+ . "daterequested) "
+ . "VALUES "
+ . "($stateid, "
+ . "$userid, "
+ . "$stateid, "
+ . "'$start', "
+ . "'$end', "
+ . "NOW())";
+ doQuery($query, 101);
+
+ $qh = doQuery("SELECT LAST_INSERT_ID() FROM request", 101);
+ if(! $row = mysql_fetch_row($qh)) {
+ abort(135);
+ }
+ $requestid = $row[0];
+
+ # add an entry to the reservation table for each image
+ $query = "INSERT INTO reservation "
+ . "(requestid, "
+ . "computerid, "
+ . "imageid, "
+ . "imagerevisionid, "
+ . "managementnodeid) "
+ . "VALUES "
+ . "($requestid, "
+ . "$compid, "
+ . "$imageid, "
+ . "$revisionid, "
+ . "$mgmtnodeid)";
+ doQuery($query, 101);
+ return $requestid;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn findManagementNode($compid, $start, $nowfuture)
+///
+/// \param $compid - a computer id
+/// \param $start - start time for the reservation (datetime format)
+/// \param $nowfuture - type of reservation - "now" or "future"
+///
+/// \return a management node id
+///
+/// \brief finds a management node that can handle $compid, if none found,
+/// returns 0
+///
+////////////////////////////////////////////////////////////////////////////////
+function findManagementNode($compid, $start, $nowfuture) {
+ global $HTMLheader;
+ $allmgmtnodes = array_keys(getManagementNodes($nowfuture));
+ $mapped = getMappedResources($compid, "computer", "managementnode");
+ $usablemgmtnodes = array_intersect($allmgmtnodes, $mapped);
+ $mgmtnodecnt = array();
+ foreach($usablemgmtnodes as $id) {
+ $mgmtnodecnt[$id] = 0;
+ }
+ if(! count($usablemgmtnodes))
+ return 0;
+ $inlist = implode(',', $usablemgmtnodes);
+ $mystart = datetimeToUnix($start);
+ $start = unixToDatetime($mystart - 1800);
+ $end = unixToDatetime($mystart + 1800);
+ $query = "SELECT DISTINCT COUNT(rs.managementnodeid) AS count, "
+ . "rs.managementnodeid AS mnid "
+ . "FROM reservation rs, "
+ . "request rq "
+ . "WHERE rs.managementnodeid IN ($inlist) AND "
+ . "rq.start > \"$start\" AND "
+ . "rq.start < \"$end\" "
+ . "GROUP BY rs.managementnodeid "
+ . "ORDER BY count";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_assoc($qh)) {
+ $mgmtnodecnt[$row["mnid"]] = $row["count"];
+ }
+ uasort($mgmtnodecnt, "sortKeepIndex");
+ $keys = array_keys($mgmtnodecnt);
+ return array_shift($keys);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getRequestInfo($id)
+///
+/// \param $id - id of request
+///
+/// \return an array containing the following elements:\n
+/// \b stateid - stateid of the request\n
+/// \b laststateid - laststateid of the request\n
+/// \b userid - id from the db of the user\n
+/// \b start - start of request\n
+/// \b end - end of request\n
+/// \b daterequested - date request was made\n
+/// \b datemodified - date request was last modified\n
+/// \b id - id of this request\n
+/// \b logid - id from log table\n
+/// \b test - test flag\n
+/// \b forimaging - 0 if request is normal, 1 if it is for imaging\n\n
+/// an array of reservations associated with the request whose key is
+/// 'reservations', each with the following items:\n
+/// \b imageid - id of the image\n
+/// \b imagerevisionid - id of the image revision\n
+/// \b production - image revision production flag (0 or 1)\n
+/// \b image - name of the image\n
+/// \b prettyimage - pretty name of the image\n
+/// \b OS - name of the os\n
+/// \b computerid - id of the computer\n
+/// \b reservationid - id of the corresponding reservation\n
+/// \b reservedIP - ip address of reserved computer\n
+/// \b hostname - hostname of reserved computer\n
+/// \b forcheckout - whether or not the image is intended for checkout\n
+/// \b password - password for this computer\n
+/// \b remoteIP - IP of remote user
+///
+/// \brief creates an array with info about request $id
+///
+////////////////////////////////////////////////////////////////////////////////
+function getRequestInfo($id) {
+ global $printedHTMLheader, $HTMLheader;
+ if(empty($id))
+ abort(9);
+ $query = "SELECT stateid, "
+ . "laststateid, "
+ . "userid, "
+ . "start, "
+ . "end, "
+ . "daterequested, "
+ . "datemodified, "
+ . "logid, "
+ . "test, "
+ . "forimaging "
+ . "FROM request "
+ . "WHERE id = $id";
+ $qh = doQuery($query, 165);
+ if(! ($data = mysql_fetch_assoc($qh))) {
+ if(! $printedHTMLheader)
+ print $HTMLheader;
+ print "<h1>OOPS! - Reservation Has Expired</h1>\n";
+ print "The selected reservation is no longer available. Go to ";
+ print "<a href=" . BASEURL . SCRIPT . "?mode=newRequest>New ";
+ print "Reservations</a><br>to request a new reservation or to ";
+ print "<a href=" . BASEURL . SCRIPT . "?mode=viewRequests>Current ";
+ print "Reservations</a> to select<br>another one that is available.";
+ printHTMLFooter();
+ dbDisconnect();
+ exit;
+ }
+ $data["id"] = $id;
+ $query = "SELECT rs.imageid, "
+ . "rs.imagerevisionid, "
+ . "rs.managementnodeid, "
+ . "ir.production, "
+ . "i.name AS image, "
+ . "i.prettyname AS prettyimage, "
+ . "o.prettyname AS OS, "
+ . "rs.computerid, "
+ . "rs.id AS reservationid, "
+ . "c.IPaddress AS reservedIP, "
+ . "c.hostname, "
+ . "i.forcheckout, "
+ . "rs.pw AS password, "
+ . "rs.remoteIP "
+ . "FROM reservation rs, "
+ . "image i, "
+ . "imagerevision ir, "
+ . "OS o, "
+ . "computer c "
+ . "WHERE rs.requestid = $id AND "
+ . "rs.imageid = i.id AND "
+ . "rs.imagerevisionid = ir.id AND "
+ . "i.OSid = o.id AND "
+ . "rs.computerid = c.id";
+ $qh = doQuery($query, 101);
+ $data["reservations"] = array();
+ while($row = mysql_fetch_assoc($qh)) {
+ array_push($data["reservations"], $row);
+ }
+ return $data;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn updateRequest($requestid)
+///
+/// \param $requestid - the id of the request to be updated
+///
+/// \brief updates an entry to the request and reservation tables
+///
+////////////////////////////////////////////////////////////////////////////////
+function updateRequest($requestid) {
+ global $requestInfo, $user;
+ $userid = getUserlistID($user['unityid']);
+ $startstamp = unixToDatetime($requestInfo["start"]);
+ $endstamp = unixToDatetime($requestInfo["end"]);
+
+ if($requestInfo["start"] <= time())
+ $nowfuture = "now";
+ else
+ $nowfuture = "future";
+
+ $query = "SELECT logid FROM request WHERE id = $requestid";
+ $qh = doQuery($query, 146);
+ if(! $row = mysql_fetch_row($qh)) {
+ abort(148);
+ }
+ $logid = $row[0];
+
+ $query = "UPDATE request "
+ . "SET start = '$startstamp', "
+ . "end = '$endstamp', "
+ . "datemodified = NOW() "
+ . "WHERE id = $requestid";
+ doQuery($query, 101);
+
+ if($nowfuture == 'now') {
+ addChangeLogEntry($logid, NULL, $endstamp, $startstamp, NULL, NULL, 1);
+ return;
+ }
+
+ $requestData = getRequestInfo($requestid);
+ foreach($requestInfo["images"] as $key => $imgid) {
+ foreach($requestData["reservations"] as $key2 => $res) {
+ if($res["imageid"] == $imgid) {
+ $oldCompid = $res["computerid"];
+ unset($requestData['reservations'][$key2]);
+ break;
+ }
+ }
+ $computerid = $requestInfo["computers"][$key];
+ $mgmtnodeid = $requestInfo['mgmtnodes'][$key];
+
+ $query = "UPDATE reservation "
+ . "SET computerid = $computerid, "
+ . "managementnodeid = $mgmtnodeid "
+ . "WHERE requestid = $requestid AND "
+ . "imageid = $imgid AND "
+ . "computerid = $oldCompid";
+ doQuery($query, 147);
+ addChangeLogEntry($logid, NULL, $endstamp, $startstamp, $computerid, NULL,
+ 1);
+ $query = "UPDATE sublog "
+ . "SET computerid = $computerid "
+ . "WHERE logid = $logid AND "
+ . "imageid = $imgid AND "
+ . "computerid = $oldCompid";
+ doQuery($query, 101);
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn deleteRequest($request)
+///
+/// \param $request - an array from getRequestInfo
+///
+/// \brief removes a request from the request and reservation tables
+///
+////////////////////////////////////////////////////////////////////////////////
+function deleteRequest($request) {
+ # new - 13
+ # deleted - 1
+ # complete - 12
+ # reserved - 3
+ # inuse - 8
+ # pending - 14
+ # timeout - 11
+ $now = time();
+ if(datetimeToUnix($request["start"]) < $now) {
+ # current: new, last: none OR
+ # current: pending, last: new
+ if($request["stateid"] == 13 ||
+ ($request["stateid"] == 14 && $request["laststateid"] == 13)) {
+ $query = "UPDATE request "
+ . "SET stateid = 1, "
+ . "laststateid = 3 "
+ . "WHERE id = " . $request["id"];
+ }
+ # current: reserved, last: new OR
+ # current: pending, last: reserved
+ elseif(($request["stateid"] == 3 && $request["laststateid"] == 13) ||
+ ($request["stateid"] == 14 && $request["laststateid"] == 3)) {
+ $query = "UPDATE request "
+ . "SET stateid = 1, "
+ . "laststateid = 3 "
+ . "WHERE id = " . $request["id"];
+ }
+ # current: inuse, last: reserved OR
+ # current: pending, last: inuse
+ elseif(($request["stateid"] == 8 && $request["laststateid"] == 3) ||
+ ($request["stateid"] == 14 && $request["laststateid"] == 8)) {
+ $query = "UPDATE request "
+ . "SET stateid = 1, "
+ . "laststateid = 8 "
+ . "WHERE id = " . $request["id"];
+ }
+ # shouldn't happen, but if current: pending, set to deleted or
+ // if not current: pending, set laststate to current state and
+ # current state to deleted
+ else {
+ if($request["stateid"] == 14) {
+ $query = "UPDATE request "
+ . "SET stateid = 1 "
+ . "WHERE id = " . $request["id"];
+ }
+ else {
+ # somehow a user submitted a deleteRequest where the current
+ # stateid was empty
+ if(! is_numeric($request["stateid"]) || $request["stateid"] < 0)
+ $request["stateid"] = 1;
+ $query = "UPDATE request "
+ . "SET stateid = 1, "
+ . "laststateid = " . $request["stateid"] . " "
+ . "WHERE id = " . $request["id"];
+ }
+ }
+ $qh = doQuery($query, 150);
+
+ addChangeLogEntry($request["logid"], NULL, unixToDatetime($now), NULL,
+ NULL, "released");
+ return;
+ }
+
+ $query = "DELETE FROM request WHERE id = " . $request["id"];
+ $qh = doQuery($query, 152);
+
+ $query = "DELETE FROM reservation WHERE requestid = {$request["id"]}";
+ doQuery($query, 153);
+
+ addChangeLogEntry($request["logid"], NULL, NULL, NULL, NULL, "deleted");
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn moveReservationsOffComputer($compid, $count)
+///
+/// \param $compid - (optional) id of computer from which to move reservations
+/// \param $count - (optional) number of reservations to move, defaults to
+/// all of them
+///
+/// \return 0 if failed to move reservations, 1 if succeeded, -1 if no
+/// reservations were found on $compid
+///
+/// \brief attempts to move reservations off of a $compid - if $compid is not
+/// given, removes all reservations from the computer with the least number
+///
+////////////////////////////////////////////////////////////////////////////////
+function moveReservationsOffComputer($compid=0, $count=0) {
+ global $requestInfo, $user;
+ $resInfo = array();
+ $checkstart = unixToDatetime(time() + 180);
+ if($compid == 0) {
+ $resources = getUserResources(array("imageAdmin", "imageCheckOut"),
+ array("available"), 0, 0);
+ $computers = implode("','", array_keys($resources["computer"]));
+ $computers = "'$computers'";
+ $query = "SELECT DISTINCT COUNT(rs.id) AS reservations, "
+ . "rs.computerid "
+ . "FROM reservation rs, "
+ . "request rq "
+ . "WHERE rq.start > '$checkstart' AND "
+ . "rs.computerid IN ($computers) "
+ . "GROUP BY computerid "
+ . "ORDER BY reservations "
+ . "LIMIT 1";
+ $qh = doQuery($query, 101);
+ if($row = mysql_fetch_assoc($qh))
+ $compid = $row["computerid"];
+ else
+ return -1;
+ }
+ # get all reservation info for $compid
+ $query = "SELECT rs.id, "
+ . "rs.requestid, "
+ . "rs.imageid, "
+ . "rq.logid, "
+ . "rq.userid, "
+ . "rq.start, "
+ . "rq.end "
+ . "FROM reservation rs, "
+ . "request rq "
+ . "WHERE rs.computerid = $compid AND "
+ . "rs.requestid = rq.id AND "
+ . "rq.start > '$checkstart' AND "
+ . "rq.stateid NOT IN (1, 5, 11, 12) "
+ . "ORDER BY rq.start";
+ if($count)
+ $query .= " LIMIT $count";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_assoc($qh)) {
+ $resInfo[$row["id"]] = $row;
+ }
+ if(! count($resInfo))
+ return -1;
+ $images = getImages();
+ $allmovable = 1;
+ foreach($resInfo as $res) {
+ $rc = isAvailable($images, $res["imageid"], datetimeToUnix($res["start"]),
+ datetimeToUnix($res["end"]), "dummy", 0, $res["userid"]);
+ if($rc < 1) {
+ $allmovable = 0;
+ break;
+ }
+ }
+ if(! $allmovable)
+ return 0;
+ foreach($resInfo as $res) {
+ $rc = isAvailable($images, $res["imageid"], datetimeToUnix($res["start"]),
+ datetimeToUnix($res["end"]), "dummy", 0, $res["userid"]);
+ if($rc > 0) {
+ $newcompid = array_shift($requestInfo["computers"]);
+ # get mgmt node for computer
+ $mgmtnodeid = findManagementNode($newcompid, $res['start'], 'future');
+ # update mgmt node and computer in reservation table
+ $query = "UPDATE reservation "
+ . "SET computerid = $newcompid, "
+ . "managementnodeid = $mgmtnodeid "
+ . "WHERE id = {$res["id"]}";
+ doQuery($query, 101);
+ # add changelog entry
+ addChangeLogEntry($res['logid'], NULL, NULL, NULL, $newcompid);
+ # update sublog entry
+ $query = "UPDATE sublog "
+ . "SET computerid = $newcompid "
+ . "WHERE logid = {$res['logid']} AND "
+ . "computerid = $compid";
+ doQuery($query, 101);
+ }
+ else
+ return 0;
+ }
+ return 1;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getUserRequests($type, $id)
+///
+/// \param $type - "normal", "forimaging", or "all"
+/// \param $id - (optional) user's id from userlist table
+///
+/// \return an array of user's requests; the array has the following elements
+/// for each entry where forcheckout == 1 for the image:\n
+/// \b id - id of the request\n
+/// \b imageid - id of requested image\n
+/// \b image - name of requested image\n
+/// \b prettyimage - pretty name of requested image\n
+/// \b OS - name of the requested os\n
+/// \b start - start time of request\n
+/// \b end - end time of request\n
+/// \b daterequested - date request was made\n
+/// \b currstateid - current stateid of request\n
+/// \b laststateid - last stateid of request\n
+/// \b forimaging - 0 if an normal request, 1 if imaging request\n
+/// \b test - test flag - 0 or 1\n
+/// \b longterm - 1 if request length is > 24 hours\n
+/// \b resid - id of primary reservation\n
+/// \b compimageid - currentimageid for primary computer\n
+/// \b computerstateid - current stateid of primary computer\n
+/// \b computerid - id of primary computer\n
+/// \b IPaddress - IP address of primary computer\n
+/// \b comptype - type of primary computer\n
+/// and an array of subimages named reservations with the following elements
+/// for each subimage:\n
+/// \b resid - id of reservation\n
+/// \b imageid - id of requested image\n
+/// \b image - name of requested image\n
+/// \b prettyname - pretty name of requested image\n
+/// \b OS - name of the requested os\n
+/// \b compimageid - currentimageid for computer\n
+/// \b computerstateid - current stateid of computer\n
+/// \b computerid - id of reserved computer\n
+/// \b IPaddress - IP address of reserved computer\n
+/// \b type - type of computer
+///
+/// \brief builds an array of current requests made by the user
+///
+////////////////////////////////////////////////////////////////////////////////
+function getUserRequests($type, $id=0) {
+ global $user;
+ if($id == 0) {
+ $id = $user["id"];
+ }
+ $query = "SELECT i.name AS image, "
+ . "i.prettyname AS prettyimage, "
+ . "i.id AS imageid, "
+ . "rq.start, "
+ . "rq.end, "
+ . "rq.daterequested, "
+ . "rq.id, "
+ . "o.prettyname AS OS, "
+ . "rq.stateid AS currstateid, "
+ . "rq.laststateid, "
+ . "rs.computerid, "
+ . "rs.id AS resid, "
+ . "c.currentimageid AS compimageid, "
+ . "c.stateid AS computerstateid, "
+ . "c.IPaddress, "
+ . "c.type AS comptype, "
+ . "rq.forimaging, "
+ . "rq.test "
+ . "FROM request rq, "
+ . "reservation rs, "
+ . "image i, "
+ . "OS o, "
+ . "computer c "
+ . "WHERE rq.userid = $id AND "
+ . "rs.requestid = rq.id AND "
+ . "rs.imageid = i.id AND "
+ . "rq.end > NOW() AND "
+ . "i.OSid = o.id AND "
+ . "c.id = rs.computerid AND "
+ . "rq.stateid NOT IN (1, 10, 16, 17) AND " # deleted, maintenance, complete, image, makeproduction
+ . "rq.laststateid NOT IN (1, 10, 16, 17) AND " # deleted, maintenance, complete, image, makeproduction
+ . "i.forcheckout = 1 ";
+ if($type == "normal")
+ $query .= "AND rq.forimaging = 0 ";
+ if($type == "forimaging")
+ $query .= "AND rq.forimaging = 1 ";
+ $query .= "ORDER BY rq.start";
+
+ $query2 = "SELECT rs.id AS resid, "
+ . "i.name AS image, "
+ . "i.prettyname, "
+ . "i.id AS imageid, "
+ . "o.prettyname as OS, "
+ . "rs.computerid, "
+ . "c.currentimageid AS compimageid, "
+ . "c.stateid AS computerstateid, "
+ . "c.IPaddress, "
+ . "c.type AS comptype "
+ . "FROM reservation rs, "
+ . "image i, "
+ . "OS o, "
+ . "computer c "
+ . "WHERE rs.requestid = $id AND "
+ . "rs.imageid = i.id AND "
+ . "rs.computerid = c.id AND "
+ . "i.OSid = o.id AND "
+ . "i.forcheckout = 0";
+ $qh = doQuery($query, 160);
+ $count = 0;
+ $data = array();
+ while($row = mysql_fetch_assoc($qh)) {
+ $data[$count] = $row;
+ if((datetimeToUnix($row['end']) - datetimeToUnix($row['start'])) > SECINDAY)
+ $data[$count]['longterm'] = 1;
+ else
+ $data[$count]['longterm'] = 0;
+ $data[$count]["reservations"] = array();
+ $qh2 = doQuery($query2, 160);
+ while($row2 = mysql_fetch_assoc($qh2)) {
+ array_push($data[$count]["reservations"], $row2);
+ }
+ $count++;
+ }
+ return $data;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn isComputerLoading($request, $computers)
+///
+/// \param $request - an element from the array returned from getUserRequests
+/// \param $computers - array from getComputers
+///
+/// \return 1 if a computer is loading, 0 if not
+///
+/// \brief checks all computers associated with the request to see if they
+/// are loading
+///
+////////////////////////////////////////////////////////////////////////////////
+function isComputerLoading($request, $computers) {
+ if($computers[$request["computerid"]]["stateid"] == 6 ||
+ ($computers[$request["computerid"]]["stateid"] == 2 &&
+ $computers[$request["computerid"]]["currentimgid"] != $request["imageid"]))
+ return 1;
+ foreach($request["reservations"] as $res) {
+ if($computers[$res["computerid"]]["stateid"] == 6 ||
+ ($computers[$res["computerid"]]["stateid"] == 2 &&
+ $computers[$res["computerid"]]["currentimgid"] != $res["imageid"]))
+ return 1;
+ }
+ return 0;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getMaxReloadTime($request, $images)
+///
+/// \param $request - an element from the array returned from getUserRequests
+/// \param $images - array returned from getImages
+///
+/// \return the max reload time for all images associated with $request
+///
+/// \brief looks at all the reload times for images associated with $request
+/// and returns the longest one
+///
+////////////////////////////////////////////////////////////////////////////////
+function getMaxReloadTime($request, $images) {
+ $reloadtime = $images[$request["imageid"]]["reloadtime"];
+ foreach($request["reservations"] as $res) {
+ if($images[$res["imageid"]]["reloadtime"] > $reloadtime)
+ $reloadtime = $images[$res["imageid"]]["reloadtime"];
+ }
+ return $reloadtime;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn datetimeToUnix($datetime)
+///
+/// \param $datetime - a mysql datetime
+///
+/// \return timestamp - a unix timestamp
+///
+/// \brief converts a mysql datetime to a unix timestamp
+///
+////////////////////////////////////////////////////////////////////////////////
+function datetimeToUnix($datetime) {
+ $tmp = explode(' ', $datetime);
+ list($year, $month, $day) = explode('-', $tmp[0]);
+ list($hour, $min, $sec) = explode(':', $tmp[1]);
+ return mktime($hour, $min, $sec, $month, $day, $year, -1);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn unixToDatetime($timestamp)
+///
+/// \param $timestamp - a unix timestamp
+///
+/// \return datetime - a mysql datetime
+///
+/// \brief converts a unix timestamp to a mysql datetime
+///
+////////////////////////////////////////////////////////////////////////////////
+function unixToDatetime($timestamp) {
+ return date("Y-m-d H:i:s", $timestamp);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn minuteOfDay($hour, $min)
+///
+/// \param $hour - hour of the day (0 - 23)
+/// \param $min - minute into the hour (0 - 59)
+///
+/// \return minutes into the day (0 - 1439)
+///
+/// \brief converts hour:min to minutes since midnight
+///
+////////////////////////////////////////////////////////////////////////////////
+function minuteOfDay($hour, $min) {
+ return ($hour * 60) + $min;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn minuteOfDay2($time)
+///
+/// \param $time - in format 'HH:MM (am|pm)'
+///
+/// \return minutes into the day (0 - 1439)
+///
+/// \brief converts 'HH:MM (am|pm)' to minutes since midnight
+///
+////////////////////////////////////////////////////////////////////////////////
+function minuteOfDay2($time) {
+ $timeArr = explode(':', $time);
+ $hour = $timeArr[0];
+ $timeArr = explode(' ', $timeArr[1]);
+ $min = $timeArr[0];
+ $meridian = $timeArr[1];
+ if($meridian == "am" && $hour == 12) {
+ return $min;
+ }
+ elseif($meridian == "pm" && $hour < 12) {
+ $hour += 12;
+ }
+ return ($hour * 60) + $min;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn minuteOfWeek($ts)
+///
+/// \param $ts - a unix timestamp
+///
+/// \return minute of the week
+///
+/// \brief takes a unix timestamp and returns how many minutes into the week it
+/// is with the week starting on Sunday at midnight
+///
+////////////////////////////////////////////////////////////////////////////////
+function minuteOfWeek($ts) {
+ # ((day of week (0-6)) * 1440) + ((hour in day) * 60) + (min in hour)
+ return (date('w', $ts) * 1440) + (date('G', $ts) * 60) + date('i', $ts);
+}
+
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn minuteToTime($minutes)
+///
+/// \param $minutes - minutes since midnight
+///
+/// \return time string in the form (H)H:MM (am/pm)
+///
+/// \brief converts "minutes since midnight" to time of day
+///
+////////////////////////////////////////////////////////////////////////////////
+function minuteToTime($minutes) {
+ $hour = sprintf("%d", $minutes / 60);
+ $min = sprintf("%02d", $minutes % 60);
+ $meridian = "am";
+ if($hour == 0) {
+ $hour = 12;
+ }
+ elseif($hour == 12) {
+ $meridian = "pm";
+ }
+ elseif($hour > 12) {
+ $hour -= 12;
+ $meridian = "pm";
+ }
+ return "$hour:$min $meridian";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn hour12to24($hour, $meridian)
+///
+/// \param $hour - 1 to 12
+/// \param $meridian - am or pm
+///
+/// \return 24 hour equivilent of $hour $meridian
+///
+/// \brief converts 12 hour format to 24 hour format
+///
+////////////////////////////////////////////////////////////////////////////////
+function hour12to24($hour, $meridian) {
+ if($meridian == 'pm' && $hour < 12)
+ return $hour + 12;
+ elseif($meridian == 'am' && $hour == 12)
+ return 0;
+ return $hour;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getDepartmentName($id)
+///
+/// \param $id - id for a department in the department table
+///
+/// \return if found, department name; if not, 0
+///
+/// \brief looks up the name field corresponding to $id in the department table
+/// and returns it
+///
+////////////////////////////////////////////////////////////////////////////////
+function getDepartmentName($id) {
+ $query = "SELECT name FROM department WHERE id = '$id'";
+ $qh = doQuery($query, 101);
+ if($row = mysql_fetch_row($qh)) {
+ return $row[0];
+ }
+ else {
+ return 0;
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getDepartmentID($dept)
+///
+/// \param $dept - department name
+///
+/// \return id from department table for the department name
+///
+/// \brief gets id field from department table for $dept
+///
+////////////////////////////////////////////////////////////////////////////////
+function getDepartmentID($dept) {
+ $dept = strtolower($dept);
+ $query = "SELECT id FROM department WHERE name = '$dept'";
+ $qh = doQuery($query, 101);
+ if(mysql_num_rows($qh)) {
+ $row = mysql_fetch_row($qh);
+ return $row[0];
+ }
+ else {
+ return 0;
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getAppId($app)
+///
+/// \param $app - name of an app (must match name in the app table)
+///
+/// \return the id of matching $app in the app table or 0 if lookup fails
+///
+/// \brief looks up the id for $app and returns it
+///
+////////////////////////////////////////////////////////////////////////////////
+function getAppId($app) {
+ $qh = doQuery("SELECT id FROM app WHERE name = '$app'", 139);
+ if($row = mysql_fetch_row($qh)) {
+ return $row[0];
+ }
+ return 0;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getImageId($image)
+///
+/// \param $image - name of an image (must match name (not prettyname) in the
+/// image table)
+///
+/// \return the id of matching $image in the image table or 0 if lookup fails
+///
+/// \brief looks up the id for $image and returns it
+///
+////////////////////////////////////////////////////////////////////////////////
+function getImageId($image) {
+ $qh = doQuery("SELECT id FROM image WHERE name = '$image'", 170);
+ if($row = mysql_fetch_row($qh)) {
+ return $row[0];
+ }
+ return 0;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getOSId($os)
+///
+/// \param $os - name of an os (must match name in the os table
+///
+/// \return the id of matching $os in the os table or 0 if lookup fails
+///
+/// \brief looks up the id for $os and returns it
+///
+////////////////////////////////////////////////////////////////////////////////
+function getOSId($os) {
+ $qh = doQuery("SELECT id FROM OS WHERE name = '$os'", 175);
+ if($row = mysql_fetch_row($qh)) {
+ return $row[0];
+ }
+ return 0;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getStates()
+///
+/// \return array of states where the index are the id from the state table
+///
+/// \brief gets names for states in state table
+///
+////////////////////////////////////////////////////////////////////////////////
+function getStates() {
+ $qh = doQuery("SELECT id, name FROM state", 176);
+ $states = array();
+ while($row = mysql_fetch_row($qh)) {
+ $states[$row[0]] = $row[1];
+ }
+ return $states;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getDepartments()
+///
+/// \return array of departments where the index are the id from the dept table,
+/// each index has the following elements:\n
+/// \b name - short name of department\n
+/// \b prettyname - nice looking name of department
+///
+/// \brief gets names for departments in dept table
+///
+////////////////////////////////////////////////////////////////////////////////
+function getDepartments() {
+ $qh = doQuery("SELECT id, name, prettyname FROM dept", 177);
+ $depts = array();
+ while($row = mysql_fetch_row($qh)) {
+ $depts[$row[0]]["name"] = $row[1];
+ $depts[$row[0]]["prettyname"] = $row[2];
+ }
+ return $depts;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getPlatforms()
+///
+/// \return array of platforms where the index are the id from the platform table
+///
+/// \brief gets names for platforms in platform table
+///
+////////////////////////////////////////////////////////////////////////////////
+function getPlatforms() {
+ $qh = doQuery("SELECT id, name FROM platform", 178);
+ $platforms = array();
+ while($row = mysql_fetch_row($qh)) {
+ $platforms[$row[0]] = $row[1];
+ }
+ return $platforms;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getProvisioning()
+///
+/// \return array of provisioning engines where each index is the id and the
+/// value is an array with these keys: name, prettyname, moduleid, modulename
+///
+/// \brief gets data from provisioning table
+///
+////////////////////////////////////////////////////////////////////////////////
+function getProvisioning() {
+ $query = "SELECT p.id, "
+ . "p.name, "
+ . "p.prettyname, "
+ . "p.moduleid, "
+ . "m.prettyname AS modulename "
+ . "FROM provisioning p, "
+ . "module m "
+ . "WHERE p.moduleid = m.id "
+ . "ORDER BY p.prettyname";
+ $qh = doQuery($query, 101);
+ $provisioning = array();
+ while($row = mysql_fetch_assoc($qh))
+ $provisioning[$row['id']] = $row;
+ return $provisioning;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getSchedules()
+///
+/// \return array of schedules where the index are the id from the schedule table,
+/// each index has the following elements:\n
+/// \b name - name of schedule\n
+/// \b ownerid - user id of owner\n
+/// \b owner - unity id of owner\n
+/// \b times - array of start and end times for the schedule
+///
+/// \brief gets information for schedules in schedule table
+///
+////////////////////////////////////////////////////////////////////////////////
+function getSchedules() {
+ $query = "SELECT s.id, "
+ . "s.name, "
+ . "s.ownerid, "
+ . "CONCAT(u.unityid, '@', a.name) AS owner, "
+ . "r.id AS resourceid "
+ . "FROM schedule s, "
+ . "resource r, "
+ . "resourcetype t, "
+ . "user u, "
+ . "affiliation a "
+ . "WHERE r.subid = s.id AND "
+ . "r.resourcetypeid = t.id AND "
+ . "t.name = 'schedule' AND "
+ . "s.ownerid = u.id AND "
+ . "u.affiliationid = a.id "
+ . "ORDER BY s.name";
+ $qh = doQuery($query, 179);
+ $schedules = array();
+ while($row = mysql_fetch_assoc($qh)) {
+ $schedules[$row["id"]] = $row;
+ $schedules[$row["id"]]["times"] = array();
+ }
+ $query = "SELECT scheduleid, "
+ . "start, "
+ . "end "
+ . "FROM scheduletimes "
+ . "ORDER BY scheduleid, "
+ . "start";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_assoc($qh)) {
+ array_push($schedules[$row["scheduleid"]]["times"],
+ array("start" => $row["start"], "end" => $row["end"]));
+ }
+ return $schedules;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn formatMinOfWeek($min)
+///
+/// \param $min - minute of the week
+///
+/// \return a string with the day of week and time
+///
+/// \brief formats $min into something useful for printing
+///
+////////////////////////////////////////////////////////////////////////////////
+function formatMinOfWeek($min) {
+ $time = minuteToTime($min % 1440);
+ if($min / 1440 == 0) {
+ return "Sunday, $time";
+ }
+ elseif((int)($min / 1440) == 1) {
+ return "Monday, $time";
+ }
+ elseif((int)($min / 1440) == 2) {
+ return "Tuesday, $time";
+ }
+ elseif((int)($min / 1440) == 3) {
+ return "Wednesday, $time";
+ }
+ elseif((int)($min / 1440) == 4) {
+ return "Thursday, $time";
+ }
+ elseif((int)($min / 1440) == 5) {
+ return "Friday, $time";
+ }
+ elseif((int)($min / 1440) == 6) {
+ return "Saturday, $time";
+ }
+ elseif((int)($min / 1440) > 6) {
+ return "Sunday, $time";
+ }
+ else {
+ return "$time";
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getManagementNodes($alive)
+///
+/// \param $alive - (optional) if given, only return "alive" nodes, can be
+/// either "now" or "future" so we know how recently it must
+/// have checked in
+///
+/// \return an array of management nodes where eash index is the id from the
+/// managementnode table and each element is an array of data about the node
+///
+/// \brief builds an array of data about the management nodes\n
+/// if $alive = now, must have checked in within 5 minutes\n
+/// if $alive = future, must have checked in within 1 hour
+///
+////////////////////////////////////////////////////////////////////////////////
+function getManagementNodes($alive="neither") {
+ if($alive == "now")
+ $lastcheckin = unixToDatetime(time() - 300);
+ elseif($alive == "future")
+ $lastcheckin = unixToDatetime(time() - 3600);
+
+ $query = "SELECT m.id, "
+ . "m.IPaddress, "
+ . "m.hostname, "
+ . "m.ownerid, "
+ . "CONCAT(u.unityid, '@', a.name) as owner, "
+ . "m.stateid, "
+ . "s.name as state, "
+ . "m.lastcheckin, "
+ . "r.id as resourceid, "
+ . "m.predictivemoduleid, "
+ . "mo.prettyname AS predictivemodule "
+ . "FROM managementnode m, "
+ . "user u, "
+ . "state s, "
+ . "resource r, "
+ . "resourcetype rt, "
+ . "affiliation a, "
+ . "module mo "
+ . "WHERE m.ownerid = u.id AND "
+ . "m.stateid = s.id AND "
+ . "m.id = r.subid AND "
+ . "r.resourcetypeid = rt.id AND "
+ . "rt.name = 'managementnode' AND "
+ . "u.affiliationid = a.id AND "
+ . "m.predictivemoduleid = mo.id";
+ if($alive == "now" || $alive == "future") {
+ $query .= " AND m.lastcheckin > '$lastcheckin'"
+ . " AND s.name != 'maintenance'";
+ }
+ $qh = doQuery($query, 101);
+ $return = array();
+ while($row = mysql_fetch_assoc($qh)) {
+ $return[$row["id"]] = $row;
+ }
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getPredictiveModules()
+///
+/// \return an array of predictive loading modules where the index is the module
+/// id and the value is a row of data from the module table
+///
+/// \brief gets all the predictive loading modules from the module table
+///
+////////////////////////////////////////////////////////////////////////////////
+function getPredictiveModules() {
+ $query = "SELECT id, "
+ . "name, "
+ . "prettyname, "
+ . "description, "
+ . "perlpackage "
+ . "FROM module "
+ . "WHERE perlpackage LIKE 'VCL::Module::Predictive::%'";
+ $qh = doQuery($query, 101);
+ $modules = array();
+ while($row = mysql_fetch_assoc($qh))
+ $modules[$row['id']] = $row;
+ return $modules;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getTimeSlots($end, $start)
+///
+/// \param $end - (optional) end time as unix timestamp
+/// \param $start - (optional) start time as unix timestamp
+///
+/// \return array of free/used timeslotes
+///
+/// \brief generates an array of availability for computers where index is a
+/// computerid with a value that is an array whose indexes are unix timestamps
+/// that increment by 15 minutes with a value that is an array with 2 indexes:
+/// 'scheduleclosed' and 'available' that tell if the computer's schedule is
+/// closed at that moment and if the computer is available at that moment\n
+/// Array {\n
+/// [computerid0] => Array {\n
+/// [timeslot0] => Array {\n
+/// [scheduleclosed] => (0/1)\n
+/// [available] => (0/1)\n
+/// }\n
+/// ...\n
+/// [timeslotN] => Array {...}\n
+/// }\n
+/// ...\n
+/// [computeridN] => Array {...}\n
+/// }
+///
+////////////////////////////////////////////////////////////////////////////////
+function getTimeSlots($compids, $end=0, $start=0) {
+ global $viewmode;
+ if(empty($compids))
+ return array();
+ $requestid = processInputVar("requestid", ARG_NUMERIC, 0);
+
+ $platsel = getContinuationVar("platforms");
+ if(empty($platsel))
+ $platsel = processInputVar("platforms", ARG_MULTINUMERIC);
+ $schsel = getContinuationVar("schedules");
+ if(empty($schsel))
+ $schsel = processInputVar("schedules", ARG_MULTINUMERIC);
+
+ # all computations done with unix timestamps
+ if($end != 0) {
+ $enddate = unixToDatetime($end);
+ }
+ if($start != 0) {
+ $startdate = unixToDatetime($start);
+ }
+
+ $computerids = array();
+ $reservedComputerids = array();
+ $schedules = getSchedules();
+ $times = array();
+ $scheduleids = array();
+ $compinlist = implode(",", $compids);
+ $query = "SELECT id, scheduleid "
+ . "FROM computer "
+ . "WHERE scheduleid IS NOT NULL AND "
+ . "scheduleid != 0 AND "
+ . "id IN ($compinlist) ";
+ if(! empty($schsel) && ! empty($platsel)) {
+ $schinlist = implode(',', $schsel);
+ $platinlist = implode(',', $platsel);
+ $query .= "AND scheduleid IN ($schinlist) "
+ . "AND platformid IN ($platinlist)";
+ }
+ $qh = doQuery($query, 155);
+ while($row = mysql_fetch_row($qh)) {
+ array_push($computerids, $row[0]);
+ $times[$row[0]] = array();
+ $scheduleids[$row[0]] = $row[1];
+ }
+
+ if($start != 0 && $end != 0) {
+ $query = "SELECT rs.computerid, "
+ . "rq.start, "
+ . "rq.end + INTERVAL 900 SECOND AS end, "
+ . "rq.id, "
+ . "u.unityid, "
+ . "i.prettyname "
+ . "FROM reservation rs, "
+ . "request rq, "
+ . "user u, "
+ . "image i "
+ . "WHERE (rq.start < '$enddate' AND "
+ . "rq.end > '$startdate') AND "
+ . "rq.id = rs.requestid AND "
+ . "u.id = rq.userid AND "
+ . "i.id = rs.imageid AND "
+ . "rq.stateid NOT IN (1,5,12) "
+ . "ORDER BY rs.computerid, "
+ . "rq.start";
+ }
+ else {
+ $query = "SELECT rs.computerid, "
+ . "rq.start, "
+ . "rq.end + INTERVAL 900 SECOND AS end, "
+ . "rq.id, "
+ . "u.unityid, "
+ . "i.prettyname "
+ . "FROM reservation rs, "
+ . "request rq, "
+ . "user u, "
+ . "image i "
+ . "WHERE rq.end > NOW() AND "
+ . "rq.id = rs.requestid AND "
+ . "u.id = rq.userid AND "
+ . "i.id = rs.imageid AND "
+ . "rq.stateid NOT IN (1,5,12) "
+ . "ORDER BY rs.computerid, "
+ . "rq.start";
+ }
+ $qh = doQuery($query, 156);
+
+ $id = "";
+ while($row = mysql_fetch_row($qh)) {
+ if($row[3] == $requestid) {
+ continue;
+ }
+ if($id != $row[0]) {
+ $count = 0;
+ $id = $row[0];
+ array_push($reservedComputerids, $id);
+ }
+ $times[$id][$count] = array();
+ $times[$id][$count]["start"] = datetimeToUnix($row[1]);
+ $times[$id][$count]["end"] = datetimeToUnix($row[2]);
+ $times[$id][$count]["requestid"] = $row[3];
+ $times[$id][$count]["unityid"] = $row[4];
+ $times[$id][$count++]["prettyimage"] = $row[5];
+ }
+
+ # use floor function to get to a 15 min increment for start
+ if($start != 0) {
+ $start = unixFloor15($start);
+ }
+ else {
+ $start = unixFloor15() + 900;
+ }
+
+ # last time to look at
+ if($end != 0) {
+ $endtime = $end;
+ }
+ else {
+ $endtime = $start + (DAYSAHEAD * SECINDAY);
+ }
+
+ $blockData = getBlockTimeData($start, $endtime);
+ $reserveInfo = array(); // 0 = reserved, 1 = available
+ foreach($computerids as $id) {
+ $reserveInfo[$id] = array();
+ $first = 1;
+ # loop from $start to $endtime by 15 minute increments
+ for($current = $start, $count = 0, $max = count($times[$id]);
+ $current < $endtime;
+ $current += 900) {
+ /*print "compid - $id<br>\n";
+ print "count - $count<br>\n";
+ print "current - " . unixToDatetime($current) . "<br>\n";
+ if(array_key_exists($count, $times[$id])) {
+ print "start - " . unixToDatetime($times[$id][$count]["start"]) . "<br>\n";
+ print "end - " . unixToDatetime($times[$id][$count]["end"]) . "<br>\n";
+ }
+ print "-----------------------------------------------------<br>\n";*/
+ $reserveInfo[$id][$current]['blockRequest'] = 0;
+ if(scheduleClosed($id, $current, $schedules[$scheduleids[$id]])) {
+ $reserveInfo[$id][$current]["available"] = 0;
+ $reserveInfo[$id][$current]["scheduleclosed"] = 1;
+ continue;
+ }
+ if($blockid = isBlockRequestTime($id, $current, $blockData)) {
+ $reserveInfo[$id][$current]['blockRequest'] = 1;
+ $reserveInfo[$id][$current]['blockRequestInfo']['groupid'] = $blockData[$blockid]['groupid'];
+ $reserveInfo[$id][$current]['blockRequestInfo']['imageid'] = $blockData[$blockid]['imageid'];
+ $reserveInfo[$id][$current]['blockRequestInfo']['name'] = $blockData[$blockid]['name'];
+ $reserveInfo[$id][$current]['blockRequestInfo']['image'] = $blockData[$blockid]['image'];
+ }
+ $reserveInfo[$id][$current]["scheduleclosed"] = 0;
+ //if computer not in $reservedComputerids, it is free
+ if(! in_array($id, $reservedComputerids)) {
+ $reserveInfo[$id][$current]["available"] = 1;
+ continue;
+ }
+ //if past an end
+ if($count != $max && $current >= $times[$id][$count]["end"]) {
+ $count++;
+ }
+ # past the end of all reservations
+ if($count == $max) {
+ $reserveInfo[$id][$current]["available"] = 1;
+ continue;
+ }
+ //if before any start times
+ if($count == 0 && $current < $times[$id][0]["start"]) {
+ $reserveInfo[$id][$current]["available"] = 1;
+ continue;
+ }
+ //if between a start and end time
+ if($current >= $times[$id][$count]["start"] &&
+ $current < $times[$id][$count]["end"]) {
+ if($first) {
+ $first = 0;
+ $reserveInfo[$id][$current - 900]['blockRequest'] = 0;
+ $reserveInfo[$id][$current - 900]["scheduleclosed"] = 0;
+ $reserveInfo[$id][$current - 900]["available"] = 0;
+ $reserveInfo[$id][$current - 900]["requestid"] = $times[$id][$count]["requestid"];
+ $reserveInfo[$id][$current - 900]["unityid"] = $times[$id][$count]["unityid"];
+ $reserveInfo[$id][$current - 900]["prettyimage"] = $times[$id][$count]["prettyimage"];
+ }
+ $reserveInfo[$id][$current]["available"] = 0;
+ $reserveInfo[$id][$current]["requestid"] = $times[$id][$count]["requestid"];
+ $reserveInfo[$id][$current]["unityid"] = $times[$id][$count]["unityid"];
+ $reserveInfo[$id][$current]["prettyimage"] = $times[$id][$count]["prettyimage"];
+ continue;
+ }
+ //if after previous end but before this start
+ if($current >= $times[$id][$count - 1]["end"] &&
+ $current < $times[$id][$count]["start"]) {
+ $reserveInfo[$id][$current]["available"] = 1;
+ continue;
+ }
+ # shouldn't get here; print debug info if we do
+ if($viewmode == ADMIN_DEVELOPER) {
+ print "******************************************************<br>\n";
+ print "current - " . unixToDatetime($current) . "<br>\n";
+ print "endtime - " . unixToDatetime($endtime) . "<br>\n";
+ print "count - $count<br>\n";
+ print "max - $max<br>\n";
+ print "start - " . unixToDatetime($times[$id][$count]["start"]) . "<br>\n";
+ print "end - " . unixToDatetime($times[$id][$count]["end"]) . "<br>\n";
+ print "------------------------------------------------------<br>\n";
+ }
+ }
+ }
+ return $reserveInfo;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn unixFloor15($timestamp)
+///
+/// \param $timestamp - (optional) unix timestamp, defaults to now
+///
+/// \return floored timestamp
+///
+/// \brief takes $timestamp and floors it to a 15 minute increment with 0 seconds
+///
+////////////////////////////////////////////////////////////////////////////////
+function unixFloor15($timestamp=0) {
+ if($timestamp == 0) {
+ $timestamp = time();
+ }
+ $timeval = getdate($timestamp);
+ if($timeval["minutes"] < 15) {
+ $timeval["minutes"] = 0;
+ }
+ elseif($timeval["minutes"] < 30) {
+ $timeval["minutes"] = 15;
+ }
+ elseif($timeval["minutes"] < 45) {
+ $timeval["minutes"] = 30;
+ }
+ elseif($timeval["minutes"] < 60) {
+ $timeval["minutes"] = 45;
+ }
+ return mktime($timeval["hours"],
+ $timeval["minutes"],
+ 0,
+ $timeval["mon"],
+ $timeval["mday"],
+ $timeval["year"],
+ -1);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn pickTimeTable()
+///
+/// \brief prints a form for selecting what elements to show in the timetable
+///
+////////////////////////////////////////////////////////////////////////////////
+function pickTimeTable() {
+ $data = getUserComputerMetaData();
+ print "<H2 align=center>Time Table</H2>\n";
+ print "Select the criteria for the computers you want to have in the timetable:\n";
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<table id=layouttable summary=\"\">\n";
+ print " <TR>\n";
+ print " <TH>Platforms:</TH>\n";
+ print " <TH>Schedules:</TH>\n";
+ print " </TR>\n";
+ print " <TR valign=top>\n";
+ print " <TD>\n";
+ printSelectInput("platforms[]", $data["platforms"], -1, 0, 1);
+ print " </TD>\n";
+ print " <TD>\n";
+ printSelectInput("schedules[]", $data["schedules"], -1, 0, 1);
+ print " </TD>\n";
+ print " </TR>\n";
+ print "</table>\n";
+ $cont = addContinuationsEntry('showTimeTable');
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "<INPUT type=submit value=Submit>\n";
+ print "</FORM>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn showTimeTable($links)
+///
+/// \param $links - 1 to make free times links; 0 for no links
+///
+/// \brief prints out a timetable of free/used timeslots
+///
+////////////////////////////////////////////////////////////////////////////////
+function showTimeTable($links) {
+ global $mode, $viewmode, $user;
+ if($links == 1) {
+ $imageid = getContinuationVar('imageid');
+ $length = getContinuationVar('length');
+ $requestid = getContinuationVar('requestid', 0);
+ $showmessage = getContinuationVar('showmessage', 0);
+ $platforms = array();
+ $schedules = array();
+ }
+ else {
+ $imageid = 0;
+ $length = 0;
+ $requestid = 0;
+ $showmessage = 0;
+ $platforms = getContinuationVar("platforms");
+ if(empty($platforms))
+ $platforms = processInputVar("platforms", ARG_MULTINUMERIC);
+ $schedules = getContinuationVar("schedules");
+ if(empty($schedules))
+ $schedules = processInputVar("schedules", ARG_MULTINUMERIC);
+ }
+ $argstart = getContinuationVar("start");
+ $argend = getContinuationVar("end");
+
+ $resources = getUserResources(array("computerAdmin"));
+ $userCompIDs = array_keys($resources["computer"]);
+
+ $computerData = getComputers();
+ $imageData = getImages();
+ $now = time();
+ if($links) {
+ $resources = getUserResources(array("imageAdmin", "imageCheckOut"));
+ $usercomputerids = array_keys($resources["computer"]);
+ # get list of computers' platformids
+ $qh = doQuery("SELECT platformid FROM image WHERE id = $imageid", 110);
+ $row = mysql_fetch_row($qh);
+ $platformid = $row[0];
+ $computer_platformids = array();
+ $qh = doQuery("SELECT id, platformid FROM computer", 111);
+ while($row = mysql_fetch_row($qh)) {
+ $computer_platformids[$row[0]] = $row[1];
+ }
+ $mappedcomputers = getMappedResources($imageid, "image", "computer");
+ $compidlist = array_intersect($mappedcomputers, $usercomputerids);
+ }
+ else
+ $compidlist = $userCompIDs;
+ if(! empty($argstart) && ! empty($argend)) {
+ $timeslots = getTimeSlots($compidlist, $argend, $argstart);
+ $start = $argstart;
+ $end = $argend;
+ }
+ else {
+ $start = $now;
+ $end = $start + (SECINDAY / 2);
+ $timeslots = getTimeSlots($compidlist, $end);
+ }
+
+ print "<DIV align=center>\n";
+ print "<H2>Time Table</H2>\n";
+ print "</DIV>\n";
+ $computeridrow = "";
+ $displayedids = array();
+ $computers = array_keys($timeslots);
+ if($links) {
+ $computers = array_intersect($computers, $usercomputerids);
+ }
+ foreach($computers as $id) {
+ if($links) {
+ # don't show computers that don't meet hardware criteria, are not
+ # in the available state, are the wrong platform, or wrong group,
+ # or aren't mapped in resourcemap
+ if($computer_platformids[$id] != $platformid ||
+ ($computerData[$id]["stateid"] != 2 &&
+ $computerData[$id]["stateid"] != 3 &&
+ $computerData[$id]["stateid"] != 6 &&
+ $computerData[$id]["stateid"] != 8) ||
+ $computerData[$id]["ram"] < $imageData[$imageid]["minram"] ||
+ $computerData[$id]["procnumber"] < $imageData[$imageid]["minprocnumber"] ||
+ $computerData[$id]["procspeed"] < $imageData[$imageid]["minprocspeed"] ||
+ $computerData[$id]["network"] < $imageData[$imageid]["minnetwork"] ||
+ ! in_array($id, $mappedcomputers)) {
+ continue;
+ }
+ }
+ elseif(! array_key_exists($id, $computerData) ||
+ ! in_array($computerData[$id]["platformid"], $platforms) ||
+ ! in_array($computerData[$id]["scheduleid"], $schedules) ||
+ ! in_array($id, $userCompIDs)) {
+ continue;
+ }
+ $computeridrow .= " <TH>$id</TH>\n";
+ array_push($displayedids, $id);
+ }
+ if(empty($displayedids)) {
+ if($links) {
+ print "There are currently no computers available that can run the application you selected.\n";
+ }
+ else {
+ print "There are no computers that meet the specified criteria\n";
+ }
+ return;
+ }
+ if($showmessage) {
+ print "The time you have requested to use the environment is not ";
+ print "available. You may select from the green blocks of time to ";
+ print "select an available time slot to make a reservation.<br>\n";
+ }
+ print "<table summary=\"\">\n";
+ print " <TR>\n";
+ print " <TD>";
+ # print Previous/Next links
+ if(! empty($argstart) && ($argstart - (SECINDAY / 2) > $now - 600)) {
+ $prevstart = $start - (SECINDAY / 2);
+ $prevend = $end - (SECINDAY / 2);
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('start' => $prevstart,
+ 'end' => $prevend,
+ 'imageid' => $imageid,
+ 'requestid' => $requestid,
+ 'length' => $length,
+ 'platforms' => $platforms,
+ 'schedules' => $schedules);
+ $cont = addContinuationsEntry($mode, $cdata, SECINDAY);
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "<INPUT type=submit value=Previous>\n";
+ print "</FORM>\n";
+ }
+ print "</TD>\n";
+ print " <TD>";
+ if($end + (SECINDAY / 2) < $now + DAYSAHEAD * SECINDAY) {
+ $nextstart = $start + (SECINDAY / 2);
+ $nextend = $end + (SECINDAY / 2);
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('start' => $nextstart,
+ 'end' => $nextend,
+ 'imageid' => $imageid,
+ 'requestid' => $requestid,
+ 'length' => $length,
+ 'platforms' => $platforms,
+ 'schedules' => $schedules);
+ $cont = addContinuationsEntry($mode, $cdata, SECINDAY);
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "<INPUT type=submit value=Next>\n";
+ print "</FORM>\n";
+ }
+ print "</TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TD>\n";
+
+ $tmpArr = array_keys($computers);
+ $first = $computers[$tmpArr[0]];
+ print " <table id=ttlayout summary=\"\">\n";
+ if(! $links || $viewmode >= ADMIN_DEVELOPER) {
+ print " <TR>\n";
+ print " <TH align=right>Computer ID:</TH>\n";
+ print $computeridrow;
+ print " </TR>\n";
+ }
+ $yesterday = "";
+ foreach(array_keys($timeslots[$first]) as $stamp) {
+ print " <TR>\n";
+ $stampArr = getdate($stamp);
+ $label = "";
+ if($stampArr["mday"] != $yesterday) {
+ $label = date('n/d/Y+g:i+a', $stamp);
+ $label = str_replace('+', ' ', $label);
+ $yesterday = $stampArr["mday"];
+ }
+ elseif($stampArr["minutes"] == 0) {
+ $label = date('g:i a', $stamp);
+ }
+ print " <TH align=right>$label</TH>\n";
+ $free = 0;
+ # print the cells
+ foreach($computers as $id) {
+ if(! in_array($id, $displayedids)) {
+ continue;
+ }
+ if($links && ($computer_platformids[$id] != $platformid ||
+ $computerData[$id]["stateid"] == 10 ||
+ $computerData[$id]["stateid"] == 5)) {
+ continue;
+ }
+ # computer's schedule is currently closed
+ if($timeslots[$id][$stamp]["scheduleclosed"] == 1) {
+ print " <TD bgcolor=\"#a0a0a0\"><img src=images/gray.jpg ";
+ print "alt=scheduleclosed border=0></TD>\n";
+ }
+ # computer is in maintenance state
+ elseif($computerData[$id]["stateid"] == 10) {
+ print " <TD bgcolor=\"#a0a0a0\"><img src=images/gray.jpg ";
+ print "alt=maintenance border=0></TD>\n";
+ }
+ # computer is reserved for a block request that doesn't match this
+ elseif($timeslots[$id][$stamp]['blockRequest'] &&
+ ($timeslots[$id][$stamp]['blockRequestInfo']['imageid'] != $imageid || # this line threw an error at one point, but we couldn't recreate it later
+ (! in_array($timeslots[$id][$stamp]['blockRequestInfo']['groupid'], array_keys($user['groups'])))) &&
+ $timeslots[$id][$stamp]['available']) {
+ if($links) {
+ print " <TD bgcolor=\"#ff0000\"><img src=images/red.jpg ";
+ print "alt=blockrequest border=0></TD>\n";
+ }
+ else {
+ print " <TD bgcolor=\"#e58304\"><img src=images/orange.jpg ";
+ $title = "Block Request: {$timeslots[$id][$stamp]['blockRequestInfo']['name']}\n"
+ . "Image: {$timeslots[$id][$stamp]['blockRequestInfo']['image']}";
+ print "alt=blockrequest border=0 title=\"$title\"></TD>\n";
+ }
+ }
+ # computer is free
+ elseif($timeslots[$id][$stamp]["available"]) {
+ if($links) {
+ print " <TD bgcolor=\"#00ff00\"><a href=\"" . BASEURL . SCRIPT;
+ print "?mode=newRequest&stamp=$stamp&imageid=$imageid&length=$length\"><img ";
+ print "src=images/green.jpg alt=free border=0></a></TD>\n";
+ }
+ else {
+ print " <TD bgcolor=\"#00ff00\"><img src=images/green.jpg alt=free border=0></TD>\n";
+ }
+ }
+ # computer is used
+ else {
+ if($links) {
+ print " <TD bgcolor=\"#ff0000\"><font color=\"#ff0000\">used</font></TD>\n";
+ }
+ else {
+ $title = "User: " . $timeslots[$id][$stamp]["unityid"]
+ . " Image: " . $timeslots[$id][$stamp]["prettyimage"];
+ print " <TD bgcolor=\"#ff0000\"><a href=\"" . BASEURL . SCRIPT;
+ print "?mode=viewRequestInfo&requestid=" . $timeslots[$id][$stamp]["requestid"] . "\"><img ";
+ print "src=images/red.jpg alt=used border=0 title=\"$title\"></a></TD>\n";
+ }
+ }
+ }
+ print " </TR>\n";
+ }
+ print " </table>\n";
+ print " </TD>\n";
+ print " </TR>\n";
+ print " <TR>\n";
+ print " <TD>";
+ # print Previous/Next links
+ if(! empty($argstart) && ($argstart - (SECINDAY / 2) > $now - 600)) {
+ $prevstart = $start - (SECINDAY / 2);
+ $prevend = $end - (SECINDAY / 2);
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('start' => $prevstart,
+ 'end' => $prevend,
+ 'imageid' => $imageid,
+ 'requestid' => $requestid,
+ 'length' => $length,
+ 'platforms' => $platforms,
+ 'schedules' => $schedules);
+ $cont = addContinuationsEntry($mode, $cdata, SECINDAY);
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "<INPUT type=submit value=Previous>\n";
+ print "</FORM>\n";
+ }
+ print "</TD>\n";
+ print " <TD>";
+ if($end + (SECINDAY / 2) < $now + DAYSAHEAD * SECINDAY) {
+ $nextstart = $start + (SECINDAY / 2);
+ $nextend = $end + (SECINDAY / 2);
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('start' => $nextstart,
+ 'end' => $nextend,
+ 'imageid' => $imageid,
+ 'requestid' => $requestid,
+ 'length' => $length,
+ 'platforms' => $platforms,
+ 'schedules' => $schedules);
+ $cont = addContinuationsEntry($mode, $cdata, SECINDAY);
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "<INPUT type=submit value=Next>\n";
+ print "</FORM>\n";
+ }
+ print "</TD>\n";
+ print " </TR>\n";
+ print "</table>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getComputers($sort, $includedeleted, $compid)
+///
+/// \param $sort - (optional) 1 to sort; 0 not to
+/// \param $includedeleted = (optional) 1 to show deleted images, 0 not to
+/// \param $compid - (optional) only get info for this computer id
+///
+/// \return an array with info about the computers in the comptuer table; each
+/// element's index is the id from the table; each element has the following
+/// items\n
+/// \b state - current state of the computer\n
+/// \b stateid - id of current state\n
+/// \b dept - department owning the computer\n
+/// \b prettydept - pretty name of department owning the computer\n
+/// \b deptid - id of department owning the computer\n
+/// \b owner - unity id of owner\n
+/// \b ownerid - user id of owner\n
+/// \b platform - computer's platform\n
+/// \b platformid - id of computer's platform\n
+/// \b schedule - computer's schedule\n
+/// \b scheduleid - id of computer's schedule\n
+/// \b currentimg - computer's current image\n
+/// \b currentimgid - id of computer's current image\n
+/// \b nextimg - computer's next image\n
+/// \b nextimgid - id of computer's next image\n
+/// \b nextimg - computer's next image\n
+/// \b nextimgid - id of computer's next image\n
+/// \b ram - amount of RAM in computer in MB\n
+/// \b procnumber - number of processors in computer\n
+/// \b procspeed - speed of processor(s) in MHz\n
+/// \b network - speed of computer's NIC\n
+/// \b hostname - computer's hostname\n
+/// \b IPaddress - computer's IP address\n
+/// \b type - either 'blade' or 'lab' - used to determine what backend utilities\n
+/// \b deleted - 0 or 1; whether or not this computer has been deleted\n
+/// \b resourceid - computer's resource id from the resource table\n
+/// \b provisioningid - id of provisioning engine\n
+/// \b provisioning - pretty name of provisioning engine
+/// need to be used to manage computer
+///
+/// \brief builds an array of computers
+///
+////////////////////////////////////////////////////////////////////////////////
+function getComputers($sort=0, $includedeleted=0, $compid="") {
+ $return = array();
+ $query = "SELECT c.id AS id, "
+ . "st.name AS state, "
+ . "c.stateid AS stateid, "
+ . "d.name AS dept, "
+ . "d.prettyname AS prettydept, "
+ . "c.deptid AS deptid, "
+ . "CONCAT(u.unityid, '@', a.name) AS owner, "
+ . "u.id AS ownerid, "
+ . "p.name AS platform, "
+ . "c.platformid AS platformid, "
+ . "sc.name AS schedule, "
+ . "c.scheduleid AS scheduleid, "
+ . "cur.name AS currentimg, "
+ . "c.currentimageid AS currentimgid, "
+ . "next.name AS nextimg, "
+ . "c.nextimageid AS nextimgid, "
+ . "c.RAM AS ram, "
+ . "c.procnumber AS procnumber, "
+ . "c.procspeed AS procspeed, "
+ . "c.network AS network, "
+ . "c.hostname AS hostname, "
+ . "c.IPaddress AS IPaddress, "
+ . "c.type AS type, "
+ . "c.deleted AS deleted, "
+ . "r.id AS resourceid, "
+ . "c.notes, "
+ . "c.vmhostid, "
+ . "c.vmtypeid, "
+ . "c2.hostname AS vmhost, "
+ . "c.provisioningid, "
+ . "pr.prettyname AS provisioning "
+ . "FROM state st, "
+ . "dept d, "
+ . "platform p, "
+ . "schedule sc, "
+ . "image cur, "
+ . "resource r, "
+ . "resourcetype t, "
+ . "user u, "
+ . "affiliation a, "
+ . "computer c "
+ . "LEFT JOIN vmhost vh ON (c.vmhostid = vh.id) "
+ . "LEFT JOIN vmtype vt ON (c.vmtypeid = vt.id) "
+ . "LEFT JOIN computer c2 ON (c2.id = vh.computerid) "
+ . "LEFT JOIN image next ON (c.nextimageid = next.id) "
+ . "LEFT JOIN provisioning pr ON (c.provisioningid = pr.id) "
+ . "WHERE c.stateid = st.id AND "
+ . "c.deptid = d.id AND "
+ . "c.platformid = p.id AND "
+ . "c.scheduleid = sc.id AND "
+ . "c.currentimageid = cur.id AND "
+ . "r.resourcetypeid = t.id AND "
+ . "t.name = 'computer' AND "
+ . "r.subid = c.id AND "
+ . "c.ownerid = u.id AND "
+ . "u.affiliationid = a.id ";
+ if(! $includedeleted)
+ $query .= "AND c.deleted = 0 ";
+ if(! empty($compid))
+ $query .= "AND c.id = $compid ";
+ $query .= "ORDER BY c.hostname";
+ $qh = doQuery($query, 180);
+ while($row = mysql_fetch_assoc($qh)) {
+ $return[$row['id']] = $row;
+ }
+ if($sort) {
+ uasort($return, "sortComputers");
+ }
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getUserComputerMetaData()
+///
+/// \return an array of 3 indices - depts, platforms, schedules - where each
+/// index's value is an array of user's computer's data
+///
+/// \brief builds an array of depts, platforms, and schedules for user's
+/// computers
+///
+////////////////////////////////////////////////////////////////////////////////
+function getUserComputerMetaData() {
+ $key = getKey(array('getUserComputerMetaData'));
+ if(array_key_exists($key, $_SESSION['usersessiondata']))
+ return $_SESSION['usersessiondata'][$key];
+ $computers = getComputers();
+ $resources = getUserResources(array("computerAdmin"),
+ array("administer", "manageGroup"), 0, 1);
+ $return = array("depts" => array(),
+ "platforms" => array(),
+ "schedules" => array());
+ foreach(array_keys($resources["computer"]) as $compid) {
+ if(! array_key_exists($compid, $computers))
+ continue;
+ /*if(! in_array($computers[$compid]["prettydept"], $return["depts"]))
+ $return["depts"][$computers[$compid]["deptid"]] =
+ $computers[$compid]["prettydept"];*/
+ if(! in_array($computers[$compid]["platform"], $return["platforms"]))
+ $return["platforms"][$computers[$compid]["platformid"]] =
+ $computers[$compid]["platform"];
+ if(! in_array($computers[$compid]["schedule"], $return["schedules"]))
+ $return["schedules"][$computers[$compid]["scheduleid"]] =
+ $computers[$compid]["schedule"];
+ }
+ uasort($return["platforms"], "sortKeepIndex");
+ uasort($return["schedules"], "sortKeepIndex");
+ $_SESSION['usersessiondata'][$key] = $return;
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getCompStateFlow($compid)
+///
+/// \param $compid - a computer id
+///
+/// \return an array of data about the flow of states for $compid; the following
+/// keys and elements are returned:\n
+/// \b repeatid - id from computerloadstate for the repeat state\n
+/// \b stateids - array of computerloadstate ids for this flow in the order
+/// they occur\n
+/// \b nextstates - array where each key is a computerloadstate id and its value
+/// is that state's following state; the last state has a NULL value\n
+/// \b totaltime - estimated time (in seconds) it takes for all states to
+/// complete\n
+/// \b data - array where each key is is a computerloadstate id and each value
+/// is an array with these elements:\n
+/// \b stateid - same as key\n
+/// \b state - name of this state\n
+/// \b nextstateid - id of next state\n
+/// \b nextstate - name of next state\n
+/// \b statetime - estimated time it takes for this state to complete
+///
+/// \brief gathers information about the flow of states for $compid
+///
+////////////////////////////////////////////////////////////////////////////////
+function getCompStateFlow($compid) {
+ $key = getKey(array($compid));
+ if(array_key_exists($key, $_SESSION['compstateflow']))
+ return $_SESSION['compstateflow'][$key];
+
+ # get id for repeat state, useful because several of the calling functions
+ # need this information
+ $query = "SELECT id FROM computerloadstate WHERE loadstatename = 'repeat'";
+ $qh = doQuery($query, 101);
+ if(! $row = mysql_fetch_assoc($qh))
+ return array();
+ $loadstates['repeatid'] = $row['id'];
+
+ $query = "SELECT `type` FROM computer WHERE id = $compid";
+ $qh = doQuery($query, 101);
+ if(! $row = mysql_fetch_assoc($qh))
+ return array();
+
+ $type = $row['type'];
+ $query = "SELECT cf.computerloadstateid AS stateid, "
+ . "cs1.prettyname AS state, "
+ . "cs1.loadstatename AS statename, "
+ . "cf.nextstateid, "
+ . "cs2.prettyname AS nextstate, "
+ . "cs1.est AS statetime "
+ . "FROM computerloadstate cs1, "
+ . "computerloadflow cf "
+ . "LEFT JOIN computerloadstate cs2 ON (cf.nextstateid = cs2.id) "
+ . "WHERE cf.computerloadstateid = cs1.id AND "
+ . "cf.type = '$type' ";
+ $query2 = $query . "AND cf.computerloadstateid NOT IN "
+ . "(SELECT nextstateid FROM computerloadflow WHERE `type` = '$type' "
+ . "AND nextstateid IS NOT NULL)";
+ $qh = doQuery($query2, 101);
+ if(! $row = mysql_fetch_assoc($qh))
+ return array();
+ $loadstates['data'][$row['stateid']] = $row;
+ $loadstates['stateids'] = array($row['stateid']);
+ $loadstates['nextstates'] = array($row['stateid'] => $row['nextstateid']);
+ $loadstates['totaltime'] = 0;
+ for($i = 0; $i < 100; $i++) { # don't want an endless loop
+ $query2 = $query . "AND cf.computerloadstateid = {$row['nextstateid']} "
+ . "AND `type` = '$type'";
+ $qh = doQuery($query2, 101);
+ if(! $row = mysql_fetch_assoc($qh)) {
+ $_SESSION['compstateflow'][$key] = $loadstates;
+ return $loadstates;
+ }
+ else {
+ array_push($loadstates['stateids'], $row['stateid']);
+ $loadstates['nextstates'][$row['stateid']] = $row['nextstateid'];
+ $loadstates['totaltime'] += $row['statetime'];
+ $loadstates['data'][$row['stateid']] = $row;
+ }
+ if(empty($row['nextstateid'])) {
+ $_SESSION['compstateflow'][$key] = $loadstates;
+ return $loadstates;
+ }
+ }
+ $_SESSION['compstateflow'][$key] = $loadstates;
+ return $loadstates;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getCompLoadLog($resid)
+///
+/// \param $resid - reservation id
+///
+/// \return an array where each key is an id from the computerloadlog table and
+/// each element is an array with these items:\n
+/// \b computerid - id of computer\n
+/// \b loadstateid - load id of this state\n
+/// \b ts - unix timestamp when item entered in log\n
+/// \b time - actual time (in seconds) this state took
+///
+/// \brief gets information from the computerloadlog table for $resid
+///
+////////////////////////////////////////////////////////////////////////////////
+function getCompLoadLog($resid) {
+ $query = "SELECT UNIX_TIMESTAMP(rq.start) AS start, "
+ . "UNIX_TIMESTAMP(rq.daterequested) AS reqtime, "
+ . "rs.computerid "
+ . "FROM request rq, "
+ . "reservation rs "
+ . "WHERE rs.id = $resid AND "
+ . "rs.requestid = rq.id "
+ . "LIMIT 1";
+ $qh = doQuery($query, 101);
+ if(! $row = mysql_fetch_assoc($qh))
+ abort(113);
+ if($row['start'] < $row['reqtime'])
+ $firststart = $row['reqtime'];
+ else
+ $firststart = $row['start'];
+ $flow = getCompStateFlow($row['computerid']);
+ $instates = implode(',', $flow['stateids']);
+ $query = "SELECT id, "
+ . "computerid, "
+ . "loadstateid, "
+ . "UNIX_TIMESTAMP(timestamp) AS ts "
+ . "FROM computerloadlog "
+ . "WHERE reservationid = $resid AND "
+ . "(loadstateid IN ($instates) OR "
+ . "loadstateid = {$flow['repeatid']}) "
+ . "ORDER BY id";
+ $qh = doQuery($query, 101);
+ $last = array();
+ $data = array();
+ while($row = mysql_fetch_assoc($qh)) {
+ $data[$row['id']] = $row;
+ if(empty($last))
+ $data[$row['id']]['time'] = $row['ts'] - $firststart;
+ else
+ $data[$row['id']]['time'] = $row['ts'] - $last['ts'];
+ $last = $row;
+ }
+ return $data;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getImageLoadEstimate($imageid)
+///
+/// \param $imageid - id of an image
+///
+/// \return estimated time in seconds that it takes to load $imageid
+///
+/// \brief determines an estimated load time (in seconds) that it takes $imageid
+/// to load based on the last 12 months of log data
+///
+////////////////////////////////////////////////////////////////////////////////
+function getImageLoadEstimate($imageid) {
+ $query = "SELECT AVG(UNIX_TIMESTAMP(loaded) - UNIX_TIMESTAMP(start)) AS avgloadtime "
+ . "FROM log "
+ . "WHERE imageid = $imageid AND "
+ . "wasavailable = 1 AND "
+ . "UNIX_TIMESTAMP(loaded) - UNIX_TIMESTAMP(start) > 120 AND "
+ . "loaded > start AND "
+ . "ending != 'failed' AND "
+ . "nowfuture = 'now' AND "
+ . "start > (NOW() - INTERVAL 12 MONTH) AND "
+ . "UNIX_TIMESTAMP(loaded) - UNIX_TIMESTAMP(start) < 1800";
+ $qh = doQuery($query, 101);
+ if($row = mysql_fetch_assoc($qh)) {
+ if(! empty($row['avgloadtime']))
+ return (int)$row['avgloadtime'];
+ else
+ return 0;
+ }
+ else
+ return 0;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getComputerCounts(&$computers)
+///
+/// \param $computers - array returned from getComputers
+///
+/// \brief adds a "counts" field for each computer in $computers that is the
+/// total number of reservations that computer has had
+///
+////////////////////////////////////////////////////////////////////////////////
+function getComputerCounts(&$computers) {
+ foreach(array_keys($computers) as $compid) {
+ $query = "SELECT COUNT(logid) "
+ . "FROM sublog "
+ . "WHERE computerid = $compid";
+ $qh = doQuery($query, 101);
+ if($row = mysql_fetch_row($qh))
+ $computers[$compid]["counts"] = $row[0];
+ else
+ $computers[$compid]["counts"] = 0;
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn sortComputers($a, $b)
+///
+/// \param $a - first input passed in by uasort
+/// \param $b - second input passed in by uasort
+///
+/// \return -1, 0, or 1 if $a < $b, $a == $b, $a > $b, respectively
+///
+/// \brief determines if $a should go before or after $b
+///
+////////////////////////////////////////////////////////////////////////////////
+function sortComputers($a, $b) {
+ //if somehow there are empty strings passed in, push them to the end
+ if(empty($a)) {
+ return 1;
+ }
+ if(empty($b)) {
+ return -1;
+ }
+
+ # get hostname and first part of domain name
+ $tmp = explode('.', $a["hostname"]);
+ $h1 = array_shift($tmp);
+ $domain1 = array_shift($tmp);
+ $letters1 = preg_replace('([^a-zA-Z])', '', $h1);
+
+ $tmp = explode('.', $b["hostname"]);
+ $h2 = array_shift($tmp);
+ $domain2 = array_shift($tmp);
+ $letters2 = preg_replace('([^a-zA-Z])', '', $h2);
+
+ // if different domain names, return based on that
+ $cmp = strcasecmp($domain1, $domain2);
+ if($cmp) {
+ return $cmp;
+ }
+
+ // if non-numeric part is different, return based on that
+ $cmp = strcasecmp($letters1, $letters2);
+ if($cmp) {
+ return $cmp;
+ }
+
+ // at this point, the only difference is in the numbers
+ $digits1 = preg_replace('([^\d-])', '', $h1);
+ $digits1Arr = explode('-', $digits1);
+ $digits2 = preg_replace('([^\d-])', '', $h2);
+ $digits2Arr = explode('-', $digits2);
+
+ $len1 = count($digits1Arr);
+ $len2 = count($digits2Arr);
+ for($i = 0; $i < $len1 && $i < $len2; $i++) {
+ if($digits1Arr[$i] < $digits2Arr[$i]) {
+ return -1;
+ }
+ elseif($digits1Arr[$i] > $digits2Arr[$i]) {
+ return 1;
+ }
+ }
+
+ return 0;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getAvailableBlockComputerids($imageid, $start, $end)
+///
+/// \param $imageid - id of an image
+/// \param $start - starting time in unix timestamp form
+/// \param $end - ending time in unix timestamp form
+///
+/// \return an array of computer ids
+///
+/// \brief gets all computer ids that are part of a block reservation the logged
+/// in user is a part of that are available between $start and $end
+///
+////////////////////////////////////////////////////////////////////////////////
+function getAvailableBlockComputerids($imageid, $start, $end) {
+ global $user;
+ $compids = array();
+ $groupids = implode(',', array_keys($user['groups']));
+ if(! count($user['groups']))
+ $groupids = "''";
+ $startdt = unixToDatetime($start);
+ $enddt = unixToDatetime($end);
+ $query = "SELECT c.computerid "
+ . "FROM blockComputers c, "
+ . "blockRequest r, "
+ . "blockTimes t, "
+ . "state s, "
+ . "computer c2 "
+ . "WHERE r.groupid IN ($groupids) AND "
+ . "r.imageid = $imageid AND "
+ . "r.expireTime > NOW() AND "
+ . "t.blockRequestid = r.id AND "
+ . "c.blockTimeid = t.id AND "
+ . "t.start < '$enddt' AND "
+ . "t.end > '$startdt' AND "
+ . "c.computerid = c2.id AND "
+ . "c2.stateid = s.id AND "
+ . "s.name != 'failed' "
+ . "ORDER BY s.name";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_assoc($qh)) {
+ array_push($compids, $row['computerid']);
+ }
+ return $compids;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getUsedBlockComputerids($start, $end)
+///
+/// \param $start - starting time in unix timestamp form
+/// \param $end - ending time in unix timestamp form
+///
+/// \return array of computer ids
+///
+/// \brief gets a list of all computerids that are allocated to block
+/// reservations during the given times
+///
+////////////////////////////////////////////////////////////////////////////////
+function getUsedBlockComputerids($start, $end) {
+ $compids = array();
+ $startdt = unixToDatetime($start);
+ $enddt = unixToDatetime($end);
+ $query = "SELECT c.computerid "
+ . "FROM blockComputers c, "
+ . "blockTimes t "
+ . "WHERE t.end > '$startdt' AND "
+ . "t.start < '$enddt' AND "
+ . "c.blockTimeid = t.id";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_assoc($qh)) {
+ array_push($compids, $row['computerid']);
+ }
+ return $compids;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getBlockTimeData($start, $end)
+///
+/// \param $start - (optional) start time of blockTimes to get in unix timestamp
+/// form
+/// \param $end - (optional) end time of blockTimes to get in unix timestamp
+/// form
+///
+/// \return an array of block request data where each index in a blockTime id
+/// and the value is an array with these elements:\n
+/// \b
+///
+/// \brief builds an array of block request data
+///
+////////////////////////////////////////////////////////////////////////////////
+function getBlockTimeData($start="", $end="") {
+ $return = array();
+ $query = "SELECT r.id AS requestid, "
+ . "r.name, "
+ . "r.imageid, "
+ . "i.prettyname AS image, "
+ . "r.numMachines, "
+ . "r.groupid, "
+ . "r.repeating, "
+ . "r.ownerid, "
+ . "r.admingroupid, "
+ . "r.managementnodeid, "
+ . "r.expireTime, "
+ . "t.id AS timeid, "
+ . "t.start, "
+ . "t.end "
+ . "FROM blockRequest r, "
+ . "blockTimes t, "
+ . "image i "
+ . "WHERE r.id = t.blockRequestid AND "
+ . "r.imageid = i.id";
+ if(! empty($start))
+ $query .= " AND t.start < '" . unixToDatetime($end) . "'";
+ if(! empty($end))
+ $query .= " AND t.end > '" . unixToDatetime($start) . "'";
+ $query .= " ORDER BY t.start, t.end";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_assoc($qh)) {
+ $return[$row['timeid']] = $row;
+ $return[$row['timeid']]['unixstart'] = datetimeToUnix($row['start']);
+ $return[$row['timeid']]['unixend'] = datetimeToUnix($row['end']);
+ $return[$row['timeid']]['computerids'] = array();
+ $query2 = "SELECT computerid "
+ . "FROM blockComputers "
+ . "WHERE blockTimeid = {$row['timeid']}";
+ $qh2 = doQuery($query2, 101);
+ while($row2 = mysql_fetch_assoc($qh2))
+ array_push($return[$row['timeid']]['computerids'], $row2['computerid']);
+ }
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn isBlockRequestTime($compid, $ts, $blockData)
+///
+/// \param $compid - a computer id
+/// \param $ts - a timestamp
+/// \param $blockData - an array as returned from getBlockTimeData
+///
+/// \return the blockTimeid $ts falls in to if it does; 0 if it doesn't fall
+/// into any block times
+///
+/// \brief determines if $ts falls into a block time $compid is part of
+///
+////////////////////////////////////////////////////////////////////////////////
+function isBlockRequestTime($compid, $ts, $blockData) {
+ foreach(array_keys($blockData) as $timeid) {
+ if(in_array($compid, $blockData[$timeid]['computerids']) &&
+ $ts >= $blockData[$timeid]['unixstart'] &&
+ $ts < $blockData[$timeid]['unixend'])
+ return $timeid;
+ }
+ return 0;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn printSelectInput($name, $dataArr, $selectedid, $skip, $multiple, $domid,
+/// $extra)
+///
+/// \param $name - name of input element
+/// \param $dataArr - array containing options
+/// \param $selectedid - (optional) index of $dataArr to be initially selected;
+/// use -1 for nothing to be selected
+/// \param $skip - (optional) this is used if the array from getImages is passed
+/// as $dataArr so we know to skip index 4 since it is the noimage element
+/// \param $multiple - (optional) use this to print select input with the
+/// multiple tag set
+/// \param $domid - (optional) use this to pass in the javascript id to be used
+/// for the select object
+/// \param $extra - (optional) any extra attributes that need to be set
+///
+/// \brief prints out a select input part of a form\n
+/// it is assumed that if $selectedid is left off, we assume $dataArr has no
+/// index '-1'\n
+/// each OPTION's value is the index of that element of the array
+///
+////////////////////////////////////////////////////////////////////////////////
+function printSelectInput($name, $dataArr, $selectedid=-1, $skip=0, $multiple=0,
+ $domid="", $extra="") {
+ if(! empty($domid))
+ $domid = "id=\"$domid\"";
+ if($multiple)
+ $multiple = "multiple";
+ else
+ $multiple = "";
+ print " <SELECT name=$name $multiple $domid $extra>\n";
+ foreach(array_keys($dataArr) as $id) {
+ if(($skip && $id == 4) || ($dataArr[$id] != 0 && empty($dataArr[$id]))) {
+ continue;
+ }
+ if($id == $selectedid) {
+ print " <OPTION value=\"$id\" selected>";
+ }
+ else {
+ print " <OPTION value=\"$id\">";
+ }
+ if(is_array($dataArr[$id]) && array_key_exists("prettyname", $dataArr[$id])) {
+ print $dataArr[$id]["prettyname"] . "</OPTION>\n";
+ }
+ elseif(is_array($dataArr[$id]) && array_key_exists("name", $dataArr[$id])) {
+ print $dataArr[$id]["name"] . "</OPTION>\n";
+ }
+ else {
+ print $dataArr[$id] . "</OPTION>\n";
+ }
+ }
+ print " </SELECT>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn printHiddenInputs($data)
+///
+/// \param $data - an array with index/value pairs that match the name/value
+/// pairs that will be used in the form
+///
+/// \brief prints INPUT forms that are type hidden with the data from $data
+///
+////////////////////////////////////////////////////////////////////////////////
+/*function printHiddenInputs($data) {
+ foreach(array_keys($data) as $key) {
+ if(is_array($data[$key])) {
+ foreach(($data[$key]) as $index => $value) {
+ print " <INPUT type=hidden name=$key" . "[$index] value=";
+ print "$value>\n";
+ }
+ }
+ else {
+ if($data[$key] != "") {
+ print " <INPUT type=hidden name=$key value=\"";
+ print $data["$key"] . "\">\n";
+ }
+ }
+ }
+}*/
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn requestIsReady($request)
+///
+/// \param $request - a request element from the array returned by
+/// getUserRequests
+///
+/// \return 1 if request is ready for a user to connect, 0 if not
+///
+/// \brief checks to see if a request is
+///
+////////////////////////////////////////////////////////////////////////////////
+function requestIsReady($request) {
+ foreach($request["reservations"] as $res) {
+ if($res["computerstateid"] != 3 && $res["computerstateid"] != 8)
+ return 0;
+ }
+ if(($request["currstateid"] == 14 && // request current state pending
+ $request["laststateid"] == 3 && // and last state reserved and
+ $request["computerstateid"] == 3) || // computer reserved
+ ($request["currstateid"] == 8 && // request current state inuse
+ $request["computerstateid"] == 8) || // and computer state inuse
+ ($request["currstateid"] == 14 && // request current state pending
+ $request["laststateid"] == 8 && // and last state inuse and
+ $request["computerstateid"] == 8) || // computer inuse
+ ($request["currstateid"] == 14 && // request current state pending
+ $request["laststateid"] == 8 && // and last state inuse
+ $request["computerstateid"] == 3)) { // and computer reserved
+ return 1;
+ }
+ return 0;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn printSubmitErr($errno, $index, $errorDiv)
+///
+/// \param $errno - an error value, should correspond to an defined constant
+/// \param $index - (optional) if $submitErrMsg will be an array, the index
+/// of the element to print
+/// \param $errorDiv - (optional, default=0), set to 1 to wrap the error in a
+/// div with class of errormsg
+///
+/// \brief if the error is set, prints the corresponding error message
+///
+////////////////////////////////////////////////////////////////////////////////
+function printSubmitErr($errno, $index=0, $errorDiv=0) {
+ global $submitErr, $submitErrMsg;
+ if($submitErr & $errno) {
+ if($errorDiv)
+ print "<p class=errormsg>";
+ if(is_array($submitErrMsg[$errno]))
+ print "<font color=red><em>{$submitErrMsg[$errno][$index]}</em></font>";
+ else
+ print "<font color=red><em>{$submitErrMsg[$errno]}</em></font>";
+ if($errorDiv)
+ print "</p>";
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn printArray($array)
+///
+/// \param $array - an array to print
+///
+/// \brief prints out an array in HTML friendly format
+///
+////////////////////////////////////////////////////////////////////////////////
+function printArray($array) {
+ print "<pre>\n";
+ print_r($array);
+ print "</pre>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn prettyDatetime($stamp)
+///
+/// \param $stamp - a timestamp in unix or mysql datetime format
+///
+/// \return date/time in html format of [Day of week], [month] [day of month],
+/// [HH:MM] [am/pm]
+///
+/// \brief reformats the datetime to look better
+///
+////////////////////////////////////////////////////////////////////////////////
+function prettyDatetime($stamp) {
+ if(preg_match('/^[\d]+$/', $stamp)) {
+ $return = date('l, M#jS, g:i a', $stamp);
+ }
+ else {
+ $return = date('l, M#jS, g:i a', datetimeToUnix($stamp));
+ }
+ $return = str_replace('#', ' ', $return);
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn minToHourMin($min)
+///
+/// \param $min - minutes
+///
+/// \return a string value
+///
+/// \brief um, I don't know how to describe this, just look at the code
+///
+////////////////////////////////////////////////////////////////////////////////
+function minToHourMin($min) {
+ if($min < 60)
+ return $min . " minutes";
+ elseif($min == 60)
+ return "1 hour";
+ elseif($min % 60 == 0)
+ return sprintf("%d hours", $min / 60);
+ elseif($min % 30 == 0)
+ return sprintf("%.1f hours", $min / 60);
+ else
+ return sprintf("%.2f hours", $min / 60);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn secToMinSec($sec)
+///
+/// \param $sec - seconds
+///
+/// \return a string value
+///
+/// \brief takes seconds and converts to min:sec
+///
+////////////////////////////////////////////////////////////////////////////////
+function secToMinSec($sec) {
+ if($sec < 60)
+ return sprintf("0:%02d", $sec);
+ elseif($sec == 60)
+ return "1:00";
+ elseif($sec % 60 == 0)
+ return sprintf("%d:00", $sec / 60);
+ else
+ return sprintf("%d:%02d", $sec / 60, $sec % 60);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn prettyLength($minutes)
+///
+/// \param $minutes - a value in minutes
+///
+/// \return a string in the form of [length] [units]
+///
+/// \brief converts from $minutes to either "[minutes] minutes" or
+/// "[hours] hour(s)
+///
+////////////////////////////////////////////////////////////////////////////////
+function prettyLength($minutes) {
+ if($minutes < 60)
+ return (int)$minutes . " minutes";
+ elseif($minutes == 60)
+ return "1 hour";
+ elseif($minutes % 60 == 0)
+ return $minutes / 60 . " hours";
+ else {
+ $hours = (int)($minutes / 60);
+ $min = (int)($minutes % 60);
+ if($hours == 1)
+ return "$hours hour, $min minutes";
+ else
+ return "$hours hours, $min minutes";
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn addLoadTime($imageid, $start, $loadtime)
+///
+/// \param $imageid - id of loaded image
+/// \param $start - start time in unix timestamp format
+/// \param $loadtime - time it took to load image in seconds
+///
+/// \brief adds an entry to the imageloadtimes table
+///
+////////////////////////////////////////////////////////////////////////////////
+function addLoadTime($imageid, $start, $loadtime) {
+ $query = "INSERT INTO imageloadtimes "
+ . "(imageid, "
+ . "starttime, "
+ . "loadtimeseconds) "
+ . "VALUES "
+ . "($imageid, "
+ . "$start, "
+ . "$loadtime)";
+ doQuery($query, 245);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn scheduleClosed($computerid, $timestamp, $schedule)
+///
+/// \param $computerid - id of a computer
+/// \param $timestamp - time to check
+/// \param $schedule - an element from the array returned from getSchedules
+///
+/// \return 1 if schedule is closed at $timestamp, 0 if it is open
+///
+/// \brief checks to see if the computer's schedule is open or closed at
+/// $timestamp
+///
+////////////////////////////////////////////////////////////////////////////////
+function scheduleClosed($computerid, $timestamp, $schedule) {
+ $time = minuteOfWeek($timestamp);
+ foreach($schedule["times"] as $schtime) {
+ if($schtime["start"] <= $time && $time < $schtime["end"])
+ return 0;
+ }
+ return 1;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn updateGroups($newusergroups, $userid)
+///
+/// \param $newusergroups - array of $userid's current set of user groups
+/// \param $userid - id of user from user table
+///
+/// \brief updates user's groups and adds any new ones to the group
+/// table
+///
+////////////////////////////////////////////////////////////////////////////////
+function updateGroups($newusergroups, $userid) {
+ $query = "SELECT m.usergroupid "
+ . "FROM usergroupmembers m, "
+ . "usergroup u "
+ . "WHERE m.userid = $userid AND "
+ . "m.usergroupid = u.id AND "
+ . "u.custom = 0 AND "
+ . "u.courseroll = 0";
+ $qh = doQuery($query, 305);
+ $oldusergroups = array();
+ while($row = mysql_fetch_row($qh)) {
+ array_push($oldusergroups, $row[0]);
+ }
+ if(count(array_diff($oldusergroups, $newusergroups)) ||
+ count(array_diff($newusergroups, $oldusergroups))) {
+ $query = "DELETE m "
+ . "FROM usergroupmembers m, "
+ . "usergroup u "
+ . "WHERE m.userid = $userid AND "
+ . "m.usergroupid = u.id AND "
+ . "u.custom = 0 AND "
+ . "u.courseroll = 0";
+ doQuery($query, 306);
+ foreach($newusergroups as $id) {
+ $query = "INSERT INTO usergroupmembers "
+ . "(userid, usergroupid) "
+ . "VALUES ($userid, $id) "
+ . "ON DUPLICATE KEY UPDATE "
+ . "userid = $userid, usergroupid = $id";
+ doQuery($query, 307);
+ }
+ }
+ return $newusergroups;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getUserGroupID($name, $affilid)
+///
+/// \param $name - a group name
+/// \param $affilid - (optional, defaults to DEFAULT_AFFILID) affiliation id
+/// for $name
+///
+/// \return id for $name from group table
+///
+/// \brief looks up the id for $name in the group table; if the name is
+/// not currently in the table, adds it and returns the new id
+///
+////////////////////////////////////////////////////////////////////////////////
+function getUserGroupID($name, $affilid=DEFAULT_AFFILID) {
+ $query = "SELECT id "
+ . "FROM usergroup "
+ . "WHERE name = '$name' AND "
+ . "((custom = 0 AND "
+ . "courseroll = 0 AND "
+ . "affiliationid = $affilid) OR "
+ . "custom = 1 OR "
+ . "courseroll = 1)";
+ $qh = doQuery($query, 300);
+ if($row = mysql_fetch_row($qh)) {
+ return $row[0];
+ }
+ $query = "INSERT INTO usergroup "
+ . "(name, "
+ . "affiliationid, "
+ . "custom, "
+ . "courseroll) "
+ . "VALUES "
+ . "('$name', "
+ . "$affilid, "
+ . "0, "
+ . "0)";
+ doQuery($query, 301);
+ $qh = doQuery("SELECT LAST_INSERT_ID() FROM usergroup", 302);
+ if(! $row = mysql_fetch_row($qh)) {
+ abort(303);
+ }
+ return $row[0];
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getUserGroupName($id, $incAffil)
+///
+/// \param $id - id of a user group
+/// \param $incAffil - 0 or 1 (optional, defaults to 0); include @ and
+/// affiliation at the end
+///
+/// \return name for $id from usergroup table or 0 if name not found
+///
+/// \brief looks up the name for $id in the group table
+///
+////////////////////////////////////////////////////////////////////////////////
+function getUserGroupName($id, $incAffil=0) {
+ if($incAffil) {
+ $query = "SELECT CONCAT(u.name, '@', a.name) as name "
+ . "FROM usergroup u, "
+ . "affiliation a "
+ . "WHERE u.id = $id AND "
+ . "u.affiliationid = a.id";
+ }
+ else {
+ $query = "SELECT name "
+ . "FROM usergroup "
+ . "WHERE id = $id";
+ }
+ $qh = doQuery($query, 101);
+ if($row = mysql_fetch_row($qh))
+ return $row[0];
+ return 0;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn unset_by_val($needle, &$haystack)
+///
+/// \param $needle - value to remove from array
+/// \param $haystack - array
+///
+/// \brief removes all entries from an array having $needle as their value
+///
+////////////////////////////////////////////////////////////////////////////////
+function unset_by_val($needle, &$haystack) {
+ while(($gotcha = array_search($needle,$haystack)) > -1) {
+ unset($haystack[$gotcha]);
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn sendRDPfile()
+///
+/// \brief generates and uploads a rdp file to the user
+///
+////////////////////////////////////////////////////////////////////////////////
+function sendRDPfile() {
+ global $user;
+ # for more info on this file, see
+ # http://dev.remotenetworktechnology.com/ts/rdpfile.htm
+ $requestid = getContinuationVar("requestid");
+ $request = getRequestInfo("$requestid");
+ foreach($request["reservations"] as $res) {
+ if($res["forcheckout"]) {
+ $ipaddress = $res["reservedIP"];
+ $passwd = $res["password"];
+ break;
+ }
+ }
+ if(empty($ipaddress))
+ return;
+
+ $width = $user["width"];
+ $height = $user["height"];
+ if($width == 0) {
+ $screenmode = 2;
+ $width = 1024;
+ $height = 768;
+ }
+ else
+ $screenmode = 1;
+ $bpp = $user["bpp"];
+ if($user["audiomode"] == "none")
+ $audiomode = 2;
+ else
+ $audiomode = 0;
+ $redirectdrives = $user["mapdrives"];
+ $redirectprinters = $user["mapprinters"];
+ $redirectcomports = $user["mapserial"];
+
+ header("Content-type: application/rdp");
+ header("Content-Disposition: inline; filename=\"{$res['prettyimage']}.rdp\"");
+ print "screen mode id:i:$screenmode\r\n";
+ print "desktopwidth:i:$width\r\n";
+ print "desktopheight:i:$height\r\n";
+ print "session bpp:i:$bpp\r\n";
+ print "winposstr:s:0,1,382,71,1182,671\r\n";
+ print "full address:s:$ipaddress\r\n";
+ print "compression:i:1\r\n";
+ print "keyboardhook:i:2\r\n";
+ print "audiomode:i:$audiomode\r\n";
+ print "redirectdrives:i:$redirectdrives\r\n";
+ print "redirectprinters:i:$redirectprinters\r\n";
+ print "redirectcomports:i:$redirectcomports\r\n";
+ print "redirectsmartcards:i:1\r\n";
+ print "displayconnectionbar:i:1\r\n";
+ print "autoreconnection enabled:i:1\r\n";
+ if($request["forimaging"])
+ print "username:s:Administrator\r\n";
+ else {
+ if(preg_match('/(.*)@(.*)/', $user['unityid'], $matches))
+ print "username:s:" . $matches[1] . "\r\n";
+ else
+ print "username:s:" . $user["unityid"] . "\r\n";
+ }
+ print "clear password:s:$passwd\r\n";
+ print "domain:s:\r\n";
+ print "alternate shell:s:\r\n";
+ print "shell working directory:s:\r\n";
+ print "disable wallpaper:i:1\r\n";
+ print "disable full window drag:i:1\r\n";
+ print "disable menu anims:i:1\r\n";
+ print "disable themes:i:0\r\n";
+ print "disable cursor setting:i:0\r\n";
+ print "bitmapcachepersistenable:i:1\r\n";
+ //print "connect to console:i:1\r\n";
+ exit(0);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn addLogEntry($nowfuture, $start, $end, $wasavailable, $imageid)
+///
+/// \param $nowfuture - 'now' or 'future'
+/// \param $start - mysql datetime for starting time
+/// \param $end - mysql datetime for initialend and finalend
+/// \param $wasavailable - 0 or 1, whether or not the request was available
+/// when requested
+/// \param $imageid - id of requested image
+///
+/// \brief adds an entry to the log table
+///
+////////////////////////////////////////////////////////////////////////////////
+function addLogEntry($nowfuture, $start, $end, $wasavailable, $imageid) {
+ global $user;
+ $query = "INSERT INTO log "
+ . "(userid, "
+ . "nowfuture, "
+ . "start, "
+ . "initialend, "
+ . "finalend, "
+ . "wasavailable, "
+ . "ending, "
+ . "imageid) "
+ . "VALUES "
+ . "(" . $user["id"] . ", "
+ . "'$nowfuture', "
+ . "'$start', "
+ . "'$end', "
+ . "'$end', "
+ . "$wasavailable, "
+ . "'none', "
+ . "$imageid)";
+ $qh = doQuery($query, 260);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn addChangeLogEntry($logid, $remoteIP, $end, $start, $computerid,
+/// $ending, $wasavailable)
+///
+/// \param $logid - id matching entry in log table
+/// \param $remoteIP - ip of remote computer (pass NULL if this isn't being
+/// updated)
+/// \param $end - (optional) ending time of request (mysql datetime)
+/// \param $start - (optional) starting time of request (mysql datetime)
+/// \param $computerid - (optional) id from computer table
+/// \param $ending - (optional) 'deleted' or 'released' - how reservation ended
+/// \param $wasavailable - (optional) 0 or 1 - if a newly requested time was
+/// available; \b NOTE: pass -1 instead of NULL if you don't want this field
+/// to be updated
+///
+/// \brief adds an entry to the changelog table and updates information in
+/// the log table
+///
+////////////////////////////////////////////////////////////////////////////////
+function addChangeLogEntry($logid, $remoteIP, $end=NULL, $start=NULL,
+ $computerid=NULL, $ending=NULL, $wasavailable=-1) {
+ if($logid == 0) {
+ return;
+ }
+ $query = "SELECT computerid, "
+ . "start, "
+ . "initialend, "
+ . "remoteIP, "
+ . "wasavailable, "
+ . "ending "
+ . "FROM log "
+ . "WHERE id = $logid";
+ $qh = doQuery($query, 265);
+ if(! $log = mysql_fetch_assoc($qh)) {
+ abort(30);
+ }
+ $log["computerid"] = array();
+ $query = "SELECT computerid FROM sublog WHERE logid = $logid";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_assoc($qh)) {
+ array_push($log["computerid"], $row["computerid"]);
+ }
+ $changed = 0;
+
+ $query1 = "INSERT INTO changelog "
+ . "(logid, "
+ . "start, "
+ . "end, "
+ . "computerid, "
+ . "remoteIP, "
+ . "wasavailable, "
+ . "timestamp) "
+ . "VALUES "
+ . "($logid, ";
+
+ $query2Arr = array();
+
+ # start
+ if($start != NULL && $start != $log["start"]) {
+ $query1 .= "'$start', ";
+ # only update start time in log table if it is in the future
+ if(datetimeToUnix($log['start']) > time())
+ array_push($query2Arr, "start = '$start'");
+ $changed = 1;
+ }
+ else {
+ $query1 .= "NULL, ";
+ }
+
+ # end
+ if($end != NULL && $end != $log["initialend"]) {
+ $query1 .= "'$end', ";
+ if(datetimeToUnix($log["start"]) > time()) {
+ array_push($query2Arr, "initialend = '$end'");
+ }
+ array_push($query2Arr, "finalend = '$end'");
+ $changed = 1;
+ }
+ else {
+ $query1 .= "NULL, ";
+ }
+
+ # computerid
+ if($computerid != NULL &&
+ ! in_array($computerid, $log["computerid"])) {
+ $query1 .= "$computerid, ";
+ $changed = 1;
+ }
+ else {
+ $query1 .= "NULL, ";
+ }
+
+ # remoteIP
+ if($remoteIP != NULL && $remoteIP != $log["remoteIP"]) {
+ $query1 .= "'$remoteIP', ";
+ array_push($query2Arr, "remoteIP = '$remoteIP'");
+ $changed = 1;
+ }
+ else {
+ $query1 .= "NULL, ";
+ }
+
+ # wasavailable
+ if($wasavailable != -1 && $wasavailable != $log["wasavailable"]) {
+ $query1 .= "$wasavailable, ";
+ array_push($query2Arr, "wasavailable = $wasavailable");
+ $changed = 1;
+ }
+ else {
+ $query1 .= "NULL, ";
+ }
+
+ # ending
+ if($ending != NULL && $ending != $log["ending"]) {
+ array_push($query2Arr, "ending = '$ending'");
+ $changed = 1;
+ }
+ $query1 .= "NOW())";
+
+ if($changed) {
+ doQuery($query1, 266);
+ if(! empty($query2Arr)) {
+ $query2 = "UPDATE log SET " . implode(', ', $query2Arr)
+ . " WHERE id = $logid";
+ doQuery($query2, 267);
+ }
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn addSublogEntry($logid, $imageid, $imagerevisionid, $computerid,
+/// $mgmtnodeid)
+///
+/// \param $logid - id of parent log entry
+/// \param $imageid - id of requested image
+/// \param $imagerevisionid - revision id of requested image
+/// \param $computerid - assigned computer id
+/// \param $mgmtnodeid - id of management node handling this reservation
+///
+/// \brief adds an entry to the log table
+///
+////////////////////////////////////////////////////////////////////////////////
+function addSublogEntry($logid, $imageid, $imagerevisionid, $computerid,
+ $mgmtnodeid) {
+ $query = "SELECT predictivemoduleid "
+ . "FROM managementnode "
+ . "WHERE id = $mgmtnodeid";
+ $qh = doQuery($query, 101);
+ $row = mysql_fetch_assoc($qh);
+ $predictiveid = $row['predictivemoduleid'];
+ $query = "INSERT INTO sublog "
+ . "(logid, "
+ . "imageid, "
+ . "imagerevisionid, "
+ . "computerid, "
+ . "managementnodeid, "
+ . "predictivemoduleid) "
+ . "VALUES "
+ . "($logid, "
+ . "$imageid, "
+ . "$imagerevisionid, "
+ . "$computerid, "
+ . "$mgmtnodeid, "
+ . "$predictiveid)";
+ doQuery($query, 101);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getTypes($subtype)
+///
+/// \param $subtype - (optional) "users", "resources", or "both"
+///
+/// \return an array with 2 indexes: users and resources, each of which is an
+/// array of those types
+///
+/// \brief returns an array of arrays of types
+///
+////////////////////////////////////////////////////////////////////////////////
+function getTypes($subtype="both") {
+ $types = array("users" => array(),
+ "resources" => array());
+ if($subtype == "users" || $subtype == "both") {
+ $query = "SELECT id, name FROM userprivtype";
+ $qh = doQuery($query, 365);
+ while($row = mysql_fetch_assoc($qh)) {
+ if($row["name"] == "block" || $row["name"] == "cascade")
+ continue;
+ $types["users"][$row["id"]] = $row["name"];
+ }
+ }
+ if($subtype == "resources" || $subtype == "both") {
+ $query = "SELECT id, name FROM resourcetype";
+ $qh = doQuery($query, 366);
+ while($row = mysql_fetch_assoc($qh)) {
+ if($row["name"] == "block" || $row["name"] == "cascade")
+ continue;
+ $types["resources"][$row["id"]] = $row["name"];
+ }
+ }
+ return $types;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getUserPrivTypeID($type)
+///
+/// \param $type - type name
+///
+/// \return id of $type
+///
+/// \brief looks up the id for $type in the userprivtype table
+///
+////////////////////////////////////////////////////////////////////////////////
+function getUserPrivTypeID($type) {
+ $query = "SELECT id FROM userprivtype WHERE name = '$type'";
+ $qh = doQuery($query, 370);
+ if($row = mysql_fetch_row($qh))
+ return $row[0];
+ else
+ return NULL;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getUserMaxTimes($uid)
+///
+/// \param $uid - (optional) user's unityid or user table id
+///
+/// \return max time in minutes that the user can checkout a reservation
+///
+/// \brief looks through all of the user's groups to find the max checkout time
+///
+////////////////////////////////////////////////////////////////////////////////
+function getUserMaxTimes($uid=0) {
+ global $user;
+ $return = array("initial" => 0,
+ "total" => 0,
+ "extend" => 0);
+ if($uid == 0)
+ $groupids = array_keys($user["groups"]);
+ else {
+ $groupids = array_keys(getUsersGroups($uid, 1));
+ }
+ if(! count($groupids))
+ array_push($groupids, getUserGroupID(DEFAULTGROUP));
+
+
+ $allgroups = getUserGroups();
+ foreach($groupids as $id) {
+ if($return["initial"] < $allgroups[$id]["initialmaxtime"])
+ $return["initial"] = $allgroups[$id]["initialmaxtime"];
+ if($return["total"] < $allgroups[$id]["totalmaxtime"])
+ $return["total"] = $allgroups[$id]["totalmaxtime"];
+ if($return["extend"] < $allgroups[$id]["maxextendtime"])
+ $return["extend"] = $allgroups[$id]["maxextendtime"];
+ }
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getResourceGroupID($groupname)
+///
+/// \param $groupname - resource group name of the form type/name
+///
+/// \return id of the group
+///
+/// \brief gets the id from the resourcegroup table for $groupname
+///
+////////////////////////////////////////////////////////////////////////////////
+function getResourceGroupID($groupdname) {
+ list($type, $name) = split('/', $groupdname);
+ $query = "SELECT g.id "
+ . "FROM resourcegroup g, "
+ . "resourcetype t "
+ . "WHERE g.name = '$name' AND "
+ . "t.name = '$type' AND "
+ . "g.resourcetypeid = t.id";
+ $qh = doQuery($query, 371);
+ if($row = mysql_fetch_row($qh))
+ return $row[0];
+ else
+ return NULL;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getResourceTypeID($name)
+///
+/// \param $name - name of resource type
+///
+/// \return id of the resource type
+///
+/// \brief gets the id from the resourcetype table for $name
+///
+////////////////////////////////////////////////////////////////////////////////
+function getResourceTypeID($name) {
+ $query = "SELECT id "
+ . "FROM resourcetype "
+ . "WHERE name = '$name'";
+ $qh = doQuery($query, 101);
+ if($row = mysql_fetch_row($qh))
+ return $row[0];
+ else
+ return NULL;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getNodeInfo($nodeid)
+///
+/// \param $nodeid - an id from the privnode table
+///
+/// \return an array of the node's name and parent or NULL if node not found
+///
+/// \brief gets $nodeid's name and parent and sticks it in an array
+///
+////////////////////////////////////////////////////////////////////////////////
+function getNodeInfo($nodeid) {
+ global $cache;
+ if(array_key_exists($nodeid, $cache['nodes']))
+ return $cache['nodes'][$nodeid];
+ $qh = doQuery("SELECT parent, name FROM privnode WHERE id = $nodeid", 330);
+ if($row = mysql_fetch_assoc($qh)) {
+ $return = array();
+ $return["name"] = $row["name"];
+ $return["parent"] = $row["parent"];
+ $cache['nodes'][$nodeid] = $return;
+ return $return;
+ }
+ else
+ return NULL;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn sortKeepIndex($a, $b)
+///
+/// \param $a - first item
+/// \param $b - second item
+///
+/// \return -1 if $a < $b, 0 if $a == $b, 1 if $a > $b
+///
+/// \brief this is just a normal sort, but it is for calling with uasort so
+/// we don't lose our indices
+///
+////////////////////////////////////////////////////////////////////////////////
+function sortKeepIndex($a, $b) {
+ if(is_array($a)) {
+ if(array_key_exists("prettyname", $a)) {
+ if(preg_match('/[0-9]-[0-9]/', $a['prettyname']))
+ return compareDashedNumbers($a["prettyname"], $b["prettyname"]);
+ return strcasecmp($a["prettyname"], $b["prettyname"]);
+ }
+ elseif(array_key_exists("name", $a)) {
+ if(preg_match('/[0-9]-[0-9]/', $a['name']))
+ return compareDashedNumbers($a["name"], $b["name"]);
+ return strcasecmp($a["name"], $b["name"]);
+ }
+ else
+ return 0;
+ }
+ if(ereg('\.ncsu\.edu$', $a)) {
+ return compareDashedNumbers($a, $b);
+ }
+ return strcasecmp($a, $b);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn compareDashedNumbers($a, $b)
+///
+/// \param $a - a string
+/// \param $b - a string
+///
+/// \return -1, 0, 1 if numerical parts of $a <, =, or > $b
+///
+/// \brief compares $a and $b to determine which one should be ordered first;
+/// has some understand of numerical order in strings
+///
+////////////////////////////////////////////////////////////////////////////////
+function compareDashedNumbers($a, $b) {
+ # get hostname and first part of domain name
+ $tmp = explode('.', $a);
+ $h1 = array_shift($tmp);
+ $domain1 = array_shift($tmp);
+ $letters1 = preg_replace('([^a-zA-Z])', '', $h1);
+
+ $tmp = explode('.', $b);
+ $h2 = array_shift($tmp);
+ $domain2 = array_shift($tmp);
+ $letters2 = preg_replace('([^a-zA-Z])', '', $h2);
+
+ // if different domain names, return based on that
+ $cmp = strcasecmp($domain1, $domain2);
+ if($cmp) {
+ return $cmp;
+ }
+
+ // if non-numeric part is different, return based on that
+ $cmp = strcasecmp($letters1, $letters2);
+ if($cmp) {
+ return $cmp;
+ }
+
+ // at this point, the only difference is in the numbers
+ $digits1 = preg_replace('([^\d-])', '', $h1);
+ $digits1Arr = explode('-', $digits1);
+ $digits2 = preg_replace('([^\d-])', '', $h2);
+ $digits2Arr = explode('-', $digits2);
+
+ $len1 = count($digits1Arr);
+ $len2 = count($digits2Arr);
+ for($i = 0; $i < $len1 && $i < $len2; $i++) {
+ if($digits1Arr[$i] < $digits2Arr[$i]) {
+ return -1;
+ }
+ elseif($digits1Arr[$i] > $digits2Arr[$i]) {
+ return 1;
+ }
+ }
+
+ return 0;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getResourceMapping($resourcetype1, $resourcetype2,
+/// $resource1inlist, $resource2inlist)
+///
+/// \param $resourcetype1 - get mapping between this type and $resourcetype2
+/// \param $resourcetype2 - get mapping between this type and $resourcetype1
+/// \param $resource1inlist - (optional) comma delimited list of resource groups
+/// to limit query to
+/// \param $resource2inlist - (optional) comma delimited list of resource groups
+/// to limit query to
+///
+/// \return an array of $resourcetype1 group to $resourcetype2 group mappings
+/// where each index is a group id from $resourcetype1 and each value is an
+/// array of $resourcetype2 group ids
+///
+/// \brief builds an array of $resourcetype2 group ids for each $resourcetype1
+/// group id
+///
+////////////////////////////////////////////////////////////////////////////////
+function getResourceMapping($resourcetype1, $resourcetype2,
+ $resource1inlist="", $resource2inlist="") {
+ if(! is_numeric($resourcetype1))
+ $resourcetype1 = getResourceTypeID($resourcetype1);
+ if(! is_numeric($resourcetype2))
+ $resourcetype2 = getResourceTypeID($resourcetype2);
+
+ $return = array();
+ $query = "SELECT resourcegroupid1, "
+ . "resourcetypeid1, "
+ . "resourcegroupid2, "
+ . "resourcetypeid2 "
+ . "FROM resourcemap "
+ . "WHERE ((resourcetypeid1 = $resourcetype1 AND "
+ . "resourcetypeid2 = $resourcetype2) OR "
+ . "(resourcetypeid1 = $resourcetype2 AND "
+ . "resourcetypeid2 = $resourcetype1)) ";
+ if(! empty($resource1inlist))
+ $query .= "AND resourcegroupid1 IN ($resource1inlist) ";
+ if(! empty($resource2inlist))
+ $query .= "AND resourcegroupid2 IN ($resource2inlist) ";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_assoc($qh)) {
+ if($resourcetype1 == $row['resourcetypeid1']) {
+ if(array_key_exists($row["resourcegroupid1"], $return))
+ array_push($return[$row["resourcegroupid1"]], $row["resourcegroupid2"]);
+ else
+ $return[$row["resourcegroupid1"]] = array($row["resourcegroupid2"]);
+ }
+ else {
+ if(array_key_exists($row["resourcegroupid2"], $return))
+ array_push($return[$row["resourcegroupid2"]], $row["resourcegroupid1"]);
+ else
+ $return[$row["resourcegroupid2"]] = array($row["resourcegroupid1"]);
+ }
+ }
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn timeToNextReservation($request)
+///
+/// \param $request - either a request id or an array returned from
+/// getRequestInfo
+///
+/// \return minutes from the end of $request until the start of the next
+/// reservation on the same computer, if there are no reservations following
+/// this one, -1 is returned
+///
+/// \brief determines the number of minutes between the end of $request and
+/// the beginning of the next request on the same computer
+///
+////////////////////////////////////////////////////////////////////////////////
+function timeToNextReservation($request) {
+ if(! is_array($request))
+ $request = getRequestInfo($request);
+ $res = array_shift($request["reservations"]);
+ $query = "SELECT rq.start "
+ . "FROM reservation rs, "
+ . "request rq "
+ . "WHERE rs.computerid = {$res["computerid"]} AND "
+ . "rq.start >= '{$request["end"]}' AND "
+ . "rs.requestid = rq.id "
+ . "ORDER BY start "
+ . "LIMIT 1";
+ $qh = doQuery($query, 101);
+ if($row = mysql_fetch_assoc($qh)) {
+ $end = datetimeToUnix($request["end"]);
+ $start = datetimeToUnix($row["start"]);
+ return ($start - $end) / 60;
+ }
+ else
+ return -1;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getImageText($text)
+///
+/// \param $text - text to be in the image
+///
+/// \return a text string
+///
+/// \brief creates an image src line that calls textimage.php to print an
+/// image with $text in it
+///
+////////////////////////////////////////////////////////////////////////////////
+function getImageText($text) {
+ return "<img src=\"" . BASEURL . "/images/textimage.php?text=$text\">";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn weekOfYear($ts)
+///
+/// \param $ts - unix timestamp
+///
+/// \return week number in the year that $ts falls in
+///
+/// \brief determines the week of the year $ts is in where week 0 is the week
+/// containing Jan 1st
+///
+////////////////////////////////////////////////////////////////////////////////
+function weekOfYear($ts) {
+ $year = date('Y', time());
+ for($i = 0; $i < 7; $i++) {
+ $time = mktime(1, 0, 0, 1, $i + 1, $year);
+ if(date('l', $time) == "Sunday") {
+ if($i)
+ $add = 7 - $i;
+ else
+ $add = 0;
+ break;
+ }
+ }
+ return (int)((date('z', $ts) + $add) / 7);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn semLock();
+///
+/// \return TRUE or FALSE
+///
+/// \brief tries to acquire a semaphore lock, and sets a global to know we
+/// have acquired it
+///
+////////////////////////////////////////////////////////////////////////////////
+function semLock() {
+ global $semid, $semislocked;
+ if($semislocked)
+ return TRUE;
+
+ if(sem_acquire($semid)) {
+ $semislocked = 1;
+ return TRUE;
+ }
+ else
+ return FALSE;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn semUnlock()
+///
+/// \return TRUE or FALSE
+///
+/// \brief unlocks the semaphore and sets a global to know we have released it
+///
+////////////////////////////////////////////////////////////////////////////////
+function semUnlock() {
+ global $semid, $semislocked;
+ if($semislocked) {
+ if(sem_release($semid)) {
+ $semislocked = 0;
+ return TRUE;
+ }
+ else
+ return FALSE;
+ }
+ return TRUE;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn setAttribute($objid, $attrib, $data)
+///
+/// \param $objid - a dom id
+/// \param $attrib - attribute of dom object to set
+/// \param $data - what to set $attrib to
+///
+/// \return dojo code to set $attrib to $data for $objid
+///
+/// \brief dojo code to set $attrib to $data for $objid
+///
+////////////////////////////////////////////////////////////////////////////////
+function setAttribute($objid, $attrib, $data) {
+ return "if(dojo.byId('$objid')) {dojo.byId('$objid').$attrib = '$data';};\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn generateString($length)
+///
+/// \param $length - (optional) length of the string, defaults to 8
+///
+/// \return a random string of upper and lower case letters and numbers
+///
+/// \brief generates a random string
+///
+////////////////////////////////////////////////////////////////////////////////
+function generateString($length=8) {
+ global $passwdArray;
+ $tmp = array_flip($passwdArray);
+ $tmp = array_rand($tmp, $length);
+ return implode('', $tmp);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getVMProfiles(id)
+///
+/// \param $id (optional) - a profile id; if specified, only data about this
+/// profile will be returned
+///
+/// \return an array of profiles where each key is the profile id and each
+/// element is an array with these keys:\n
+/// \b name - name of profile\n
+/// \b type - name of vm type\n
+/// \b typeid - id of vm type\n
+/// \b image - name of image used for this profile\n
+/// \b imageid - id of image used for this profile\n
+/// \b nasshare - share exported by nas to the vmhost\n
+/// \b datastorepath - path to where vm data files are stored\n
+/// \b vmpath - path to where vm configuration files are stored\n
+/// \b virtualswitch0 - name of first virtual switch\n
+/// \b virtualswitch1 - name of second virtual switch\n
+/// \b vmdisk - "localdisk" or "networkdisk" - whether or not vm files are
+/// stored on local disk or network attached storage
+///
+/// \brief gets information about vm profiles and returns it as an array
+///
+////////////////////////////////////////////////////////////////////////////////
+function getVMProfiles($id="") {
+ $query = "SELECT vp.id, "
+ . "vp.profilename AS name, "
+ . "vt.name AS type, "
+ . "vp.vmtypeid, "
+ . "i.prettyname AS image, "
+ . "vp.imageid, "
+ . "vp.nasshare, "
+ . "vp.datastorepath, "
+ . "vp.vmpath, "
+ . "vp.virtualswitch0, "
+ . "vp.virtualswitch1, "
+ . "vp.vmdisk "
+ . "FROM vmprofile vp "
+ . "LEFT JOIN vmtype vt ON (vp.vmtypeid = vt.id) "
+ . "LEFT JOIN image i ON (vp.imageid = i.id)";
+ if(! empty($id))
+ $query .= " AND vp.id = $id";
+ $qh = doQuery($query, 101);
+ $ret = array();
+ while($row = mysql_fetch_assoc($qh))
+ $ret[$row['id']] = $row;
+ return $ret;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getVMtypes()
+///
+/// \return an array where each key is the id of the type and each element is
+/// the name of the type
+///
+/// \brief gets the entries from the vmtype table
+///
+////////////////////////////////////////////////////////////////////////////////
+function getVMtypes() {
+ $types = array();
+ $qh = doQuery("SELECT id, name FROM vmtype", 101);
+ while($row = mysql_fetch_assoc($qh))
+ $types[$row['id']] = $row['name'];
+ return $types;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn addContinuationsEntry($nextmode, $data, $duration, $deleteFromSelf,
+/// $multicall, $repeatProtect)
+///
+/// \param $nextmode - next mode to go in to
+/// \param $data (optional, default=array())- array of data to make available
+/// in $nextmode
+/// \param $duration (optional, default=SECINWEEK)- how long this continuation
+/// should be available (in seconds)
+/// \param $deleteFromSelf (optional, default=1)- set the deletefromid to be
+/// the id of this continuation
+/// \param $multicall (optional, default=1) - boolean, if false, entry should be
+/// deleted after being called once
+/// \param $repeatProtect (optional, default=0) - boolean, if true, we add
+/// the current continuationid to $data; this keeps us from having a tree
+/// structure "loop" with the continuations; this situation occurs when we have
+/// a page that can lead off in 2 directions, one of which ends up causing us
+/// to come back to the page - then the continuation in the other direction
+/// ends up having conflicting parents
+///
+/// \return an encrypted string that can be passed to the client as an
+/// identifier for where to continue execution
+///
+/// \brief generates a continuation id based on $data and $nextmode; if the id
+/// already exists in continuations, updates that entry's expiretime; if not,
+/// adds an entry
+///
+////////////////////////////////////////////////////////////////////////////////
+function addContinuationsEntry($nextmode, $data=array(), $duration=SECINWEEK,
+ $deleteFromSelf=1, $multicall=1,
+ $repeatProtect=0) {
+ global $user, $mode, $inContinuation, $continuationid;
+ if($repeatProtect)
+ $data['______parent'] = $continuationid;
+ $serdata = serialize($data);
+ $contid = md5($mode . $nextmode . $serdata . $user['id']);
+ $serdata = mysql_escape_string($serdata);
+ $expiretime = unixToDatetime(time() + $duration);
+ $query = "SELECT id, "
+ . "parentid "
+ . "FROM continuations "
+ . "WHERE id = '$contid' AND "
+ . "userid = {$user['id']}";
+ $qh = doQuery($query, 101);
+ if($row = mysql_fetch_assoc($qh)) {
+ # update expiretime
+ $query = "UPDATE continuations "
+ . "SET expiretime = '$expiretime' "
+ . "WHERE id = '$contid' AND "
+ . "userid = {$user['id']}";
+ doQuery($query, 101);
+ }
+ else {
+ if(! $inContinuation)
+ $parent = 'NULL';
+ else
+ $parent = "'$continuationid'";
+ if($deleteFromSelf || ! $inContinuation) {
+ $deletefromid = $contid;
+ $parent = 'NULL';
+ }
+ else {
+ $query = "SELECT deletefromid "
+ . "FROM continuations "
+ . "WHERE id = '$continuationid' AND "
+ . "userid = {$user['id']}";
+ $qh = doQuery($query, 101);
+ if(! $row = mysql_fetch_assoc($qh))
+ abort(108);
+ $deletefromid = $row['deletefromid'];
+ }
+ $query = "INSERT INTO continuations "
+ . "(id, "
+ . "userid, "
+ . "expiretime, "
+ . "frommode, "
+ . "tomode, "
+ . "data, "
+ . "multicall, "
+ . "parentid, "
+ . "deletefromid) "
+ . "VALUES "
+ . "('$contid', "
+ . "{$user['id']}, "
+ . "'$expiretime', "
+ . "'$mode', "
+ . "'$nextmode', "
+ . "'$serdata', "
+ . "$multicall, "
+ . "$parent, "
+ . "'$deletefromid')";
+ doQuery($query, 101);
+ }
+ $salt = generateString(8);
+ $now = time();
+ $data = "$salt:$contid:{$user['id']}:$now";
+ $edata = encryptData($data);
+ $udata = urlencode($edata);
+ return $udata;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getContinuationsData($data)
+///
+/// \param $data - data as returned by addContinuationsEntry
+///
+/// \return an array with these keys:\n
+/// \b frommode - current mode\n
+/// \b nextmode - mode to go to next\n
+/// \b userid - id from user table\n
+/// \b data - data saved in the db for this continuation
+///
+/// \brief gets data saved in continuations table associated with $data
+///
+////////////////////////////////////////////////////////////////////////////////
+function getContinuationsData($data) {
+ global $user, $continuationid;
+ if(array_key_exists('continuation', $_POST))
+ $edata = urldecode($data);
+ else
+ $edata = $data;
+ if(! ($ddata = decryptData($edata)))
+ return array('error' => 'invalid input');
+ $items = explode(':', $ddata);
+ $now = time();
+ $continuationid = $items[1];
+
+ # validate input
+ if((count($items) != 4) ||
+ (! preg_match('/^[0-9a-fA-F]+$/', $continuationid)) ||
+ (! is_numeric($items[2])) ||
+ /*($items[1] != $user['id']) ||*/
+ (! is_numeric($items[3])) ||
+ ($items[3] > $now)) {
+ return array('error' => 'invalid input');
+ }
+
+ # get continuation
+ $query = "SELECT UNIX_TIMESTAMP(expiretime) AS expiretime, "
+ . "frommode, "
+ . "tomode, "
+ . "data, "
+ . "multicall, "
+ . "deletefromid "
+ . "FROM continuations "
+ . "WHERE id = '$continuationid' AND "
+ . "userid = {$items[2]}";
+ $qh = doQuery($query, 101);
+
+ # return error if it is not there
+ if(! ($row = mysql_fetch_assoc($qh)))
+ return array('error' => 'continuation does not exist');
+
+ # return error if it is expired
+ if($row['expiretime'] < $now) {
+ $query = "DELETE FROM continuations "
+ . "WHERE id = '{$row['deletefromid']}' AND "
+ . "userid = {$items[2]}";
+ doQuery($query, 101, 'vcl', 1);
+ return array('error' => 'expired');
+ }
+
+ # remove if multicall is 0
+ if($row['multicall'] == 0) {
+ $query = "DELETE FROM continuations "
+ . "WHERE id = '{$row['deletefromid']}' AND "
+ . "userid = {$items[2]}";
+ doQuery($query, 101, 'vcl', 1);
+ }
+ return array('frommode' => $row['frommode'],
+ 'nextmode' => $row['tomode'],
+ 'userid' => $items[2],
+ 'data' => unserialize($row['data']));
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn continuationsError()
+///
+/// \brief prints an error page related to a continuations problem
+///
+////////////////////////////////////////////////////////////////////////////////
+function continuationsError() {
+ global $contdata, $printedHTMLheader, $HTMLheader;
+ if(empty($HTMLheader))
+ printHTMLHeader();
+ if(! $printedHTMLheader) {
+ $printedHTMLheader = 1;
+ print $HTMLheader;
+ }
+ if(array_key_exists('error', $contdata)) {
+ switch($contdata['error']) {
+ case 'invalid input':
+ print "<h2>Error: Invalid Input</h2><br>\n";
+ print "You submitted input invalid for this web site. If you have no ";
+ print "idea why this happened and the problem persists, please email ";
+ print "<a href=\"mailto:" . HELPEMAIL . "?Subject=Problem%20With%20VCL\">";
+ print HELPEMAIL . "</a> for further assistance. Please include the ";
+ print "steps you took that led up to this problem in your email message.";
+ break;
+ case 'continuation does not exist':
+ case 'expired':
+ print "<h2>Error: Invalid Input</h2><br>\n";
+ print "You submitted expired data to this web site. Please restart the ";
+ print "steps you were following without using your browser's <strong>";
+ print "Back</strong> button.";
+ break;
+ default:
+ print "<h2>Error: Invalid Input</h2><br>\n";
+ print "An error has occurred. If this problem persists, please email ";
+ print "<a href=\"mailto:" . HELPEMAIL . "?Subject=Problem%20With%20VCL\">";
+ print HELPEMAIL . "</a> for further assistance. Please include the ";
+ print "steps you took that led up to this problem in your email message.";
+ }
+ }
+ printHTMLFooter();
+ dbDisconnect();
+ exit;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn xmlrpccall()
+///
+/// \brief registers all functions available to xmlrpc, handles the current
+/// xmlrpc call
+///
+////////////////////////////////////////////////////////////////////////////////
+function xmlrpccall() {
+ global $xmlrpc_handle, $HTTP_RAW_POST_DATA, $user;
+ # create xmlrpc handle
+ $xmlrpc_handle = xmlrpc_server_create();
+ # register functions available via rpc calls
+ xmlrpc_server_register_method($xmlrpc_handle, "XMLRPCtest", "xmlRPChandler");
+ xmlrpc_server_register_method($xmlrpc_handle, "XMLRPCgetImages", "xmlRPChandler");
+ xmlrpc_server_register_method($xmlrpc_handle, "XMLRPCaddRequest", "xmlRPChandler");
+ xmlrpc_server_register_method($xmlrpc_handle, "XMLRPCgetRequestStatus", "xmlRPChandler");
+ xmlrpc_server_register_method($xmlrpc_handle, "XMLRPCgetRequestConnectData", "xmlRPChandler");
+ xmlrpc_server_register_method($xmlrpc_handle, "XMLRPCendRequest", "xmlRPChandler");
+ xmlrpc_server_register_method($xmlrpc_handle, "XMLRPCgetRequestIds", "xmlRPChandler");
+
+ print xmlrpc_server_call_method($xmlrpc_handle, $HTTP_RAW_POST_DATA, '');
+ xmlrpc_server_destroy($xmlrpc_handle);
+ semUnlock();
+ dbDisconnect();
+ exit;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn xmlrpcgetaffiliations()
+///
+/// \brief registers function to handle xmlrpcaffiliations and handles the call
+///
+////////////////////////////////////////////////////////////////////////////////
+function xmlrpcgetaffiliations() {
+ global $xmlrpc_handle, $HTTP_RAW_POST_DATA;
+ # create xmlrpc handle
+ $xmlrpc_handle = xmlrpc_server_create();
+ # register functions available via rpc calls
+ xmlrpc_server_register_method($xmlrpc_handle, "XMLRPCaffiliations", "xmlRPChandler");
+
+ print xmlrpc_server_call_method($xmlrpc_handle, $HTTP_RAW_POST_DATA, '');
+ xmlrpc_server_destroy($xmlrpc_handle);
+ semUnlock();
+ dbDisconnect();
+ exit;
+}
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn xmlRPChandler($function, $args, $blah)
+///
+/// \param $function - name of a function to call
+/// \param $args - array of arguments to pass when calling $function, use empty
+/// array if $function takes no args
+/// \param $blah - not used, but required by xmlrpc_server_call_method
+///
+/// \return whatever $function returns
+///
+/// \brief calls $function with $args (if non-empty array) and returns whatever
+/// $function returns
+///
+////////////////////////////////////////////////////////////////////////////////
+function xmlRPChandler($function, $args, $blah) {
+ global $user, $remoteIP;
+ header("Content-type: text/xml");
+ $apiversion = processInputData($_SERVER['HTTP_X_APIVERSION'], ARG_NUMERIC);
+ if($function == 'XMLRPCaffiliations')
+ $keyid = 0;
+ elseif($apiversion == 1)
+ $keyid = $user['xmlrpckeyid'];
+ else
+ $keyid = $user['id'];
+ if(function_exists($function)) {
+ $saveargs = serialize($args);
+ $query = "INSERT INTO xmlrpcLog "
+ . "(xmlrpcKeyid, "
+ . "timestamp, "
+ . "IPaddress, "
+ . "method, "
+ . "apiversion, "
+ . "comments) "
+ . "VALUES "
+ . "($keyid, "
+ . "NOW(), "
+ . "'$remoteIP', "
+ . "'$function', "
+ . "$apiversion, "
+ . "'$saveargs')";
+ doQuery($query, 101);
+ }
+ else {
+ printXMLRPCerror(2);
+ dbDisconnect();
+ semUnlock();
+ exit;
+ }
+
+ if(count($args))
+ return call_user_func_array($function, $args);
+ else
+ return $function();
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn xmlRPCabort($errcode, $query)
+///
+/// \param $errcode - an error code from $ERRORS
+/// \param $query - (optional, default="") a query
+///
+/// \brief call this to handle errors for XML RPC connections
+///
+////////////////////////////////////////////////////////////////////////////////
+function xmlRPCabort($errcode, $query='') {
+ global $mysql_link_vcl, $mysql_link_acct, $ERRORS, $user, $mode;
+ global $XMLRPCERRORS;
+ if(ONLINEDEBUG && $user["adminlevel"] == "developer") {
+ $msg = '';
+ if($errcode >= 100 && $errcode < 400) {
+ $msg .= mysql_error($mysql_link_vcl) . " $query ";
+ }
+ $msg .= $ERRORS["$errcode"];
+ $XMLRPCERRORS[100] = $msg;
+ $faultcode = 100;
+ }
+ else {
+ $message = "";
+ if($errcode >= 100 && $errcode < 400) {
+ $message .= mysql_error($mysql_link_vcl) . "\n";
+ $message .= mysql_error($mysql_link_acct) . "\n";
+ $message .= $query . "\n";
+ }
+ $message .= "ERROR($errcode): " . $ERRORS["$errcode"] . "\n";
+ $message .= "Logged in user was " . $user["unityid"] . "\n";
+ $message .= "Mode was $mode\n\n";
+ if($errcode == 20) {
+ $urlArray = explode('?', $_SERVER["HTTP_REFERER"]);
+ $message .= "HTTP_REFERER URL - " . $urlArray[0] . "\n";
+ $message .= "correct URL - " . BASEURL . SCRIPT . "\n";
+ }
+ $message .= getBacktraceString(FALSE);
+ $mailParams = "-f" . ENVELOPESENDER;
+ mail(ERROREMAIL, "Error with VCL XMLRPC call", $message, '', $mailParams);
+ $faultcode = 1;
+ }
+ printXMLRPCerror($faultcode);
+ dbDisconnect();
+ semUnlock();
+ exit;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn printXMLRPCerror($errcode)
+///
+/// \param $errcode - an error code from $XMLRPCERRORS
+///
+/// \brief prints the XML for an RPC error
+///
+////////////////////////////////////////////////////////////////////////////////
+function printXMLRPCerror($errcode) {
+ global $XMLRPCERRORS;
+ print "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>\n";
+ print "<methodResponse>\n";
+ print "<fault>\n";
+ print " <value>\n";
+ print " <struct>\n";
+ print " <member>\n";
+ print " <name>faultString</name>\n";
+ print " <value>\n";
+ print " <string>{$XMLRPCERRORS[$errcode]}</string>\n";
+ print " </value>\n";
+ print " </member>\n";
+ print " <member>\n";
+ print " <name>faultCode</name>\n";
+ print " <value>\n";
+ print " <int>$errcode</int>\n";
+ print " </value>\n";
+ print " </member>\n";
+ print " </struct>\n";
+ print " </value>\n";
+ print "</fault>\n";
+ print "</methodResponse>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn json_encode()
+///
+/// \brief json_encode was introduced in php 5.2, this function was taked from
+/// the comments of the help page for that function for php < 5.2
+///
+////////////////////////////////////////////////////////////////////////////////
+if(! function_exists('json_encode')) {
+function json_encode($a=false) {
+ if(is_null($a))
+ return 'null';
+ if($a === false)
+ return 'false';
+ if($a === true)
+ return 'true';
+ if(is_scalar($a)) {
+ if (is_float($a)) {
+ // Always use "." for floats.
+ return floatval(str_replace(",", ".", strval($a)));
+ }
+
+ if (is_string($a)) {
+ static $jsonReplaces = array(array("\\", "/", "\n", "\t", "\r", "\b", "\f", '"'), array('\\\\', '\\/', '\\n', '\\t', '\\r', '\\b', '\\f', '\"'));
+ return '"' . str_replace($jsonReplaces[0], $jsonReplaces[1], $a) . '"';
+ }
+ else
+ return $a;
+ }
+ $isList = true;
+ for ($i = 0, reset($a); $i < count($a); $i++, next($a)) {
+ if (key($a) !== $i) {
+ $isList = false;
+ break;
+ }
+ }
+ $result = array();
+ if ($isList) {
+ foreach ($a as $v) $result[] = json_encode($v);
+ return '[' . join(',', $result) . ']';
+ }
+ else {
+ foreach($a as $k => $v)
+ $result[] = json_encode($k).':'.json_encode($v);
+ return '{' . join(',', $result) . '}';
+ }
+}
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn vcldquery()
+///
+/// \brief this function is a sort of wrapper for a web API for vcld\n
+/// \n
+/// This allows the vcld daemon to call this web code so code does not
+/// have to be developed in both perl and php. The perl code needs to use
+/// the \b LWP::Simple and \b WDDX libraries. Data returned from the called function
+/// is returned in a WDDX serialized structure. To call a function, use the
+/// perl \c get function from \b LWP::Simple, calling \c index.php with \c mode=vcldquery,
+/// \c key=<shared \c key>, \c query=<comma \c delimited \c list> where the first
+/// item in the list is the function to call and the rest of the items in the
+/// list are the arguments to the function. If an argument needs to be an
+/// array, use a colon delimited list for the elements of the array. If you
+/// need the array to have 0 or 1 items, either use just a : or add a : at the
+/// end of the first element. Example:\n
+/// \code
+/// my $doc = get("http://..../index.php?mode=vcldquery&key=<key>&query=getOverallUserPrivs,1");
+/// my $doc_id = new WDDX;
+/// my $wddk_obj = $doc_id->deserialize($doc);
+/// my $value = $wddx_obj->as_hasref();
+/// $value->{"data"}; # will contain what the php function (getOverallUserPrivs) returned
+/// \endcode
+///
+////////////////////////////////////////////////////////////////////////////////
+
+/* /// \example vcldphpcall.pl */
+function vcldquery() {
+ $query = processInputVar("query", ARG_STRING);
+ $arr = explode(',', $query);
+ $function = array_shift($arr);
+ $args = array();
+ foreach($arr as $item) {
+ if(ereg(':', $item)) {
+ $item = array_diff(explode(':', $item), array(""));
+ }
+ array_push($args, $item);
+ }
+ require_once(".ht-inc/groups.php");
+ require_once(".ht-inc/privileges.php");
+ require_once(".ht-inc/requests.php");
+ require_once(".ht-inc/schedules.php");
+ require_once(".ht-inc/statistics.php");
+ require_once(".ht-inc/userpreferences.php");
+
+ if(count($args) == 0)
+ $data = $function();
+ elseif(count($args) == 1)
+ $data = $function($args[0]);
+ elseif(count($args) == 2)
+ $data = $function($args[0], $args[1]);
+ elseif(count($args) == 3)
+ $data = $function($args[0], $args[1], $args[2]);
+ elseif(count($args) == 4)
+ $data = $function($args[0], $args[1], $args[2], $args[3]);
+ elseif(count($args) == 5)
+ $data = $function($args[0], $args[1], $args[2], $args[3], $args[4]);
+ elseif(count($args) == 6)
+ $data = $function($args[0], $args[1], $args[2], $args[3], $args[4], $args[5]);
+
+ print wddx_serialize_vars("data");
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn menulistLI($page)
+///
+/// \param $page - name of a page
+///
+/// \return a list item tag, with the class set to selected if this mode belogs
+/// to this page
+///
+/// \brief determines if the current mode is part of $page and returns a list
+/// item tag with the class set if it is, or just a list item tag if it is not
+///
+////////////////////////////////////////////////////////////////////////////////
+function menulistLI($page) {
+ global $mode, $actions;
+ $mymode = $mode;
+ if(empty($mymode))
+ $mymode = "home";
+ if($actions['pages'][$mymode] == $page)
+ return "<li class=selected>";
+ else
+ return "<li>";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn sendHeaders()
+///
+/// \brief makes any needed header calls for the current mode
+///
+////////////////////////////////////////////////////////////////////////////////
+function sendHeaders() {
+ global $mode, $user, $authed, $oldmode, $viewmode, $actionFunction, $skin;
+ $setwrapreferer = processInputVar('am', ARG_NUMERIC, 0);
+ if(! $authed && $mode == "auth") {
+ /*if($oldmode != "auth" && $oldmode != "" && array_key_exists('mode', $_GET)) {
+ $cookieHeaderString = "WRAP_REFERER=" . BASEURL . SCRIPT . "?mode=$oldmode; path=/; domain=" . COOKIEDOMAIN;
+ $itecscookie = BASEURL . SCRIPT . "?mode=$oldmode";
+ }
+ else {
+ $cookieHeaderString = "WRAP_REFERER=" . BASEURL . "; path=/; domain=" . COOKIEDOMAIN;
+ $itecscookie = BASEURL;
+ }
+ header("Set-Cookie: $cookieHeaderString");
+ setcookie("ITECSAUTH_RETURN", "$itecscookie", 0, "/", COOKIEDOMAIN);
+ setcookie("ITECSAUTH_CSS", "vcl.css", 0, "/", COOKIEDOMAIN);*/
+ header("Location: " . BASEURL . SCRIPT . "?mode=selectauth");
+ dbDisconnect();
+ exit;
+ }
+ elseif(! $authed && $mode == 'selectauth' && $setwrapreferer == 1) {
+ $tmp = explode('/', $_SERVER['HTTP_REFERER']);
+ if($tmp[2] == 'vcl.ncsu.edu')
+ $cookieHeaderString = "WRAP_REFERER={$_SERVER['HTTP_REFERER']}; path=/; domain=" . COOKIEDOMAIN;
+ else
+ $cookieHeaderString = "WRAP_REFERER=https://vcl.ncsu.edu/; path=/; domain=" . COOKIEDOMAIN;
+ header("Set-Cookie: $cookieHeaderString");
+ }
+ if($mode == "logout") {
+ setcookie("VCLAUTH", "", time() - 10, "/", COOKIEDOMAIN);
+ header("Location: " . HOMEURL);
+ stopSession();
+ dbDisconnect();
+ exit;
+ }
+ if($mode == "submitviewmode") {
+ $expire = time() + 31536000; //expire in 1 year
+ /*if(array_key_exists('WRAP_USERID', $_SERVER)) {
+ $testuser = getUserInfo("{$_SERVER['WRAP_USERID']}@NCSU");
+ if($testuser['adminlevelid'] == ADMIN_DEVELOPER) {
+ $viewasuser = processInputVar("viewasuser", ARG_STRING, $_SERVER['WRAP_USERID']);
+ if(validateUserid($viewasuser)) {
+ if($viewasuser == $_SERVER['WRAP_USERID'])
+ setcookie("VCLTESTUSER", "", time() - 10, "/", COOKIEDOMAIN);
+ else
+ setcookie("VCLTESTUSER", $viewasuser, $expire, "/", COOKIEDOMAIN);
+ }
+ }
+ }*/
+ $newviewmode = processInputVar("viewmode", ARG_NUMERIC);
+ if(! empty($newviewmode) && $newviewmode <= $user['adminlevelid'])
+ setcookie("VCLVIEWMODE", $newviewmode, $expire, "/", COOKIEDOMAIN);
+ stopSession();
+ header("Location: " . BASEURL . SCRIPT);
+ dbDisconnect();
+ exit;
+ }
+ if($mode == "statgraphday" ||
+ $mode == "statgraphdayconcuruser" ||
+ $mode == "statgraphdayconcurblade" ||
+ $mode == "statgraphhour") {
+ $actionFunction();
+ dbDisconnect();
+ exit;
+ }
+ if($mode == "viewNodes") {
+ $openNodes = processInputVar("openNodes", ARG_STRING);
+ $activeNode = processInputVar("activeNode", ARG_NUMERIC);
+ if(! empty($openNodes)) {
+ $expire = time() + 31536000; //expire in 1 year
+ setcookie("VCLNODES", $openNodes, $expire, "/", COOKIEDOMAIN);
+ }
+ if(! empty($activeNode)) {
+ $expire = time() + 31536000; //expire in 1 year
+ setcookie("VCLACTIVENODE", $activeNode, $expire, "/", COOKIEDOMAIN);
+ }
+ return;
+ }
+ if($mode == "submitDeleteNode") {
+ $activeNode = processInputVar("activeNode", ARG_NUMERIC);
+ $nodeinfo = getNodeInfo($activeNode);
+ $expire = time() + 31536000; //expire in 1 year
+ setcookie("VCLACTIVENODE", $nodeinfo["parent"], $expire, "/", COOKIEDOMAIN);
+
+ }
+ if($mode == "sendRDPfile") {
+ header("Cache-Control: max-age=5, must-revalidate");
+ header('Pragma: cache');
+ }
+ else
+ header("Cache-Control: no-cache, must-revalidate");
+ header("Expires: Sat, 1 Jan 2000 00:00:00 GMT");
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn printHTMLHeader()
+///
+/// \brief prints the header part of the template
+///
+////////////////////////////////////////////////////////////////////////////////
+function printHTMLHeader() {
+ global $mode, $user, $authed, $oldmode, $viewmode, $HTMLheader;
+ global $printedHTMLheader, $docreaders, $skin, $noHTMLwrappers, $actions;
+ if($printedHTMLheader)
+ return;
+ $refresh = 0;
+ if($authed && $mode == "viewRequests") {
+ $requests = getUserRequests("all", $user["id"]);
+ if($count = count($requests)) {
+ $now = time() + (15 * 60);
+ for($i = 0; $i < $count; $i++) {
+ if(datetimeToUnix($requests[$i]["start"]) < $now &&
+ ($requests[$i]["currstateid"] == 13 ||
+ ($requests[$i]["currstateid"] == 14 &&
+ $requests[$i]["laststateid"] == 13) ||
+ $requests[$i]["currstateid"] == 3)) {
+ $refresh = 1;
+ }
+ }
+ }
+ }
+
+ if($mode != 'selectauth' && $mode != 'submitLogin')
+ $HTMLheader .= getHeader($refresh);
+
+ if(! in_array($mode, $noHTMLwrappers)) {
+ print $HTMLheader;
+ $printedHTMLheader = 1;
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getNavMenu($inclogout, $inchome, $homeurl)
+///
+/// \param $inclogout - bool flag for printing logout link
+/// \param $inchome - bool flag for printing home link
+/// \param $homeurl - (optional, defaults to HOMEURL) url for home link
+/// to point to
+///
+/// \return string of html to display the navigation menu
+///
+/// \brief build the html for the navigation menu
+///
+////////////////////////////////////////////////////////////////////////////////
+function getNavMenu($inclogout, $inchome, $homeurl=HOMEURL) {
+ global $user, $viewmode, $docreaders, $authed, $userlookupUsers, $skin;
+ global $mode;
+ if($authed && $mode != 'expiredemouser')
+ $computermetadata = getUserComputerMetaData();
+ else
+ $computermetadata = array("platforms" => array(),
+ "schedules" => array());
+ $rt = '';
+ if($inchome) {
+ $rt .= menulistLI('home');
+ $rt .= "<a href=\"$homeurl\">HOME</a></li>\n";
+ }
+ $rt .= menulistLI('newReservations');
+ $rt .= "<a href=\"" . BASEURL . SCRIPT . "?mode=newRequest\">";
+ $rt .= "New Reservation</a></li>\n";
+ if(in_array("imageCheckOut", $user["privileges"]) ||
+ in_array("imageAdmin", $user["privileges"])) {
+ $rt .= menulistLI('currentReservations');
+ $rt .= "<a href=\"" . BASEURL . SCRIPT . "?mode=viewRequests\">";
+ $rt .= "Current Reservations</a></li>\n";
+ }
+ if($viewmode == ADMIN_DEVELOPER) {
+ $rt .= menulistLI('blockReservations');
+ $rt .= "<a href=\"" . BASEURL . SCRIPT . "?mode=blockRequest\">";
+ $rt .= "Block Reservations</a></li>\n";
+ }
+ $rt .= menulistLI('userPreferences');
+ $rt .= "<a href=\"" . BASEURL . SCRIPT . "?mode=userpreferences\">";
+ $rt .= "User Preferences</a></li>\n";
+ if(in_array("groupAdmin", $user["privileges"])) {
+ $rt .= menulistLI('manageGroups');
+ $rt .= "<a href=\"" . BASEURL . SCRIPT . "?mode=viewGroups\">";
+ $rt .= "Manage Groups</a></li>\n";
+ }
+ if(in_array("imageAdmin", $user["privileges"])) {
+ $rt .= menulistLI('manageImages');
+ $rt .= "<a href=\"" . BASEURL . SCRIPT . "?mode=selectImageOption\">";
+ $rt .= "Manage Images</a></li>\n";
+ }
+ if(in_array("scheduleAdmin", $user["privileges"])) {
+ $rt .= menulistLI('manageSchedules');
+ $rt .= "<a href=\"" . BASEURL . SCRIPT . "?mode=viewSchedules\">";
+ $rt .= "Manage Schedules</a></li>\n";
+ }
+ if(in_array("computerAdmin", $user["privileges"])) {
+ $rt .= menulistLI('manageComputers');
+ $rt .= "<a href=\"" . BASEURL . SCRIPT . "?mode=selectComputers\">";
+ $rt .= "Manage Computers</a></li>\n";
+ }
+ if(in_array("mgmtNodeAdmin", $user["privileges"])) {
+ $rt .= menulistLI('managementNodes');
+ $rt .= "<a href=\"" . BASEURL . SCRIPT;
+ $rt .= "?mode=selectMgmtnodeOption\">Management Nodes</a></li>\n";
+ }
+ if(count($computermetadata["platforms"]) &&
+ count($computermetadata["schedules"])) {
+ $rt .= menulistLI('timeTable');
+ $rt .= "<a href=\"" . BASEURL . SCRIPT . "?mode=pickTimeTable\">";
+ $rt .= "View Time Table</a></li>\n";
+ }
+ if(in_array("userGrant", $user["privileges"]) ||
+ in_array("resourceGrant", $user["privileges"]) ||
+ in_array("nodeAdmin", $user["privileges"])) {
+ $rt .= menulistLI('privileges');
+ $rt .= "<a href=\"" . BASEURL . SCRIPT . "?mode=viewNodes\">";
+ $rt .= "Privileges</a></li>\n";
+ }
+ if($viewmode == ADMIN_DEVELOPER ||
+ in_array($user['id'], $userlookupUsers)) {
+ $rt .= menulistLI('userLookup');
+ $rt .= "<a href=\"" . BASEURL . SCRIPT . "?mode=userLookup\">";
+ $rt .= "User Lookup</a></li>\n";
+ }
+ if(in_array("computerAdmin", $user["privileges"])) {
+ $rt .= menulistLI('vm');
+ $rt .= "<a href=\"" . BASEURL . SCRIPT . "?mode=editVMInfo\">";
+ $rt .= "Virtual Hosts</a></li>\n";
+ }
+ $rt .= menulistLI('statistics');
+ $rt .= "<a href=\"" . BASEURL . SCRIPT . "?mode=selectstats\">";
+ $rt .= "Statistics</a></li>\n";
+ if($skin != 'ecu') {
+ $rt .= menulistLI('help');
+ $rt .= "<a href=\"" . HELPURL . "\">Help</a></li>\n";
+ }
+ if($skin == 'ecu') {
+ $rt .= "<li><a href=\"http://www.ecu.edu/cs-itcs/vcl/connect.cfm\">Requirements</a></li>\n";
+ $rt .= "<li><a href=\"http://www.ecu.edu/cs-itcs/vcl/save.cfm\">File Saving</a></li>\n";
+ $rt .= "<li><a href=\"http://www.ecu.edu/cs-itcs/vcl/faqs.cfm\">Help</a></li>\n";
+ }
+ if(in_array("userGrant", $user["privileges"]) ||
+ in_array("resourceGrant", $user["privileges"]) ||
+ in_array("nodeAdmin", $user["privileges"]) ||
+ in_array($user['id'], $docreaders)) {
+ $rt .= menulistLI('codeDocumentation');
+ $rt .= "<a href=\"" . BASEURL . SCRIPT . "?mode=viewdocs\">";
+ $rt .= "Documentation</a></li>\n";
+ }
+ if($inclogout) {
+ $rt .= menulistLI('authentication');
+ $rt .= "<a href=\"" . BASEURL . SCRIPT . "?mode=logout\">";
+ $rt .= "Logout</a></li>\n";
+ }
+ return $rt;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getDojoHTML($refresh)
+///
+/// \param $refresh - 1 to set page to refresh, 0 not to
+///
+/// \brief builds the header html for dojo related stuff
+///
+////////////////////////////////////////////////////////////////////////////////
+function getDojoHTML($refresh) {
+ global $mode, $actions, $skin;
+ $rt = '';
+ $dojoRequires = array();
+ switch($mode) {
+ case 'viewNodes':
+ case 'changeUserPrivs':
+ case 'submitAddResourcePriv':
+ case 'changeResourcePrivs':
+ $dojoRequires = array('dojo.io.*',
+ 'dojo.lfx.*',
+ 'dojo.html.*',
+ 'dojo.widget.*',
+ 'dojo.widget.Button',
+ 'dojo.widget.Tree',
+ 'dojo.widget.TreeSelector',
+ 'dojo.widget.FloatingPane');
+ break;
+ case 'newRequest':
+ case 'submitRequest':
+ case 'createSelectImage':
+ case 'submitCreateImage':
+ $dojoRequires = array('dojo.io.*',
+ 'dojo.widget.*',
+ 'dojo.html.*');
+ break;
+ case 'viewRequests':
+ $dojoRequires = array('dojo.io.*',
+ 'dojo.html.*',
+ 'dojo.widget.*',
+ 'dojo.widget.FloatingPane');
+ break;
+ case 'viewImages':
+ /*$dojoRequires = array('dojo.data.ItemFileWriteStore',
+ 'dojox.grid.Grid',
+ 'dojox.grid.data.model',
+ 'dojo.parser');*/
+ break;
+ case 'viewImageGrouping':
+ case 'submitImageGroups':
+ case 'viewImageMapping':
+ case 'submitImageMapping':
+ $dojoRequires = array('dojo.parser',
+ 'dijit.layout.LinkPane',
+ 'dijit.layout.ContentPane',
+ 'dijit.layout.TabContainer',
+ 'dijit.form.Button');
+ break;
+ case 'newImage':
+ case 'submitImageButton':
+ case 'confirmEditOrAddImage':
+ case 'submitEditImageButtons':
+ case 'submitAddSubimage':
+ case 'updateExistingImageComments':
+ case 'updateExistingImage':
+ $dojoRequires = array('dojo.parser',
+ 'dijit.InlineEditBox',
+ 'dijit.form.Textarea',
+ 'dijit.TitlePane');
+ break;
+ case 'selectComputers':
+ case 'viewComputerGroups':
+ case 'submitComputerGroups':
+ $dojoRequires = array('dojo.parser',
+ 'dijit.layout.LinkPane',
+ 'dijit.layout.ContentPane',
+ 'dijit.layout.TabContainer',
+ 'dijit.form.Button');
+ break;
+ case 'viewGroups':
+ case 'submitEditGroup':
+ case 'submitAddGroup':
+ case 'submitDeleteGroup':
+ $dojoRequires = array('dojo.parser');
+ break;
+ case 'selectauth':
+ $dojoRequires = array('dojo.parser');
+ break;
+ case 'editVMInfo':
+ $dojoRequires = array('dojo.parser',
+ 'dijit.InlineEditBox',
+ 'dijit.form.NumberSpinner',
+ 'dijit.form.Button',
+ 'dijit.form.TextBox',
+ 'dijit.form.FilteringSelect',
+ 'dijit.TitlePane',
+ 'dijit.layout.ContentPane',
+ 'dijit.layout.TabContainer',
+ 'dojo.data.ItemFileReadStore',
+ 'dijit.Dialog');
+ break;
+ }
+ if(empty($dojoRequires))
+ return '';
+ switch($mode) {
+ case "viewImageGrouping":
+ case "submitImageGroups":
+ case "viewImageMapping":
+ case "submitImageMapping":
+ $rt .= "<style type=\"text/css\">\n";
+ $rt .= " @import \"themes/$skin/css/dojo/$skin.css\";\n";
+ #$rt .= " @import \"dojo/dojo/resources/dojo.css\";\n";
+ $rt .= "</style>\n";
+ $rt .= "<script type=\"text/javascript\" src=\"js/images.js\"></script>\n";
+ $rt .= "<script type=\"text/javascript\" src=\"dojo/dojo/dojo.js\"\n";
+ $rt .= " djConfig=\"parseOnLoad: true\">\n";
+ $rt .= "</script>\n";
+ $rt .= "<script type=\"text/javascript\">\n";
+ $rt .= " dojo.addOnLoad(function() {\n";
+ foreach($dojoRequires as $req) {
+ $rt .= " dojo.require(\"$req\");\n";
+ }
+ $rt .= " });\n";
+ if($mode == "viewImageGrouping" ||
+ $mode == "submitImageGroups") {
+ $rt .= " dojo.addOnLoad(getImagesButton);\n";
+ $rt .= " dojo.addOnLoad(getGroupsButton);\n";
+ }
+ elseif($mode == "viewImageMapping" ||
+ $mode == "submitImageMapping") {
+ $rt .= " dojo.addOnLoad(getMapCompGroupsButton);\n";
+ $rt .= " dojo.addOnLoad(getMapImgGroupsButton);\n";
+ }
+ $rt .= "</script>\n";
+ return $rt;
+
+ case 'newImage':
+ case 'submitImageButton':
+ case 'confirmEditOrAddImage':
+ case 'submitEditImageButtons':
+ case 'submitAddSubimage':
+ case 'updateExistingImageComments':
+ case 'updateExistingImage':
+ $rt .= "<style type=\"text/css\">\n";
+ $rt .= " @import \"themes/$skin/css/dojo/$skin.css\";\n";
+ #$rt .= " @import \"dojo/dojo/resources/dojo.css\";\n";
+ $rt .= "</style>\n";
+ $rt .= "<script type=\"text/javascript\" src=\"js/images.js\"></script>\n";
+ $rt .= "<script type=\"text/javascript\" src=\"dojo/dojo/dojo.js\"\n";
+ $rt .= " djConfig=\"parseOnLoad: true\">\n";
+ $rt .= "</script>\n";
+ $rt .= "<script type=\"text/javascript\">\n";
+ $rt .= " dojo.addOnLoad(function() {\n";
+ foreach($dojoRequires as $req) {
+ $rt .= " dojo.require(\"$req\");\n";
+ }
+ $rt .= " });\n";
+ $rt .= " dojo.addOnLoad(function() {\n";
+ $rt .= " if(document.getElementById('hide1')) {\n";
+ $rt .= " document.getElementById('hide1').className = 'hidden';\n";
+ $rt .= " document.getElementById('hide2').className = 'hidden';\n";
+ $rt .= " document.getElementById('hide3').className = 'hidden';\n";
+ $rt .= " }\n";
+ $rt .= " });\n";
+ $rt .= "</script>\n";
+ return $rt;
+
+ case 'viewGroups':
+ case 'submitEditGroup':
+ case 'submitAddGroup':
+ case 'submitDeleteGroup':
+ $rt .= "<style type=\"text/css\">\n";
+ $rt .= " @import \"themes/$skin/css/dojo/$skin.css\";\n";
+ #$rt .= " @import \"dojo/dojo/resources/dojo.css\";\n";
+ $rt .= "</style>\n";
+ $rt .= "<script type=\"text/javascript\" src=\"dojo/dojo/dojo.js\"></script>\n";
+ $rt .= "<script type=\"text/javascript\">\n";
+ $rt .= " dojo.addOnLoad(function() {\n";
+ foreach($dojoRequires as $req) {
+ $rt .= " dojo.require(\"$req\");\n";
+ }
+ $rt .= " });\n";
+ $rt .= " dojo.addOnLoad(function() {document.onmousemove = updateMouseXY;});\n";
+ $rt .= "</script>\n";
+ $rt .= "<script type=\"text/javascript\" src=\"js/groups.js\"></script>\n";
+ return $rt;
+
+ case "selectComputers":
+ case "viewComputerGroups":
+ case "submitComputerGroups":
+ $rt .= "<style type=\"text/css\">\n";
+ $rt .= " @import \"themes/$skin/css/dojo/$skin.css\";\n";
+ #$rt .= " @import \"dojo/dojo/resources/dojo.css\";\n";
+ $rt .= "</style>\n";
+ $rt .= "<script type=\"text/javascript\" src=\"js/computers.js\"></script>\n";
+ $rt .= "<script type=\"text/javascript\" src=\"dojo/dojo/dojo.js\"\n";
+ $rt .= " djConfig=\"parseOnLoad: true\">\n";
+ $rt .= "</script>\n";
+ $rt .= "<script type=\"text/javascript\">\n";
+ $rt .= " dojo.addOnLoad(function() {\n";
+ foreach($dojoRequires as $req) {
+ $rt .= " dojo.require(\"$req\");\n";
+ }
+ $rt .= " });\n";
+ if($mode != 'selectComputers') {
+ $rt .= " dojo.addOnLoad(getCompsButton);\n";
+ $rt .= " dojo.addOnLoad(getGroupsButton);\n";
+ }
+ $rt .= "</script>\n";
+ return $rt;
+ case 'selectauth':
+ $rt .= "<script type=\"text/javascript\" src=\"dojo/dojo/dojo.js\"></script>\n";
+ $rt .= "<script type=\"text/javascript\">\n";
+ foreach($dojoRequires as $req) {
+ $rt .= " dojo.require(\"$req\");\n";
+ }
+ $authtype = processInputVar("authtype", ARG_STRING);
+ $rt .= " dojo.addOnLoad(function() {document.loginform.userid.focus(); document.loginform.userid.select();});\n";
+ $rt .= "</script>\n";
+ return $rt;
+ case "editVMInfo":
+ $rt .= "<style type=\"text/css\">\n";
+ $rt .= " @import \"themes/$skin/css/dojo/$skin.css\";\n";
+ #$rt .= " @import \"dojo/dojo/resources/dojo.css\";\n";
+ $rt .= "</style>\n";
+ $rt .= "<script type=\"text/javascript\" src=\"js/vm.js\"></script>\n";
+ $rt .= "<script type=\"text/javascript\" src=\"dojo/dojo/dojo.js\"\n";
+ $rt .= " djConfig=\"parseOnLoad: true\">\n";
+ $rt .= "</script>\n";
+ $rt .= "<script type=\"text/javascript\">\n";
+ $rt .= " dojo.addOnLoad(function() {\n";
+ foreach($dojoRequires as $req) {
+ $rt .= " dojo.require(\"$req\");\n";
+ }
+ $rt .= " });\n";
+ $rt .= "dojo.addOnLoad(function() {";
+ $rt .= "var dialog = dijit.byId('profileDlg'); ";
+ $rt .= "dojo.connect(dialog, 'hide', cancelVMprofileChange);});";
+ /*if($mode != 'selectComputers') {
+ $rt .= " dojo.addOnLoad(getCompsButton);\n";
+ $rt .= " dojo.addOnLoad(getGroupsButton);\n";
+ }*/
+ $rt .= "</script>\n";
+ return $rt;
+ }
+ $rt .= "<script type=\"text/javascript\" src=\"dojoAjax/dojo.js\"></script>";
+ $rt .= "<script type=\"text/javascript\">\n";
+ foreach($dojoRequires as $req) {
+ $rt .= " dojo.require(\"$req\");\n";
+ }
+ $rt .= " function RPCwrapper(data, callback) {\n";
+ $rt .= " dojo.io.bind({\n";
+ $rt .= " url: \"" . BASEURL . SCRIPT . "\",\n";
+ $rt .= " method: \"post\",\n";
+ $rt .= " content: data,\n";
+ $rt .= " load: callback,\n";
+ $rt .= " error: errorHandler\n";
+ $rt .= " });\n";
+ $rt .= " }\n";
+ if($actions['pages'][$mode] == 'privileges') {
+ $rt .= " var treeListener = {\n";
+ $rt .= " nodeExpand: function(message) {\n";
+ $rt .= " var nodes = dojo.io.cookie.get('VCLNODES');\n";
+ $rt .= " if(nodes) {\n";
+ $rt .= " var nodesArr = nodes.split(':');\n";
+ $rt .= " if(! nodesArr.inArray(message.source.widgetId)) {\n";
+ $rt .= " nodesArr.push(message.source.widgetId);\n";
+ $rt .= " nodes = nodesArr.join(':');\n";
+ $rt .= " }\n";
+ $rt .= " }\n";
+ $rt .= " else {\n";
+ $rt .= " nodes = message.source.widgetId;\n";
+ $rt .= " }\n";
+ $rt .= " dojo.io.cookie.set('VCLNODES', nodes, 365, '/', '" . COOKIEDOMAIN . "');\n";
+ $rt .= " },\n";
+ $rt .= " nodeCollapse: function(message) {\n";
+ $rt .= " checkSelectParent(message);\n";
+ $rt .= " var nodes = dojo.io.cookie.get('VCLNODES');\n";
+ $rt .= " var nodesArr = nodes.split(':');\n";
+ $rt .= " var index;\n";
+ $rt .= " if(index = nodesArr.search(message.source.widgetId)) {\n";
+ $rt .= " nodesArr.splice(index, 1);\n";
+ $rt .= " nodes = nodesArr.join(':');\n";
+ $rt .= " dojo.io.cookie.set('VCLNODES', nodes, 365, '/', '" . COOKIEDOMAIN . "');\n";
+ $rt .= " }\n";
+ $rt .= " }\n";
+ $rt .= " };\n";
+ }
+ $rt .= " dojo.addOnLoad(function() {\n";
+ $rt .= " testJS();\n";
+ $rt .= " document.onmousemove = updateMouseXY;\n";
+ if($actions['pages'][$mode] == 'privileges')
+ $rt .= " initPrivTree();\n";
+ if($mode == 'newRequest' || $mode == 'submitRequest') {
+ $rt .= " if(dojo.byId('waittime'))\n";
+ $rt .= " dojo.byId('waittime').className = 'shown';\n";
+ }
+ if($refresh && $mode == 'viewRequests') {
+ $rt .= " setTimeout(function() {if(! dojo.widget.byId('resStatusPane')) {AJdojoCreate('resStatusPane');}}, 1200);\n";
+ $rt .= " refresh_timer = setTimeout(resRefresh, 20000);\n";
+ }
+ $rt .= " });\n";
+ $rt .= "</script>\n";
+ return $rt;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn printHTMLFooter()
+///
+/// \brief prints the footer part of the html template
+///
+////////////////////////////////////////////////////////////////////////////////
+function printHTMLFooter() {
+ global $mode, $noHTMLwrappers;
+ if(in_array($mode, $noHTMLwrappers))
+ return;
+ print getFooter();
+}
+
+?>
diff --git a/web/.ht-inc/vcldocs.php b/web/.ht-inc/vcldocs.php
new file mode 100644
index 0000000..8152365
--- /dev/null
+++ b/web/.ht-inc/vcldocs.php
@@ -0,0 +1,397 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+// docreaders:
+// 1 - admin
+
+$docreaders = array(1);
+$doceditors = array(1);
+$actions['mode']['viewdocs'] = "viewDocs";
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn viewDocs()
+///
+/// \brief prints a page to select which VCL docs to view
+///
+////////////////////////////////////////////////////////////////////////////////
+function viewDocs() {
+ global $user, $docreaders, $viewmode;
+ if(! (in_array("userGrant", $user["privileges"]) ||
+ in_array("resourceGrant", $user["privileges"]) ||
+ in_array("nodeAdmin", $user["privileges"]) ||
+ in_array($user['id'], $docreaders)))
+ return;
+ $item = getContinuationVar("item", processInputVar('item', ARG_STRING));
+
+ switch($item) {
+ case "xmlrpcapi":
+ showXmlrpcapi();
+ return;
+ case "xmlrpcexample":
+ showXmlrpcExample();
+ return;
+ default:
+ if(! empty($item)) {
+ showDatabaseDoc($item);
+ return;
+ }
+ }
+
+ $query = "SELECT name, title FROM documentation ORDER BY title";
+ $qh = doQuery($query, 101);
+ $docs = array();
+ while($row = mysql_fetch_assoc($qh))
+ $docs[$row['name']] = $row['title'];
+
+ if($viewmode == ADMIN_DEVELOPER || in_array($user['id'], $doceditors)) {
+ $cdata = array('submode' => 'newpage');
+ $cont = addContinuationsEntry('editdoc', $cdata);
+ print "[ <a href=\"" . BASEURL . SCRIPT . "?continuation=$cont\">";
+ print "New page</a> ";
+ print "]<br>\n";
+ }
+ if(count($docs)) {
+ print "<h2>Main Documentation</h2>\n";
+ foreach($docs as $key => $val) {
+ print "<a href=\"" . BASEURL . SCRIPT . "?mode=viewdocs&item=$key\">";
+ print "$val</a><br>\n";
+ }
+ }
+ if(in_array($user['id'], $docreaders)) {
+ print "<h2>API Documentation</h2>\n";
+ print "<a href=\"" . BASEURL . SCRIPT . "?mode=viewdocs&item=xmlrpcapi\">";
+ print "XML RPC API</a><br>\n";
+ print "<a href=\"" . BASEURL . SCRIPT . "?mode=viewdocs&item=xmlrpcexample\">";
+ print "XML RPC API Example Code</a><br>\n";
+ }
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn showXmlrpcapi()
+///
+/// \brief prints XML RPC API docs
+///
+////////////////////////////////////////////////////////////////////////////////
+function showXmlrpcapi() {
+ $text = file_get_contents(".ht-inc/xmlrpcdocs/xmlrpcWrappers_8php.html");
+ $text = preg_replace('/xmlrpcWrappers_8php.html/', '', $text);
+ $replace = BASEURL . SCRIPT . "?mode=viewdocs&item=xmlrpcexample";
+ $text = preg_replace('/xmlrpc__example_8php-example.html/', $replace, $text);
+ $text = preg_replace('~^<\!DOCTYPE.*</head><body>~s', '', $text);
+ $text = preg_replace('~<h1>/afs.*</h1>~', '', $text);
+ $text = preg_replace('~</body>\n</html>$~', '', $text);
+ print $text;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn showXmlrpcExample()
+///
+/// \brief prints XML RPC API example
+///
+////////////////////////////////////////////////////////////////////////////////
+function showXmlrpcExample() {
+ $text = file_get_contents(".ht-inc/xmlrpcdocs/xmlrpc__example_8php-example.html");
+ $replace = BASEURL . SCRIPT . "?mode=viewdocs&item=xmlrpcapi";
+ $text = preg_replace('/xmlrpcWrappers_8php.html/', $replace, $text);
+ $text = preg_replace('~^<\!DOCTYPE.*</head><body>~s', '', $text);
+ $text = preg_replace('~<h1>xmlrpc_example\.php</h1>~', '', $text);
+ $text = preg_replace('~</body>\n</html>$~', '', $text);
+ print $text;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn showDatabaseDoc($item)
+///
+/// \param $item - name of a documentation item
+///
+/// \brief prints out documentation for $item
+///
+////////////////////////////////////////////////////////////////////////////////
+function showDatabaseDoc($item) {
+ global $viewmode, $user;
+ $query = "SELECT title, data FROM documentation WHERE name = '$item'";
+ $qh = doQuery($query, 101);
+ if(! ($row = mysql_fetch_assoc($qh))) {
+ print "<h2>Online Documentation</h2>\n";
+ print "Failed to retrieve documentation for \"$item\".<br>\n";
+ return;
+ }
+ if($viewmode == ADMIN_DEVELOPER || in_array($user['id'], $doceditors)) {
+ $cdata = array('item' => $item,
+ 'submode' => 'newpage');
+ $cont = addContinuationsEntry('editdoc', $cdata);
+ print "[ <a href=\"" . BASEURL . SCRIPT . "?continuation=$cont\">";
+ print "New page</a> ";
+ $cdata = array('item' => $item,
+ 'submode' => 'editpage');
+ $cont = addContinuationsEntry('editdoc', $cdata);
+ print "| <a href=\"" . BASEURL . SCRIPT . "?continuation=$cont\">";
+ print "Edit page</a> ";
+ $cdata = array('item' => $item);
+ $cont = addContinuationsEntry('confirmdeletedoc', $cdata);
+ print "| <a href=\"" . BASEURL . SCRIPT . "?continuation=$cont\">";
+ print "Delete page</a> ";
+ print "]<br>\n";
+ }
+ print "<div class=vcldocpage>\n";
+ print "<h2>{$row['title']}</h2>\n";
+ print $row['data'];
+ print "</div\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn editDoc()
+///
+/// \brief prints a page for editing a documentation item
+///
+////////////////////////////////////////////////////////////////////////////////
+function editDoc() {
+ global $viewmode, $user;
+ $item = getContinuationVar('item');
+ if($viewmode != ADMIN_DEVELOPER && ! in_array($user['id'], $doceditors)) {
+ showDatabaseDoc($item);
+ return;
+ }
+ $submode = getContinuationVar('submode');
+ if($submode == 'editfurther' || $submode == 'titleerror') {
+ $row['title'] = getContinuationVar('title');
+ $row['data'] = rawurldecode(getContinuationVar('data'));
+ $newedit = getContinuationVar('newedit');
+ }
+ elseif($submode == 'editpage') {
+ $query = "SELECT title, data FROM documentation WHERE name = '$item'";
+ $qh = doQuery($query, 101);
+ if(! ($row = mysql_fetch_assoc($qh))) {
+ print "<h2>Online Documentation</h2>\n";
+ print "Failed to retrieve documentation for \"$item\".<br>\n";
+ return;
+ }
+ $newedit = 'edit';
+ }
+ else {
+ $row['title'] = "";
+ $row['data'] = "";
+ $newedit = 'new';
+ }
+ print "<FORM action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ print "<INPUT type=submit value=\"Confirm Changes\"><br><br>\n";
+ print "<big>Title</big>:<INPUT type=text name=title value=\"{$row['title']}\">";
+ if($submode == 'titleerror') {
+ print "<font color=red>Title cannot be empty</font>";
+ }
+ print "<br>\n";
+ $edit = new FCKeditor('data');
+ $edit->BasePath = BASEURL . '/fckeditor/';
+ $edit->Value = $row['data'];
+ $edit->Height = '600';
+ $edit->ToolbarSet = 'VCLDocs';
+ $edit->Create();
+ $cdata = array('item' => $item,
+ 'newedit' => $newedit);
+ $cont = addContinuationsEntry('confirmeditdoc', $cdata);
+ print "<INPUT type=hidden name=continuation value=\"$cont\">\n";
+ print "<INPUT type=submit value=\"Confirm Changes\">\n";
+ print "</FORM>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn confirmEditDoc()
+///
+/// \brief prints a page asking the user to confirm the changes to the page;
+/// includes a link to go back and edit further
+///
+////////////////////////////////////////////////////////////////////////////////
+function confirmEditDoc() {
+ global $viewmode, $mysql_link_vcl, $contdata;
+ $item = getContinuationVar('item');
+ $newedit = getContinuationVar('newedit');
+ if($viewmode != ADMIN_DEVELOPER && ! in_array($user['id'], $doceditors)) {
+ showDatabaseDoc($item);
+ return;
+ }
+ $title = processInputVar('title', ARG_STRING);
+ if(get_magic_quotes_gpc()) {
+ $data = stripslashes($_POST['data']);
+ $submitdata = rawurlencode(mysql_real_escape_string($data, $mysql_link_vcl));
+ }
+ else {
+ $submitdata = rawurlencode(mysql_real_escape_string($_POST['data'], $mysql_link_vcl));
+ $data = $_POST['data'];
+ }
+ if(empty($title)) {
+ $contdata['title'] = "";
+ $contdata['data'] = rawurlencode($data);
+ $contdata['submode'] = 'titleerror';
+ editDoc();
+ return;
+ }
+ $cdata = array('item' => $item,
+ 'title' => $title,
+ 'data' => $submitdata,
+ 'newedit' => $newedit);
+ $cont = addContinuationsEntry('submiteditdoc', $cdata, SECINDAY, 0, 0);
+ print "[ <a href=\"" . BASEURL . SCRIPT . "?continuation=$cont\">";
+ print "Save Changes</a> ";
+ $cdata['data'] = rawurlencode($data);
+ $cdata['submode'] = 'editfurther';
+ $cont = addContinuationsEntry('editdoc', $cdata, SECINDAY, 0, 0);
+ print "| <a href=\"" . BASEURL . SCRIPT . "?continuation=$cont\">";
+ print "Edit Further</a> ]<br>\n";
+
+ print "<h2>$title</h2>\n";
+ print $data;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitEditDoc()
+///
+/// \brief saves submitted changes to a documentation item
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitEditDoc() {
+ global $viewmode, $mysql_link_vcl;
+ $item = getContinuationVar('item');
+ $newedit = getContinuationVar('newedit');
+ if($viewmode != ADMIN_DEVELOPER && ! in_array($user['id'], $doceditors)) {
+ showDatabaseDoc($item);
+ return;
+ }
+ $title = getContinuationVar('title');
+ $data = rawurldecode(getContinuationVar('data'));
+ $name = ereg_replace('[^-A-Za-z0-9_]', '', $title);
+ $query = "SELECT name FROM documentation WHERE name = '$name'";
+ $qh = doQuery($query, 101);
+ $count = 1;
+ $basename = $name;
+ while(mysql_num_rows($qh)) {
+ $name = $basename . $count;
+ $count++;
+ $query = "SELECT name FROM documentation WHERE name = '$name'";
+ $qh = doQuery($query, 101);
+ }
+ if($newedit == 'edit') {
+ $query = "SELECT name FROM documentation WHERE name = '$item'";
+ $qh = doQuery($query, 101);
+ if(! ($row = mysql_fetch_assoc($qh))) {
+ print "<h2>Online Documentation</h2>\n";
+ print "Failed to retrieve documentation for \"$item\".<br>\n";
+ return;
+ }
+ $query = "UPDATE documentation "
+ . "SET name = '$name', "
+ . "title = '$title', "
+ . "data = '$data' "
+ . "WHERE name = '$item'";
+ }
+ else {
+ $query = "INSERT INTO documentation "
+ . "(name, "
+ . "title, "
+ . "data) "
+ . "VALUES "
+ . "('$name', "
+ . "'$title', "
+ . "'$data')";
+ }
+ doQuery($query, 101);
+ if(mysql_affected_rows($mysql_link_vcl)) {
+ print "Page successfully updated.<br>\n";
+ }
+ else
+ print "No changes were made to the page.<br>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn confirmDeleteDoc()
+///
+/// \brief prints a confirmation page about deleting a documentation item
+///
+////////////////////////////////////////////////////////////////////////////////
+function confirmDeleteDoc() {
+ global $viewmode;
+ $item = getContinuationVar('item');
+ if($viewmode != ADMIN_DEVELOPER && ! in_array($user['id'], $doceditors)) {
+ showDatabaseDoc($item);
+ return;
+ }
+ $query = "SELECT title, data FROM documentation WHERE name = '$item'";
+ $qh = doQuery($query, 101);
+ if(! ($row = mysql_fetch_assoc($qh))) {
+ print "<h2>Online Documentation</h2>\n";
+ print "Failed to retrieve documentation for \"$item\".<br>\n";
+ return;
+ }
+ print "Are you sure you want to delete the following documentation ";
+ print "page?<br>\n";
+ print "<font color=red>Note: the document will be unrecoverable</font>";
+ print "<br>\n";
+ print "<table>\n";
+ print "<tr><td>\n";
+ print "<form action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cdata = array('item' => $item);
+ $cont = addContinuationsEntry('submitdeletedoc', $cdata, SECINDAY, 0, 0);
+ print "<input type=hidden name=continuation value=$cont>\n";
+ print "<input type=submit value=\"Delete Page\">\n";
+ print "</form>\n";
+ print "</td><td>\n";
+ print "<form action=\"" . BASEURL . SCRIPT . "\" method=post>\n";
+ $cont = addContinuationsEntry('viewdocs', $cdata);
+ print "<input type=hidden name=continuation value=$cont>\n";
+ print "<input type=submit value=\"View Page\">\n";
+ print "</form>\n";
+ print "</td></tr>\n";
+ print "</table>\n";
+ print "<h2>{$row['title']}</h2>\n";
+ print $row['data'];
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn submitDeleteDoc()
+///
+/// \brief deletes a documentation item
+///
+////////////////////////////////////////////////////////////////////////////////
+function submitDeleteDoc() {
+ global $viewmode;
+ $item = getContinuationVar('item');
+ if($viewmode != ADMIN_DEVELOPER && ! in_array($user['id'], $doceditors)) {
+ showDatabaseDoc($item);
+ return;
+ }
+ $query = "SELECT title FROM documentation WHERE name = '$item'";
+ $qh = doQuery($query, 101);
+ if(! ($row = mysql_fetch_assoc($qh))) {
+ print "<h2>Online Documentation</h2>\n";
+ print "Failed to retrieve documentation for \"$item\".<br>\n";
+ return;
+ }
+ $query = "DELETE FROM documentation WHERE name = '$item'";
+ doQuery($query, 101);
+ print "The page titled <strong>{$row['title']}</strong> has been deleted.";
+ print "<br>\n";
+}
+?>
diff --git a/web/.ht-inc/vcldphpcall.pl b/web/.ht-inc/vcldphpcall.pl
new file mode 100644
index 0000000..830ca10
--- /dev/null
+++ b/web/.ht-inc/vcldphpcall.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/perl
+
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+
+use LWP::Simple;
+use lib '/tmp/WDDX-1.02/blib/lib';
+use WDDX;
+
+my $function = "getUserResources";
+my $arg1 = "imageAdmin:imageCheckOut";
+my $arg2 = "available:";
+my $arg3 = 0;
+my $arg4 = 0;
+my $arg5 = 21;
+
+my $doc = get("http://webtest.people.engr.ncsu.edu/jfthomps/vcl/index.php?mode=vcldquery&key=1234&query=$function,$arg1,$arg2,$arg3,$arg4,$arg5");
+
+$doc_id = new WDDX;
+$wddx_obj = $doc_id->deserialize($doc);
+$value = $wddx_obj->as_hashref();
+
+@keys = $wddx_obj->keys();
+
+foreach my $key (keys %{ $value->{"data"} }) {
+ print "---------------------------------------------\n";
+ print "$key\n";
+ foreach my $key2 (keys %{ $value->{"data"}->{$key} }) {
+ print "\t$key2 => " . $value->{"data"}->{$key}->{$key2} . "\n";
+ }
+}
diff --git a/web/.ht-inc/vm.php b/web/.ht-inc/vm.php
new file mode 100644
index 0000000..f5040df
--- /dev/null
+++ b/web/.ht-inc/vm.php
@@ -0,0 +1,841 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+/**
+ * \file vm.php
+ */
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn editVMInfo()
+///
+/// \brief prints a page for editing VM Hosts and VM Host Profiles
+///
+////////////////////////////////////////////////////////////////////////////////
+function editVMInfo() {
+ global $viewmode;
+ print "<h2>Manage Virtual Hosts</h2>\n";
+
+ $profiles = getVMProfiles();
+ if($viewmode == ADMIN_DEVELOPER) {
+ print "<div id=\"mainTabContainer\" dojoType=\"dijit.layout.TabContainer\"\n";
+ print " style=\"width:650px;height:600px\">\n";
+
+ print "<div id=\"vmhosts\" dojoType=\"dijit.layout.ContentPane\" title=\"VM Hosts\">\n";
+ }
+
+ print "<div dojoType=\"dijit.Dialog\"\n";
+ print " id=\"messages\">\n";
+ print "<span id=messagestext></span>";
+ print "<button id=\"messagesokbtn\"></button>\n";
+ print "<button onclick=\"dijit.byId('messages').hide()\">Cancel</button>\n";
+ print "</div>\n";
+
+ $newmsg = "To create a new Virtual Host, change the state of a computer to<br>\n"
+ . "'vmhostinuse' under Manage Computers->Computer Utilities.<br><br>\n";
+ $vmhosts = getVMHostData();
+ $resources = getUserResources(array("computerAdmin"), array("administer"));
+ foreach($vmhosts as $key => $value) {
+ if(! array_key_exists($value['computerid'], $resources['computer']))
+ unset($vmhosts[$key]);
+ }
+ if(empty($vmhosts)) {
+ print "You do not have access to manage any existing virtual hosts.<br><br>\n";
+ print $newmsg;
+ return;
+ }
+ print $newmsg;
+ print "Select a Virtual Host:<br>\n";
+ printSelectInput("vmhostid", $vmhosts, -1, 0, 0, 'vmhostid');
+ $cont = addContinuationsEntry('vmhostdata');
+ print "<button dojoType=\"dijit.form.Button\" id=\"fetchCompGrpsButton\">\n";
+ print " Configure Host\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ print " getVMHostData('$cont');\n";
+ print " </script>\n";
+ print "</button><br><br>\n";
+ print "<div id=vmhostdata class=hidden>\n";
+ print "<table summary=\"\">\n";
+ print " <tr>\n";
+ print " <th align=right>VM limit:</th>\n";
+ print " <td>\n";
+ $cont = addContinuationsEntry('updateVMlimit');
+ print " <input dojoType=\"dijit.form.NumberSpinner\"\n";
+ print " constraints=\"{min:1,max:" . MAXVMLIMIT . "}\"\n";
+ print " maxlength=\"3\"\n";
+ print " id=\"vmlimit\"\n";
+ print " onChange=\"updateVMlimit('$cont')\">\n";
+ print " </td>\n";
+ print " </tr>\n";
+ #$cont = addContinuationsEntry('changeVMprofile');
+ print " <tr>\n";
+ print " <th align=right>VM Profile:</th>\n";
+ print " <td>\n";
+ #printSelectInput("vmprofileid", $profiles, -1, 0, 0, 'vmprofileid', "onchange=changeVMprofile('$cont')");
+ print " <div dojoType=\"dijit.TitlePane\" id=vmprofile></div>\n";
+ print " </td>\n";
+ print " </tr>\n";
+ /*if(! empty($data['vmkernalnic'])) {
+ print " <tr>\n";
+ print " <th align=right>VM Kernal NIC:</th>\n";
+ print " <td>{$data['vmkernalnic']}</td>\n";
+ print " </tr>\n";
+ }*/
+ print "</table><br><br>\n";
+
+ print "<div id=movevms class=hidden>\n";
+ print "The followig VM(s) will removed from this host at the listed ";
+ print "time(s):<br>\n";
+ print "<select name=movevmssel multiple id=movevmssel size=3>\n";
+ print "</select><br>\n";
+ print "<button dojoType=\"dijit.form.Button\" id=\"cancelBtn\">\n";
+ print " <div>Cancel Removing of Selected VMs</div>\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ $cont = addContinuationsEntry('AJcancelVMmove');
+ print " cancelVMmove('$cont');\n";
+ print " </script>\n";
+ print "</button>\n";
+ print "<br><br></div>\n";
+
+ print "<table summary=\"\"><tbody><tr>\n";
+
+ # select for vms on host
+ print "<td valign=top>\n";
+ print "VMs assigned to host:<br>\n";
+ print "<select name=currvms multiple id=currvms size=15 onChange=showVMstate()>\n";
+ print "</select><br>\n";
+ print "State of selected vm:<br>\n";
+ print "<span id=vmstate></span>\n";
+ print "</td>\n";
+ # transfer buttons
+ print "<td style=\"vertical-align: middle;\">\n";
+ print "<button dojoType=\"dijit.form.Button\" id=\"addBtn1\">\n";
+ print " <div style=\"width: 50px;\"><-Add</div>\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ $cont = addContinuationsEntry('AJvmToHost');
+ print " vmToHost('$cont');\n";
+ print " </script>\n";
+ print "</button>\n";
+ print "<br>\n";
+ print "<br>\n";
+ print "<br>\n";
+ print "<button dojoType=\"dijit.form.Button\" id=\"remBtn1\">\n";
+ print " <div style=\"width: 50px;\">Remove</div>\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ $cont = addContinuationsEntry('AJvmFromHost');
+ print " vmFromHost('$cont');\n";
+ print " </script>\n";
+ print "</button>\n";
+ print "</td>\n";
+ # select for unassigned vms
+ print "<td valign=top>\n";
+ print "Unassigned VMs:<br>\n";
+ print "<select name=freevms multiple id=freevms size=20>\n";
+ print "</select>\n";
+ print "</td>\n";
+ print "</tr><tbody/></table>\n";
+ print "</div><br><br>\n";
+
+ /*print "<div dojoType=\"dijit.Dialog\"\n";
+ print " id=\"profileDlg\"\n";
+ print " title=\"Change Profile\">\n";
+ print "You have selected to change the VM Profile for this host.<br>\n";
+ print "Doing this will attempt to move any future reservations on the<br>\n";
+ print "host's VMs to other VMs and will submit a reload reservation for this<br>\n";
+ print "host after any active reservations on its VMs.<br><br>\n";
+ print "Are you sure you want to do this?<br><br>\n";
+ print "<button onclick=\"submitChangeProfile()\">Update VM Profile</button>\n";
+ print "<button onclick=\"dijit.byId('profileDlg').hide()\">Cancel</button>\n";
+ print "<input type=hidden id=changevmcont>\n";
+ print "</div>\n";*/
+ print "</div>\n";
+
+ if($viewmode != ADMIN_DEVELOPER)
+ return;
+ print "<div id=\"vmprofiles\" dojoType=\"dijit.layout.ContentPane\" title=\"VM Host Profiles\">\n";
+ print "<br>Select a profile to configure:<br>\n";
+ printSelectInput("profileid", $profiles, -1, 0, 0, 'profileid');
+ $cont = addContinuationsEntry('AJprofiledata');
+ print "<button dojoType=\"dijit.form.Button\" id=\"fetchProfilesBtn\">\n";
+ print " Configure Profile\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ print " getVMprofileData('$cont');\n";
+ print " </script>\n";
+ print "</button>";
+ $cont = addContinuationsEntry('AJnewProfile');
+ print "<button dojoType=\"dijit.form.Button\" id=\"newProfilesBtn\">\n";
+ print " New Profile...\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ print " newProfile('$cont');\n";
+ print " </script>\n";
+ print "</button>";
+ print "<br><br>\n";
+
+ print "<div id=vmprofiledata class=hidden>\n";
+ $cont = addContinuationsEntry('AJdelProfile');
+ print "<button dojoType=\"dijit.form.Button\" id=\"delProfilesBtn\">\n";
+ print " Delete this Profile\n";
+ print " <script type=\"dojo/method\" event=onClick>\n";
+ print " delProfile('$cont');\n";
+ print " </script>\n";
+ print "</button><br><br>";
+ $cont = addContinuationsEntry('AJupdateVMprofileItem');
+ print "(Click a value to edit it)<br>\n";
+ print "<input type=hidden id=pcont value=\"$cont\">\n";
+ print "<table summary=\"\">\n";
+ print " <tr>\n";
+ print " <th align=right>Name:</th>\n";
+ print " <td><span id=pname dojoType=\"dijit.InlineEditBox\" onChange=\"updateProfile('pname', 'name');\"></span></td>\n";
+ print " </tr>\n";
+ print " <tr>\n";
+ print " <th align=right>Type:</th>\n";
+ print " <td><select id=ptype dojoType=\"dijit.form.FilteringSelect\" searchAttr=\"name\" onchange=\"updateProfile('ptype', 'vmtypeid');\"></span></td>\n";
+ print " </tr>\n";
+ print " <tr>\n";
+ print " <th align=right>Image:</th>\n";
+ print " <td><span id=pimage dojoType=\"dijit.form.FilteringSelect\" searchAttr=\"name\" onchange=\"updateProfile('pimage', 'imageid');\" style=\"width: 420px\"></span></td>\n";
+ print " </tr>\n";
+ print " <tr>\n";
+ print " <th align=right>NAS Share:</th>\n";
+ print " <td><span id=pnasshare dojoType=\"dijit.InlineEditBox\" onChange=\"updateProfile('pnasshare', 'nasshare');\"></span></td>\n";
+ print " </tr>\n";
+ print " <tr>\n";
+ print " <th align=right>Data Store Path:</th>\n";
+ print " <td><span id=pdspath dojoType=\"dijit.InlineEditBox\" onChange=\"updateProfile('pdspath', 'datastorepath');\"></span></td>\n";
+ print " </tr>\n";
+ print " <tr>\n";
+ print " <th align=right>VM Path:</th>\n";
+ print " <td><span id=pvmpath dojoType=\"dijit.InlineEditBox\" onChange=\"updateProfile('pvmpath', 'vmpath');\"></span></td>\n";
+ print " </tr>\n";
+ print " <tr>\n";
+ print " <th align=right>Virtual Switch 0:</th>\n";
+ print " <td><span id=pvs0 dojoType=\"dijit.InlineEditBox\" onChange=\"updateProfile('pvs0', 'virtualswitch0');\"></span></td>\n";
+ print " </tr>\n";
+ print " <tr>\n";
+ print " <th align=right>Virtual Switch 1:</th>\n";
+ print " <td><span id=pvs1 dojoType=\"dijit.InlineEditBox\" onChange=\"updateProfile('pvs1', 'virtualswitch1');\"></span></td>\n";
+ print " </tr>\n";
+ print " <tr>\n";
+ print " <th align=right>VM Disk:</th>\n";
+ print " <td><select id=pvmdisk dojoType=\"dijit.form.FilteringSelect\" searchAttr=\"name\" onchange=\"updateProfile('pvmdisk', 'vmdisk');\"></span></td>\n";
+ print " </tr>\n";
+ print "</table>\n";
+ print "</div>\n";
+ print "</div>\n";
+
+ print "</div>\n";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn vmhostdata()
+///
+/// \brief prints json formatted data with information about the submitted VM
+/// host
+///
+////////////////////////////////////////////////////////////////////////////////
+function vmhostdata() {
+ $vmhostid = processInputVar('vmhostid', ARG_NUMERIC);
+ $ret = '';
+ $data = getVMHostData($vmhostid);
+
+ $resources = getUserResources(array("computerAdmin"), array("administer"));
+ if(! array_key_exists($data[$vmhostid]['computerid'], $resources['computer'])) {
+ $arr = array('failed' => 'noaccess');
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+
+ # get vms assigned to vmhost
+ $query = "SELECT c.id, "
+ . "c.hostname, "
+ . "s.name AS state, "
+ . "c.vmhostid "
+ . "FROM computer c, "
+ . "state s "
+ . "WHERE c.type = 'virtualmachine' AND "
+ . "c.stateid = s.id AND "
+ . "(vmhostid IS NULL OR "
+ . "vmhostid NOT IN (SELECT id FROM vmhost) OR "
+ . "c.vmhostid = $vmhostid) "
+ . "ORDER BY c.hostname";
+ $qh = doQuery($query, 101);
+ $ids = array();
+ $allvms = array();
+ $currvms = array();
+ $freevms = array();
+ while($row = mysql_fetch_assoc($qh)) {
+ if($row['vmhostid'] == $vmhostid) {
+ $ids[$row['id']] = $row['hostname'];
+ $currvms[$row['id']] = array('id' => $row['id'],
+ 'name' => $row['hostname'],
+ 'state' => $row['state']);
+ $allvms[] = array('id' => $row['id'],
+ 'name' => $row['hostname'],
+ 'inout' => 1);
+ }
+ else {
+ $freevms[] = array('id' => $row['id'],
+ 'name' => $row['hostname']);
+ $allvms[] = array('id' => $row['id'],
+ 'name' => $row['hostname'],
+ 'inout' => 0);
+ }
+ }
+ uasort($allvms, "sortKeepIndex");
+ uasort($currvms, "sortKeepIndex");
+ uasort($freevms, "sortKeepIndex");
+
+ $keys = array_keys($ids);
+ $movevms = array();
+ if(! empty($keys)) {
+ $keys = join(',', $keys);
+ $query = "SELECT rq.id, "
+ . "DATE_FORMAT(rq.start, '%l:%i%p %c/%e/%y') AS start, "
+ . "rs.computerid "
+ . "FROM request rq, "
+ . "reservation rs "
+ . "WHERE rs.requestid = rq.id AND "
+ . "rs.computerid IN ($keys) AND "
+ . "(rq.stateid = 18 OR "
+ . "rq.laststateid = 18) AND "
+ . "rq.start > NOW()";
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_assoc($qh)) {
+ $movevms[] = array('id' => $row['id'],
+ 'time' => strtolower($row['start']),
+ 'hostname' => $currvms[$row['computerid']]['name']);
+ unset($currvms[$row['computerid']]);
+ }
+ uasort($movevms, "sortKeepIndex");
+ $movevms = array_merge($movevms);
+ }
+
+ $allvms = array_merge($allvms);
+ $currvms = array_merge($currvms);
+ $freevms = array_merge($freevms);
+ $cont = addContinuationsEntry('AJchangeVMprofile', array(), 3600, 1, 0);
+ $arr = array('vmlimit' => $data[$vmhostid]['vmlimit'],
+ 'profile' => $data[$vmhostid]['vmprofiledata'],
+ 'continuation' => $cont,
+ 'allvms' => $allvms,
+ 'currvms' => $currvms,
+ 'freevms' => $freevms,
+ 'movevms' => $movevms);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getVMHostData($id)
+///
+/// \param $id - (optional) a host id about which to get data
+///
+/// \return an array where each key is a vmhost id and each element is an array
+/// with these values:\n
+/// \b computerid - id of computer\n
+/// \b name - hostname of computer\n
+/// \b hostname - hostname of computer\n
+/// \b vmlimit - maximum number of vm's host can handle\n
+/// \b vmprofileid - id of vm profile\n
+/// \b vmkernalnic - name of kernel nic\n
+/// \b vmprofiledata - array of data about the vm's profile as returned from
+/// getVMProfiles
+///
+/// \brief builds a array of information about the vmhosts
+///
+////////////////////////////////////////////////////////////////////////////////
+function getVMHostData($id='') {
+ $profiles = getVMProfiles();
+ $query = "SELECT vh.id, "
+ . "vh.computerid, "
+ . "c.hostname AS name, "
+ . "c.hostname, "
+ . "vh.vmlimit, "
+ . "vh.vmprofileid, "
+ #. "vp.profilename, "
+ . "vh.vmkernalnic "
+ . "FROM vmhost vh, "
+ . "vmprofile vp, "
+ . "computer c "
+ . "WHERE vh.vmprofileid = vp.id AND "
+ . "vh.computerid = c.id";
+ if(! empty($id))
+ $query .= " AND vh.id = $id";
+ $qh = doQuery($query, 101);
+ $ret = array();
+ while($row = mysql_fetch_assoc($qh)) {
+ $ret[$row['id']] = $row;
+ $ret[$row['id']]['vmprofiledata'] = $profiles[$row['vmprofileid']];
+ }
+ uasort($ret, 'sortKeepIndex');
+ return $ret;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn updateVMlimit()
+///
+/// \brief updates the vmlimit for the submitted vmhostid
+///
+////////////////////////////////////////////////////////////////////////////////
+function updateVMlimit() {
+ global $mysql_link_vcl;
+ $vmhostid = processInputVar('vmhostid', ARG_NUMERIC);
+
+ $data = getVMHostData($vmhostid);
+ $resources = getUserResources(array("computerAdmin"), array("administer"));
+ if(! array_key_exists($data[$vmhostid]['computerid'], $resources['computer'])) {
+ print 'You do not have access to manage this host.';
+ return;
+ }
+
+ $newlimit = processInputVar('newlimit', ARG_NUMERIC);
+ if($newlimit < 0 || $newlimit > MAXVMLIMIT) {
+ print "ERROR: newlimit out of range";
+ return;
+ }
+ $query = "UPDATE vmhost SET vmlimit = $newlimit WHERE id = $vmhostid";
+ $qh = doQuery($query, 101);
+ if(mysql_affected_rows($mysql_link_vcl))
+ print "SUCCESS";
+ else
+ print "ERROR: failed to update vmlimit";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJvmToHost()
+///
+/// \brief adds vm's to a vmhost; prints json data with:\n
+/// \b vms - array of vm's successfully added\n
+/// \b fails - array of vm's that couldn't be added for some reason\n
+/// \b addrem - 1
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJvmToHost() {
+ $hostid = processInputVar('hostid', ARG_NUMERIC);
+
+ $hostdata = getVMHostData($hostid);
+ $resources = getUserResources(array("computerAdmin"), array("administer"));
+ if(! array_key_exists($hostdata[$hostid]['computerid'], $resources['computer'])) {
+ $arr = array('failed' => 'nohostaccess');
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+
+ # find out how many vms are currently on the host
+ $query = "SELECT COUNT(id) "
+ . "FROM computer "
+ . "WHERE vmhostid = $hostid";
+ $qh = doQuery($query, 101);
+ $row = mysql_fetch_row($qh);
+ if($row[0] >= $hostdata[$hostid]['vmlimit']) {
+ $arr = array('failed' => 'vmlimit');
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+
+ $adds = array();
+ $fails = array();
+
+ $vmlistids = processInputVar('listids', ARG_STRING);
+ $vmids = explode(',', $vmlistids);
+
+ # get data about submitted vms to add
+ $query = "SELECT id, hostname, vmhostid "
+ . "FROM computer "
+ . "WHERE id in ($vmlistids)";
+ $qh = doQuery($query, 101);
+ $vmdata = array();
+ while($row = mysql_fetch_assoc($qh)) {
+ if(! array_key_exists($row['id'], $resources['computer'])) {
+ $fails[] = array('id' => $row['id'], 'name' => $row['hostname'], 'reason' => 'noaccess');
+ unset_by_val($row['id'], $vmids);
+ continue;
+ }
+ $vmdata[$row['id']] = $row;
+ }
+
+ # build list of vm hosts
+ $query = "SELECT id FROM vmhost";
+ $vmhosts = array();
+ $qh = doQuery($query, 101);
+ while($row = mysql_fetch_assoc($qh))
+ $vmhosts[$row['id']] = 1;
+
+ # check to see if there any submitted vms have a hostid of an existing vm host
+ foreach($vmids as $compid) {
+ if(! array_key_exists($vmdata[$compid]['vmhostid'], $vmhosts)) {
+ $query = "UPDATE computer "
+ . "SET vmhostid = $hostid, "
+ . "stateid = 2 "
+ . "WHERE id = $compid";
+ doQuery($query, 101);
+ $adds[] = array('id' => $compid, 'name' => $vmdata[$compid]['hostname'], 'state' => 'available');
+ }
+ else
+ $fails[] = array('id' => $compid, 'name' => $vmdata[$compid]['hostname'], 'reason' => 'otherhost');
+ }
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ $arr = array('vms' => $adds, 'fails' => $fails, 'addrem' => 1);
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJvmFromHost()
+///
+/// \brief removes vm's from a host by adding reservations for them in the
+/// tomaintenance state; prints json data with:\n
+/// \b vms - vm's that successfully had reservastions created to move them off\n
+/// \b checks - vm's that have reservations on them that can be removed in the
+/// future by adding a future tomaintenance reservation\n
+/// \b addrem - 0\n
+/// \b cont - a new continuation for submitting the future tomaintenance
+/// reservations
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJvmFromHost() {
+ $hostid = processInputVar('hostid', ARG_NUMERIC);
+
+ $hostdata = getVMHostData($hostid);
+ $resources = getUserResources(array("computerAdmin"), array("administer"));
+ if(! array_key_exists($hostdata[$hostid]['computerid'], $resources['computer'])) {
+ $arr = array('failed' => 'nohostaccess');
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+
+ $fails = array();
+ $vmlistids = processInputVar('listids', ARG_STRING);
+ $vmids = explode(',', $vmlistids);
+ $rems = array();
+ $checks = array();
+ $vclreloadid = getUserlistID('vclreload');
+ $start = getReloadStartTime();
+ $end = $start + SECINMONTH;
+ $start = unixToDatetime($start);
+ $end = unixToDatetime($end);
+ foreach($vmids as $compid) {
+ $compdata = getComputers(0, 0, $compid);
+ if(! array_key_exists($compid, $resources['computer'])) {
+ $fails[] = array('id' => $compid,
+ 'name' => $compdata[$compid]['hostname'],
+ 'reason' => 'noaccess');
+ continue;
+ }
+ # try to remove reservations off of computer
+ if(($compdata[$compid]['state'] == 'available' ||
+ $compdata[$compid]['state'] == 'maintenance' ||
+ $compdata[$compid]['state'] == 'failed') &&
+ moveReservationsOffComputer($compid)) {
+ // if no reservations on computer, submit reload
+ # reservation so vm gets stopped on host
+ $reqid = simpleAddRequest($compid, 4, 3, $start, $end, 18, $vclreloadid);
+ $rems[] = array('id' => $compid,
+ 'hostname' => $compdata[$compid]['hostname'],
+ 'reqid' => $reqid,
+ 'time' => 'immediately');
+ }
+ else {
+ # existing reservation on computer, find end time and prompt user
+ # if ok to wait until then to move it
+ $query = "SELECT DATE_FORMAT(rq.end, '%l:%i%p %c/%e/%y') AS end, "
+ . "rq.end AS end2 "
+ . "FROM request rq, "
+ . "reservation rs "
+ . "WHERE rs.requestid = rq.id AND "
+ . "rs.computerid = $compid AND "
+ . "rq.stateid NOT IN (1,5,12) "
+ . "ORDER BY end DESC "
+ . "LIMIT 1";
+ $qh = doQuery($query, 101);
+ if($row = mysql_fetch_assoc($qh)) {
+ $checks[] = array('id' => $compid,
+ 'hostname' => $compdata[$compid]['hostname'],
+ 'end' => strtolower($row['end']),
+ 'end2' => $row['end2']);
+ }
+ else
+ $rems[] = array('id' => $compid);
+ }
+ }
+ if(count($checks))
+ $cont = addContinuationsEntry('AJvmFromHostDelayed', $checks, 120, 1, 0);
+ else
+ $cont = '';
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ $arr = array('vms' => $rems,
+ 'checks' => $checks,
+ 'fails' => $fails,
+ 'addrem' => 0,
+ 'cont' => $cont);
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJvmFromHostDelayed()
+///
+/// \brief submits future tomaintenance reservations for vm's saved in the
+/// continuation
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJvmFromHostDelayed() {
+ $data = getContinuationVar();
+ $vclreloadid = getUserlistID('vclreload');
+ foreach($data as $comp) {
+ $end = datetimeToUnix($comp['end2']) + SECINMONTH;
+ $end = unixToDatetime($end);
+ simpleAddRequest($comp['id'], 4, 3, $comp['end2'], $end, 18, $vclreloadid);
+ }
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ $cont = addContinuationsEntry('vmhostdata');
+ $arr = array('msg' => 'SUCCESS', 'cont' => $cont);
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJchangeVMprofile()
+///
+/// \brief stub function for changing the vm profile of a vm host
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJchangeVMprofile() {
+ $hostid = processInputVar('hostid', ARG_NUMERIC);
+ $oldprofileid = processInputVar('oldprofileid', ARG_NUMERIC);
+ $newprofileid = processInputVar('newprofileid', ARG_NUMERIC);
+ # add security checks
+ # try to remove reservations off of each vm
+ // if no reservations on any vms, create reload reservation
+ # else try to create reservation to handle in future
+ # else return error message
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ $cont = addContinuationsEntry('AJchangeVMprofile', array(), 3600, 1, 0);
+ $arr = array('msg' => 'function not implemented', 'continuation' => $cont);
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJcancelVMmove()
+///
+/// \brief cancels tomaintenance reservations that had been submitted to move
+/// a vm off of a vmhost
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJcancelVMmove() {
+ $hostid = processInputVar('hostid', ARG_NUMERIC);
+
+ $hostdata = getVMHostData($hostid);
+ $resources = getUserResources(array("computerAdmin"), array("administer"));
+ if(! array_key_exists($hostdata[$hostid]['computerid'], $resources['computer'])) {
+ $arr = array('failed' => 'nohostaccess');
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+
+ $fails = array();
+ $requestids = processInputVar('listids', ARG_STRING);
+ $now = time();
+ $msg = 'FAIL';
+ foreach(explode(',', $requestids) AS $reqid) {
+ $request = getRequestInfo($reqid);
+ if(! array_key_exists($request['reservations'][0]['computerid'], $resources['computer'])) {
+ $fails[] = array('id' => $request['reservations'][0]['computerid'],
+ 'name' => $request['reservations'][0]['hostname'],
+ 'reason' => 'noaccess');
+ continue;
+ }
+ if(datetimeToUnix($request["start"]) < $now) {
+ # set stateid and laststateid for each request to deleted
+ $query = "UPDATE request "
+ . "SET stateid = 1, "
+ . "laststateid = 1 "
+ . "WHERE id = $reqid";
+ doQuery($query, 101);
+ }
+ else {
+ $query = "DELETE FROM request WHERE id = $reqid";
+ doQuery($query, 101);
+ $query = "DELETE FROM reservation WHERE requestid = $reqid";
+ doQuery($query, 101);
+ }
+ $msg = 'SUCCESS';
+ }
+
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ $cont = addContinuationsEntry('vmhostdata');
+ $arr = array('msg' => $msg, 'cont' => $cont, 'fails' => $fails);
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJprofiledata()
+///
+/// \param $profileid - (optional) id of a vm profile
+///
+/// \brief prints json data about a submitted or passed in vm profile with these
+/// fields:\n
+/// \b profile - array returned from getVMProfiles\n
+/// \b types - array of vm types\n
+/// \b vmdisk - array of vm disk options\n
+/// \b images - array of images
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJprofileData($profileid="") {
+ global $viewmode;
+ if($viewmode != ADMIN_DEVELOPER) {
+ $arr = array('failed' => 'noaccess');
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+ $profileid = processInputVar('profileid', ARG_NUMERIC, $profileid);
+ $profiledata = getVMProfiles($profileid);
+ foreach($profiledata[$profileid] AS $key => $value) {
+ if(is_null($value))
+ $profiledata[$profileid][$key] = '';
+ }
+ $types = getVMtypes();
+ $allimages = getImages();
+ $images = array();
+ foreach($allimages as $key => $image)
+ $images[] = array('id' => $key, 'name' => $image['prettyname']);
+ $imagedata = array('identifier' => 'id', 'items' => $images);
+
+ $types2 = array();
+ foreach($types as $id => $val) {
+ $types2[] = array('id' => $id, 'name' => $val);
+ }
+ $typedata = array('identifier' => 'id', 'items' => $types2);
+
+ $vmdiskitems = array();
+ $vmdiskitems[] = array('id' => 'localdisk', 'name' => 'localdisk');
+ $vmdiskitems[] = array('id' => 'networkdisk', 'name' => 'networkdisk');
+ $vmdisk = array('identifier' => 'id', 'items' => $vmdiskitems);
+
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ $arr = array('profile' => $profiledata[$profileid],
+ 'types' => $typedata,
+ 'vmdisk' => $vmdisk,
+ 'images' => $imagedata);
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJupdateVMprofileItem()
+///
+/// \brief updates the submitted item for the submitted vm profile and prints
+/// javascript to keep the global curprofile object updated
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJupdateVMprofileItem() {
+ global $viewmode;
+ if($viewmode != ADMIN_DEVELOPER) {
+ print "alert('You do not have access to manage this vm profile.');";
+ return;
+ }
+ $profileid = processInputVar('profileid', ARG_NUMERIC);
+ $item = processInputVar('item', ARG_STRING);
+ $newvalue = processInputVar('newvalue', ARG_STRING);
+ if($newvalue == '')
+ $newvalue2 = 'NULL';
+ else {
+ if(get_magic_quotes_gpc()) {
+ $newvalue2 = stripslashes($newvalue);
+ $newvalue2 = mysql_escape_string($newvalue2);
+ }
+ $newvalue2 = "'$newvalue2'";
+ }
+
+ $profile = getVMProfiles($profileid);
+ if($profile[$profileid][$item] == $newvalue)
+ return;
+ $query = "UPDATE vmprofile "
+ . "SET `$item` = $newvalue2 "
+ . "WHERE id = $profileid";
+ doQuery($query, 101);
+ print "curprofile.$item = '$newvalue';";
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJnewProfile()
+///
+/// \brief creates a new vmprofile entry using just the submitted new name and
+/// the defaults for the rest of the fields; calls AJprofileData
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJnewProfile() {
+ $newprofile = processInputVar('newname', ARG_STRING);
+ if(get_magic_quotes_gpc()) {
+ $newprofile = stripslashes($newprofile);
+ $newprofile = mysql_escape_string($newprofile);
+ }
+ # TODO add check for existing name
+ $query = "SELECT id FROM vmprofile WHERE profilename = '$newprofile'";
+ $qh = doQuery($query, 101);
+ if($row = mysql_fetch_assoc($qh)) {
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ $arr = array('failed' => 'exists');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+ $query = "INSERT INTO vmprofile (profilename) VALUES ('$newprofile')";
+ doQuery($query, 101);
+ $qh = doQuery("SELECT LAST_INSERT_ID() FROM vmprofile", 101);
+ $row = mysql_fetch_row($qh);
+ $newid = $row[0];
+ AJprofileData($newid);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn AJdelProfile()
+///
+/// \brief deletes the submitted vm profile
+///
+////////////////////////////////////////////////////////////////////////////////
+function AJdelProfile() {
+ global $viewmode;
+ if($viewmode != ADMIN_DEVELOPER) {
+ $arr = array('failed' => 'noaccess');
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+ return;
+ }
+ $profileid = processInputVar('profileid', ARG_NUMERIC);
+ $query = "DELETE FROM vmprofile WHERE id = $profileid";
+ doQuery($query, 101);
+ header('Content-Type: text/json-comment-filtered; charset=utf-8');
+ $arr = array('SUCCESS');
+ print '/*{"items":' . json_encode($arr) . '}*/';
+}
+
+?>
diff --git a/web/.ht-inc/xmlrpcWrappers.php b/web/.ht-inc/xmlrpcWrappers.php
new file mode 100644
index 0000000..72ce2f3
--- /dev/null
+++ b/web/.ht-inc/xmlrpcWrappers.php
@@ -0,0 +1,470 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+/**
+ * \file
+ * The functions listed here are for making VCL requests from other applications.
+ * They are implemented according to the XML RPC spec defined at
+ * http://www.xmlrpc.com/ \n
+ * There is one function called \b XMLRPCtest() that can be used during
+ * initial development to get started without actually making a request.\n
+ * \n
+ * The URL you will use to submit RPC calls is\n\n
+ * https://vcl.ncsu.edu/scheduling/index.php?mode=xmlrpccall\n\n
+ * Your application must connect using HTTPS.\n\n
+ * Internal to the VCL code, "Reservations" are called "Requests"; therefore,
+ * "request" is used instead of "reservation" in this documentation and in the
+ * RPC functions.
+ * \n
+ * <h2>API Version 2</h2>
+ * This is the current version of the API. It should be used for any new code
+ * development. Any older code needs to be migrated to this version.\n\n
+ * Authentication is handled by 2 additional HTTP headers you will need to
+ * send:\n
+ * \b X-User - the userid you would use to log in to the VCL site, followed
+ * by the at sign (@), followed by your affiliation\n
+ * example: myuserid\@NCSU -
+ * currently, you need to contact vcl_help@ncsu.edu to find out your
+ * affiliation, but in the future there will be an API method of obtaining
+ * this\n
+ * \b X-Pass - the password you would use to log in to the VCL site\n
+ * \n
+ * There is one other additional HTTP header you must send:\n
+ * \b X-APIVERSION - set this to 2\n\n
+ *
+ * <h2>API Version 1</h2>
+ * This version is being phased out in favor of version 2. Documentation is
+ * provided for those currently using version 1 who are not ready to switch
+ * to using version 2.\n\n
+ * To connect to VCL with XML RPC, you will need to obtain a key. Contact
+ * vcl_help@ncsu.edu to get one.\n
+ *
+ * Authentication is handled by 2 additional HTTP headers you will need to
+ * send:\n
+ * \b X-User - use the same id you would use to log in to the VCL site\n
+ * \b X-Pass - the key mentioned above\n
+ * \n
+ * There is one other additional HTTP header you must send:\n
+ * \b X-APIVERSION - set this to 1\n
+ */
+
+/// \example xmlrpc_example.php
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn XMLRPCaffiliations()
+///
+/// \return an array of affiliation arrays, each with 2 indices:\n
+/// \b id - id of the affiliation\n
+/// \b name - name of the affiliation
+///
+/// \brief gets all of the affilations for which users can log in to VCL
+///
+////////////////////////////////////////////////////////////////////////////////
+function XMLRPCaffiliations() {
+ $affils = getAffiliations();
+ $return = array();
+ foreach($affils as $key => $val) {
+ $tmp = array('id' => $key, 'name' => $val);
+ array_push($return, $tmp);
+ }
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn XMLRPCgetImages()
+///
+/// \return an array of image arrays, each with 2 indices:\n
+/// \b id - id of the image\n
+/// \b name - name of the image
+///
+/// \brief gets the images to which the user has acces
+///
+////////////////////////////////////////////////////////////////////////////////
+function XMLRPCgetImages() {
+ $resources = getUserResources(array("imageAdmin", "imageCheckOut"));
+ $resources["image"] = removeNoCheckout($resources["image"]);
+ $return = array();
+ foreach($resources['image'] as $key => $val) {
+ $tmp = array('id' => $key, 'name' => $val);
+ array_push($return, $tmp);
+ }
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn XMLRPCaddRequest($imageid, $start, $length, $foruser)
+///
+/// \param $imageid - id of an image
+/// \param $start - "now" or unix timestamp for start of reservation; will
+/// use a floor function to round down to the nearest 15 minute increment
+/// for actual reservation
+/// \param $length - length of reservation in minutes (must be in 15 minute
+/// increments)
+/// \param $foruser - (optional) login to be used when setting up the account
+/// on the reserved machine - CURRENTLY, THIS IS UNSUPPORTED
+///
+/// \return an array with at least one index named '\b status' which will have
+/// one of these values:\n
+/// \b error - error occurred; there will be 2 additional elements in the array:
+/// \li \b errorcode - error number\n
+/// \li \b errormsg - error string\n
+///
+/// \b notavailable - no computers were available for the request\n
+/// \b success - there will be an additional element in the array:
+/// \li \b requestid - identifier that should be passed to later calls when
+/// acting on the request
+///
+/// \brief tries to make a request
+///
+////////////////////////////////////////////////////////////////////////////////
+function XMLRPCaddRequest($imageid, $start, $length, $foruser='') {
+ global $user;
+ $imageid = processInputData($imageid, ARG_NUMERIC);
+ $start = processInputData($start, ARG_STRING, 1);
+ $length = processInputData($length, ARG_NUMERIC);
+ #$foruser = processInputData($foruser, ARG_STRING, 1);
+
+ // make sure user didn't submit a request for an image he
+ // doesn't have access to
+ $resources = getUserResources(array("imageAdmin", "imageCheckOut"));
+ $validImageids = array_keys($resources['image']);
+ if(! in_array($imageid, $validImageids)) {
+ return array('status' => 'error',
+ 'errorcode' => 3,
+ 'errormsg' => "access denied to $imageid");
+ }
+
+ # validate $start
+ if($start != 'now' && ! is_numeric($start)) {
+ return array('status' => 'error',
+ 'errorcode' => 4,
+ 'errormsg' => "received invalid input");
+ }
+
+ # validate $length
+ $maxtimes = getUserMaxTimes();
+ if($maxtimes['initial'] < $length) {
+ return array('status' => 'error',
+ 'errorcode' => 6,
+ 'errormsg' => "max allowed initial length is {$maxtimes['initial']} minutes");
+ }
+
+ $nowfuture = 'future';
+ if($start == 'now') {
+ $start = time();
+ $nowfuture = 'now';
+ }
+ else
+ if($start < (time() - 30))
+ return array('status' => 'error',
+ 'errorcode' => 5,
+ 'errormsg' => "start time is in the past");
+ $start = unixFloor15($start);
+ $end = $start + $length * 60;
+ if($end % (15 * 60))
+ $end = unixFloor15($end) + (15 * 60);
+
+ $max = getMaxOverlap($user['id']);
+ if(checkOverlap($start, $end, $max)) {
+ return array('status' => 'error',
+ 'errorcode' => 7,
+ 'errormsg' => "reservation overlaps with another one you "
+ . "have, and you are allowed $max "
+ . "overlapping reservations at a time");
+ }
+
+ $images = getImages();
+ $rc = isAvailable($images, $imageid, $start, $end, '');
+ if($rc < 1) {
+ addLogEntry($nowfuture, unixToDatetime($start),
+ unixToDatetime($end), 0, $imageid);
+ return array('status' => 'notavailable');
+ }
+ $return['requestid']= addRequest();
+ $return['status'] = 'success';
+ return $return;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn XMLRPCgetRequestStatus($requestid)
+///
+/// \param $requestid - id of a request
+///
+/// \return an array with at least one index named '\b status' which will have
+/// one of these values:\n
+/// \b error - error occurred; there will be 2 additional elements in the array:
+/// \li \b errorcode - error number\n
+/// \li \b errormsg - error string\n
+///
+/// \b ready - request is ready\n
+/// \b failed - request failed to load properly\n
+/// \b timedout - request timed out (user didn't connect before timeout
+/// expired)\n
+/// \b loading - request is still loading; there will be an additional element
+/// in the array:
+/// \li \b time - the estimated wait time (in minutes) for loading to complete\n
+///
+/// \b future - start time of request is in the future
+///
+/// \brief determines and returns the status of the request
+///
+////////////////////////////////////////////////////////////////////////////////
+function XMLRPCgetRequestStatus($requestid) {
+ global $user;
+ $requestid = processInputData($requestid, ARG_NUMERIC);
+ $userRequests = getUserRequests('all', $user['id']);
+ $found = 0;
+ foreach($userRequests as $req) {
+ if($req['id'] == $requestid) {
+ $request = $req;
+ $found = 1;
+ break;
+ }
+ }
+ if(! $found)
+ return array('status' => 'error',
+ 'errorcode' => 1,
+ 'errormsg' => 'unknown requestid');
+
+ $now = time();
+ # request is ready
+ if(requestIsReady($request))
+ return array('status' => 'ready');
+ # request failed
+ elseif($request["currstateid"] == 5)
+ return array('status' => 'failed');
+ # other cases where the reservation start time has been reached
+ elseif(datetimeToUnix($request["start"]) < $now) {
+ # request has timed out
+ if($request["currstateid"] == 12 ||
+ $request["currstateid"] == 11 ||
+ ($request["currstateid"] == 14 &&
+ $request["laststateid"] == 11)) {
+ return array('status' => 'timedout');
+ }
+ # computer is loading
+ else {
+ $imageid = $request['imageid'];
+ $images = getImages(0, $imageid);
+ $remaining = 1;
+ $computers = getComputers(0, 0, $request['computerid']);
+ if(isComputerLoading($request, $computers)) {
+ if(datetimeToUnix($request["daterequested"]) >=
+ datetimeToUnix($request["start"]))
+ $startload = datetimeToUnix($request["daterequested"]);
+ else
+ $startload = datetimeToUnix($request["start"]);
+ $imgLoadTime = getImageLoadEstimate($imageid);
+ if($imgLoadTime == 0)
+ $imgLoadTime = $images[$imageid]['reloadtime'] * 60;
+ $tmp = ($imgLoadTime - ($now - $startload)) / 60;
+ $remaining = sprintf("%d", $tmp) + 1;
+ if($remaining < 1) {
+ $remaining = 1;
+ }
+ }
+ return array('status' => 'loading', 'time' => $remaining);
+ }
+ }
+ # reservation is in the future
+ else
+ return array('status' => 'future');
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn XMLRPCgetRequestConnectData($requestid, $remoteIP)
+///
+/// \param $requestid - id of a request
+/// \param $remoteIP - ip address of connecting user's computer
+///
+/// \return an array with at least one index named '\b status' which will have
+/// one of these values\n
+/// \b error - error occurred; there will be 2 additional elements in the array:
+/// \li \b errorcode - error number\n
+/// \li \b errormsg - error string\n
+///
+/// \b ready - request is ready; there will be 3 additional elements in the
+/// array:
+/// \li \b serverIP - address of the reserved machine
+/// \li \b user - user to use when connecting to the machine
+/// \li \b password - password to use when connecting to the machine
+///
+/// \b notready - request is not ready for connection
+///
+/// \brief if request is ready, adds the connecting user's computer to the
+/// request and returns info about how to connect to the computer
+///
+////////////////////////////////////////////////////////////////////////////////
+function XMLRPCgetRequestConnectData($requestid, $remoteIP) {
+ global $user;
+ $requestid = processInputData($requestid, ARG_NUMERIC);
+ $remoteIP = processInputData($remoteIP, ARG_STRING, 1);
+ if(! preg_match('/^([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})$/', $remoteIP, $matches) ||
+ $matches[1] < 1 || $matches[1] > 223 ||
+ $matches[2] > 255 ||
+ $matches[3] > 255 ||
+ $matches[4] > 255) {
+ return array('status' => 'error',
+ 'errorcode' => 2,
+ 'errormsg' => 'invalid IP address');
+ }
+ $userRequests = getUserRequests('all', $user['id']);
+ $found = 0;
+ foreach($userRequests as $req) {
+ if($req['id'] == $requestid) {
+ $request = $req;
+ $found = 1;
+ break;
+ }
+ }
+ if(! $found)
+ return array('status' => 'error',
+ 'errorcode' => 1,
+ 'errormsg' => 'unknown requestid');
+
+ // FIXME - add support for cluster requests
+ if(requestIsReady($request)) {
+ $requestData = getRequestInfo($requestid);
+ $query = "UPDATE reservation "
+ . "SET remoteIP = '$remoteIP' "
+ . "WHERE requestid = $requestid";
+ $qh = doQuery($query, 101);
+ addChangeLogEntry($requestData["logid"], $remoteIP);
+ $serverIP = $requestData["reservations"][0]["reservedIP"];
+ $passwd = $requestData["reservations"][0]["password"];
+ if($requestData["forimaging"])
+ $thisuser = 'Administrator';
+ else
+ if(preg_match('/(.*)@(.*)/', $user['unityid'], $matches))
+ $thisuser = $matches[1];
+ else
+ $thisuser = $user['unityid'];
+ return array('status' => 'ready',
+ 'serverIP' => $serverIP,
+ 'user' => $thisuser,
+ 'password' => $passwd);
+ }
+ return array('status' => 'notready');
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn XMLRPCendRequest($requestid)
+///
+/// \param $requestid - id of a request
+///
+/// \return an array with at least one index named 'status' which will have
+/// one of these values\n
+/// \b error - error occurred; there will be 2 additional elements in the array:
+/// \li \b errorcode - error number\n
+/// \li \b errormsg - error string\n
+///
+/// \b success - request was successfully ended\n
+///
+/// \brief ends/deletes a request
+///
+////////////////////////////////////////////////////////////////////////////////
+function XMLRPCendRequest($requestid) {
+ global $user;
+ $requestid = processInputData($requestid, ARG_NUMERIC);
+ $userRequests = getUserRequests('all', $user['id']);
+ $found = 0;
+ foreach($userRequests as $req) {
+ if($req['id'] == $requestid) {
+ $request = getRequestInfo($requestid);
+ $found = 1;
+ break;
+ }
+ }
+ if(! $found)
+ return array('status' => 'error',
+ 'errorcode' => 1,
+ 'errormsg' => 'unknown requestid');
+
+ deleteRequest($request);
+ return array('status' => 'success');
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn XMLRPCgetRequestIds()
+///
+/// \return an array with at least one index named 'status' which will have
+/// one of these values\n
+/// \b error - error occurred; there will be 2 additional elements in the array:
+/// \li \b errorcode - error number\n
+/// \li \b errormsg - error string\n
+///
+/// \b success - request was successfully ended; there will be an additional
+/// element whose index is 'requests' which is an array of arrays, each having
+/// these elements (or empty if no existing requests):\n
+/// \li \b requestid - id of the request\n
+/// \li \b imageid - id of the image\n
+/// \li \b imagename - name of the image\n
+/// \li \b start - unix timestamp of start time\n
+/// \li \b end - unix timestamp of end time
+///
+/// \brief gets information about all of user's requests
+///
+////////////////////////////////////////////////////////////////////////////////
+function XMLRPCgetRequestIds() {
+ global $user;
+ $requests = getUserRequests("all");
+ if(empty($requests))
+ return array('status' => 'success', 'requests' => array());
+ $ret = array();
+ foreach($requests as $req) {
+ $start = datetimeToUnix($req['start']);
+ $end = datetimeToUnix($req['end']);
+ $tmp = array('requestid' => $req['id'],
+ 'imageid' => $req['imageid'],
+ 'imagename' => $req['prettyimage'],
+ 'start' => $start,
+ 'end' => $end);
+ array_push($ret, $tmp);
+ }
+ return array('status' => 'success', 'requests' => $ret);
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn XMLRPCtest($string)
+///
+/// \param $string - a string
+///
+/// \return an array with 3 indices:\n
+/// \b status - will be 'success'\n
+/// \b message - will be 'RPC call worked successfully'\n
+/// \b string - contents of $string (after being sanatized)
+///
+/// \brief this is a test function that call be called when getting XML RPC
+/// calls to this site to work
+///
+////////////////////////////////////////////////////////////////////////////////
+function XMLRPCtest($string) {
+ $string = processInputData($string, ARG_STRING);
+ return array('status' => 'success',
+ 'message' => 'RPC call worked successfully',
+ 'string' => $string);
+}
+?>
diff --git a/web/.ht-inc/xmlrpc_example.php b/web/.ht-inc/xmlrpc_example.php
new file mode 100644
index 0000000..5228c82
--- /dev/null
+++ b/web/.ht-inc/xmlrpc_example.php
@@ -0,0 +1,112 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+session_start();
+
+$url = "http://{$_SERVER['HTTP_HOST']}{$_SERVER['PHP_SELF']}";
+print "<a href=\"$url?state=test\">Test</a><br>\n";
+print "<a href=\"$url?state=listimages\">List Available Images</a><br>\n";
+print "<a href=\"$url?state=addrequest\">Add request for Maple 10</a><br>\n";
+print "<a href=\"$url?state=requeststatus\">Get status of request</a><br>\n";
+print "<a href=\"$url?state=connectdata\">Get connection data</a><br>\n";
+print "<a href=\"$url?state=endrequest\">End request</a><br>\n";
+
+print "<pre>\n";
+
+// test
+if($_GET['state'] == 'test') {
+ $rc = remoteVCLCall('XMLRPCtest', array('foo'));
+ print_r($rc);
+}
+// list images
+elseif($_GET['state'] == 'listimages') {
+ $rc = remoteVCLCall('XMLRPCgetImages', array());
+ print_r($rc);
+}
+// add request
+elseif($_GET['state'] == 'addrequest') {
+ $rc = remoteVCLCall('XMLRPCaddRequest', array(98, 'now', 60));
+ if($rc['status'] == 'success') {
+ print "request id is {$rc['requestid']}<br>\n";
+ $_SESSION['requestid'] = $rc['requestid'];
+ }
+ else {
+ print_r($rc);
+ }
+}
+// get request status
+elseif($_GET['state'] == 'requeststatus') {
+ if(! array_key_exists('requestid', $_SESSION)) {
+ print "no request created<br>\n";
+ exit;
+ }
+ $rc = remoteVCLCall('XMLRPCgetRequestStatus', array($_SESSION['requestid']));
+ print "current status of request {$_SESSION['requestid']} is {$rc['status']}";
+}
+// get connection data
+elseif($_GET['state'] == 'connectdata') {
+ if(! array_key_exists('requestid', $_SESSION)) {
+ print "no request created<br>\n";
+ exit;
+ }
+ $rc = remoteVCLCall('XMLRPCgetRequestConnectData', array($_SESSION['requestid'], $_SERVER["REMOTE_ADDR"]));
+ if($rc['status'] == 'ready')
+ print_r($rc);
+ else
+ print "status of request is {$rc['status']}";
+}
+// end request
+elseif($_GET['state'] == 'endrequest') {
+ if(! array_key_exists('requestid', $_SESSION)) {
+ print "no request created<br>\n";
+ exit;
+ }
+ $rc = remoteVCLCall('XMLRPCendRequest', array($_SESSION['requestid']));
+ if($rc['status'] == 'error')
+ print_r($rc);
+ else {
+ print "request ended<br>\n";
+ unset($_SESSION['requestid']);
+ }
+}
+print "</pre>\n";
+
+function remoteVCLCall($method, $args) {
+ $request = xmlrpc_encode_request($method, $args);
+ $header = "Content-Type: text/xml\r\n";
+ $header .= "X-User: userid\r\n"; // user your userid here
+ $header .= "X-Pass: password\r\n"; // user your password here
+ $header .= "X-APIVERSION: 1"; // this is to allow for future changes to the api
+ $context = stream_context_create(
+ array(
+ 'http' => array(
+ 'method' => "POST",
+ 'header' => $header,
+ 'content' => $request
+ )
+ )
+ );
+ $file = file_get_contents("https://vcl.ncsu.edu/scheduling/index.php?mode=xmlrpccall", false, $context);
+ $response = xmlrpc_decode($file);
+ if(xmlrpc_is_fault($response)) {
+ trigger_error("xmlrpc: {$response['faultString']} ({$response['faultCode']})");
+ exit;
+ }
+ return $response;
+}
+?>
diff --git a/web/.ht-inc/xmlrpcdocs/doxygen.css b/web/.ht-inc/xmlrpcdocs/doxygen.css
new file mode 100644
index 0000000..8cae9fb
--- /dev/null
+++ b/web/.ht-inc/xmlrpcdocs/doxygen.css
@@ -0,0 +1,374 @@
+/*
+* Licensed to the Apache Software Foundation (ASF) under one or more
+* contributor license agreements. See the NOTICE file distributed with
+* this work for additional information regarding copyright ownership.
+* The ASF licenses this file to You under the Apache License, Version 2.0
+* (the "License"); you may not use this file except in compliance with
+* the License. You may obtain a copy of the License at
+*
+* http://www.apache.org/licenses/LICENSE-2.0
+*
+* Unless required by applicable law or agreed to in writing, software
+* distributed under the License is distributed on an "AS IS" BASIS,
+* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+* See the License for the specific language governing permissions and
+* limitations under the License.
+*/
+BODY,H1,H2,H3,H4,H5,H6,P,CENTER,TD,TH,UL,DL,DIV {
+ font-family: Geneva, Arial, Helvetica, sans-serif;
+}
+BODY,TD {
+ font-size: 90%;
+}
+H1 {
+ text-align: center;
+ font-size: 160%;
+}
+H2 {
+ font-size: 120%;
+}
+H3 {
+ font-size: 100%;
+}
+CAPTION { font-weight: bold }
+DIV.qindex {
+ width: 100%;
+ background-color: #e8eef2;
+ border: 1px solid #84b0c7;
+ text-align: center;
+ margin: 2px;
+ padding: 2px;
+ line-height: 140%;
+}
+DIV.nav {
+ width: 100%;
+ background-color: #e8eef2;
+ border: 1px solid #84b0c7;
+ text-align: center;
+ margin: 2px;
+ padding: 2px;
+ line-height: 140%;
+}
+DIV.navtab {
+ background-color: #e8eef2;
+ border: 1px solid #84b0c7;
+ text-align: center;
+ margin: 2px;
+ margin-right: 15px;
+ padding: 2px;
+}
+TD.navtab {
+ font-size: 70%;
+}
+A.qindex {
+ text-decoration: none;
+ font-weight: bold;
+ color: #1A419D;
+}
+A.qindex:visited {
+ text-decoration: none;
+ font-weight: bold;
+ color: #1A419D
+}
+A.qindex:hover {
+ text-decoration: none;
+ background-color: #ddddff;
+}
+A.qindexHL {
+ text-decoration: none;
+ font-weight: bold;
+ background-color: #6666cc;
+ color: #ffffff;
+ border: 1px double #9295C2;
+}
+A.qindexHL:hover {
+ text-decoration: none;
+ background-color: #6666cc;
+ color: #ffffff;
+}
+A.qindexHL:visited { text-decoration: none; background-color: #6666cc; color: #ffffff }
+A.el { text-decoration: none; font-weight: bold }
+A.elRef { font-weight: bold }
+A.code:link { text-decoration: none; font-weight: normal; color: #0000FF}
+A.code:visited { text-decoration: none; font-weight: normal; color: #0000FF}
+A.codeRef:link { font-weight: normal; color: #0000FF}
+A.codeRef:visited { font-weight: normal; color: #0000FF}
+A:hover { text-decoration: none; background-color: #f2f2ff }
+DL.el { margin-left: -1cm }
+.fragment {
+ font-family: monospace, fixed;
+ font-size: 95%;
+}
+PRE.fragment {
+ border: 1px solid #CCCCCC;
+ background-color: #f5f5f5;
+ margin-top: 4px;
+ margin-bottom: 4px;
+ margin-left: 2px;
+ margin-right: 8px;
+ padding-left: 6px;
+ padding-right: 6px;
+ padding-top: 4px;
+ padding-bottom: 4px;
+}
+DIV.ah { background-color: black; font-weight: bold; color: #ffffff; margin-bottom: 3px; margin-top: 3px }
+
+DIV.groupHeader {
+ margin-left: 16px;
+ margin-top: 12px;
+ margin-bottom: 6px;
+ font-weight: bold;
+}
+DIV.groupText { margin-left: 16px; font-style: italic; font-size: 90% }
+BODY {
+ background: white;
+ color: black;
+ margin-right: 20px;
+ margin-left: 20px;
+}
+TD.indexkey {
+ background-color: #e8eef2;
+ font-weight: bold;
+ padding-right : 10px;
+ padding-top : 2px;
+ padding-left : 10px;
+ padding-bottom : 2px;
+ margin-left : 0px;
+ margin-right : 0px;
+ margin-top : 2px;
+ margin-bottom : 2px;
+ border: 1px solid #CCCCCC;
+}
+TD.indexvalue {
+ background-color: #e8eef2;
+ font-style: italic;
+ padding-right : 10px;
+ padding-top : 2px;
+ padding-left : 10px;
+ padding-bottom : 2px;
+ margin-left : 0px;
+ margin-right : 0px;
+ margin-top : 2px;
+ margin-bottom : 2px;
+ border: 1px solid #CCCCCC;
+}
+TR.memlist {
+ background-color: #f0f0f0;
+}
+P.formulaDsp { text-align: center; }
+IMG.formulaDsp { }
+IMG.formulaInl { vertical-align: middle; }
+SPAN.keyword { color: #008000 }
+SPAN.keywordtype { color: #604020 }
+SPAN.keywordflow { color: #e08000 }
+SPAN.comment { color: #800000 }
+SPAN.preprocessor { color: #806020 }
+SPAN.stringliteral { color: #002080 }
+SPAN.charliteral { color: #008080 }
+.mdescLeft {
+ padding: 0px 8px 4px 8px;
+ font-size: 80%;
+ font-style: italic;
+ background-color: #FAFAFA;
+ border-top: 1px none #E0E0E0;
+ border-right: 1px none #E0E0E0;
+ border-bottom: 1px none #E0E0E0;
+ border-left: 1px none #E0E0E0;
+ margin: 0px;
+}
+.mdescRight {
+ padding: 0px 8px 4px 8px;
+ font-size: 80%;
+ font-style: italic;
+ background-color: #FAFAFA;
+ border-top: 1px none #E0E0E0;
+ border-right: 1px none #E0E0E0;
+ border-bottom: 1px none #E0E0E0;
+ border-left: 1px none #E0E0E0;
+ margin: 0px;
+}
+.memItemLeft {
+ padding: 1px 0px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: solid;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.memItemRight {
+ padding: 1px 8px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: solid;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.memTemplItemLeft {
+ padding: 1px 0px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: none;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.memTemplItemRight {
+ padding: 1px 8px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: none;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.memTemplParams {
+ padding: 1px 0px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: solid;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ color: #606060;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.search { color: #003399;
+ font-weight: bold;
+}
+FORM.search {
+ margin-bottom: 0px;
+ margin-top: 0px;
+}
+INPUT.search { font-size: 75%;
+ color: #000080;
+ font-weight: normal;
+ background-color: #e8eef2;
+}
+TD.tiny { font-size: 75%;
+}
+a {
+ color: #1A41A8;
+}
+a:visited {
+ color: #2A3798;
+}
+.dirtab { padding: 4px;
+ border-collapse: collapse;
+ border: 1px solid #84b0c7;
+}
+TH.dirtab { background: #e8eef2;
+ font-weight: bold;
+}
+HR { height: 1px;
+ border: none;
+ border-top: 1px solid black;
+}
+
+/* Style for detailed member documentation */
+.memtemplate {
+ font-size: 80%;
+ color: #606060;
+ font-weight: normal;
+}
+.memnav {
+ background-color: #e8eef2;
+ border: 1px solid #84b0c7;
+ text-align: center;
+ margin: 2px;
+ margin-right: 15px;
+ padding: 2px;
+}
+.memitem {
+ padding: 4px;
+ background-color: #eef3f5;
+ border-width: 1px;
+ border-style: solid;
+ border-color: #dedeee;
+ -moz-border-radius: 8px 8px 8px 8px;
+}
+.memname {
+ white-space: nowrap;
+ font-weight: bold;
+}
+.memdoc{
+ padding-left: 10px;
+}
+.memproto {
+ background-color: #d5e1e8;
+ width: 100%;
+ border-width: 1px;
+ border-style: solid;
+ border-color: #84b0c7;
+ font-weight: bold;
+ -moz-border-radius: 8px 8px 8px 8px;
+}
+.paramkey {
+ text-align: right;
+}
+.paramtype {
+ white-space: nowrap;
+}
+.paramname {
+ color: #602020;
+ font-style: italic;
+ white-space: nowrap;
+}
+/* End Styling for detailed member documentation */
+
+/* for the tree view */
+.ftvtree {
+ font-family: sans-serif;
+ margin:0.5em;
+}
+.directory { font-size: 9pt; font-weight: bold; }
+.directory h3 { margin: 0px; margin-top: 1em; font-size: 11pt; }
+.directory > h3 { margin-top: 0; }
+.directory p { margin: 0px; white-space: nowrap; }
+.directory div { display: none; margin: 0px; }
+.directory img { vertical-align: -30%; }
diff --git a/web/.ht-inc/xmlrpcdocs/doxygen.png b/web/.ht-inc/xmlrpcdocs/doxygen.png
new file mode 100644
index 0000000..f0a274b
--- /dev/null
+++ b/web/.ht-inc/xmlrpcdocs/doxygen.png
Binary files differ
diff --git a/web/.ht-inc/xmlrpcdocs/examples.html b/web/.ht-inc/xmlrpcdocs/examples.html
new file mode 100644
index 0000000..4bbf064
--- /dev/null
+++ b/web/.ht-inc/xmlrpcdocs/examples.html
@@ -0,0 +1,31 @@
+<!--
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+-->
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<html><head><meta http-equiv="Content-Type" content="text/html;charset=UTF-8">
+<title>VCL XML RPC: Examples</title>
+<link href="doxygen.css" rel="stylesheet" type="text/css">
+<link href="tabs.css" rel="stylesheet" type="text/css">
+</head><body>
+<!-- Generated by Doxygen 1.5.3 -->
+<h1>VCL XML RPC Examples</h1>Here is a list of all examples:<ul>
+<li><a class="el" href="xmlrpc__example_8php-example.html">xmlrpc_example.php</a>
+</ul>
+<hr size="1"><address style="text-align: right;"><small>Generated on Wed Dec 19 11:28:46 2007 for VCL XML RPC by
+<a href="http://www.doxygen.org/index.html">
+<img src="doxygen.png" alt="doxygen" align="middle" border="0"></a> 1.5.3 </small></address>
+</body>
+</html>
diff --git a/web/.ht-inc/xmlrpcdocs/files.html b/web/.ht-inc/xmlrpcdocs/files.html
new file mode 100644
index 0000000..4005e5e
--- /dev/null
+++ b/web/.ht-inc/xmlrpcdocs/files.html
@@ -0,0 +1,31 @@
+<!--
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+-->
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<html><head><meta http-equiv="Content-Type" content="text/html;charset=UTF-8">
+<title>VCL XML RPC: File Index</title>
+<link href="doxygen.css" rel="stylesheet" type="text/css">
+<link href="tabs.css" rel="stylesheet" type="text/css">
+</head><body>
+<!-- Generated by Doxygen 1.5.3 -->
+<h1>VCL XML RPC File List</h1>Here is a list of all documented files with brief descriptions:<table>
+ <tr><td class="indexkey">/afs/eos.ncsu.edu/engrwww/vcl.ncsu/scheduling/.ht-inc/<a class="el" href="xmlrpcWrappers_8php.html">xmlrpcWrappers.php</a></td><td class="indexvalue"></td></tr>
+</table>
+<hr size="1"><address style="text-align: right;"><small>Generated on Wed Dec 19 11:28:46 2007 for VCL XML RPC by
+<a href="http://www.doxygen.org/index.html">
+<img src="doxygen.png" alt="doxygen" align="middle" border="0"></a> 1.5.3 </small></address>
+</body>
+</html>
diff --git a/web/.ht-inc/xmlrpcdocs/globals.html b/web/.ht-inc/xmlrpcdocs/globals.html
new file mode 100644
index 0000000..041e807
--- /dev/null
+++ b/web/.ht-inc/xmlrpcdocs/globals.html
@@ -0,0 +1,52 @@
+<!--
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+-->
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<html><head><meta http-equiv="Content-Type" content="text/html;charset=UTF-8">
+<title>VCL XML RPC: Class Members</title>
+<link href="doxygen.css" rel="stylesheet" type="text/css">
+<link href="tabs.css" rel="stylesheet" type="text/css">
+</head><body>
+<!-- Generated by Doxygen 1.5.3 -->
+<div class="tabs">
+ <ul>
+ <li class="current"><a href="globals.html"><span>All</span></a></li>
+ <li><a href="globals_func.html"><span>Functions</span></a></li>
+ </ul>
+</div>
+Here is a list of all documented file members with links to the documentation:
+<p>
+<ul>
+<li>XMLRPCaddRequest()
+: <a class="el" href="xmlrpcWrappers_8php.html#e6f9d40f20e08994fa3d82c8dd12bdf5">xmlrpcWrappers.php</a>
+<li>XMLRPCendRequest()
+: <a class="el" href="xmlrpcWrappers_8php.html#dfdaad6201dbcaaf5c2249a2c38437cc">xmlrpcWrappers.php</a>
+<li>XMLRPCgetImages()
+: <a class="el" href="xmlrpcWrappers_8php.html#e2c01a27349e7a7788a42cfb5fe0d5ab">xmlrpcWrappers.php</a>
+<li>XMLRPCgetRequestConnectData()
+: <a class="el" href="xmlrpcWrappers_8php.html#f8b8c718ea7ea9cc973602a2fe9ae20e">xmlrpcWrappers.php</a>
+<li>XMLRPCgetRequestIds()
+: <a class="el" href="xmlrpcWrappers_8php.html#815cd48d7d8c85754b2091313c02ccec">xmlrpcWrappers.php</a>
+<li>XMLRPCgetRequestStatus()
+: <a class="el" href="xmlrpcWrappers_8php.html#131560f1aa7577bd1da62d5b7e228e4c">xmlrpcWrappers.php</a>
+<li>XMLRPCtest()
+: <a class="el" href="xmlrpcWrappers_8php.html#c3e09831835663a8bd79aab3f0ea3e69">xmlrpcWrappers.php</a>
+</ul>
+<hr size="1"><address style="text-align: right;"><small>Generated on Wed Dec 19 11:28:46 2007 for VCL XML RPC by
+<a href="http://www.doxygen.org/index.html">
+<img src="doxygen.png" alt="doxygen" align="middle" border="0"></a> 1.5.3 </small></address>
+</body>
+</html>
diff --git a/web/.ht-inc/xmlrpcdocs/globals_func.html b/web/.ht-inc/xmlrpcdocs/globals_func.html
new file mode 100644
index 0000000..4697c22
--- /dev/null
+++ b/web/.ht-inc/xmlrpcdocs/globals_func.html
@@ -0,0 +1,52 @@
+<!--
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+-->
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<html><head><meta http-equiv="Content-Type" content="text/html;charset=UTF-8">
+<title>VCL XML RPC: Class Members</title>
+<link href="doxygen.css" rel="stylesheet" type="text/css">
+<link href="tabs.css" rel="stylesheet" type="text/css">
+</head><body>
+<!-- Generated by Doxygen 1.5.3 -->
+<div class="tabs">
+ <ul>
+ <li><a href="globals.html"><span>All</span></a></li>
+ <li class="current"><a href="globals_func.html"><span>Functions</span></a></li>
+ </ul>
+</div>
+
+<p>
+<ul>
+<li>XMLRPCaddRequest()
+: <a class="el" href="xmlrpcWrappers_8php.html#e6f9d40f20e08994fa3d82c8dd12bdf5">xmlrpcWrappers.php</a>
+<li>XMLRPCendRequest()
+: <a class="el" href="xmlrpcWrappers_8php.html#dfdaad6201dbcaaf5c2249a2c38437cc">xmlrpcWrappers.php</a>
+<li>XMLRPCgetImages()
+: <a class="el" href="xmlrpcWrappers_8php.html#e2c01a27349e7a7788a42cfb5fe0d5ab">xmlrpcWrappers.php</a>
+<li>XMLRPCgetRequestConnectData()
+: <a class="el" href="xmlrpcWrappers_8php.html#f8b8c718ea7ea9cc973602a2fe9ae20e">xmlrpcWrappers.php</a>
+<li>XMLRPCgetRequestIds()
+: <a class="el" href="xmlrpcWrappers_8php.html#815cd48d7d8c85754b2091313c02ccec">xmlrpcWrappers.php</a>
+<li>XMLRPCgetRequestStatus()
+: <a class="el" href="xmlrpcWrappers_8php.html#131560f1aa7577bd1da62d5b7e228e4c">xmlrpcWrappers.php</a>
+<li>XMLRPCtest()
+: <a class="el" href="xmlrpcWrappers_8php.html#c3e09831835663a8bd79aab3f0ea3e69">xmlrpcWrappers.php</a>
+</ul>
+<hr size="1"><address style="text-align: right;"><small>Generated on Wed Dec 19 11:28:46 2007 for VCL XML RPC by
+<a href="http://www.doxygen.org/index.html">
+<img src="doxygen.png" alt="doxygen" align="middle" border="0"></a> 1.5.3 </small></address>
+</body>
+</html>
diff --git a/web/.ht-inc/xmlrpcdocs/index.html b/web/.ht-inc/xmlrpcdocs/index.html
new file mode 100644
index 0000000..37e7efb
--- /dev/null
+++ b/web/.ht-inc/xmlrpcdocs/index.html
@@ -0,0 +1,36 @@
+<!--
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+-->
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<html><head><meta http-equiv="Content-Type" content="text/html;charset=UTF-8">
+<title>VCL XML RPC: Main Page</title>
+<link href="doxygen.css" rel="stylesheet" type="text/css">
+<link href="tabs.css" rel="stylesheet" type="text/css">
+</head><body>
+<!-- Generated by Doxygen 1.5.3 -->
+<h1>VCL XML RPC Documentation</h1>
+<p>
+<ul> <li class="current"><a href="index.html"><span>Main Page</span></a></li>
+ <li><a href="files.html"><span>Files</span></a></li>
+<ul> <li><a href="files.html"><span>File List</span></a></li>
+</ul>
+ <li><a href="examples.html"><span>Examples</span></a></li>
+</ul>
+<hr size="1"><address style="text-align: right;"><small>Generated on Wed Dec 19 11:28:46 2007 for VCL XML RPC by
+<a href="http://www.doxygen.org/index.html">
+<img src="doxygen.png" alt="doxygen" align="middle" border="0"></a> 1.5.3 </small></address>
+</body>
+</html>
diff --git a/web/.ht-inc/xmlrpcdocs/tab_b.gif b/web/.ht-inc/xmlrpcdocs/tab_b.gif
new file mode 100644
index 0000000..0d62348
--- /dev/null
+++ b/web/.ht-inc/xmlrpcdocs/tab_b.gif
Binary files differ
diff --git a/web/.ht-inc/xmlrpcdocs/tab_l.gif b/web/.ht-inc/xmlrpcdocs/tab_l.gif
new file mode 100644
index 0000000..9b1e633
--- /dev/null
+++ b/web/.ht-inc/xmlrpcdocs/tab_l.gif
Binary files differ
diff --git a/web/.ht-inc/xmlrpcdocs/tab_r.gif b/web/.ht-inc/xmlrpcdocs/tab_r.gif
new file mode 100644
index 0000000..ce9dd9f
--- /dev/null
+++ b/web/.ht-inc/xmlrpcdocs/tab_r.gif
Binary files differ
diff --git a/web/.ht-inc/xmlrpcdocs/tabs.css b/web/.ht-inc/xmlrpcdocs/tabs.css
new file mode 100644
index 0000000..f5b46d0
--- /dev/null
+++ b/web/.ht-inc/xmlrpcdocs/tabs.css
@@ -0,0 +1,118 @@
+/*
+* Licensed to the Apache Software Foundation (ASF) under one or more
+* contributor license agreements. See the NOTICE file distributed with
+* this work for additional information regarding copyright ownership.
+* The ASF licenses this file to You under the Apache License, Version 2.0
+* (the "License"); you may not use this file except in compliance with
+* the License. You may obtain a copy of the License at
+*
+* http://www.apache.org/licenses/LICENSE-2.0
+*
+* Unless required by applicable law or agreed to in writing, software
+* distributed under the License is distributed on an "AS IS" BASIS,
+* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+* See the License for the specific language governing permissions and
+* limitations under the License.
+*/
+/* tabs styles, based on http://www.alistapart.com/articles/slidingdoors */
+
+DIV.tabs
+{
+ float : left;
+ width : 100%;
+ background : url("tab_b.gif") repeat-x bottom;
+ margin-bottom : 4px;
+}
+
+DIV.tabs UL
+{
+ margin : 0px;
+ padding-left : 10px;
+ list-style : none;
+}
+
+DIV.tabs LI, DIV.tabs FORM
+{
+ display : inline;
+ margin : 0px;
+ padding : 0px;
+}
+
+DIV.tabs FORM
+{
+ float : right;
+}
+
+DIV.tabs A
+{
+ float : left;
+ background : url("tab_r.gif") no-repeat right top;
+ border-bottom : 1px solid #84B0C7;
+ font-size : x-small;
+ font-weight : bold;
+ text-decoration : none;
+}
+
+DIV.tabs A:hover
+{
+ background-position: 100% -150px;
+}
+
+DIV.tabs A:link, DIV.tabs A:visited,
+DIV.tabs A:active, DIV.tabs A:hover
+{
+ color: #1A419D;
+}
+
+DIV.tabs SPAN
+{
+ float : left;
+ display : block;
+ background : url("tab_l.gif") no-repeat left top;
+ padding : 5px 9px;
+ white-space : nowrap;
+}
+
+DIV.tabs INPUT
+{
+ float : right;
+ display : inline;
+ font-size : 1em;
+}
+
+DIV.tabs TD
+{
+ font-size : x-small;
+ font-weight : bold;
+ text-decoration : none;
+}
+
+
+
+/* Commented Backslash Hack hides rule from IE5-Mac \*/
+DIV.tabs SPAN {float : none;}
+/* End IE5-Mac hack */
+
+DIV.tabs A:hover SPAN
+{
+ background-position: 0% -150px;
+}
+
+DIV.tabs LI.current A
+{
+ background-position: 100% -150px;
+ border-width : 0px;
+}
+
+DIV.tabs LI.current SPAN
+{
+ background-position: 0% -150px;
+ padding-bottom : 6px;
+}
+
+DIV.nav
+{
+ background : none;
+ border : none;
+ border-bottom : 1px solid #84B0C7;
+}
diff --git a/web/.ht-inc/xmlrpcdocs/xmlrpcWrappers_8php.html b/web/.ht-inc/xmlrpcdocs/xmlrpcWrappers_8php.html
new file mode 100644
index 0000000..3b85a59
--- /dev/null
+++ b/web/.ht-inc/xmlrpcdocs/xmlrpcWrappers_8php.html
@@ -0,0 +1,383 @@
+<!--
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+-->
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<html><head><meta http-equiv="Content-Type" content="text/html;charset=UTF-8">
+<title>VCL XML RPC: /afs/eos.ncsu.edu/engrwww/vcl.ncsu/scheduling/.ht-inc/xmlrpcWrappers.php File Reference</title>
+<link href="doxygen.css" rel="stylesheet" type="text/css">
+<link href="tabs.css" rel="stylesheet" type="text/css">
+</head><body>
+<!-- Generated by Doxygen 1.5.3 -->
+<h1>/afs/eos.ncsu.edu/engrwww/vcl.ncsu/scheduling/.ht-inc/xmlrpcWrappers.php File Reference</h1><table border="0" cellpadding="0" cellspacing="0">
+<tr><td></td></tr>
+<tr><td colspan="2"><br><h2>Functions</h2></td></tr>
+<tr><td class="memItemLeft" nowrap align="right" valign="top"> </td><td class="memItemRight" valign="bottom"><a class="el" href="xmlrpcWrappers_8php.html#e2c01a27349e7a7788a42cfb5fe0d5ab">XMLRPCgetImages</a> ()</td></tr>
+
+<tr><td class="mdescLeft"> </td><td class="mdescRight">gets the images to which the user has acces <a href="#e2c01a27349e7a7788a42cfb5fe0d5ab"></a><br></td></tr>
+<tr><td class="memItemLeft" nowrap align="right" valign="top"> </td><td class="memItemRight" valign="bottom"><a class="el" href="xmlrpcWrappers_8php.html#e6f9d40f20e08994fa3d82c8dd12bdf5">XMLRPCaddRequest</a> ($imageid, $start, $length, $foruser='')</td></tr>
+
+<tr><td class="mdescLeft"> </td><td class="mdescRight">tries to make a request <a href="#e6f9d40f20e08994fa3d82c8dd12bdf5"></a><br></td></tr>
+<tr><td class="memItemLeft" nowrap align="right" valign="top"> </td><td class="memItemRight" valign="bottom"><a class="el" href="xmlrpcWrappers_8php.html#131560f1aa7577bd1da62d5b7e228e4c">XMLRPCgetRequestStatus</a> ($requestid)</td></tr>
+
+<tr><td class="mdescLeft"> </td><td class="mdescRight">determines and returns the status of the request <a href="#131560f1aa7577bd1da62d5b7e228e4c"></a><br></td></tr>
+<tr><td class="memItemLeft" nowrap align="right" valign="top"> </td><td class="memItemRight" valign="bottom"><a class="el" href="xmlrpcWrappers_8php.html#f8b8c718ea7ea9cc973602a2fe9ae20e">XMLRPCgetRequestConnectData</a> ($requestid, $remoteIP)</td></tr>
+
+<tr><td class="mdescLeft"> </td><td class="mdescRight">if request is ready, adds the connecting user's computer to the request and returns info about how to connect to the computer <a href="#f8b8c718ea7ea9cc973602a2fe9ae20e"></a><br></td></tr>
+<tr><td class="memItemLeft" nowrap align="right" valign="top"> </td><td class="memItemRight" valign="bottom"><a class="el" href="xmlrpcWrappers_8php.html#dfdaad6201dbcaaf5c2249a2c38437cc">XMLRPCendRequest</a> ($requestid)</td></tr>
+
+<tr><td class="mdescLeft"> </td><td class="mdescRight">ends/deletes a request <a href="#dfdaad6201dbcaaf5c2249a2c38437cc"></a><br></td></tr>
+<tr><td class="memItemLeft" nowrap align="right" valign="top"> </td><td class="memItemRight" valign="bottom"><a class="el" href="xmlrpcWrappers_8php.html#815cd48d7d8c85754b2091313c02ccec">XMLRPCgetRequestIds</a> ()</td></tr>
+
+<tr><td class="mdescLeft"> </td><td class="mdescRight">gets information about all of user's requests <a href="#815cd48d7d8c85754b2091313c02ccec"></a><br></td></tr>
+<tr><td class="memItemLeft" nowrap align="right" valign="top"> </td><td class="memItemRight" valign="bottom"><a class="el" href="xmlrpcWrappers_8php.html#c3e09831835663a8bd79aab3f0ea3e69">XMLRPCtest</a> ($string)</td></tr>
+
+<tr><td class="mdescLeft"> </td><td class="mdescRight">this is a test function that call be called when getting XML RPC calls to this site to work <a href="#c3e09831835663a8bd79aab3f0ea3e69"></a><br></td></tr>
+</table>
+<hr><a name="_details"></a><h2>Detailed Description</h2>
+The functions listed here are for making VCL requests from other applications. They are implemented according to the XML RPC spec defined at <a href="http://www.xmlrpc.com/">http://www.xmlrpc.com/</a> <br>
+ There is one function called <b><a class="el" href="xmlrpcWrappers_8php.html#c3e09831835663a8bd79aab3f0ea3e69" title="this is a test function that call be called when getting XML RPC calls to this site...">XMLRPCtest()</a></b> that can be used during initial development to get started without actually making a request.<br>
+ <br>
+ The URL you will use to submit RPC calls is<br>
+<br>
+ <a href="https://vcl.ncsu.edu/scheduling/index.php?mode=xmlrpccall">https://vcl.ncsu.edu/scheduling/index.php?mode=xmlrpccall</a><br>
+<br>
+ Your application must connect using HTTPS.<br>
+<br>
+ Internal to the VCL code, "Reservations" are called "Requests"; therefore, "request" is used instead of "reservation" in this documentation and in the RPC functions. <br>
+ <h2>API Version 2</h2>
+<p>
+This is the current version of the API. It should be used for any new code development. Any older code needs to be migrated to this version.<br>
+<br>
+ Authentication is handled by 2 additional HTTP headers you will need to send:<br>
+ <b>X-User</b> - the userid you would use to log in to the VCL site, followed by the at sign (@), followed by your affiliation<br>
+ example: myuserid@NCSU - currently, you need to contact <a href="mailto:vcl_help@ncsu.edu">vcl_help@ncsu.edu</a> to find out your affiliation, but in the future there will be an API method of obtaining this<br>
+ <b>X-Pass</b> - the password you would use to log in to the VCL site<br>
+ <br>
+ There is one other additional HTTP header you must send:<br>
+ <b>X-APIVERSION</b> - set this to 2<br>
+<br>
+<p>
+<h2>API Version 1</h2>
+<p>
+This version is being phased out in favor of version 2. Documentation is provided for those currently using version 1 who are not ready to switch to using version 2.<br>
+<br>
+ To connect to VCL with XML RPC, you will need to obtain a key. Contact <a href="mailto:vcl_help@ncsu.edu">vcl_help@ncsu.edu</a> to get one.<br>
+<p>
+Authentication is handled by 2 additional HTTP headers you will need to send:<br>
+ <b>X-User</b> - use the same id you would use to log in to the VCL site<br>
+ <b>X-Pass</b> - the key mentioned above<br>
+ <br>
+ There is one other additional HTTP header you must send:<br>
+ <b>X-APIVERSION</b> - set this to 1<br>
+ <hr><h2>Function Documentation</h2>
+<a class="anchor" name="e6f9d40f20e08994fa3d82c8dd12bdf5"></a><!-- doxytag: member="xmlrpcWrappers.php::XMLRPCaddRequest" ref="e6f9d40f20e08994fa3d82c8dd12bdf5" args="($imageid, $start, $length, $foruser='')" -->
+<div class="memitem">
+<div class="memproto">
+ <table class="memname">
+ <tr>
+ <td class="memname">function XMLRPCaddRequest </td>
+ <td>(</td>
+ <td class="paramtype">$ </td>
+ <td class="paramname"> <em>imageid</em>, </td>
+ </tr>
+ <tr>
+ <td class="paramkey"></td>
+ <td></td>
+ <td class="paramtype">$ </td>
+ <td class="paramname"> <em>start</em>, </td>
+ </tr>
+ <tr>
+ <td class="paramkey"></td>
+ <td></td>
+ <td class="paramtype">$ </td>
+ <td class="paramname"> <em>length</em>, </td>
+ </tr>
+ <tr>
+ <td class="paramkey"></td>
+ <td></td>
+ <td class="paramtype">$ </td>
+ <td class="paramname"> <em>foruser</em> = <code>''</code></td><td> </td>
+ </tr>
+ <tr>
+ <td></td>
+ <td>)</td>
+ <td></td><td></td><td width="100%"></td>
+ </tr>
+ </table>
+</div>
+<div class="memdoc">
+
+<p>
+tries to make a request
+<p>
+<dl compact><dt><b>Parameters:</b></dt><dd>
+ <table border="0" cellspacing="2" cellpadding="0">
+ <tr><td valign="top"></td><td valign="top"><em>$imageid</em> </td><td>- id of an image </td></tr>
+ <tr><td valign="top"></td><td valign="top"><em>$start</em> </td><td>- "now" or unix timestamp for start of reservation; will use a floor function to round down to the nearest 15 minute increment for actual reservation </td></tr>
+ <tr><td valign="top"></td><td valign="top"><em>$length</em> </td><td>- length of reservation in minutes (must be in 15 minute increments) </td></tr>
+ <tr><td valign="top"></td><td valign="top"><em>$foruser</em> </td><td>- (optional) login to be used when setting up the account on the reserved machine - CURRENTLY, THIS IS UNSUPPORTED</td></tr>
+ </table>
+</dl>
+<dl class="return" compact><dt><b>Returns:</b></dt><dd>an array with at least one index named '<b>status'</b> which will have one of these values:<br>
+ <b>error</b> - error occurred; there will be 2 additional elements in the array: <ul>
+<li><b>errorcode</b> - error number<br>
+ </li>
+<li><b>errormsg</b> - error string<br>
+</li>
+</ul>
+<b>notavailable</b> - no computers were available for the request<br>
+ <b>success</b> - there will be an additional element in the array: <ul>
+<li><b>requestid</b> - identifier that should be passed to later calls when acting on the request </li>
+</ul>
+</dd></dl>
+<dl compact><dt><b>Examples: </b></dt><dd>
+<a class="el" href="xmlrpc__example_8php-example.html#a2">xmlrpc_example.php</a>.</dl>
+</div>
+</div><p>
+<a class="anchor" name="dfdaad6201dbcaaf5c2249a2c38437cc"></a><!-- doxytag: member="xmlrpcWrappers.php::XMLRPCendRequest" ref="dfdaad6201dbcaaf5c2249a2c38437cc" args="($requestid)" -->
+<div class="memitem">
+<div class="memproto">
+ <table class="memname">
+ <tr>
+ <td class="memname">function XMLRPCendRequest </td>
+ <td>(</td>
+ <td class="paramtype">$ </td>
+ <td class="paramname"> <em>requestid</em> </td>
+ <td> ) </td>
+ <td width="100%"></td>
+ </tr>
+ </table>
+</div>
+<div class="memdoc">
+
+<p>
+ends/deletes a request
+<p>
+<dl compact><dt><b>Parameters:</b></dt><dd>
+ <table border="0" cellspacing="2" cellpadding="0">
+ <tr><td valign="top"></td><td valign="top"><em>$requestid</em> </td><td>- id of a request</td></tr>
+ </table>
+</dl>
+<dl class="return" compact><dt><b>Returns:</b></dt><dd>an array with at least one index named 'status' which will have one of these values<br>
+ <b>error</b> - error occurred; there will be 2 additional elements in the array: <ul>
+<li><b>errorcode</b> - error number<br>
+ </li>
+<li><b>errormsg</b> - error string<br>
+</li>
+</ul>
+<b>success</b> - request was successfully ended<br>
+ </dd></dl>
+<dl compact><dt><b>Examples: </b></dt><dd>
+<a class="el" href="xmlrpc__example_8php-example.html#a5">xmlrpc_example.php</a>.</dl>
+</div>
+</div><p>
+<a class="anchor" name="e2c01a27349e7a7788a42cfb5fe0d5ab"></a><!-- doxytag: member="xmlrpcWrappers.php::XMLRPCgetImages" ref="e2c01a27349e7a7788a42cfb5fe0d5ab" args="()" -->
+<div class="memitem">
+<div class="memproto">
+ <table class="memname">
+ <tr>
+ <td class="memname">function XMLRPCgetImages </td>
+ <td>(</td>
+ <td class="paramname"> </td>
+ <td> ) </td>
+ <td width="100%"></td>
+ </tr>
+ </table>
+</div>
+<div class="memdoc">
+
+<p>
+gets the images to which the user has acces
+<p>
+<dl class="return" compact><dt><b>Returns:</b></dt><dd>an array of image arrays, each with 2 indices:<br>
+ <b>id</b> - id of the image<br>
+ <b>name</b> - name of the image </dd></dl>
+<dl compact><dt><b>Examples: </b></dt><dd>
+<a class="el" href="xmlrpc__example_8php-example.html#a1">xmlrpc_example.php</a>.</dl>
+</div>
+</div><p>
+<a class="anchor" name="f8b8c718ea7ea9cc973602a2fe9ae20e"></a><!-- doxytag: member="xmlrpcWrappers.php::XMLRPCgetRequestConnectData" ref="f8b8c718ea7ea9cc973602a2fe9ae20e" args="($requestid, $remoteIP)" -->
+<div class="memitem">
+<div class="memproto">
+ <table class="memname">
+ <tr>
+ <td class="memname">function XMLRPCgetRequestConnectData </td>
+ <td>(</td>
+ <td class="paramtype">$ </td>
+ <td class="paramname"> <em>requestid</em>, </td>
+ </tr>
+ <tr>
+ <td class="paramkey"></td>
+ <td></td>
+ <td class="paramtype">$ </td>
+ <td class="paramname"> <em>remoteIP</em></td><td> </td>
+ </tr>
+ <tr>
+ <td></td>
+ <td>)</td>
+ <td></td><td></td><td width="100%"></td>
+ </tr>
+ </table>
+</div>
+<div class="memdoc">
+
+<p>
+if request is ready, adds the connecting user's computer to the request and returns info about how to connect to the computer
+<p>
+<dl compact><dt><b>Parameters:</b></dt><dd>
+ <table border="0" cellspacing="2" cellpadding="0">
+ <tr><td valign="top"></td><td valign="top"><em>$requestid</em> </td><td>- id of a request </td></tr>
+ <tr><td valign="top"></td><td valign="top"><em>$remoteIP</em> </td><td>- ip address of connecting user's computer</td></tr>
+ </table>
+</dl>
+<dl class="return" compact><dt><b>Returns:</b></dt><dd>an array with at least one index named '<b>status'</b> which will have one of these values<br>
+ <b>error</b> - error occurred; there will be 2 additional elements in the array: <ul>
+<li><b>errorcode</b> - error number<br>
+ </li>
+<li><b>errormsg</b> - error string<br>
+</li>
+</ul>
+<b>ready</b> - request is ready; there will be 3 additional elements in the array: <ul>
+<li><b>serverIP</b> - address of the reserved machine </li>
+<li><b>user</b> - user to use when connecting to the machine </li>
+<li><b>password</b> - password to use when connecting to the machine</li>
+</ul>
+<b>notready</b> - request is not ready for connection </dd></dl>
+<dl compact><dt><b>Examples: </b></dt><dd>
+<a class="el" href="xmlrpc__example_8php-example.html#a4">xmlrpc_example.php</a>.</dl>
+</div>
+</div><p>
+<a class="anchor" name="815cd48d7d8c85754b2091313c02ccec"></a><!-- doxytag: member="xmlrpcWrappers.php::XMLRPCgetRequestIds" ref="815cd48d7d8c85754b2091313c02ccec" args="()" -->
+<div class="memitem">
+<div class="memproto">
+ <table class="memname">
+ <tr>
+ <td class="memname">function XMLRPCgetRequestIds </td>
+ <td>(</td>
+ <td class="paramname"> </td>
+ <td> ) </td>
+ <td width="100%"></td>
+ </tr>
+ </table>
+</div>
+<div class="memdoc">
+
+<p>
+gets information about all of user's requests
+<p>
+<dl class="return" compact><dt><b>Returns:</b></dt><dd>an array with at least one index named 'status' which will have one of these values<br>
+ <b>error</b> - error occurred; there will be 2 additional elements in the array: <ul>
+<li><b>errorcode</b> - error number<br>
+ </li>
+<li><b>errormsg</b> - error string<br>
+</li>
+</ul>
+<b>success</b> - request was successfully ended; there will be an additional element whose index is 'requests' which is an array of arrays, each having these elements (or empty if no existing requests):<br>
+ <ul>
+<li><b>requestid</b> - id of the request<br>
+ </li>
+<li><b>imageid</b> - id of the image<br>
+ </li>
+<li><b>imagename</b> - name of the image<br>
+ </li>
+<li><b>start</b> - unix timestamp of start time<br>
+ </li>
+<li><b>end</b> - unix timestamp of end time </li>
+</ul>
+</dd></dl>
+
+</div>
+</div><p>
+<a class="anchor" name="131560f1aa7577bd1da62d5b7e228e4c"></a><!-- doxytag: member="xmlrpcWrappers.php::XMLRPCgetRequestStatus" ref="131560f1aa7577bd1da62d5b7e228e4c" args="($requestid)" -->
+<div class="memitem">
+<div class="memproto">
+ <table class="memname">
+ <tr>
+ <td class="memname">function XMLRPCgetRequestStatus </td>
+ <td>(</td>
+ <td class="paramtype">$ </td>
+ <td class="paramname"> <em>requestid</em> </td>
+ <td> ) </td>
+ <td width="100%"></td>
+ </tr>
+ </table>
+</div>
+<div class="memdoc">
+
+<p>
+determines and returns the status of the request
+<p>
+<dl compact><dt><b>Parameters:</b></dt><dd>
+ <table border="0" cellspacing="2" cellpadding="0">
+ <tr><td valign="top"></td><td valign="top"><em>$requestid</em> </td><td>- id of a request</td></tr>
+ </table>
+</dl>
+<dl class="return" compact><dt><b>Returns:</b></dt><dd>an array with at least one index named '<b>status'</b> which will have one of these values:<br>
+ <b>error</b> - error occurred; there will be 2 additional elements in the array: <ul>
+<li><b>errorcode</b> - error number<br>
+ </li>
+<li><b>errormsg</b> - error string<br>
+</li>
+</ul>
+<b>ready</b> - request is ready<br>
+ <b>failed</b> - request failed to load properly<br>
+ <b>timedout</b> - request timed out (user didn't connect before timeout expired)<br>
+ <b>loading</b> - request is still loading; there will be an additional element in the array: <ul>
+<li><b>time</b> - the estimated wait time (in minutes) for loading to complete<br>
+</li>
+</ul>
+<b>future</b> - start time of request is in the future </dd></dl>
+<dl compact><dt><b>Examples: </b></dt><dd>
+<a class="el" href="xmlrpc__example_8php-example.html#a3">xmlrpc_example.php</a>.</dl>
+</div>
+</div><p>
+<a class="anchor" name="c3e09831835663a8bd79aab3f0ea3e69"></a><!-- doxytag: member="xmlrpcWrappers.php::XMLRPCtest" ref="c3e09831835663a8bd79aab3f0ea3e69" args="($string)" -->
+<div class="memitem">
+<div class="memproto">
+ <table class="memname">
+ <tr>
+ <td class="memname">function XMLRPCtest </td>
+ <td>(</td>
+ <td class="paramtype">$ </td>
+ <td class="paramname"> <em>string</em> </td>
+ <td> ) </td>
+ <td width="100%"></td>
+ </tr>
+ </table>
+</div>
+<div class="memdoc">
+
+<p>
+this is a test function that call be called when getting XML RPC calls to this site to work
+<p>
+<dl compact><dt><b>Parameters:</b></dt><dd>
+ <table border="0" cellspacing="2" cellpadding="0">
+ <tr><td valign="top"></td><td valign="top"><em>$string</em> </td><td>- a string</td></tr>
+ </table>
+</dl>
+<dl class="return" compact><dt><b>Returns:</b></dt><dd>an array with 3 indices:<br>
+ <b>status</b> - will be 'success'<br>
+ <b>message</b> - will be 'RPC call worked successfully'<br>
+ <b>string</b> - contents of $string (after being sanatized) </dd></dl>
+<dl compact><dt><b>Examples: </b></dt><dd>
+<a class="el" href="xmlrpc__example_8php-example.html#a0">xmlrpc_example.php</a>.</dl>
+</div>
+</div><p>
+<hr size="1"><address style="text-align: right;"><small>Generated on Wed Dec 19 11:28:46 2007 for VCL XML RPC by
+<a href="http://www.doxygen.org/index.html">
+<img src="doxygen.png" alt="doxygen" align="middle" border="0"></a> 1.5.3 </small></address>
+</body>
+</html>
diff --git a/web/.ht-inc/xmlrpcdocs/xmlrpc__example_8php-example.html b/web/.ht-inc/xmlrpcdocs/xmlrpc__example_8php-example.html
new file mode 100644
index 0000000..8d9be59
--- /dev/null
+++ b/web/.ht-inc/xmlrpcdocs/xmlrpc__example_8php-example.html
@@ -0,0 +1,123 @@
+<!--
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+-->
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<html><head><meta http-equiv="Content-Type" content="text/html;charset=UTF-8">
+<title>VCL XML RPC: xmlrpc_example.php</title>
+<link href="doxygen.css" rel="stylesheet" type="text/css">
+<link href="tabs.css" rel="stylesheet" type="text/css">
+</head><body>
+<!-- Generated by Doxygen 1.5.3 -->
+<h1>xmlrpc_example.php</h1><div class="fragment"><pre class="fragment"><a name="l00001"></a>00001 <?php
+<a name="l00002"></a>00002 session_start();
+<a name="l00003"></a>00003
+<a name="l00004"></a>00004 $url = <span class="stringliteral">"http://{$_SERVER['HTTP_HOST']}{$_SERVER['PHP_SELF']}"</span>;
+<a name="l00005"></a>00005 print <span class="stringliteral">"<a href=\"$url?state=test\">Test</a><br>\n"</span>;
+<a name="l00006"></a>00006 print <span class="stringliteral">"<a href=\"$url?state=listimages\">List Available Images</a><br>\n"</span>;
+<a name="l00007"></a>00007 print <span class="stringliteral">"<a href=\"$url?state=addrequest\">Add request for Maple 10</a><br>\n"</span>;
+<a name="l00008"></a>00008 print <span class="stringliteral">"<a href=\"$url?state=requeststatus\">Get status of request</a><br>\n"</span>;
+<a name="l00009"></a>00009 print <span class="stringliteral">"<a href=\"$url?state=connectdata\">Get connection data</a><br>\n"</span>;
+<a name="l00010"></a>00010 print <span class="stringliteral">"<a href=\"$url?state=endrequest\">End request</a><br>\n"</span>;
+<a name="l00011"></a>00011
+<a name="l00012"></a>00012 print <span class="stringliteral">"<pre>\n"</span>;
+<a name="l00013"></a>00013
+<a name="l00014"></a>00014 <span class="comment">// test</span>
+<a name="l00015"></a>00015 <span class="keywordflow">if</span>($_GET['state'] == 'test') {
+<a name="l00016"></a>00016 $rc = remoteVCLCall('<a name="a0"></a><a class="code" href="xmlrpcWrappers_8php.html#c3e09831835663a8bd79aab3f0ea3e69" title="this is a test function that call be called when getting XML RPC calls to this site...">XMLRPCtest</a>', array('foo'));
+<a name="l00017"></a>00017 print_r($rc);
+<a name="l00018"></a>00018 }
+<a name="l00019"></a>00019 <span class="comment">// list images</span>
+<a name="l00020"></a>00020 elseif($_GET['state'] == 'listimages') {
+<a name="l00021"></a>00021 $rc = remoteVCLCall('<a name="a1"></a><a class="code" href="xmlrpcWrappers_8php.html#e2c01a27349e7a7788a42cfb5fe0d5ab" title="gets the images to which the user has acces">XMLRPCgetImages</a>', array());
+<a name="l00022"></a>00022 print_r($rc);
+<a name="l00023"></a>00023 }
+<a name="l00024"></a>00024 <span class="comment">// add request</span>
+<a name="l00025"></a>00025 elseif($_GET['state'] == 'addrequest') {
+<a name="l00026"></a>00026 $rc = remoteVCLCall('<a name="a2"></a><a class="code" href="xmlrpcWrappers_8php.html#e6f9d40f20e08994fa3d82c8dd12bdf5" title="tries to make a request">XMLRPCaddRequest</a>', array(98, 'now', 60));
+<a name="l00027"></a>00027 <span class="keywordflow">if</span>($rc['status'] == 'success') {
+<a name="l00028"></a>00028 print <span class="stringliteral">"request id is {$rc['requestid']}<br>\n"</span>;
+<a name="l00029"></a>00029 $_SESSION['requestid'] = $rc['requestid'];
+<a name="l00030"></a>00030 }
+<a name="l00031"></a>00031 <span class="keywordflow">else</span> {
+<a name="l00032"></a>00032 print_r($rc);
+<a name="l00033"></a>00033 }
+<a name="l00034"></a>00034 }
+<a name="l00035"></a>00035 <span class="comment">// get request status</span>
+<a name="l00036"></a>00036 elseif($_GET['state'] == 'requeststatus') {
+<a name="l00037"></a>00037 <span class="keywordflow">if</span>(! array_key_exists('requestid', $_SESSION)) {
+<a name="l00038"></a>00038 print <span class="stringliteral">"no request created<br>\n"</span>;
+<a name="l00039"></a>00039 exit;
+<a name="l00040"></a>00040 }
+<a name="l00041"></a>00041 $rc = remoteVCLCall('<a name="a3"></a><a class="code" href="xmlrpcWrappers_8php.html#131560f1aa7577bd1da62d5b7e228e4c" title="determines and returns the status of the request">XMLRPCgetRequestStatus</a>', array($_SESSION['requestid']));
+<a name="l00042"></a>00042 print <span class="stringliteral">"current status of request {$_SESSION['requestid']} is {$rc['status']}"</span>;
+<a name="l00043"></a>00043 }
+<a name="l00044"></a>00044 <span class="comment">// get connection data</span>
+<a name="l00045"></a>00045 elseif($_GET['state'] == 'connectdata') {
+<a name="l00046"></a>00046 <span class="keywordflow">if</span>(! array_key_exists('requestid', $_SESSION)) {
+<a name="l00047"></a>00047 print <span class="stringliteral">"no request created<br>\n"</span>;
+<a name="l00048"></a>00048 exit;
+<a name="l00049"></a>00049 }
+<a name="l00050"></a>00050 $rc = remoteVCLCall('<a name="a4"></a><a class="code" href="xmlrpcWrappers_8php.html#f8b8c718ea7ea9cc973602a2fe9ae20e" title="if request is ready, adds the connecting user&#39;s computer to the request and returns...">XMLRPCgetRequestConnectData</a>', array($_SESSION['requestid'], $_SERVER[<span class="stringliteral">"REMOTE_ADDR"</span>]));
+<a name="l00051"></a>00051 <span class="keywordflow">if</span>($rc['status'] == 'ready')
+<a name="l00052"></a>00052 print_r($rc);
+<a name="l00053"></a>00053 <span class="keywordflow">else</span>
+<a name="l00054"></a>00054 print <span class="stringliteral">"status of request is {$rc['status']}"</span>;
+<a name="l00055"></a>00055 }
+<a name="l00056"></a>00056 <span class="comment">// end request</span>
+<a name="l00057"></a>00057 elseif($_GET['state'] == 'endrequest') {
+<a name="l00058"></a>00058 <span class="keywordflow">if</span>(! array_key_exists('requestid', $_SESSION)) {
+<a name="l00059"></a>00059 print <span class="stringliteral">"no request created<br>\n"</span>;
+<a name="l00060"></a>00060 exit;
+<a name="l00061"></a>00061 }
+<a name="l00062"></a>00062 $rc = remoteVCLCall('<a name="a5"></a><a class="code" href="xmlrpcWrappers_8php.html#dfdaad6201dbcaaf5c2249a2c38437cc" title="ends/deletes a request">XMLRPCendRequest</a>', array($_SESSION['requestid']));
+<a name="l00063"></a>00063 <span class="keywordflow">if</span>($rc['status'] == 'error')
+<a name="l00064"></a>00064 print_r($rc);
+<a name="l00065"></a>00065 <span class="keywordflow">else</span> {
+<a name="l00066"></a>00066 print <span class="stringliteral">"request ended<br>\n"</span>;
+<a name="l00067"></a>00067 unset($_SESSION['requestid']);
+<a name="l00068"></a>00068 }
+<a name="l00069"></a>00069 }
+<a name="l00070"></a>00070 print <span class="stringliteral">"</pre>\n"</span>;
+<a name="l00071"></a>00071
+<a name="l00072"></a>00072 function remoteVCLCall($method, $args) {
+<a name="l00073"></a>00073 $request = xmlrpc_encode_request($method, $args);
+<a name="l00074"></a>00074 $header = <span class="stringliteral">"Content-Type: text/xml\r\n"</span>;
+<a name="l00075"></a>00075 $header .= <span class="stringliteral">"X-User: userid\r\n"</span>; <span class="comment">// user your userid here</span>
+<a name="l00076"></a>00076 $header .= <span class="stringliteral">"X-Pass: password\r\n"</span>; <span class="comment">// user your password here</span>
+<a name="l00077"></a>00077 $header .= <span class="stringliteral">"X-APIVERSION: 1"</span>; <span class="comment">// this is to allow for future changes to the api</span>
+<a name="l00078"></a>00078 $context = stream_context_create(
+<a name="l00079"></a>00079 array(
+<a name="l00080"></a>00080 'http' => array(
+<a name="l00081"></a>00081 'method' => <span class="stringliteral">"POST"</span>,
+<a name="l00082"></a>00082 'header' => $header,
+<a name="l00083"></a>00083 'content' => $request
+<a name="l00084"></a>00084 )
+<a name="l00085"></a>00085 )
+<a name="l00086"></a>00086 );
+<a name="l00087"></a>00087 $file = file_get_contents(<span class="stringliteral">"https://vcl.ncsu.edu/scheduling/index.php?mode=xmlrpccall"</span>, <span class="keyword">false</span>, $context);
+<a name="l00088"></a>00088 $response = xmlrpc_decode($file);
+<a name="l00089"></a>00089 <span class="keywordflow">if</span>(xmlrpc_is_fault($response)) {
+<a name="l00090"></a>00090 trigger_error(<span class="stringliteral">"xmlrpc: {$response['faultString']} ({$response['faultCode']})"</span>);
+<a name="l00091"></a>00091 exit;
+<a name="l00092"></a>00092 }
+<a name="l00093"></a>00093 <span class="keywordflow">return</span> $response;
+<a name="l00094"></a>00094 }
+<a name="l00095"></a>00095 ?>
+</pre></div> <hr size="1"><address style="text-align: right;"><small>Generated on Wed Dec 19 11:28:46 2007 for VCL XML RPC by
+<a href="http://www.doxygen.org/index.html">
+<img src="doxygen.png" alt="doxygen" align="middle" border="0"></a> 1.5.3 </small></address>
+</body>
+</html>
diff --git a/web/css/doxygen.css b/web/css/doxygen.css
new file mode 100644
index 0000000..baf855b
--- /dev/null
+++ b/web/css/doxygen.css
@@ -0,0 +1,360 @@
+/*
+* Licensed to the Apache Software Foundation (ASF) under one or more
+* contributor license agreements. See the NOTICE file distributed with
+* this work for additional information regarding copyright ownership.
+* The ASF licenses this file to You under the Apache License, Version 2.0
+* (the "License"); you may not use this file except in compliance with
+* the License. You may obtain a copy of the License at
+*
+* http://www.apache.org/licenses/LICENSE-2.0
+*
+* Unless required by applicable law or agreed to in writing, software
+* distributed under the License is distributed on an "AS IS" BASIS,
+* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+* See the License for the specific language governing permissions and
+* limitations under the License.
+*/
+BODY,H1,H2,H3,H4,H5,H6,P,CENTER,TD,TH,UL,DL,DIV {
+ font-family: Geneva, Arial, Helvetica, sans-serif;
+}
+CAPTION { font-weight: bold }
+DIV.qindex {
+ width: 100%;
+ background-color: #e8eef2;
+ border: 1px solid #84b0c7;
+ text-align: center;
+ margin: 2px;
+ padding: 2px;
+ line-height: 140%;
+}
+DIV.nav {
+ width: 100%;
+ background-color: #e8eef2;
+ border: 1px solid #84b0c7;
+ text-align: center;
+ margin: 2px;
+ padding: 2px;
+ line-height: 140%;
+}
+DIV.navtab {
+ background-color: #e8eef2;
+ border: 1px solid #84b0c7;
+ text-align: center;
+ margin: 2px;
+ margin-right: 15px;
+ padding: 2px;
+}
+TD.navtab {
+ font-size: 70%;
+}
+A.qindex {
+ text-decoration: none;
+ font-weight: bold;
+ color: #1A419D;
+}
+A.qindex:visited {
+ text-decoration: none;
+ font-weight: bold;
+ color: #1A419D
+}
+A.qindex:hover {
+ text-decoration: none;
+ background-color: #ddddff;
+}
+A.qindexHL {
+ text-decoration: none;
+ font-weight: bold;
+ background-color: #6666cc;
+ color: #ffffff;
+ border: 1px double #9295C2;
+}
+A.qindexHL:hover {
+ text-decoration: none;
+ background-color: #6666cc;
+ color: #ffffff;
+}
+A.qindexHL:visited { text-decoration: none; background-color: #6666cc; color: #ffffff }
+A.el { text-decoration: none; font-weight: bold }
+A.elRef { font-weight: bold }
+A.code:link { text-decoration: none; font-weight: normal; color: #0000FF}
+A.code:visited { text-decoration: none; font-weight: normal; color: #0000FF}
+A.codeRef:link { font-weight: normal; color: #0000FF}
+A.codeRef:visited { font-weight: normal; color: #0000FF}
+DL.el { margin-left: -1cm }
+.fragment {
+ font-family: monospace, fixed;
+ font-size: 95%;
+}
+PRE.fragment {
+ border: 1px solid #CCCCCC;
+ background-color: #f5f5f5;
+ margin-top: 4px;
+ margin-bottom: 4px;
+ margin-left: 2px;
+ margin-right: 8px;
+ padding-left: 6px;
+ padding-right: 6px;
+ padding-top: 4px;
+ padding-bottom: 4px;
+}
+DIV.ah { background-color: black; font-weight: bold; color: #ffffff; margin-bottom: 3px; margin-top: 3px }
+
+DIV.groupHeader {
+ margin-left: 16px;
+ margin-top: 12px;
+ margin-bottom: 6px;
+ font-weight: bold;
+}
+DIV.groupText { margin-left: 16px; font-style: italic; font-size: 90% }
+BODY {
+ background: white;
+ color: black;
+ margin-right: 20px;
+ margin-left: 20px;
+}
+TD.indexkey {
+ background-color: #e8eef2;
+ font-weight: bold;
+ padding-right : 10px;
+ padding-top : 2px;
+ padding-left : 10px;
+ padding-bottom : 2px;
+ margin-left : 0px;
+ margin-right : 0px;
+ margin-top : 2px;
+ margin-bottom : 2px;
+ border: 1px solid #CCCCCC;
+}
+TD.indexvalue {
+ background-color: #e8eef2;
+ font-style: italic;
+ padding-right : 10px;
+ padding-top : 2px;
+ padding-left : 10px;
+ padding-bottom : 2px;
+ margin-left : 0px;
+ margin-right : 0px;
+ margin-top : 2px;
+ margin-bottom : 2px;
+ border: 1px solid #CCCCCC;
+}
+TR.memlist {
+ background-color: #f0f0f0;
+}
+P.formulaDsp { text-align: center; }
+IMG.formulaDsp { }
+IMG.formulaInl { vertical-align: middle; }
+SPAN.keyword { color: #008000 }
+SPAN.keywordtype { color: #604020 }
+SPAN.keywordflow { color: #e08000 }
+SPAN.comment { color: #800000 }
+SPAN.preprocessor { color: #806020 }
+SPAN.stringliteral { color: #002080 }
+SPAN.charliteral { color: #008080 }
+.mdescLeft {
+ padding: 0px 8px 4px 8px;
+ font-size: 80%;
+ font-style: italic;
+ background-color: #FAFAFA;
+ border-top: 1px none #E0E0E0;
+ border-right: 1px none #E0E0E0;
+ border-bottom: 1px none #E0E0E0;
+ border-left: 1px none #E0E0E0;
+ margin: 0px;
+}
+.mdescRight {
+ padding: 0px 8px 4px 8px;
+ font-size: 80%;
+ font-style: italic;
+ background-color: #FAFAFA;
+ border-top: 1px none #E0E0E0;
+ border-right: 1px none #E0E0E0;
+ border-bottom: 1px none #E0E0E0;
+ border-left: 1px none #E0E0E0;
+ margin: 0px;
+}
+.memItemLeft {
+ padding: 1px 0px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: solid;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.memItemRight {
+ padding: 1px 8px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: solid;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.memTemplItemLeft {
+ padding: 1px 0px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: none;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.memTemplItemRight {
+ padding: 1px 8px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: none;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.memTemplParams {
+ padding: 1px 0px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: solid;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ color: #606060;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.search { color: #003399;
+ font-weight: bold;
+}
+FORM.search {
+ margin-bottom: 0px;
+ margin-top: 0px;
+}
+INPUT.search { font-size: 75%;
+ color: #000080;
+ font-weight: normal;
+ background-color: #e8eef2;
+}
+TD.tiny { font-size: 75%;
+}
+a {
+ color: #1A41A8;
+}
+a:visited {
+ color: #2A3798;
+}
+.dirtab { padding: 4px;
+ border-collapse: collapse;
+ border: 1px solid #84b0c7;
+}
+TH.dirtab { background: #e8eef2;
+ font-weight: bold;
+}
+HR { height: 1px;
+ border: none;
+ border-top: 1px solid black;
+}
+
+/* Style for detailed member documentation */
+.memtemplate {
+ font-size: 80%;
+ color: #606060;
+ font-weight: normal;
+}
+.memnav {
+ background-color: #e8eef2;
+ border: 1px solid #84b0c7;
+ text-align: center;
+ margin: 2px;
+ margin-right: 15px;
+ padding: 2px;
+}
+.memitem {
+ padding: 4px;
+ background-color: #eef3f5;
+ border-width: 1px;
+ border-style: solid;
+ border-color: #dedeee;
+ -moz-border-radius: 8px 8px 8px 8px;
+}
+.memname {
+ white-space: nowrap;
+ font-weight: bold;
+}
+.memdoc{
+ padding-left: 10px;
+}
+.memproto {
+ background-color: #d5e1e8;
+ width: 100%;
+ border-width: 1px;
+ border-style: solid;
+ border-color: #84b0c7;
+ font-weight: bold;
+ -moz-border-radius: 8px 8px 8px 8px;
+}
+.paramkey {
+ text-align: right;
+}
+.paramtype {
+ white-space: nowrap;
+}
+.paramname {
+ color: #602020;
+ font-style: italic;
+}
+/* End Styling for detailed member documentation */
+
+/* for the tree view */
+.ftvtree {
+ font-family: sans-serif;
+ margin:0.5em;
+}
+.directory { font-size: 9pt; font-weight: bold; }
+.directory h3 { margin: 0px; margin-top: 1em; font-size: 11pt; }
+.directory > h3 { margin-top: 0; }
+.directory p { margin: 0px; white-space: nowrap; }
+.directory div { display: none; margin: 0px; }
+.directory img { vertical-align: -30%; }
+
diff --git a/web/css/vcl.css b/web/css/vcl.css
new file mode 100644
index 0000000..eec805f
--- /dev/null
+++ b/web/css/vcl.css
@@ -0,0 +1,177 @@
+/*
+* Licensed to the Apache Software Foundation (ASF) under one or more
+* contributor license agreements. See the NOTICE file distributed with
+* this work for additional information regarding copyright ownership.
+* The ASF licenses this file to You under the Apache License, Version 2.0
+* (the "License"); you may not use this file except in compliance with
+* the License. You may obtain a copy of the License at
+*
+* http://www.apache.org/licenses/LICENSE-2.0
+*
+* Unless required by applicable law or agreed to in writing, software
+* distributed under the License is distributed on an "AS IS" BASIS,
+* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+* See the License for the specific language governing permissions and
+* limitations under the License.
+*/
+.scriptonly {
+ display: none;
+}
+
+.scriptoff {
+ display: inline;
+}
+.compstatelink {
+ color: red;
+}
+
+.compstatelink a {
+ color: red;
+}
+
+.compstatelink a:hover {
+ background: #CCCCCC;
+ text-decoration: none;
+}
+
+#expauthul li {
+ list-style-type: disc;
+}
+
+.shown {
+ display: block;
+}
+
+.hidden {
+ display: none;
+}
+
+.hlrow td {
+ background: #ffff88;
+}
+
+.hlrow th {
+ background: #ffff88;
+}
+
+.hlcol {
+ background: #ccccff;
+}
+
+.nohlcol {
+ background: #ededed;
+}
+
+.rightborder {
+ border-right: 1px solid #000000;
+}
+
+.preferenceslist {
+ display: block;
+ list-style-type: none;
+ margin: 0 1px 0 0;
+ padding: 0;
+ text-align: left;
+}
+
+.preferenceslist a {
+ font-size: 15px;
+}
+
+.whenusefieldset {
+ border-width: 0px;
+}
+
+.errormsg {
+ float: right;
+ width: 100px;
+}
+
+#resStatusText div {
+ background: threedface;
+}
+
+#resStatusText table {
+ background: threedface;
+ border-spacing: 5px 0px;
+ margin: 0px 0px 0px 0px;
+}
+
+#resStatusText table td {
+ padding: 1px;
+}
+
+.usergrouptable form {
+ margin: 0;
+}
+
+.usergrouptable td {
+ padding-left: 1px;
+}
+
+.resourcegrouptable form {
+ margin: 0;
+}
+
+.resourcegrouptable td {
+ padding-left: 1px;
+}
+
+#layouttable td {
+ vertical-align: top;
+}
+
+#ttlayout td {
+ border: solid 1px #eeeeee;
+}
+
+#listitems {
+ z-index: -10;
+ position: absolute;
+ left: 50px;
+ top: 100px;
+ background-color: lightblue;
+ border: 2px;
+}
+
+.dojoDialog {
+ background: #eee;
+ border: 1px solid #999;
+ -moz-border-radius: 5px;
+ padding: 4px;
+}
+.vcldocpage ol {
+ list-style-type: decimal;
+}
+
+.vcldocpage ul {
+ list-style-type: disc;
+}
+
+.profileDlg {
+ background: #eee;
+ border: 1px solid #999;
+ -moz-border-radius: 5px;
+ padding: 4px;
+}
+
+.nperrormsg {
+ font-style: italic;
+ color: red;
+}
+
+#revisiontable th {
+ border: solid 1px #000000;
+ padding: 2px;
+ vertical-align: middle;
+}
+
+#revisiontable td {
+ border: solid 1px #000000;
+ padding: 2px;
+ vertical-align: middle;
+}
+
+.numbers {
+ list-style-type: decimal;
+}
diff --git a/web/images/blank.gif b/web/images/blank.gif
new file mode 100755
index 0000000..a856ec5
--- /dev/null
+++ b/web/images/blank.gif
Binary files differ
diff --git a/web/images/fonts/arial.ttf b/web/images/fonts/arial.ttf
new file mode 100644
index 0000000..d59f53b
--- /dev/null
+++ b/web/images/fonts/arial.ttf
Binary files differ
diff --git a/web/images/fonts/arialbd.ttf b/web/images/fonts/arialbd.ttf
new file mode 100644
index 0000000..f09499b
--- /dev/null
+++ b/web/images/fonts/arialbd.ttf
Binary files differ
diff --git a/web/images/gray.jpg b/web/images/gray.jpg
new file mode 100644
index 0000000..81e6310
--- /dev/null
+++ b/web/images/gray.jpg
Binary files differ
diff --git a/web/images/green.jpg b/web/images/green.jpg
new file mode 100644
index 0000000..b839bd1
--- /dev/null
+++ b/web/images/green.jpg
Binary files differ
diff --git a/web/images/list.gif b/web/images/list.gif
new file mode 100644
index 0000000..b8447ae
--- /dev/null
+++ b/web/images/list.gif
Binary files differ
diff --git a/web/images/orange.jpg b/web/images/orange.jpg
new file mode 100644
index 0000000..b1e9488
--- /dev/null
+++ b/web/images/orange.jpg
Binary files differ
diff --git a/web/images/red.jpg b/web/images/red.jpg
new file mode 100644
index 0000000..86bb555
--- /dev/null
+++ b/web/images/red.jpg
Binary files differ
diff --git a/web/images/textimage.php b/web/images/textimage.php
new file mode 100644
index 0000000..ad0a62d
--- /dev/null
+++ b/web/images/textimage.php
@@ -0,0 +1,70 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+// most of this was taken from Troy's documentation at
+// http://sysadm.eos.ncsu.edu/site/pages/phpdev/gd-graphics
+
+$face = "fonts/arialbd.ttf";
+
+function vectordist($a, $b){
+ if($a < 0 && $b < 0) return abs($a - $b);
+ else if( $a < 0 || $b < 0) return abs($a) + abs($b);
+ else return abs($a - $b);
+}
+
+// create a filename safe version of the provided text for the button
+$text = $_GET["text"];
+$lowertext = strtolower($_GET["text"]);
+$pattern = "/\W/";
+$replacement = "";
+$lowertext = preg_replace($pattern, $replacement, $lowertext);
+//if($_GET["style"] == "off") $lowertext .= "_off";
+//else $lowertext .= "_on";
+
+// these headers are needed so the browser knows what it is getting
+header('Content-Type: image/gif');
+header('Content-Disposition: inline; filename=$lowertext.gif');
+
+// calculate the size the text will fill
+$size = imagettfbbox( 14, 90, $face, $text);
+$height = vectordist($size[1], $size[3]);
+$width = vectordist($size[0], $size[4]) + 2;
+#print "<pre>\n";
+#print_r($size);
+#print "</pre>\nwidth - $width<br>height - $height<br>\n";
+
+// create an "image resource" big enough to show the text and have some padding.
+// set the background color, the text color, and make the background color the
+// transparency color.
+$image = imagecreate($width, $height);
+#imagecolorallocate($image, 0xDD, 0xDD, 0xDD);
+#imagefill($image, 0, 0, 0xDDDDDD);
+$background = imagecolorallocate($image, 0xFF, 0xFF, 0xFF);
+$textcolor = imagecolorallocate($image, 0, 0, 0);
+imagecolortransparent($image, $background);
+
+// this line inserts the text into the image, I have noticed that the font sizes
+// that GD uses do not really match point sizes. 11 below roughly matches 15 points.
+// 90 is the angle the text is rotated at, 5 is the horizontal displacement (right) of the text,
+// $height + 2 is the vertical displacement (down) of the text.
+imagettftext( $image, 13, 90, 13, $height - 5, $textcolor, $face, $text);
+
+// output the image, destroy the resource (not really needed in this case), and terminate
+imagegif($image);
+imagedestroy($image);
+?>
diff --git a/web/images/x.png b/web/images/x.png
new file mode 100644
index 0000000..1187282
--- /dev/null
+++ b/web/images/x.png
Binary files differ
diff --git a/web/index.php b/web/index.php
new file mode 100644
index 0000000..357b843
--- /dev/null
+++ b/web/index.php
@@ -0,0 +1,89 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+@include_once("fckeditor/fckeditor.php");
+require_once(".ht-inc/conf.php");
+if(! isset($_SERVER['HTTPS']) || $_SERVER['HTTPS'] != "on") {
+ header("Location: " . BASEURL . "/");
+ exit;
+}
+
+$user = '';
+$mysql_link_vcl = '';
+$mysql_link_acct = '';
+$mode = '';
+$oldmode = '';
+$submitErr = '';
+$submitErrMsg = '';
+$remoteIP = '';
+$authed = '';
+$viewmode = '';
+$semid = '';
+$semislocked = '';
+unset($GLOBALS['php_errormsg']);
+$cache['nodes'] = array();
+$cache['unityids'] = array();
+$cache['nodeprivs']['resources'] = array();
+$docreaders = array();
+
+require_once(".ht-inc/states.php");
+
+require_once('.ht-inc/errors.php');
+
+require_once('.ht-inc/utils.php');
+
+dbConnect();
+
+initGlobals();
+
+$modes = array_keys($actions['mode']);
+$args = array_keys($actions['args']);
+$hasArg = 0;
+if(in_array($mode, $modes)) {
+ $actionFunction = $actions['mode'][$mode];
+ if(in_array($mode, $args)) {
+ $hasArg = 1;
+ $arg = $actions['args'][$mode];
+ }
+}
+else {
+ $actionFunction = "main";
+}
+
+checkAccess();
+
+sendHeaders();
+
+printHTMLHeader();
+
+if($viewmode == ADMIN_DEVELOPER) {
+ set_error_handler("errorHandler");
+}
+
+if($hasArg) {
+ $actionFunction($arg);
+}
+else {
+ $actionFunction();
+}
+dbDisconnect();
+
+printHTMLFooter();
+
+semUnlock();
+?>
diff --git a/web/js/code.js b/web/js/code.js
new file mode 100644
index 0000000..a23f36b
--- /dev/null
+++ b/web/js/code.js
@@ -0,0 +1,886 @@
+/*
+* Licensed to the Apache Software Foundation (ASF) under one or more
+* contributor license agreements. See the NOTICE file distributed with
+* this work for additional information regarding copyright ownership.
+* The ASF licenses this file to You under the Apache License, Version 2.0
+* (the "License"); you may not use this file except in compliance with
+* the License. You may obtain a copy of the License at
+*
+* http://www.apache.org/licenses/LICENSE-2.0
+*
+* Unless required by applicable law or agreed to in writing, software
+* distributed under the License is distributed on an "AS IS" BASIS,
+* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+* See the License for the specific language governing permissions and
+* limitations under the License.
+*/
+var toggledRows = new Array();
+var toggledCols = new Array();
+var mouseX = 0;
+var mouseY = 0;
+var passvar = 0;
+
+var browser = "";
+function setBrowser() {
+ browser = navigator.appName;
+ if(navigator.appName == 'Netscape') {
+ var regex = new RegExp('Safari');
+ if(navigator.appVersion.match(regex)) {
+ browser = 'Safari';
+ }
+ }
+ else if(navigator.appName == 'Microsoft Internet Explorer') {
+ browser = 'IE';
+ }
+}
+setBrowser();
+
+function testJS() {
+ if(document.getElementById('testjavascript'))
+ document.getElementById('testjavascript').value = '1';
+}
+
+function fixButtons2() {
+ var btns = new Array('addNodeBtn',
+ 'deleteNodeBtn',
+ 'userPrivBtn',
+ 'addUserBtn',
+ 'groupPrivBtn',
+ 'addGroupBtn',
+ 'resourcePrivBtn',
+ 'addResourceBtn',
+ 'submitAddUserBtn',
+ 'cancelAddUserBtn',
+ 'submitAddGroupBtn',
+ 'cancelAddGroupBtn',
+ 'submitAddNodeBtn',
+ 'cancelAddNodeBtn',
+ 'submitDeleteNodeBtn',
+ 'cancelDeleteNodeBtn'
+ );
+ var obj;
+ for(var i = 0; i < btns.length; i++) {
+ obj = dojo.widget.byId(btns[i]);
+ if(obj) {
+ obj.domNode.style.zoom = 1;
+ obj.domNode.style.zoom = "";
+ }
+ }
+}
+
+function initPrivTree() {
+ var obj = dojo.widget.byId('privTree');
+ if(obj) {
+ dojo.event.topic.subscribe("nodeSelected",
+ function(message) {nodeSelect(message.node);}
+ );
+ dojo.event.topic.subscribe(obj.eventNames['expand'],
+ treeListener, 'nodeExpand');
+ var selectedNodeId = dojo.io.cookie.get('VCLACTIVENODE');
+ var selectedNode = dojo.widget.byId(selectedNodeId);
+ setSelectedPrivNode(selectedNodeId);
+ var selector = dojo.widget.byId('treeSelector');
+ dojo.event.connect('before', selector, 'onCollapse', treeListener, 'nodeCollapse');
+ }
+}
+
+function checkAllCompUtils() {
+ var count = 0;
+ var obj;
+ while(obj = document.getElementById('comp' + count)) {
+ obj.checked = true;
+ document.getElementById('compid' + count).className = 'hlrow';
+ toggledRows['compid' + count] = 1;
+ count++;
+ }
+ return true;
+}
+
+function uncheckAllCompUtils() {
+ var count = 0;
+ var obj;
+ while(obj = document.getElementById('comp' + count)) {
+ obj.checked = false;
+ document.getElementById('compid' + count).className = '';
+ toggledRows['compid' + count] = 0;
+ count++;
+ }
+ return true;
+}
+
+function reloadComputerSubmit() {
+ var formobj = document.getElementById('utilform');
+ var obj = document.getElementById('continuation');
+ var contobj = document.getElementById('reloadcont');
+ obj.value = contobj.value;
+ formobj.submit();
+}
+
+function compStateChangeSubmit() {
+ var formobj = document.getElementById('utilform');
+ var obj = document.getElementById('continuation');
+ var contobj = document.getElementById('statecont');
+ obj.value = contobj.value;
+ formobj.submit();
+}
+
+function compScheduleChangeSubmit() {
+ var formobj = document.getElementById('utilform');
+ var obj = document.getElementById('continuation');
+ var contobj = document.getElementById('schcont');
+ obj.value = contobj.value;
+ formobj.submit();
+}
+
+Array.prototype.inArray = function(data) {
+ for(var i = 0; i < this.length; i++) {
+ if(this[i] === data) {
+ return true;
+ }
+ }
+ return false;
+}
+
+Array.prototype.search = function(data) {
+ for (var i = 0; i < this.length; i++) {
+ if(this[i] === data) {
+ return i;
+ }
+ }
+ return false;
+}
+
+function checkSelectParent(message) {
+ var node = message.source;
+ var selector = dojo.widget.byId('treeSelector');
+ if(! selector.selectedNode)
+ return;
+ var parent = selector.selectedNode.parent;
+ while(parent !== node && parent.isTreeNode) {
+ parent = parent.parent;
+ }
+ if(parent === node)
+ selector.select(message);
+}
+
+function hidePrivileges() {
+ //dojo.lfx.fadeHide(dojo.byId('nodePerms'), 200).play();
+}
+
+function showPrivileges() {
+ //dojo.lfx.fadeShow(dojo.byId('nodePerms'), 300).play();
+}
+
+function showAddNodePane() {
+ showWindow('addNodePane');
+}
+
+function showDeleteNodeDialog() {
+ dojo.widget.byId('deleteDialog').show();
+}
+
+function showAddUserPane() {
+ showWindow('addUserPane');
+}
+
+function showAddUserGroupPane() {
+ showWindow('addUserGroupPane');
+}
+
+function showAddResourceGroupPane() {
+ showWindow('addResourceGroupPane');
+}
+
+function showResStatusPane(reqid) {
+ var currdetailid = dojo.byId('detailreqid').value;
+ if(! dojo.widget.byId('resStatusPane')) {
+ window.location.reload();
+ return;
+ }
+ var windowstate = dojo.widget.byId('resStatusPane').windowState;
+ if(currdetailid != reqid) {
+ dojo.byId('detailreqid').value = reqid;
+ dojo.byId('resStatusText').innerHTML = 'Loading...';
+ }
+ if( windowstate == 'minimized' || currdetailid != reqid) {
+ if(typeof(refresh_timer) != "undefined")
+ clearTimeout(refresh_timer);
+ if(windowstate == 'minimized')
+ showWindow('resStatusPane');
+ resRefresh();
+ }
+}
+
+function hideResStatusPane() {
+ dojo.widget.byId('resStatusPane').minimizeWindow();
+}
+
+/*function showWindow(name, offset, leftdist) {
+ var obj = dojo.widget.byId(name);
+ obj[name].style.position = 'absolute';
+ if(leftdist == null)
+ obj[name].style.left = 30;
+ else
+ obj[name].style.left = leftdist;
+ obj.restoreWindow();
+ //var offset = dojo.byId('offset').value;
+ obj[name].style.top = mouseY - offset;
+}*/
+
+function showWindow(name) {
+ var x = mouseX;
+ var y = mouseY;
+ var obj = dojo.widget.byId(name);
+ obj.domNode.style.position = 'absolute';
+ obj.domNode.style.left = x + 'px';
+ var newtop = y - (parseInt(obj.domNode.style.height) / 2);
+ if(newtop < 0)
+ newtop = 0;
+ obj.domNode.style.top = newtop + 'px';
+ obj.restoreWindow();
+}
+
+var genericCB = function(type, data, evt) {
+ unsetLoading();
+ var regex = new RegExp('^<!DOCTYPE html');
+ if(data.match(regex)) {
+ var mesg = 'A minor error has occurred. It is probably safe to ' +
+ 'ignore. However, if you keep getting this message and ' +
+ 'are unable to use VCL, you may contact vcl_help@ncsu.edu ' +
+ 'for further assistance.';
+ alert(mesg);
+ var d = {mode: 'errorrpt',
+ data: data};
+ RPCwrapper(d, function(type, data, evt) {});
+ return;
+ }
+ eval(data);
+}
+
+var errorHandler = function(type, error, data) {
+ alert('error occurred' + error.message + data.responseText);
+}
+
+function nodeSelect(node) {
+ var nodeid = node.widgetId;
+ var nodename = node.title;
+ dojo.byId('addPaneNodeName').innerHTML = 'Node: <strong>' + nodename + '</strong>';
+ dojo.byId('addGroupPaneNodeName').innerHTML = 'Node: <strong>' + nodename + '</strong>';
+ dojo.byId('addResourceGroupPaneNodeName').innerHTML = 'Node: <strong>' + nodename + '</strong>';
+ dojo.byId('addChildNodeName').innerHTML = 'Node: <strong>' + nodename + '</strong>';
+ dojo.byId('deleteNodeName').innerHTML = 'Node: <strong>' + nodename + '</strong>';
+ setLoading();
+ if(dojo.byId('activeNodeAdd'))
+ dojo.byId('activeNodeAdd').value = nodeid;
+ if(dojo.byId('activeNodeDel'))
+ dojo.byId('activeNodeDel').value = nodeid;
+ hidePrivileges();
+ dojo.io.cookie.set('VCLACTIVENODE', nodeid, 365, '/', cookiedomain);
+ var obj = document.getElementById('nodecont');
+ var data = {continuation: obj.value,
+ node: nodeid};
+ RPCwrapper(data, genericCB);
+}
+
+function refreshPerms() {
+ setLoading();
+ var selector = dojo.widget.byId('treeSelector');
+ var nodeid = selector.selectedNode.widgetId;
+ dojo.widget.byId('addUserPane').minimizeWindow();
+ hidePrivileges();
+ var obj = document.getElementById('nodecont');
+ var data = {continuation: obj.value,
+ node: nodeid};
+ RPCwrapper(data, genericCB);
+}
+
+function submitAddUser() {
+ dojo.byId('addUserPrivStatus').innerHTML = '';
+ var obj = dojo.byId('newuser');
+ var userid = obj.value;
+ if(! userid.length)
+ return;
+ var perms = new Array();
+ obj = dojo.widget.byId('blockchk');
+ if(obj.checked)
+ perms.push('block');
+ for(var i = 0; obj = dojo.widget.byId('userck0:' + i); i++) {
+ if(obj.checked)
+ perms.push(obj.name);
+ }
+ var perms2 = perms.join(':', perms);
+ var selector = dojo.widget.byId('treeSelector');
+ var contid = dojo.byId('addusercont').value;
+ var data = {continuation: contid,
+ perms: perms2,
+ newuser: userid,
+ activeNode: selector.selectedNode.widgetId};
+ setLoading();
+ RPCwrapper(data, genericCB);
+}
+
+function addUserPaneHide() {
+ dojo.byId('addUserPrivStatus').innerHTML = '';
+ dojo.byId('newuser').value = '';
+ dojo.widget.byId('addUserPane').minimizeWindow();
+ var obj = dojo.widget.byId('blockchk');
+ if(obj.checked) {
+ obj.checked = false;
+ obj._setInfo();
+ }
+ for(var i = 0; obj = dojo.widget.byId('userck0:' + i); i++) {
+ if(obj.checked) {
+ obj.checked = false;
+ obj._setInfo();
+ }
+ }
+}
+
+function submitAddUserGroup() {
+ dojo.byId('addUserGroupPrivStatus').innerHTML = '';
+ var obj = dojo.byId('newgroupid');
+ var groupid = obj.value;
+ if(! groupid.length)
+ return;
+ var perms = new Array();
+ obj = dojo.widget.byId('blockgrpchk');
+ if(obj.checked)
+ perms.push('block');
+ for(var i = 0; obj = dojo.widget.byId('usergrpck0:' + i); i++) {
+ if(obj.checked)
+ perms.push(obj.name);
+ }
+ var perms2 = perms.join(':', perms);
+ var selector = dojo.widget.byId('treeSelector');
+ var contid = dojo.byId('addusergroupcont').value;
+ var data = {continuation: contid,
+ perms: perms2,
+ newgroupid: groupid,
+ activeNode: selector.selectedNode.widgetId};
+ setLoading();
+ RPCwrapper(data, genericCB);
+}
+
+function addUserGroupPaneHide() {
+ dojo.byId('addUserGroupPrivStatus').innerHTML = '';
+ dojo.byId('newgroupid').value = '';
+ dojo.widget.byId('addUserGroupPane').minimizeWindow();
+ var obj = dojo.widget.byId('blockgrpchk');
+ if(obj.checked) {
+ obj.checked = false;
+ obj._setInfo();
+ }
+ for(var i = 0; obj = dojo.widget.byId('usergrpck0:' + i); i++) {
+ if(obj.checked) {
+ obj.checked = false;
+ obj._setInfo();
+ }
+ }
+}
+
+function privChange(checked, row, col, type) {
+ var objname = 'ck' + row + ':' + col;
+ var obj = dojo.widget.byId(objname);
+ if(obj.disabled)
+ return;
+ var nameArr = obj.name.split('[');
+ nameArr = nameArr[1].split(']');
+ nameArr = nameArr[0].split(':');
+ if(type == 1)
+ var contid = dojo.byId('changeuserprivcont').value;
+ else if(type == 2)
+ var contid = dojo.byId('changeusergroupprivcont').value;
+ else if(type == 3)
+ var contid = dojo.byId('changeresourceprivcont').value;
+ var selector = dojo.widget.byId('treeSelector');
+ var data = {continuation: contid,
+ activeNode: selector.selectedNode.widgetId,
+ item: nameArr[0],
+ priv: nameArr[1],
+ value: checked};
+ setLoading();
+ RPCwrapper(data, genericCB);
+}
+
+function submitUserPrivChanges() {
+ var allusers = dojo.byId('allusers').value;
+ var selector = dojo.widget.byId('treeSelector');
+ var contid = dojo.byId('changeuserprivcont').value;
+ var data = {continuation: contid,
+ activeNode: selector.selectedNode.widgetId,
+ allusers: allusers};
+ var obj;
+ var name;
+ var nameArr;
+ obj = dojo.byId('lastUserNum');
+ if(obj) {
+ var lastid = obj.innerHTML;
+ for(var j = 0; j <= lastid; j++) {
+ obj = dojo.byId('ck' + j + ':block');
+ if(obj.checked) {
+ nameArr = obj.name.split('[');
+ nameArr = nameArr[1].split(']');
+ data["privrow[" + nameArr[0] + "]"] = 1;
+ }
+ for(var i = 0; obj = dojo.byId('ck' + j + ':' + i); i++) {
+ if(obj.checked) {
+ nameArr = obj.name.split('[');
+ nameArr = nameArr[1].split(']');
+ data["privrow[" + nameArr[0] + "]"] = 1;
+ }
+ }
+ }
+ setLoading();
+ RPCwrapper(data, genericCB);
+ }
+}
+
+function submitUserGroupPrivChanges() {
+ var allgroups = dojo.byId('allgroups').value;
+ var selector = dojo.widget.byId('treeSelector');
+ var contid = dojo.byId('changeusergroupprivscont').value;
+ var data = {continuation: contid,
+ activeNode: selector.selectedNode.widgetId,
+ allgroups: allgroups};
+ var obj;
+ var obj2;
+ var name;
+ var nameArr;
+ obj = dojo.byId('firstUserGroupNum');
+ obj2 = dojo.byId('lastUserGroupNum');
+ if(obj) {
+ var firstid = obj.innerHTML;
+ var lastid = obj2.innerHTML;
+ for(var j = firstid; j <= lastid; j++) {
+ obj = dojo.byId('ck' + j + ':block');
+ if(obj.checked) {
+ nameArr = obj.name.split('[');
+ nameArr = nameArr[1].split(']');
+ data["privrow[" + nameArr[0] + "]"] = 1;
+ }
+ for(var i = 0; obj = dojo.byId('ck' + j + ':' + i); i++) {
+ if(obj.checked) {
+ nameArr = obj.name.split('[');
+ nameArr = nameArr[1].split(']');
+ data["privrow[" + nameArr[0] + "]"] = 1;
+ }
+ }
+ }
+ setLoading();
+ RPCwrapper(data, genericCB);
+ }
+}
+
+function submitResourceGroupPrivChanges() {
+ // FIXME - this needs to be replaced by using ajax to submit changes
+ // as checkboxes are clicked
+}
+
+function submitAddResourceGroup() {
+ dojo.byId('addResourceGroupPrivStatus').innerHTML = '';
+ var obj = dojo.byId('newresourcegroupid');
+ var groupid = obj.value;
+ if(! groupid.length)
+ return;
+ var perms = new Array();
+ obj = dojo.widget.byId('blockresgrpck');
+ if(obj.checked)
+ perms.push('block');
+ obj = dojo.widget.byId('resgrpck0:0');
+ if(obj.checked)
+ perms.push('cascade');
+ for(var i = 1; obj = dojo.widget.byId('resgrpck0:' + i); i++) {
+ if(obj.checked)
+ perms.push(obj.name);
+ }
+ var perms2 = perms.join(':', perms);
+ var selector = dojo.widget.byId('treeSelector');
+ var contid = dojo.byId('addresourcegroupcont').value;
+ var data = {continuation: contid,
+ perms: perms2,
+ newgroupid: groupid,
+ activeNode: selector.selectedNode.widgetId};
+ setLoading();
+ RPCwrapper(data, genericCB);
+}
+
+function addResourceGroupPaneHide() {
+ dojo.byId('addResourceGroupPrivStatus').innerHTML = '';
+ dojo.byId('newresourcegroupid').value = '';
+ dojo.widget.byId('addResourceGroupPane').minimizeWindow();
+ var obj = dojo.widget.byId('blockresgrpck');
+ if(obj.checked) {
+ obj.checked = false;
+ obj._setInfo();
+ }
+ for(var i = 0; obj = dojo.widget.byId('resgrpck0:' + i); i++) {
+ if(obj.checked) {
+ obj.checked = false;
+ obj._setInfo();
+ }
+ }
+}
+
+function AJdojoCreate(objid) {
+ if(dojo.byId(objid)) {
+ var parseObj = new dojo.xml.Parse();
+ var newObjs = parseObj.parseElement(dojo.byId(objid), null, true);
+ dojo.widget.getParser().createComponents(newObjs);
+ }
+}
+
+function changeCascadedRights(checked, row, count, fromclick, type) {
+ var i;
+ var objname;
+ var color;
+ var value;
+ var obj;
+ var obj2;
+ var namearr;
+ for(i = 1; i < count; i++) {
+ objname = "ck" + row + ":" + i;
+ obj = dojo.widget.byId(objname);
+ if(! obj)
+ continue;
+ if(checked) {
+ value = obj.value;
+ if(value != 'single') {
+ objname = "cell" + row + ":" + i;
+ obj2 = dojo.byId(objname);
+ if(! obj2)
+ continue;
+ obj2.bgColor = '#FFFFFF';
+ if(value == 'cascade') {
+ objname = "ck" + row + ":" + i;
+ obj = dojo.widget.byId(objname)
+ obj.checked = false;
+ obj._setInfo();
+ }
+ }
+ }
+ else {
+ value = obj.value;
+ if(value == 'single') {
+ obj.checked = true;
+ obj._setInfo();
+ }
+ else if(value == 'cascadesingle' || value == 'cascade') {
+ obj.checked = true;
+ obj._setInfo();
+ objname = "cell" + row + ":" + i;
+ obj2 = dojo.byId(objname);
+ if(! obj2)
+ continue;
+ obj2.bgColor = '#008000';
+ }
+ }
+ }
+ if(fromclick)
+ privChange(checked, row, 'block', type);
+}
+
+function nodeCheck(checked, row, col, type) {
+ var objname;
+ var color;
+ var obj;
+ var nameArr;
+ objname = "cell" + row + ":" + col;
+ color = document.getElementById(objname).bgColor;
+ if(color == '#008000') {
+ objname = "ck" + row + ":" + col;
+ obj = dojo.widget.byId(objname);
+ obj.checked = true;
+ obj._setInfo();
+ }
+ else {
+ privChange(checked, row, col, type);
+ }
+}
+
+function submitAddChildNode() {
+ dojo.byId('addChildNodeStatus').innerHTML = '';
+ var obj = dojo.byId('childNodeName');
+ var newnode = obj.value;
+ if(! newnode.length)
+ return;
+ var selector = dojo.widget.byId('treeSelector');
+ var contid = dojo.byId('addchildcont').value;
+ var data = {continuation: contid,
+ newnode: newnode,
+ activeNode: selector.selectedNode.widgetId};
+ setLoading();
+ RPCwrapper(data, genericCB);
+}
+
+function deleteNode() {
+ var selector = dojo.widget.byId('treeSelector');
+ var contid = dojo.byId('delchildcont').value;
+ var data = {continuation: contid,
+ activeNode: selector.selectedNode.widgetId};
+ dojo.widget.byId('deleteDialog').hide();
+ setLoading();
+ RPCwrapper(data, genericCB);
+}
+
+function addNodePaneHide() {
+ dojo.byId('addChildNodeStatus').innerHTML = '';
+ dojo.byId('childNodeName').value = '';
+ dojo.widget.byId('addNodePane').minimizeWindow();
+}
+
+function addChildNode(name, id) {
+ var selector = dojo.widget.byId('treeSelector');
+ var selectedNode = selector.selectedNode;
+ var newnode = dojo.widget.createWidget("TreeNode", {title: name, widgetId: id});
+ selectedNode.addChild(newnode);
+ addNodePaneHide();
+}
+
+function setLoading() {
+ document.body.style.cursor = 'wait';
+ if(dojo.widget.byId('workingDialog'))
+ dojo.widget.byId('workingDialog').show();
+}
+
+function unsetLoading() {
+ document.body.style.cursor = 'default';
+ if(dojo.widget.byId('workingDialog'))
+ dojo.widget.byId('workingDialog').hide();
+}
+
+function setSelectedPrivNode(nodeid) {
+ var selectedNode = dojo.widget.byId(nodeid);
+ if(! selectedNode)
+ selectedNode = dojo.widget.byId('3');
+ selectedNode.markSelected();
+ var selector = dojo.widget.byId('treeSelector');
+ selector.selectedNode = selectedNode;
+ var nodename = selectedNode.title;
+ dojo.byId('addPaneNodeName').innerHTML = 'Node: <strong>' + nodename + '</strong>';
+ dojo.byId('addChildNodeName').innerHTML = 'Node: <strong>' + nodename + '</strong>';
+ dojo.byId('deleteNodeName').innerHTML = 'Node: <strong>' + nodename + '</strong>';
+ dojo.io.cookie.set('VCLACTIVENODE', nodeid, 365, '/', cookiedomain);
+}
+
+function submitAddResource() {
+ dojo.byId('addResourceMode').value = 'changeResourcePrivs';
+ dojo.byId('resourceForm').submit();
+}
+
+/*function submitAddResourcePriv() {
+ dojo.byId('addResourceMode').value = 'addResourcePriv';
+ dojo.byId('resourceForm').submit();
+}*/
+
+function toggleRowSelect(id) {
+ var row = document.getElementById(id);
+ if(toggledRows[id] && toggledRows[id] == 1) {
+ row.className = '';
+ toggledRows[id] = 0;
+ }
+ else {
+ row.className = 'hlrow';
+ toggledRows[id] = 1;
+ }
+}
+
+function toggleColSelect(id) {
+ var col = document.getElementById(id);
+ if(toggledCols[id] && toggledCols[id] == 1) {
+ col.className = '';
+ toggledCols[id] = 0;
+ }
+ else {
+ col.className = 'hlcol';
+ toggledCols[id] = 1;
+ }
+}
+
+function selectEnvironment() {
+ var imageid = dojo.byId('imagesel').value;
+ if(maxTimes[imageid])
+ setMaxRequestLength(maxTimes[imageid]);
+ else
+ setMaxRequestLength(defaultMaxTime);
+ updateWaitTime(1);
+}
+
+function updateWaitTime(cleardesc) {
+ var desconly = 0;
+ if(cleardesc)
+ dojo.byId('imgdesc').innerHTML = '';
+ dojo.byId('waittime').innerHTML = '';
+ if(! dojo.byId('timenow').checked) {
+ dojo.byId('waittime').className = 'hidden';
+ if(dojo.byId('newsubmit'))
+ dojo.byId('newsubmit').value = 'Create Reservation';
+ //return;
+ desconly = 1;
+ }
+ if(dojo.byId('openend') &&
+ dojo.byId('openend').checked) {
+ dojo.byId('waittime').className = 'hidden';
+ dojo.byId('newsubmit').value = 'Create Reservation';
+ //return;
+ desconly = 1;
+ }
+ var imageid = dojo.byId('imagesel').value;
+ if(dojo.byId('reqlength'))
+ var length = dojo.byId('reqlength').value;
+ else
+ var length = 480;
+ var contid = dojo.byId('waitcontinuation').value;
+ var data = {continuation: contid,
+ imageid: imageid,
+ length: length,
+ desconly: desconly};
+ if(! desconly)
+ dojo.byId('waittime').className = 'shown';
+ setLoading();
+ RPCwrapper(data, genericCB);
+}
+
+function setMaxRequestLength(minutes) {
+ var obj = dojo.byId('reqlength');
+ var i;
+ var text;
+ var newminutes;
+ var tmp;
+ for(i = obj.length - 1; i >= 0; i--) {
+ if(parseInt(obj.options[i].value) > minutes)
+ obj.options[i] = null;
+ }
+ for(i = obj.length - 1; obj.options[i].value < minutes; i++) {
+ // if last option is < 60, add 1 hr
+ if(parseInt(obj.options[i].value) < 60 &&
+ minutes >= 60) {
+ text = '1 hour';
+ newminutes = 60;
+ }
+ // else add in 2 hr chuncks up to max
+ else {
+ tmp = parseInt(obj.options[i].value);
+ if(tmp % 120)
+ tmp = tmp - (tmp % 120);
+ newminutes = tmp + 120;
+ if(newminutes < minutes)
+ text = (newminutes / 60) + ' hours';
+ else {
+ newminutes = minutes;
+ tmp = newminutes - (newminutes % 60);
+ if(newminutes % 60)
+ if(newminutes % 60 < 10)
+ text = (tmp / 60) + ':0' + (newminutes % 60) + ' hours';
+ else
+ text = (tmp / 60) + ':' + (newminutes % 60) + ' hours';
+ else
+ text = (tmp / 60) + ' hours';
+ }
+ }
+ obj.options[i + 1] = new Option(text, newminutes);
+ }
+}
+
+function updateMouseXY(e) {
+ if(e) {
+ mouseX = e.pageX;
+ mouseY = e.pageY;
+ }
+ else if(event) {
+ mouseX = event.clientX + document.documentElement.scrollLeft;
+ mouseY = event.clientY + document.documentElement.scrollTop;
+ }
+}
+
+function findPosX(obj) {
+ var curleft = 0;
+ if(obj.offsetParent)
+ while(1) {
+ curleft += obj.offsetLeft;
+ if(!obj.offsetParent)
+ break;
+ obj = obj.offsetParent;
+ }
+ else if(obj.x)
+ curleft += obj.x;
+ return curleft;
+}
+
+function findPosY(obj) {
+ var curtop = 0;
+ if(obj.offsetParent)
+ while(1) {
+ curtop += obj.offsetTop;
+ if(!obj.offsetParent)
+ break;
+ obj = obj.offsetParent;
+ }
+ else if(obj.y)
+ curtop += obj.y;
+ return curtop;
+}
+
+function resRefresh() {
+ if(! dojo.byId('resRefreshCont'))
+ return;
+ var contid = dojo.byId('resRefreshCont').value;
+ var reqid = dojo.byId('detailreqid').value;
+ if(! dojo.widget.byId('resStatusPane')) {
+ window.location.reload();
+ return;
+ }
+ if(dojo.widget.byId('resStatusPane').windowState == 'minimized') {
+ var incdetails = 0;
+ }
+ else {
+ var incdetails = 1;
+ }
+ var data = {continuation: contid,
+ incdetails: incdetails,
+ reqid: reqid};
+ RPCwrapper(data, genericCB);
+}
+
+function showScriptOnly() {
+ if(!document.styleSheets)
+ return;
+ var cssobj = new Array();
+ if(document.styleSheets[0].cssRules) // Standards Compliant
+ cssobj = document.styleSheets[0].cssRules;
+ else
+ cssobj = document.styleSheets[0].rules; // IE
+ var stop = 0;
+ for(var i = 0; i < cssobj.length; i++) {
+ if(cssobj[i].selectorText) {
+ if(cssobj[i].selectorText.toLowerCase() == '.scriptonly') {
+ //cssobj[i].style.display = "inline";
+ cssobj[i].style.cssText = "display: inline;";
+ stop++;
+ }
+ if(cssobj[i].selectorText.toLowerCase() == '.scriptoff') {
+ cssobj[i].style.cssText = "display: none;";
+ stop++;
+ }
+ if(stop > 1)
+ return;
+ }
+ }
+}
+
+function showGroupInfo(data, ioArgs) {
+ var members = data.items.members;
+ var mx = data.items.x;
+ var my = data.items.y;
+ var text = "";
+ for(var i = 0; i < members.length; i++) {
+ text = text + members[i] + '<br>';
+ }
+ var obj = document.getElementById('content');
+ var x = findPosX(obj);
+ var y = findPosY(obj);
+ obj = document.getElementById('listitems');
+ obj.innerHTML = text;
+ obj.style.left = mx - x - obj.clientWidth;
+ obj.style.top = my - y - obj.clientWidth;
+ obj.style.zIndex = 10;
+}
diff --git a/web/js/computers.js b/web/js/computers.js
new file mode 100644
index 0000000..9a0c65c
--- /dev/null
+++ b/web/js/computers.js
@@ -0,0 +1,250 @@
+/*
+* Licensed to the Apache Software Foundation (ASF) under one or more
+* contributor license agreements. See the NOTICE file distributed with
+* this work for additional information regarding copyright ownership.
+* The ASF licenses this file to You under the Apache License, Version 2.0
+* (the "License"); you may not use this file except in compliance with
+* the License. You may obtain a copy of the License at
+*
+* http://www.apache.org/licenses/LICENSE-2.0
+*
+* Unless required by applicable law or agreed to in writing, software
+* distributed under the License is distributed on an "AS IS" BASIS,
+* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+* See the License for the specific language governing permissions and
+* limitations under the License.
+*/
+var allcomps = '';
+var allgroups = '';
+var allcompgroups = '';
+
+function addRemItem(cont, objid1, objid2, cb) {
+ document.body.style.cursor = 'wait';
+ var obj = document.getElementById(objid1);
+ var id = obj.options[obj.selectedIndex].value;
+
+ obj = document.getElementById(objid2);
+ var listids = "";
+ for(var i = obj.options.length - 1; i >= 0; i--) {
+ if(obj.options[i].selected) {
+ listids = listids + ',' + obj.options[i].value;
+ obj.remove(i);
+ }
+ }
+ if(listids == "")
+ return;
+ dojo.xhrPost({
+ url: 'index.php',
+ load: cb,
+ handleAs: "json-comment-filtered",
+ error: errorHandler,
+ content: {continuation: cont,
+ listids: listids,
+ id: id},
+ timeout: 15000
+ });
+}
+
+function addRemGroup2(data, ioArgs) {
+ /*
+ for each compid sent back we
+ search through allcomps until we find it keeping track of the previous item with inout == 1
+ we set allcomps[compid].inout to 1
+ we find the previous item in the select.options array
+ we insert a new option right after that one
+ */
+ var comps = data.items.comps;
+ var addrem = data.items.addrem; // 1 for add, 0 for rem
+ if(addrem)
+ var obj = document.getElementById('incomps');
+ else
+ var obj = document.getElementById('outcomps');
+ for(var i = 0; i < comps.length; i++) {
+ var lastid = -1;
+ for(var j = 0; j < allcomps.length; j++) {
+ if(allcomps[j].id == comps[i]) {
+ if(addrem == 1)
+ allcomps[j].inout = 1;
+ else
+ allcomps[j].inout = 0;
+ if(lastid < 0) {
+ var before = obj.options[0];
+ var newoption = new Option(allcomps[j].name, allcomps[j].id);
+ try {
+ obj.add(newoption, before);
+ }
+ catch(ex) {
+ obj.add(newoption, 0);
+ }
+ break;
+ }
+ else {
+ for(var k = 0; k < obj.options.length; k++) {
+ if(obj.options[k].value == lastid) {
+ var before = obj.options[k + 1];
+ var newoption = new Option(allcomps[j].name, allcomps[j].id);
+ if(before)
+ try {
+ obj.add(newoption, before);
+ }
+ catch(ex) {
+ obj.add(newoption, k + 1);
+ }
+ else
+ obj.options[obj.options.length] = newoption;
+ break;
+ }
+ }
+ }
+ break;
+ }
+ if(allcomps[j].inout == addrem)
+ lastid = allcomps[j].id;
+ }
+ }
+ document.body.style.cursor = 'default';
+}
+
+function addRemComp2(data, ioArgs) {
+ var groups = data.items.groups;
+ var addrem = data.items.addrem; // 1 for add, 0 for rem
+ if(addrem)
+ var obj = document.getElementById('ingroups');
+ else
+ var obj = document.getElementById('outgroups');
+ for(var i = 0; i < groups.length; i++) {
+ var lastid = -1;
+ for(var j = 0; j < allgroups.length; j++) {
+ if(allgroups[j].id == groups[i]) {
+ if(addrem == 1)
+ allgroups[j].inout = 1;
+ else
+ allgroups[j].inout = 0;
+ if(lastid < 0) {
+ var before = obj.options[0];
+ var newoption = new Option(allgroups[j].name, allgroups[j].id);
+ try {
+ obj.add(newoption, before);
+ }
+ catch(ex) {
+ obj.add(newoption, 0);
+ }
+ break;
+ }
+ else {
+ for(var k = 0; k < obj.options.length; k++) {
+ if(obj.options[k].value == lastid) {
+ var before = obj.options[k + 1];
+ var newoption = new Option(allgroups[j].name, allgroups[j].id);
+ if(before)
+ try {
+ obj.add(newoption, before);
+ }
+ catch(ex) {
+ obj.add(newoption, k + 1);
+ }
+ else
+ obj.options[obj.options.length] = newoption;
+ break;
+ }
+ }
+ }
+ break;
+ }
+ if(allgroups[j].inout == addrem) {
+ lastid = allgroups[j].id;
+ }
+ }
+ }
+ document.body.style.cursor = 'default';
+}
+
+function errorHandler(data, ioArgs) {
+ alert('Error encountered while processing AJAX callback');
+}
+
+function getCompsButton() {
+ document.body.style.cursor = 'wait';
+ var selobj1 = document.getElementById('incomps');
+ for(var i = selobj1.options.length - 1; i >= 0; i--) {
+ selobj1.remove(i);
+ }
+ var selobj2 = document.getElementById('outcomps');
+ for(i = selobj2.options.length - 1; i >= 0; i--) {
+ selobj2.remove(i);
+ }
+ var obj = document.getElementById('compGroups');
+ var groupid = obj.options[obj.selectedIndex].value;
+ var groupname = obj.options[obj.selectedIndex].text;
+
+ obj = document.getElementById('ingroupname').innerHTML = groupname;
+ obj = document.getElementById('outgroupname').innerHTML = groupname;
+
+ obj = document.getElementById('compcont');
+
+ dojo.xhrPost({
+ url: 'index.php',
+ handleAs: "json-comment-filtered",
+ load: compsCallback,
+ error: errorHandler,
+ content: {continuation: obj.value,
+ groupid: groupid},
+ timeout: 15000
+ });
+}
+
+function compsCallback(data, ioArgs) {
+ var inobj = document.getElementById('incomps');
+ for(var i = 0; i < data.items.incomps.length; i++) {
+ inobj.options[inobj.options.length] = new Option(data.items.incomps[i].name, data.items.incomps[i].id);
+ }
+ var outobj = document.getElementById('outcomps');
+ for(var i = 0; i < data.items.outcomps.length; i++) {
+ outobj.options[outobj.options.length] = new Option(data.items.outcomps[i].name, data.items.outcomps[i].id);
+ }
+ allcomps = data.items.all;
+ document.body.style.cursor = 'default';
+}
+
+function getGroupsButton() {
+ document.body.style.cursor = 'wait';
+ var selobj1 = document.getElementById('ingroups');
+ for(var i = selobj1.options.length - 1; i >= 0; i--) {
+ selobj1.remove(i);
+ }
+ var selobj2 = document.getElementById('outgroups');
+ for(i = selobj2.options.length - 1; i >= 0; i--) {
+ selobj2.remove(i);
+ }
+ var obj = document.getElementById('comps');
+ var compid = obj.options[obj.selectedIndex].value;
+ var compname = obj.options[obj.selectedIndex].text;
+
+ obj = document.getElementById('incompname').innerHTML = compname;
+ obj = document.getElementById('outcompname').innerHTML = compname;
+
+ obj = document.getElementById('grpcont');
+
+ dojo.xhrPost({
+ url: 'index.php',
+ handleAs: "json-comment-filtered",
+ load: groupsCallback,
+ error: errorHandler,
+ content: {continuation: obj.value,
+ compid: compid},
+ timeout: 15000
+ });
+}
+
+function groupsCallback(data, ioArgs) {
+ var inobj = document.getElementById('ingroups');
+ for(var i = 0; i < data.items.ingroups.length; i++) {
+ inobj.options[inobj.options.length] = new Option(data.items.ingroups[i].name, data.items.ingroups[i].id);
+ }
+ var outobj = document.getElementById('outgroups');
+ for(var i = 0; i < data.items.outgroups.length; i++) {
+ outobj.options[outobj.options.length] = new Option(data.items.outgroups[i].name, data.items.outgroups[i].id);
+ }
+ allgroups = data.items.all;
+ document.body.style.cursor = 'default';
+}
diff --git a/web/js/groups.js b/web/js/groups.js
new file mode 100644
index 0000000..2fdaac5
--- /dev/null
+++ b/web/js/groups.js
@@ -0,0 +1,87 @@
+/*
+* Licensed to the Apache Software Foundation (ASF) under one or more
+* contributor license agreements. See the NOTICE file distributed with
+* this work for additional information regarding copyright ownership.
+* The ASF licenses this file to You under the Apache License, Version 2.0
+* (the "License"); you may not use this file except in compliance with
+* the License. You may obtain a copy of the License at
+*
+* http://www.apache.org/licenses/LICENSE-2.0
+*
+* Unless required by applicable law or agreed to in writing, software
+* distributed under the License is distributed on an "AS IS" BASIS,
+* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+* See the License for the specific language governing permissions and
+* limitations under the License.
+*/
+var xhrobj;
+var blockHide = 0;
+
+function getGroupInfo(cont, groupid) {
+ xhrobj = dojo.xhrPost({
+ url: 'index.php',
+ load: showGroupInfo,
+ handleAs: "json-comment-filtered",
+ error: errorHandler,
+ content: {continuation: cont,
+ groupid: groupid,
+ mousex: mouseX,
+ mousey: mouseY},
+ timeout: 15000
+ });
+}
+
+function mouseoverHelp() {
+ var data = [];
+ data['items'] = [];
+ data['items']['members'] = [];
+ data['items']['members'][0] = 'mouse over icon to<br>display a group’s<br>resources';
+ data['items']['x'] = mouseX;
+ data['items']['y'] = mouseY;
+ showGroupInfo(data);
+}
+
+function showGroupInfo(data, ioArgs) {
+ var members = data.items.members;
+ var mx = data.items.x;
+ var my = data.items.y;
+ var text = "";
+ for(var i = 0; i < members.length; i++) {
+ text = text + members[i] + '<br>';
+ }
+ var obj = document.getElementById('content');
+ var x = findPosX(obj);
+ var y = findPosY(obj);
+ obj = document.getElementById('listitems');
+ obj.innerHTML = text;
+ //if(browser == 'IE') {
+ var a = mx - obj.clientWidth - 2;
+ var b = my - (obj.clientHeight / 2);
+ /*}
+ else {
+ var a = mx - x - obj.clientWidth;
+ var b = my - y - obj.clientHeight;
+ }*/
+ obj.style.left = a + "px";
+ obj.style.top = b + "px";
+ obj.style.zIndex = 10;
+}
+
+function clearGroupPopups() {
+ setTimeout(function() {clearGroupPopups2(1);}, 50);
+}
+
+function clearGroupPopups2(fromicon) {
+ if(xhrobj)
+ xhrobj.ioArgs.xhr.abort();
+ if(fromicon && blockHide)
+ return;
+ blockHide = 0;
+ var obj = document.getElementById('listitems');
+ obj.innerHTML = '';
+ obj.style.zIndex = -10;
+}
+
+function blockClear() {
+ blockHide = 1;
+}
diff --git a/web/js/images.js b/web/js/images.js
new file mode 100644
index 0000000..24bac1f
--- /dev/null
+++ b/web/js/images.js
@@ -0,0 +1,514 @@
+/*
+* Licensed to the Apache Software Foundation (ASF) under one or more
+* contributor license agreements. See the NOTICE file distributed with
+* this work for additional information regarding copyright ownership.
+* The ASF licenses this file to You under the Apache License, Version 2.0
+* (the "License"); you may not use this file except in compliance with
+* the License. You may obtain a copy of the License at
+*
+* http://www.apache.org/licenses/LICENSE-2.0
+*
+* Unless required by applicable law or agreed to in writing, software
+* distributed under the License is distributed on an "AS IS" BASIS,
+* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+* See the License for the specific language governing permissions and
+* limitations under the License.
+*/
+var allimages = '';
+var allgroups = '';
+var allcompgroups = '';
+var allimggroups = '';
+
+function addRemItem(cont, objid1, objid2, cb) {
+ document.body.style.cursor = 'wait';
+ var obj = document.getElementById(objid1);
+ var id = obj.options[obj.selectedIndex].value;
+
+ obj = document.getElementById(objid2);
+ var listids = "";
+ for(var i = obj.options.length - 1; i >= 0; i--) {
+ if(obj.options[i].selected) {
+ listids = listids + ',' + obj.options[i].value;
+ obj.remove(i);
+ }
+ }
+ if(listids == "")
+ return;
+ dojo.xhrPost({
+ url: 'index.php',
+ load: cb,
+ handleAs: "json-comment-filtered",
+ error: errorHandler,
+ content: {continuation: cont,
+ listids: listids,
+ id: id},
+ timeout: 15000
+ });
+}
+
+function addRemGroup2(data, ioArgs) {
+ /*
+ for each imageid sent back we
+ search through allimages until we find it keeping track of the previous item with inout == 1
+ we set allimages[imageid].inout to 1
+ we find the previous item in the select.options array
+ we insert a new option right after that one
+ */
+ var images = data.items.images;
+ var addrem = data.items.addrem; // 1 for add, 0 for rem
+ if(addrem)
+ var obj = document.getElementById('inimages');
+ else
+ var obj = document.getElementById('outimages');
+ for(var i = 0; i < images.length; i++) {
+ var lastid = -1;
+ for(var j = 0; j < allimages.length; j++) {
+ if(allimages[j].id == images[i]) {
+ if(addrem == 1)
+ allimages[j].inout = 1;
+ else
+ allimages[j].inout = 0;
+ if(lastid < 0) {
+ var before = obj.options[0];
+ var newoption = new Option(allimages[j].name, allimages[j].id);
+ try {
+ obj.add(newoption, before);
+ }
+ catch(ex) {
+ obj.add(newoption, 0);
+ }
+ break;
+ }
+ else {
+ for(var k = 0; k < obj.options.length; k++) {
+ if(obj.options[k].value == lastid) {
+ var before = obj.options[k + 1];
+ var newoption = new Option(allimages[j].name, allimages[j].id);
+ if(before)
+ try {
+ obj.add(newoption, before);
+ }
+ catch(ex) {
+ obj.add(newoption, k + 1);
+ }
+ else
+ obj.options[obj.options.length] = newoption;
+ break;
+ }
+ }
+ }
+ break;
+ }
+ if(allimages[j].inout == addrem)
+ lastid = allimages[j].id;
+ }
+ }
+ document.body.style.cursor = 'default';
+}
+
+function addRemImage2(data, ioArgs) {
+ var groups = data.items.groups;
+ var addrem = data.items.addrem; // 1 for add, 0 for rem
+ if(addrem)
+ var obj = document.getElementById('ingroups');
+ else
+ var obj = document.getElementById('outgroups');
+ for(var i = 0; i < groups.length; i++) {
+ var lastid = -1;
+ for(var j = 0; j < allgroups.length; j++) {
+ if(allgroups[j].id == groups[i]) {
+ if(addrem == 1)
+ allgroups[j].inout = 1;
+ else
+ allgroups[j].inout = 0;
+ if(lastid < 0) {
+ var before = obj.options[0];
+ var newoption = new Option(allgroups[j].name, allgroups[j].id);
+ try {
+ obj.add(newoption, before);
+ }
+ catch(ex) {
+ obj.add(newoption, 0);
+ }
+ break;
+ }
+ else {
+ for(var k = 0; k < obj.options.length; k++) {
+ if(obj.options[k].value == lastid) {
+ var before = obj.options[k + 1];
+ var newoption = new Option(allgroups[j].name, allgroups[j].id);
+ if(before)
+ try {
+ obj.add(newoption, before);
+ }
+ catch(ex) {
+ obj.add(newoption, k + 1);
+ }
+ else
+ obj.options[obj.options.length] = newoption;
+ break;
+ }
+ }
+ }
+ break;
+ }
+ if(allgroups[j].inout == addrem) {
+ lastid = allgroups[j].id;
+ }
+ }
+ }
+ document.body.style.cursor = 'default';
+}
+
+function addRemCompGrpImgGrp(data, ioArgs) {
+ var groups = data.items.groups;
+ var addrem = data.items.addrem; // 1 for add, 0 for rem
+ if(addrem)
+ var obj = document.getElementById('incompgroups');
+ else
+ var obj = document.getElementById('outcompgroups');
+ for(var i = 0; i < groups.length; i++) {
+ var lastid = -1;
+ for(var j = 0; j < allcompgroups.length; j++) {
+ if(allcompgroups[j].id == groups[i]) {
+ if(addrem == 1)
+ allcompgroups[j].inout = 1;
+ else
+ allcompgroups[j].inout = 0;
+ if(lastid < 0) {
+ var before = obj.options[0];
+ var newoption = new Option(allcompgroups[j].name, allcompgroups[j].id);
+ try {
+ obj.add(newoption, before);
+ }
+ catch(ex) {
+ obj.add(newoption, 0);
+ }
+ break;
+ }
+ else {
+ for(var k = 0; k < obj.options.length; k++) {
+ if(obj.options[k].value == lastid) {
+ var before = obj.options[k + 1];
+ var newoption = new Option(allcompgroups[j].name, allcompgroups[j].id);
+ if(before)
+ try {
+ obj.add(newoption, before);
+ }
+ catch(ex) {
+ obj.add(newoption, k + 1);
+ }
+ else
+ obj.options[obj.options.length] = newoption;
+ break;
+ }
+ }
+ }
+ break;
+ }
+ if(allcompgroups[j].inout == addrem) {
+ lastid = allcompgroups[j].id;
+ }
+ }
+ }
+ document.body.style.cursor = 'default';
+}
+
+function addRemImgGrpCompGrp(data, ioArgs) {
+ var groups = data.items.groups;
+ var addrem = data.items.addrem; // 1 for add, 0 for rem
+ if(addrem)
+ var obj = document.getElementById('inimggroups');
+ else
+ var obj = document.getElementById('outimggroups');
+ for(var i = 0; i < groups.length; i++) {
+ var lastid = -1;
+ for(var j = 0; j < allimggroups.length; j++) {
+ if(allimggroups[j].id == groups[i]) {
+ if(addrem == 1)
+ allimggroups[j].inout = 1;
+ else
+ allimggroups[j].inout = 0;
+ if(lastid < 0) {
+ var before = obj.options[0];
+ var newoption = new Option(allimggroups[j].name, allimggroups[j].id);
+ try {
+ obj.add(newoption, before);
+ }
+ catch(ex) {
+ obj.add(newoption, 0);
+ }
+ break;
+ }
+ else {
+ for(var k = 0; k < obj.options.length; k++) {
+ if(obj.options[k].value == lastid) {
+ var before = obj.options[k + 1];
+ var newoption = new Option(allimggroups[j].name, allimggroups[j].id);
+ if(before)
+ try {
+ obj.add(newoption, before);
+ }
+ catch(ex) {
+ obj.add(newoption, k + 1);
+ }
+ else
+ obj.options[obj.options.length] = newoption;
+ break;
+ }
+ }
+ }
+ break;
+ }
+ if(allimggroups[j].inout == addrem) {
+ lastid = allimggroups[j].id;
+ }
+ }
+ }
+ document.body.style.cursor = 'default';
+}
+
+function errorHandler(data, ioArgs) {
+ alert('Error encountered while processing AJAX callback');
+}
+
+function getImagesButton() {
+ document.body.style.cursor = 'wait';
+ var selobj1 = document.getElementById('inimages');
+ for(var i = selobj1.options.length - 1; i >= 0; i--) {
+ selobj1.remove(i);
+ }
+ var selobj2 = document.getElementById('outimages');
+ for(i = selobj2.options.length - 1; i >= 0; i--) {
+ selobj2.remove(i);
+ }
+ var obj = document.getElementById('imgGroups');
+ var groupid = obj.options[obj.selectedIndex].value;
+ var groupname = obj.options[obj.selectedIndex].text;
+
+ obj = document.getElementById('ingroupname').innerHTML = groupname;
+ obj = document.getElementById('outgroupname').innerHTML = groupname;
+
+ obj = document.getElementById('imgcont');
+
+ dojo.xhrPost({
+ url: 'index.php',
+ handleAs: "json-comment-filtered",
+ load: imagesCallback,
+ error: errorHandler,
+ content: {continuation: obj.value,
+ groupid: groupid},
+ timeout: 15000
+ });
+}
+
+function imagesCallback(data, ioArgs) {
+ var inobj = document.getElementById('inimages');
+ for(var i = 0; i < data.items.inimages.length; i++) {
+ inobj.options[inobj.options.length] = new Option(data.items.inimages[i].name, data.items.inimages[i].id);
+ }
+ var outobj = document.getElementById('outimages');
+ for(var i = 0; i < data.items.outimages.length; i++) {
+ outobj.options[outobj.options.length] = new Option(data.items.outimages[i].name, data.items.outimages[i].id);
+ }
+ allimages = data.items.all;
+ document.body.style.cursor = 'default';
+}
+
+function getGroupsButton() {
+ document.body.style.cursor = 'wait';
+ var selobj1 = document.getElementById('ingroups');
+ for(var i = selobj1.options.length - 1; i >= 0; i--) {
+ selobj1.remove(i);
+ }
+ var selobj2 = document.getElementById('outgroups');
+ for(i = selobj2.options.length - 1; i >= 0; i--) {
+ selobj2.remove(i);
+ }
+ var obj = document.getElementById('images');
+ var imageid = obj.options[obj.selectedIndex].value;
+ var imagename = obj.options[obj.selectedIndex].text;
+
+ obj = document.getElementById('inimagename').innerHTML = imagename;
+ obj = document.getElementById('outimagename').innerHTML = imagename;
+
+ obj = document.getElementById('grpcont');
+
+ dojo.xhrPost({
+ url: 'index.php',
+ handleAs: "json-comment-filtered",
+ load: groupsCallback,
+ error: errorHandler,
+ content: {continuation: obj.value,
+ imageid: imageid},
+ timeout: 15000
+ });
+}
+
+function groupsCallback(data, ioArgs) {
+ var inobj = document.getElementById('ingroups');
+ for(var i = 0; i < data.items.ingroups.length; i++) {
+ inobj.options[inobj.options.length] = new Option(data.items.ingroups[i].name, data.items.ingroups[i].id);
+ }
+ var outobj = document.getElementById('outgroups');
+ for(var i = 0; i < data.items.outgroups.length; i++) {
+ outobj.options[outobj.options.length] = new Option(data.items.outgroups[i].name, data.items.outgroups[i].id);
+ }
+ allgroups = data.items.all;
+ document.body.style.cursor = 'default';
+}
+
+function getMapCompGroupsButton() {
+ document.body.style.cursor = 'wait';
+ var selobj1 = document.getElementById('incompgroups');
+ for(var i = selobj1.options.length - 1; i >= 0; i--) {
+ selobj1.remove(i);
+ }
+ var selobj2 = document.getElementById('outcompgroups');
+ for(i = selobj2.options.length - 1; i >= 0; i--) {
+ selobj2.remove(i);
+ }
+ var obj = document.getElementById('imagegrps');
+ var imagegrpid = obj.options[obj.selectedIndex].value;
+ var imagegrpname = obj.options[obj.selectedIndex].text;
+
+ obj = document.getElementById('inimagegrpname').innerHTML = imagegrpname;
+ obj = document.getElementById('outimagegrpname').innerHTML = imagegrpname;
+
+ obj = document.getElementById('compcont');
+
+ dojo.xhrPost({
+ url: 'index.php',
+ handleAs: "json-comment-filtered",
+ load: mapCompGroupsCB,
+ error: errorHandler,
+ content: {continuation: obj.value,
+ imagegrpid: imagegrpid},
+ timeout: 15000
+ });
+}
+
+function mapCompGroupsCB(data, ioArgs) {
+ var inobj = document.getElementById('incompgroups');
+ for(var i = 0; i < data.items.ingroups.length; i++) {
+ inobj.options[inobj.options.length] = new Option(data.items.ingroups[i].name, data.items.ingroups[i].id);
+ }
+ var outobj = document.getElementById('outcompgroups');
+ for(var i = 0; i < data.items.outgroups.length; i++) {
+ outobj.options[outobj.options.length] = new Option(data.items.outgroups[i].name, data.items.outgroups[i].id);
+ }
+ allcompgroups = data.items.all;
+ document.body.style.cursor = 'default';
+}
+
+function getMapImgGroupsButton() {
+ document.body.style.cursor = 'wait';
+ var selobj1 = document.getElementById('inimggroups');
+ for(var i = selobj1.options.length - 1; i >= 0; i--) {
+ selobj1.remove(i);
+ }
+ var selobj2 = document.getElementById('outimggroups');
+ for(i = selobj2.options.length - 1; i >= 0; i--) {
+ selobj2.remove(i);
+ }
+ var obj = document.getElementById('compgroups');
+ var compgrpid = obj.options[obj.selectedIndex].value;
+ var compgrpname = obj.options[obj.selectedIndex].text;
+
+ obj = document.getElementById('incompgroupname').innerHTML = compgrpname;
+ obj = document.getElementById('outcompgroupname').innerHTML = compgrpname;
+
+ obj = document.getElementById('imgcont');
+
+ dojo.xhrPost({
+ url: 'index.php',
+ handleAs: "json-comment-filtered",
+ load: mapImgGroupsCB,
+ error: errorHandler,
+ content: {continuation: obj.value,
+ compgrpid: compgrpid},
+ timeout: 15000
+ });
+}
+
+function mapImgGroupsCB(data, ioArgs) {
+ var inobj = document.getElementById('inimggroups');
+ for(var i = 0; i < data.items.ingroups.length; i++) {
+ inobj.options[inobj.options.length] = new Option(data.items.ingroups[i].name, data.items.ingroups[i].id);
+ }
+ var outobj = document.getElementById('outimggroups');
+ for(var i = 0; i < data.items.outgroups.length; i++) {
+ outobj.options[outobj.options.length] = new Option(data.items.outgroups[i].name, data.items.outgroups[i].id);
+ }
+ allimggroups = data.items.all;
+ document.body.style.cursor = 'default';
+}
+
+function generalCB(data, ioArgs) {
+ document.body.style.cursor = 'default';
+}
+
+function updateRevisionProduction(cont) {
+ document.body.style.cursor = 'wait';
+ dojo.xhrPost({
+ url: 'index.php',
+ load: generalCB,
+ error: errorHandler,
+ content: {continuation: cont},
+ timeout: 15000
+ });
+}
+
+function updateRevisionComments(id, cont) {
+ document.body.style.cursor = 'wait';
+ var comments = dijit.byId(id).value;
+ dojo.xhrPost({
+ url: 'index.php',
+ handleAs: "json-comment-filtered",
+ load: updateRevisionCommentsCB,
+ error: errorHandler,
+ content: {continuation: cont,
+ comments: comments},
+ timeout: 15000
+ });
+}
+
+function updateRevisionCommentsCB(data, ioArgs) {
+ var obj = dijit.byId('comments' + data.items.id);
+ obj.setValue(data.items.comments);
+ document.body.style.cursor = 'default';
+}
+
+function deleteRevisions(cont, idlist) {
+ var ids = idlist.split(',');
+ var checkedids = new Array();
+ for(var i = 0; i < ids.length; i++) {
+ var id = ids[i];
+ var obj = document.getElementById('chkrev' + id);
+ var obj2 = document.getElementById('radrev' + id);
+ if(obj.checked) {
+ if(obj2.checked) {
+ alert('You cannot delete the production revision.');
+ return;
+ }
+ checkedids.push(id);
+ }
+ }
+ if(checkedids.length == 0)
+ return;
+ checkedids = checkedids.join(',');
+ dojo.xhrPost({
+ url: 'index.php',
+ handleAs: "json-comment-filtered",
+ load: deleteRevisionsCB,
+ error: errorHandler,
+ content: {continuation: cont,
+ checkedids: checkedids},
+ timeout: 15000
+ });
+}
+
+function deleteRevisionsCB(data, ioArgs) {
+ var obj = document.getElementById('revisiondiv');
+ obj.innerHTML = data.items.html;
+}
diff --git a/web/js/vm.js b/web/js/vm.js
new file mode 100644
index 0000000..b99a52b
--- /dev/null
+++ b/web/js/vm.js
@@ -0,0 +1,720 @@
+/*
+* Licensed to the Apache Software Foundation (ASF) under one or more
+* contributor license agreements. See the NOTICE file distributed with
+* this work for additional information regarding copyright ownership.
+* The ASF licenses this file to You under the Apache License, Version 2.0
+* (the "License"); you may not use this file except in compliance with
+* the License. You may obtain a copy of the License at
+*
+* http://www.apache.org/licenses/LICENSE-2.0
+*
+* Unless required by applicable law or agreed to in writing, software
+* distributed under the License is distributed on an "AS IS" BASIS,
+* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+* See the License for the specific language governing permissions and
+* limitations under the License.
+*/
+var currvms = '';
+var curprofileid = '';
+var fromok = 0;
+var allvms = '';
+var curprofile = '';
+
+function getVMHostData(cont) {
+ var hostid = document.getElementById('vmhostid').value;
+ document.body.style.cursor = 'wait';
+ dijit.byId('messages').hide();
+ document.getElementById('vmhostdata').className = 'hidden';
+ document.getElementById('movevms').className = 'hidden';
+ document.getElementById('vmstate').innerHTML = '';
+
+ var selobj1 = document.getElementById('currvms');
+ for(var i = selobj1.options.length - 1; i >= 0; i--) {
+ selobj1.remove(i);
+ }
+ var selobj2 = document.getElementById('freevms');
+ for(i = selobj2.options.length - 1; i >= 0; i--) {
+ selobj2.remove(i);
+ }
+ var selobj3 = document.getElementById('movevmssel');
+ for(i = selobj3.options.length - 1; i >= 0; i--) {
+ selobj3.remove(i);
+ }
+
+ dojo.xhrPost({
+ url: 'index.php',
+ load: VMHostDataCB,
+ handleAs: "json-comment-filtered",
+ error: errorHandler,
+ content: {continuation: cont,
+ vmhostid: hostid},
+ timeout: 15000
+ });
+}
+
+function VMHostDataCB(data, ioArgs) {
+ if(data.items.failed) {
+ alert('You do not have access to manage this host.');
+ document.body.style.cursor = 'default';
+ return;
+ }
+ document.getElementById('vmlimit').value = data.items.vmlimit;
+ document.getElementById('vmhostdata').className = 'shown';
+
+ curprofileid = data.items.profileid;
+
+ // leave this block for allowing changing of profiles later
+ /*var selobj = document.getElementById('vmprofileid');
+ for(var i = 0; i < selobj.options.length; i++) {
+ if(selobj.options[i].value == data.items.profile.id) {
+ selobj.selectedIndex = i;
+ break;
+ }
+ }*/
+ var profile = data.items.profile;
+ var obj = dijit.byId('vmprofile');
+ obj.setTitle(profile.name);
+ var ct = '<table>';
+ ct += '<tr><th align=right>VM type:</th><td>' + profile.type + '</td></tr>';
+ ct += '<tr><th align=right>Image:</th><td>' + profile.image + '</td></tr>';
+ ct += '<tr><th align=right>NAS Share:</th><td>' + profile.nasshare + '</td></tr>';
+ ct += '<tr><th align=right>Datastore Path:</th><td>' + profile.datastorepath + '</td></tr>';
+ ct += '<tr><th align=right>VM Path:</th><td>' + profile.vmpath + '</td>';
+ ct += '<tr><th align=right>Virtual Switch 0:</th><td>' + profile.virtualswitch0 + '</td></tr>';
+ ct += '<tr><th align=right>Virtual Switch 1:</th><td>' + profile.virtualswitch1 + '</td></tr>';
+ ct += '<tr><th align=right>VM Disk:</th><td>' + profile.vmdisk + '</td></tr>';
+ ct += '</table>';
+ obj.setContent(ct);
+ if(obj.open)
+ obj.toggle();
+
+ allvms = data.items.allvms;
+ currvms = data.items.currvms;
+
+ var inobj = document.getElementById('currvms');
+ for(var i = 0; i < data.items.currvms.length; i++) {
+ inobj.options[inobj.options.length] = new Option(data.items.currvms[i].name, data.items.currvms[i].id);
+ }
+ var outobj = document.getElementById('freevms');
+ for(var i = 0; i < data.items.freevms.length; i++) {
+ outobj.options[outobj.options.length] = new Option(data.items.freevms[i].name, data.items.freevms[i].id);
+ }
+
+ if(data.items.movevms.length) {
+ document.getElementById('movevms').className = 'shown';
+ obj = document.getElementById('movevmssel');
+ var movevms = data.items.movevms;
+ for(var i = 0; i < movevms.length; i++) {
+ var label = movevms[i]['hostname'] + ' (' + movevms[i]['time'] + ')';
+ obj.options[obj.options.length] = new Option(label, data.items.movevms[i].id);
+ }
+ }
+
+ //document.getElementById('changevmcont').value = data.items.continuation;
+
+ document.body.style.cursor = 'default';
+}
+
+function updateVMlimit(cont) {
+ var hostid = document.getElementById('vmhostid').value;
+ var newlimit = document.getElementById('vmlimit').value;
+ document.body.style.cursor = 'wait';
+
+ dojo.xhrPost({
+ url: 'index.php',
+ load: updateVMlimitCB,
+ error: errorHandler,
+ content: {continuation: cont,
+ vmhostid: hostid,
+ newlimit: newlimit},
+ timeout: 15000
+ });
+}
+
+function updateVMlimitCB(data, ioArgs) {
+ if(data != 'SUCCESS') {
+ alert(data);
+ }
+ document.body.style.cursor = 'default';
+}
+
+function showVMstate() {
+ var selobj = document.getElementById('currvms');
+ var cnt = 0;
+ var state = '';
+ for(var i = 0; i < selobj.options.length; i++) {
+ if(selobj.options[i].selected) {
+ cnt++;
+ state = currvms[i].state;
+ }
+ }
+ if(cnt == 1)
+ document.getElementById('vmstate').innerHTML = state;
+ else
+ document.getElementById('vmstate').innerHTML = '';
+}
+
+function changeVMprofile() {
+ var hostid = document.getElementById('vmhostid').value;
+ var selobj = document.getElementById('vmprofileid');
+ var newid = selobj.options[selobj.selectedIndex].value;
+ dijit.byId('profileDlg').show();
+}
+
+function cancelVMprofileChange() {
+ if(fromok) {
+ fromok = 0;
+ }
+ else {
+ var selobj = document.getElementById('vmprofileid');
+ for(var i = 0; i < selobj.options.length; i++) {
+ if(selobj.options[i].value == curprofileid) {
+ selobj.selectedIndex = i;
+ break;
+ }
+ }
+ }
+}
+
+function submitChangeProfile() {
+ fromok = 1;
+ var hostid = document.getElementById('vmhostid').value;
+ var cont = document.getElementById('changevmcont').value;
+ var selobj = document.getElementById('vmprofileid');
+ var oldid = curprofileid;
+ var newid = selobj.options[selobj.selectedIndex].value;
+ dijit.byId('profileDlg').hide();
+ dojo.xhrPost({
+ url: 'index.php',
+ load: submitChangeProfileCB,
+ handleAs: "json-comment-filtered",
+ error: errorHandler,
+ content: {continuation: cont,
+ vmhostid: hostid,
+ oldprofileid: oldid,
+ newprofileid: newid},
+ timeout: 15000
+ });
+}
+
+function submitChangeProfileCB(data, ioArgs) {
+ var selobj = document.getElementById('vmprofileid');
+ curprofileid = selobj.options[selobj.selectedIndex].value;
+ document.getElementById('changevmcont').value = data.items.continuation;
+ alert(data.items.msg);
+}
+
+function vmToHost(cont) {
+ document.body.style.cursor = 'wait';
+ var hostid = document.getElementById('vmhostid').value;
+
+ var obj = document.getElementById('freevms');
+ var listids = new Array();
+ for(var i = obj.options.length - 1; i >= 0; i--) {
+ if(obj.options[i].selected) {
+ listids.push(obj.options[i].value);
+ }
+ }
+ //var limit = dijit.byId('vmlimit').value;
+ var limit = document.getElementById('vmlimit').value;
+ var currcnt = document.getElementById('currvms').options.length;
+ if(limit < currcnt + listids.length) {
+ alert('You\'re attempting to add more VMs to this host\nthan the current VM limit. This is not allowed.');
+ document.body.style.cursor = 'default';
+ return;
+ }
+
+ if(listids.length == 0) {
+ document.body.style.cursor = 'default';
+ return;
+ }
+
+ dojo.xhrPost({
+ url: 'index.php',
+ load: vmToHostCB,
+ handleAs: "json-comment-filtered",
+ error: errorHandler,
+ content: {continuation: cont,
+ listids: listids.join(','),
+ hostid: hostid},
+ timeout: 15000
+ });
+}
+
+function vmToHostCB(data, ioArgs) {
+ if(data.items.failed) {
+ if(data.items.failed == 'nohostaccess')
+ alert('You do not have access to manage this VM host.');
+ else if(data.items.failed == 'vmlimit')
+ alert('You\'re attempting to add more VMs to this host\nthan the current VM limit. This is not allowed.');
+ document.body.style.cursor = 'default';
+ return;
+ }
+ /*
+ for each vmid sent back we
+ search through allvms until we find it keeping track of the previous item with inout == 1
+ we set allvms[vmid].inout to 1
+ we find the previous item in the select.options array
+ we insert a new option right after that one
+ */
+ var vms = data.items.vms;
+ var addrem = data.items.addrem; // 1 for add, 0 for rem
+ var fails = data.items.fails;
+ var obj = document.getElementById('freevms');
+ for(var i = obj.options.length - 1; i >= 0; i--) {
+ if(obj.options[i].selected) {
+ var remove = 1;
+ for(var j = 0; j < fails.length; j++) {
+ if(obj.options[i].value == fails[j].id) {
+ obj.options[i].selected = false;
+ remove = 0;
+ break;
+ }
+ }
+ if(remove)
+ obj.remove(i);
+ }
+ }
+ var obj = document.getElementById('currvms');
+ for(var i = 0; i < vms.length; i++) {
+ var lastid = -1;
+ for(var j = 0; j < allvms.length; j++) {
+ if(allvms[j].id == vms[i].id) {
+ allvms[j].inout = addrem;
+ if(lastid < 0) {
+ if(addrem)
+ currvms.splice(0, 0, vms[i]);
+ var before = obj.options[0];
+ var newoption = new Option(allvms[j].name, allvms[j].id);
+ try {
+ obj.add(newoption, before);
+ }
+ catch(ex) {
+ obj.add(newoption, 0);
+ }
+ break;
+ }
+ else {
+ for(var k = 0; k < obj.options.length; k++) {
+ if(obj.options[k].value == lastid) {
+ if(addrem)
+ currvms.splice(0, 0, vms[i]);
+ var before = obj.options[k + 1];
+ var newoption = new Option(allvms[j].name, allvms[j].id);
+ if(before)
+ try {
+ obj.add(newoption, before);
+ }
+ catch(ex) {
+ obj.add(newoption, k + 1);
+ }
+ else
+ obj.options[obj.options.length] = newoption;
+ break;
+ }
+ }
+ }
+ break;
+ }
+ if(allvms[j].inout == addrem)
+ lastid = allvms[j].id;
+ }
+ }
+ document.body.style.cursor = 'default';
+ if(fails.length) {
+ var msg = '';
+ var msg1 = 'There was a problem that prevented the following\n'
+ + 'VM(s) from being added to the host:\n\n';
+ var msg2 = 'You do not have access to add the following vm(s):\n\n';
+ var msg3 = ''; // problem
+ var msg4 = ''; // no access
+ for(var i = 0; i < fails.length; i++) {
+ if(fails[i].reason == 'noaccess')
+ msg4 += fails[i].name + '\n';
+ else
+ msg3 += fails[i].name + '\n';
+ }
+ if(msg3 != '')
+ msg += msg1 + msg3 + '\n';
+ if(msg4 != '')
+ msg += msg2 + msg4 + '\n';
+ alert(msg);
+ }
+}
+
+function vmFromHost(cont) {
+ document.body.style.cursor = 'wait';
+ var hostid = document.getElementById('vmhostid').value;
+
+ var obj = document.getElementById('currvms');
+ var listids = new Array();
+ for(var i = obj.options.length - 1; i >= 0; i--) {
+ if(obj.options[i].selected)
+ listids.push(obj.options[i].value);
+ }
+
+ if(listids.length == 0) {
+ document.body.style.cursor = 'default';
+ return;
+ }
+ dojo.xhrPost({
+ url: 'index.php',
+ load: vmFromHostCB,
+ handleAs: "json-comment-filtered",
+ error: errorHandler,
+ content: {continuation: cont,
+ listids: listids.join(','),
+ hostid: hostid},
+ timeout: 15000
+ });
+}
+
+function vmFromHostCB(data, ioArgs) {
+ if(data.items.failed) {
+ alert('You do not have access to manage this VM host.');
+ document.body.style.cursor = 'default';
+ return;
+ }
+ /*
+ for each vmid sent back we
+ search through allvms until we find it keeping track of the previous item with inout == 1
+ we set allvms[vmid].inout to 1
+ we find the previous item in the select.options array
+ we insert a new option right after that one
+ */
+ var vms = data.items.vms;
+ var addrem = data.items.addrem; // 1 for add, 0 for rem
+ var checks = data.items.checks;
+ var fails = data.items.fails;
+ var obj = document.getElementById('currvms');
+ for(var i = obj.options.length - 1; i >= 0; i--) {
+ if(obj.options[i].selected) {
+ var remove = 1;
+ for(var j = 0; j < checks.length; j++) {
+ if(obj.options[i].value == checks[j].id) {
+ obj.options[i].selected = false;
+ remove = 0;
+ break;
+ }
+ }
+ for(var j = 0; j < fails.length; j++) {
+ if(obj.options[i].value == fails[j].id) {
+ obj.options[i].selected = false;
+ remove = 0;
+ break;
+ }
+ }
+ if(remove) {
+ obj.remove(i);
+ document.getElementById('vmstate').innerHTML = '';
+ currvms.splice(i, 1);
+ }
+ }
+ }
+ for(var i = 0; i < vms.length; i++) {
+ for(var j = 0; j < allvms.length; j++) {
+ if(allvms[j].id == vms[i].id) {
+ allvms.splice(j, 1);
+ break;
+ }
+ }
+ }
+
+ if(data.items.vms.length) {
+ document.getElementById('movevms').className = 'shown';
+ obj = document.getElementById('movevmssel');
+ var vms = data.items.vms;
+ for(var i = 0; i < vms.length; i++) {
+ var label = vms[i]['hostname'] + ' (' + vms[i]['time'] + ')';
+ obj.options[obj.options.length] = new Option(label, data.items.vms[i].reqid);
+ }
+ }
+
+ if(fails.length) {
+ var msg = 'You do not have access to remove the following vm(s):\n\n';
+ for(var i = 0; i < fails.length; i++) {
+ msg += fails[i].name + '\n';
+ }
+ alert(msg);
+ }
+
+ var checks = data.items.checks;
+ if(checks.length) {
+ var content = 'The following computer(s) have reservations on them that cannot be<br>'
+ + 'moved. Click <strong>Move Later</strong> to move the computer(s) off of the host<br>'
+ + 'at the listed time(s) or click <strong>Cancel</strong> to leave the computer(s) on<br>'
+ + 'the host:<br><br>';
+ for(var i = 0; i < checks.length; i++) {
+ content += 'computer: ' + checks[i].hostname + '<br>';
+ content += 'free at: ' + checks[i].end + '<br><br>';
+ }
+ var func = function() {vmFromHostDelayed(data.items.cont);};
+ setMessageWindow('Delayed Move', 'Move Later', content, func);
+ }
+ document.body.style.cursor = 'default';
+}
+
+function vmFromHostDelayed(cont) {
+ dojo.xhrPost({
+ url: 'index.php',
+ load: reloadVMhostCB,
+ handleAs: "json-comment-filtered",
+ error: errorHandler,
+ content: {continuation: cont},
+ timeout: 15000
+ });
+}
+
+function reloadVMhostCB(data, ioArgs) {
+ if(data.items.failed) {
+ alert('You do not have access to manage this VM host.');
+ document.body.style.cursor = 'default';
+ return;
+ }
+ if(data.items.failed && data.items.fails.length) {
+ var msg = 'You do not have access to remove the following vm(s):\n\n';
+ for(var i = 0; i < data.items.fails.length; i++) {
+ msg += data.items.fails[i].name + '\n';
+ }
+ alert(msg);
+ }
+ if(data.items.msg == 'SUCCESS')
+ getVMHostData(data.items.cont);
+ else
+ document.body.style.cursor = 'default';
+}
+
+function setMessageWindow(title, okbtntext, content, submitFunc) {
+ obj = dijit.byId('messages');
+ obj.titleNode.innerHTML = title;
+ document.getElementById('messagestext').innerHTML = content;
+ document.getElementById('messagesokbtn').innerHTML = okbtntext;
+ document.getElementById('messagesokbtn').onclick = submitFunc;
+ obj.show();
+}
+
+function cancelVMmove(cont) {
+ document.body.style.cursor = 'wait';
+ var hostid = document.getElementById('vmhostid').value;
+
+ var obj = document.getElementById('movevmssel');
+ var listids = new Array();
+ for(var i = obj.options.length - 1; i >= 0; i--) {
+ if(obj.options[i].selected)
+ listids.push(obj.options[i].value);
+ }
+
+ if(listids.length == 0) {
+ document.body.style.cursor = 'default';
+ return;
+ }
+ dojo.xhrPost({
+ url: 'index.php',
+ load: reloadVMhostCB,
+ handleAs: "json-comment-filtered",
+ error: errorHandler,
+ content: {continuation: cont,
+ listids: listids.join(','),
+ hostid: hostid},
+ timeout: 15000
+ });
+}
+
+function getVMprofileData(cont) {
+ document.body.style.cursor = 'wait';
+ document.getElementById('vmprofiledata').className = 'hidden';
+ var profileid = document.getElementById('profileid').value;
+
+ dojo.xhrPost({
+ url: 'index.php',
+ load: getVMprofileDataCB,
+ handleAs: "json-comment-filtered",
+ error: errorHandler,
+ content: {continuation: cont,
+ profileid: profileid},
+ timeout: 15000
+ });
+}
+
+function getVMprofileDataCB(data, ioArgs) {
+ if(data.items.failed) {
+ alert('You do not have access to manage this vm profile.');
+ document.body.style.cursor = 'default';
+ return;
+ }
+ curprofile = data.items.profile;
+ var obj = dijit.byId('ptype');
+ var store = new dojo.data.ItemFileReadStore({data: data.items.types});
+ obj.store = store;
+ obj.setValue(curprofile.vmtypeid);
+
+ var obj = dijit.byId('pimage');
+ var store = new dojo.data.ItemFileReadStore({data: data.items.images});
+ obj.store = store;
+ obj.setValue(curprofile.imageid);
+
+ var obj = dijit.byId('pvmdisk');
+ var store = new dojo.data.ItemFileReadStore({data: data.items.vmdisk});
+ obj.store = store;
+ obj.setValue(curprofile.vmdisk);
+
+ dijit.byId('pname').noValueIndicator = '(empty)';
+ dijit.byId('pnasshare').noValueIndicator = '(empty)';
+ dijit.byId('pdspath').noValueIndicator = '(empty)';
+ dijit.byId('pvmpath').noValueIndicator = '(empty)';
+ dijit.byId('pvs0').noValueIndicator = '(empty)';
+ dijit.byId('pvs1').noValueIndicator = '(empty)';
+
+ dijit.byId('pname').setValue(curprofile.name);
+ dijit.byId('pnasshare').setValue(curprofile.nasshare);
+ dijit.byId('pdspath').setValue(curprofile.datastorepath);
+ dijit.byId('pvmpath').setValue(curprofile.vmpath);
+ dijit.byId('pvs0').setValue(curprofile.virtualswitch0);
+ dijit.byId('pvs1').setValue(curprofile.virtualswitch1);
+ document.getElementById('vmprofiledata').className = 'shown';
+ document.body.style.cursor = 'default';
+}
+
+function newProfile(cont) {
+ var title = 'Create New Profile';
+ var btn = 'Create Profile';
+ var content = 'Enter name of new profile:<br>'
+ + '<input type=text id=newprofile><br>'
+ + '<font color=red><em><span id=nperrormsg></span></em></font><br>';
+ var func = function() {
+ var newname = document.getElementById('newprofile').value;
+ var regex = new RegExp('^[-A-Za-z0-9:\(\)# ]{3,56}$');
+ if(! newname.match(regex)) {
+ alert('Name must be between 3 and 56 characters\nand can only include letters, numbers,\nspaces, and these characters -:()#');
+ return;
+ }
+ document.body.style.cursor = 'wait';
+ dojo.xhrPost({
+ url: 'index.php',
+ load: newProfileCB,
+ handleAs: "json-comment-filtered",
+ error: errorHandler,
+ content: {continuation: cont,
+ newname: newname},
+ timeout: 15000
+ });
+ };
+ setMessageWindow(title, btn, content, func);
+}
+
+function newProfileCB(data, ioArgs) {
+ if(data.items.failed) {
+ document.getElementById('nperrormsg').innerHTML =
+ 'A profile with this name already exists';
+ return;
+ }
+ dijit.byId('messages').hide();
+ alert('Be sure to finish configuring this profile');
+ var obj = document.getElementById('profileid');
+ obj.options[obj.options.length] = new Option(data.items.profile.name, data.items.profile.id);
+ obj.options[obj.options.length - 1].selected = true;
+ // TODO insert new entry in correct order
+ getVMprofileDataCB(data, ioArgs);
+}
+
+function delProfile(cont) {
+ var title = 'Delete Profile';
+ var btn = 'Delete Profile';
+ var content = "Delete the following profile?<br>";
+ content += "<table summary=\"\">";
+ content += "<tr>";
+ content += "<th align=right>Name:</th>";
+ content += "<td>" + curprofile.name + "</td>";
+ content += "</tr>";
+ content += "<tr>";
+ content += "<th align=right>Type:</th>";
+ content += "<td>" + curprofile.type + "</td>";
+ content += "</tr>";
+ content += "<tr>";
+ content += "<th align=right>Image:</th>";
+ content += "<td>" + curprofile.image + "</td>";
+ content += "</tr>";
+ content += "<tr>";
+ content += "<th align=right>NAS Share:</th>";
+ content += "<td>" + curprofile.nasshare + "</td>";
+ content += "</tr>";
+ content += "<tr>";
+ content += "<th align=right>Data Store Path:</th>";
+ content += "<td>" + curprofile.datastorepath + "</td>";
+ content += "</tr>";
+ content += "<tr>";
+ content += "<th align=right>VM Path:</th>";
+ content += "<td>" + curprofile.vmpath + "</td>";
+ content += "</tr>";
+ content += "<tr>";
+ content += "<th align=right>Virtual Switch 0:</th>";
+ content += "<td>" + curprofile.virtualswitch0 + "</td>";
+ content += "</tr>";
+ content += "<tr>";
+ content += "<th align=right>Virtual Switch 1:</th>";
+ content += "<td>" + curprofile.virtualswitch1 + "</td>";
+ content += "</tr>";
+ content += "<tr>";
+ content += "<th align=right>VM Disk:</th>";
+ content += "<td>" + curprofile.vmdisk + "</td>";
+ content += "</tr>";
+ content += "</table>";
+ var func = function() {
+ var profileid = document.getElementById('profileid').value;
+ if(profileid == curprofileid)
+ document.getElementById('vmhostdata').className = 'hidden';
+ document.body.style.cursor = 'wait';
+ dojo.xhrPost({
+ url: 'index.php',
+ load: delProfileCB,
+ handleAs: "json-comment-filtered",
+ error: errorHandler,
+ content: {continuation: cont,
+ profileid: profileid},
+ timeout: 15000
+ });
+ };
+ setMessageWindow(title, btn, content, func);
+}
+
+function delProfileCB(data, ioArgs) {
+ if(data.items.failed) {
+ alert('You do not have access to manage this vm profile.');
+ dijit.byId('messages').hide();
+ document.body.style.cursor = 'default';
+ return;
+ }
+ dijit.byId('messages').hide();
+ var obj = document.getElementById('profileid');
+ obj.remove(obj.selectedIndex);
+ document.getElementById('vmprofiledata').className = 'hidden';
+ document.body.style.cursor = 'default';
+}
+
+function updateProfile(id, field) {
+ var newvalue = dijit.byId(id).value;
+ if(curprofile[field] == newvalue)
+ return;
+ document.body.style.cursor = 'wait';
+
+ var profileid = document.getElementById('profileid').value;
+ var cont = document.getElementById('pcont').value;
+ if(profileid == curprofileid)
+ document.getElementById('vmhostdata').className = 'hidden';
+
+ dojo.xhrPost({
+ url: 'index.php',
+ load: updateProfileCB,
+ error: errorHandler,
+ content: {continuation: cont,
+ profileid: profileid,
+ item: field,
+ newvalue: newvalue},
+ timeout: 15000
+ });
+}
+
+function updateProfileCB(data, ioArgs) {
+ eval(data);
+ document.body.style.cursor = 'default';
+}
diff --git a/web/themes/default/css/vcl.css b/web/themes/default/css/vcl.css
new file mode 100644
index 0000000..af8a59c
--- /dev/null
+++ b/web/themes/default/css/vcl.css
@@ -0,0 +1,383 @@
+/*
+* Licensed to the Apache Software Foundation (ASF) under one or more
+* contributor license agreements. See the NOTICE file distributed with
+* this work for additional information regarding copyright ownership.
+* The ASF licenses this file to You under the Apache License, Version 2.0
+* (the "License"); you may not use this file except in compliance with
+* the License. You may obtain a copy of the License at
+*
+* http://www.apache.org/licenses/LICENSE-2.0
+*
+* Unless required by applicable law or agreed to in writing, software
+* distributed under the License is distributed on an "AS IS" BASIS,
+* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+* See the License for the specific language governing permissions and
+* limitations under the License.
+*/
+body {
+ font: 11px helvetica, arial, sans;
+ color: black;
+ background: #FFFFFF;
+ margin: 0;
+ padding: 0;
+ text-align: center;
+
+}
+
+p {
+ font: 11px arial, helvetica, sans;
+ margin-top: 0px;
+ text-align: left;
+}
+
+pre {
+ font: 11px trebuchet ms, arial, helvetica, sans;
+ font-weight: bold;
+}
+
+a:link {
+ text-decoration: none;
+ color: #990000;
+}
+
+a:visited {
+ text-decoration: none;
+ color: #595959;
+}
+
+a:hover, a:active {
+ background: #CCCCCC;
+ text-decoration: none;
+ color: black;
+}
+
+table, td {
+ font: 11px helvetica, arial, sans;
+ font-weight: normal;
+ color: black;
+}
+
+table tr td.white {
+ background: white;
+}
+
+th {
+ font: 12px helvetica, arial, sans;
+ font-weight: bold;
+ color: black;
+ cursor: default;
+}
+
+h1, h2, h3 span {display:none}
+
+form {
+ margin-bottom: 0;
+}
+
+#container {
+ background: #E5E5E5 url(../images/background.gif) repeat-y center;
+ display: block;
+ position: relative;
+ border: none;
+ margin: 0 auto 0 auto;
+ width: 752px;
+ min-height: 768px;
+ text-align: center;
+ overflow: visible;
+}
+
+#gradient {
+ background: url(../images/background_gradient.gif) left top;
+ display: block;
+ position: relative;
+ border: none;
+ min-height: 768px;
+ text-align: center;
+ overflow: visible;
+}
+
+#container-whitespace {
+ background: url(../images/background_whitespace.gif) center;
+ display: block;
+ border: none;
+ padding: 0;
+ text-align: center;
+ overflow: visible;
+}
+
+#container-inner {
+ background: transparent url(../images/menu_bg.jpg) repeat-y left top;
+ display: block;
+ border: none;
+ margin: 0 3px 0 3px;
+ padding: 0;
+ overflow: visible;
+}
+
+#header {
+ display: block;
+ background: transparent;
+ height: 100px;
+ margin: 0;
+ padding: 0;
+ border: 0;
+}
+
+#bar {
+ background: url(../images/bar_bg.jpg) repeat-x left top;
+ display: block;
+ height: 23px;
+ margin: 0;
+ padding: 0;
+}
+
+#menu {
+ float: left;
+ width: 160px;
+ padding: 0;
+ border: 0;
+}
+
+#menulist {
+ background: none;
+ display: block;
+ margin: 0;
+ border: 0;
+ padding: 0;
+}
+
+#menulist ul {
+ margin: 0;
+ padding: 0;
+}
+
+#menulist ul li {
+ display: block;
+ background: url(../images/menu.jpg) no-repeat left top;
+ height: 22px;
+ width: 158px;
+ list-style-type: none;
+ margin: 0 1px 0 0;
+ padding: 0;
+ text-align: left;
+ vertical-align: bottom;
+}
+
+#menulist ul li a {
+ display: block;
+ background: none;
+ font: 12px arial, helvetica, sans-serif;
+ font-weight: bold;
+ text-align: left;
+ color: black;
+ line-height: 13px;
+ padding: 4px 0 0 4px;
+}
+
+#menulist ul li a:visted {
+ display: block;
+ background: none;
+ font: 12px arial, helvetica, sans-serif;
+ font-weight: bold;
+ text-align: left;
+ line-height: 13px;
+ color: black;
+}
+
+#menulist ul li a:hover, a:active {
+ text-decoration: none;
+ color: #B90000;
+}
+
+#menulist ul li.selected {
+ display: block;
+ background: url(../images/menu_selected.jpg) no-repeat left top;
+ height: 22px;
+ width: 158px;
+ list-style-type: none;
+ padding: 0;
+ margin: 0 1px 0 0;
+ vertical-align: bottom;
+}
+
+#menulist ul li.selected a {
+ display: block;
+ background: none;
+ font: 12px arial, helvetica, sans-serif;
+ font-weight: bold;
+ text-align: left;
+ color: white;
+ line-height: 13px;
+ padding: 4px 0 0 4px;
+}
+
+#menulist ul li.selected a:visted {
+ display: block;
+ background: none;
+ font: 12px arial, helvetica, sans-serif;
+ font-weight: bold;
+ text-align: left;
+ line-height: 13px;
+ color: white;
+}
+
+#menulist ul li.selected a:hover, a:active {
+ text-decoration: none;
+ color: black;
+}
+
+#links {
+ width: 158px;
+ margin: 0;
+ padding: 0;
+ border: 0;
+}
+
+#links p {
+ margin: 0;
+ padding: 5px;
+ font: 10px arial, helvetica, sans-serif;
+ color: black;
+}
+
+#content {
+ margin: 0px 0px 0px 10px;
+ display: block;
+ text-align: left;
+ overflow: visible;
+}
+
+#content h2 {
+ display: block;
+ font-family: arial, helvetica, sans;
+ text-shadow: #ccc 0 0 2px;
+ color: #111;
+}
+
+
+#content table {
+ background: #ffffff;
+ border-spacing: 1px;
+ margin: 10px 10px 10px 0;
+ padding: 0;
+}
+
+#content table th {
+ margin: 0;
+ padding: 3px;
+ vertical-align: top;
+}
+
+#content table td {
+ margin: 0;
+ padding: 3px;
+
+}
+
+
+#ext {
+ clear: left;
+ height: 1px;
+}
+
+#footer {
+ background: transparent;
+ width: 750px;
+ margin: 0 8px 0 8px;
+ padding: 0 0 20px 0;
+}
+
+#footer-top {
+ height: 5px;
+ width: 724px;
+ margin: 0;
+ padding: 0;
+}
+
+#footer-top span {display: none}
+
+#footer-padding {
+ clear: left;
+ background: transparent;
+ width: 724px;
+ height: 10px;
+ margin: 0;
+ padding: 0;
+}
+
+#footer-box-left {
+ float: left;
+ background: #F2F2F2;
+ width: 350px;
+ margin: 8px 1px 1px 1px;
+ padding: 5px;
+ border: #595959 1px solid;
+ color: black;
+ font: 9px helvetica, arial, sans;
+}
+
+#footer-box-left p {
+ margin: 0;
+ padding: 0;
+}
+
+#footer-box-left p a:link {
+ text-decoration: none;
+ color: black;
+}
+
+#footer-box-left p a:visited {
+ text-decoration: none;
+ color: #595959;
+}
+
+#footer-box-left p a:hover, a:active {
+ background: #CCCCCC;
+ text-decoration: none;
+ color: black;
+}
+
+
+#footer-box-right {
+ display: block;
+ background: transparent;
+ margin: 8px 0 0 370px;
+ padding: 0;
+}
+
+#footer-box-right p {
+ font: 9px helvetica, arial, sans;
+ text-align: left;
+ color: black;
+}
+
+.leftlabel {
+ width: 150px;
+ float: left;
+ text-align: right;
+ margin-right: 0.5em;
+ margin-bottom: 0.2em;
+ display: block;
+ font-weight: bold;
+ font-size: 12px;
+}
+
+.helpformleftlabel {
+ width: 80px;
+ float: left;
+ text-align: right;
+ margin-right: 0.5em;
+ margin-bottom: 0.2em;
+ display: block;
+ font-weight: bold;
+ font-size: 12px;
+}
+
+.leftlabeldiv {
+ float: left;
+}
+
+.test1 {
+ float: none;
+ display: block;
+}
diff --git a/web/themes/default/images/background.gif b/web/themes/default/images/background.gif
new file mode 100644
index 0000000..bab17d6
--- /dev/null
+++ b/web/themes/default/images/background.gif
Binary files differ
diff --git a/web/themes/default/images/background_L.png b/web/themes/default/images/background_L.png
new file mode 100644
index 0000000..4eb3883
--- /dev/null
+++ b/web/themes/default/images/background_L.png
Binary files differ
diff --git a/web/themes/default/images/background_R.png b/web/themes/default/images/background_R.png
new file mode 100644
index 0000000..b5fe1d6
--- /dev/null
+++ b/web/themes/default/images/background_R.png
Binary files differ
diff --git a/web/themes/default/images/background_bottom_C.jpg b/web/themes/default/images/background_bottom_C.jpg
new file mode 100644
index 0000000..c3d7559
--- /dev/null
+++ b/web/themes/default/images/background_bottom_C.jpg
Binary files differ
diff --git a/web/themes/default/images/background_bottom_L.jpg b/web/themes/default/images/background_bottom_L.jpg
new file mode 100644
index 0000000..0134809
--- /dev/null
+++ b/web/themes/default/images/background_bottom_L.jpg
Binary files differ
diff --git a/web/themes/default/images/background_bottom_R.jpg b/web/themes/default/images/background_bottom_R.jpg
new file mode 100644
index 0000000..7e614da
--- /dev/null
+++ b/web/themes/default/images/background_bottom_R.jpg
Binary files differ
diff --git a/web/themes/default/images/background_gradient.gif b/web/themes/default/images/background_gradient.gif
new file mode 100644
index 0000000..d722ea2
--- /dev/null
+++ b/web/themes/default/images/background_gradient.gif
Binary files differ
diff --git a/web/themes/default/images/background_whitespace.gif b/web/themes/default/images/background_whitespace.gif
new file mode 100644
index 0000000..11e44b2
--- /dev/null
+++ b/web/themes/default/images/background_whitespace.gif
Binary files differ
diff --git a/web/themes/default/images/bar_bg.jpg b/web/themes/default/images/bar_bg.jpg
new file mode 100644
index 0000000..8fc83d9
--- /dev/null
+++ b/web/themes/default/images/bar_bg.jpg
Binary files differ
diff --git a/web/themes/default/images/belltower.jpg b/web/themes/default/images/belltower.jpg
new file mode 100644
index 0000000..87c697e
--- /dev/null
+++ b/web/themes/default/images/belltower.jpg
Binary files differ
diff --git a/web/themes/default/images/black.jpg b/web/themes/default/images/black.jpg
new file mode 100644
index 0000000..8717c45
--- /dev/null
+++ b/web/themes/default/images/black.jpg
Binary files differ
diff --git a/web/themes/default/images/content_border_R.jpg b/web/themes/default/images/content_border_R.jpg
new file mode 100644
index 0000000..1a04239
--- /dev/null
+++ b/web/themes/default/images/content_border_R.jpg
Binary files differ
diff --git a/web/themes/default/images/menu-leaf.png b/web/themes/default/images/menu-leaf.png
new file mode 100644
index 0000000..827ba08
--- /dev/null
+++ b/web/themes/default/images/menu-leaf.png
Binary files differ
diff --git a/web/themes/default/images/menu.jpg b/web/themes/default/images/menu.jpg
new file mode 100644
index 0000000..b9ed593
--- /dev/null
+++ b/web/themes/default/images/menu.jpg
Binary files differ
diff --git a/web/themes/default/images/menu_bg.jpg b/web/themes/default/images/menu_bg.jpg
new file mode 100644
index 0000000..ff348e5
--- /dev/null
+++ b/web/themes/default/images/menu_bg.jpg
Binary files differ
diff --git a/web/themes/default/images/menu_dividerblock.jpg b/web/themes/default/images/menu_dividerblock.jpg
new file mode 100644
index 0000000..6e29289
--- /dev/null
+++ b/web/themes/default/images/menu_dividerblock.jpg
Binary files differ
diff --git a/web/themes/default/images/menu_selected.jpg b/web/themes/default/images/menu_selected.jpg
new file mode 100644
index 0000000..b310ee2
--- /dev/null
+++ b/web/themes/default/images/menu_selected.jpg
Binary files differ
diff --git a/web/themes/default/images/vclbanner_C.jpg b/web/themes/default/images/vclbanner_C.jpg
new file mode 100644
index 0000000..29313ef
--- /dev/null
+++ b/web/themes/default/images/vclbanner_C.jpg
Binary files differ
diff --git a/web/themes/default/images/vclbanner_L.jpg b/web/themes/default/images/vclbanner_L.jpg
new file mode 100644
index 0000000..d8560e2
--- /dev/null
+++ b/web/themes/default/images/vclbanner_L.jpg
Binary files differ
diff --git a/web/themes/default/images/vclbanner_R.jpg b/web/themes/default/images/vclbanner_R.jpg
new file mode 100644
index 0000000..590fb9f
--- /dev/null
+++ b/web/themes/default/images/vclbanner_R.jpg
Binary files differ
diff --git a/web/themes/default/page.php b/web/themes/default/page.php
new file mode 100644
index 0000000..21c3349
--- /dev/null
+++ b/web/themes/default/page.php
@@ -0,0 +1,139 @@
+<?php
+/*
+ Licensed to the Apache Software Foundation (ASF) under one or more
+ contributor license agreements. See the NOTICE file distributed with
+ this work for additional information regarding copyright ownership.
+ The ASF licenses this file to You under the Apache License, Version 2.0
+ (the "License"); you may not use this file except in compliance with
+ the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getHeader($refresh)
+///
+/// \param $refresh - bool for adding code to refresh page
+///
+/// \return string of html to go before the main content
+///
+/// \brief builds the html that goes before the main content
+///
+////////////////////////////////////////////////////////////////////////////////
+function getHeader($refresh) {
+ global $user, $mode, $authed;
+ $rt = "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n";
+ $rt .= "<html lang=\"en\">\n";
+ $rt .= "<head>\n";
+ $rt .= "<title>VCL :: Virtual Computing Lab</title>\n";
+ $rt .= "<link rel=stylesheet type=\"text/css\" href=\"css/vcl.css\">\n";
+ $rt .= "<link rel=stylesheet type=\"text/css\" href=\"themes/default/css/vcl.css\">\n";
+ if($mode == 'viewdocs')
+ $rt .= "<link rel=stylesheet type=\"text/css\" href=\"css/doxygen.css\" />\n";
+ $rt .= "<script src=\"js/code.js\" type=\"text/javascript\"></script>\n";
+ $rt .= "<script type=\"text/javascript\">\n";
+ $rt .= "var cookiedomain = '" . COOKIEDOMAIN . "';\n";
+ $rt .= "</script>\n";
+ $rt .= getDojoHTML($refresh);
+ if($refresh)
+ $rt .= "<noscript><META HTTP-EQUIV=REFRESH CONTENT=20></noscript>\n";
+ $rt .= "</head>\n\n";
+ $rt .= "<body>\n\n";
+ $rt .= "<a class=hidden href=\"#content\" accesskey=2>Skip to content</a>\n";
+ $rt .= "<table border=0 cellpadding=0 cellspacing=0 summary=\"\">\n";
+ $rt .= " <TR>\n";
+ $rt .= " <TD width=80px nowrap></TD>\n";
+ $rt .= " <TD width=6px background=\"themes/default/images/background_L.png\" nowrap></TD>\n";
+ $rt .= " <TD width=8px background=\"themes/default/images/background_gradient.gif\" nowrap></TD>\n";
+ $rt .= " <TD background=\"themes/default/images/background_gradient.gif\" width=\"100%\">\n";
+ $rt .= " <table border=0 cellpadding=0 cellspacing=0 width=\"100%\" summary=\"\">\n";
+ $rt .= " <TR>\n";
+ $rt .= " <TD width=1px background=\"themes/default/images/black.jpg\" nowrap></TD>\n";
+ $rt .= " <TD width=215px nowrap><img src=\"themes/default/images/vclbanner_L.jpg\" alt=\"\"></TD>\n";
+ $rt .= " <TD background=\"themes/default/images/vclbanner_C.jpg\" width=\"100%\"></TD>\n";
+ $rt .= " <TD width=198px nowrap><img src=\"themes/default/images/vclbanner_R.jpg\" alt=\"\"></TD>\n";
+ $rt .= " <TD width=3px background=\"themes/default/images/content_border_R.jpg\" nowrap></TD>\n";
+ $rt .= " </TR>\n";
+ $rt .= " <TR>\n";
+ $rt .= " <TD width=1px background=\"themes/default/images/black.jpg\" nowrap></TD>\n";
+ $rt .= " <TD background=\"themes/default/images/bar_bg.jpg\" width=\"100%\" colspan=3 height=23px></TD>\n";
+ $rt .= " <TD width=3px background=\"themes/default/images/content_border_R.jpg\" nowrap></TD>\n";
+ $rt .= " </TR>\n";
+ $rt .= " </table>\n";
+ $rt .= " <table border=0 cellpadding=0 cellspacing=0 width=\"100%\" summary=\"\">\n";
+ $rt .= " <TR valign=top>\n";
+ $rt .= " <TD width=160px background=\"themes/default/images/menu_bg.jpg\" nowrap>\n";
+ $rt .= "<div id=menulist>\n";
+ $rt .= "<h3 class=hidden>Resources</h3>\n";
+ $rt .= "<ul>\n";
+ if($authed)
+ $rt .= getNavMenu(1, 1);
+ /*else
+ $rt .= "<img src=\"themes/default/images/belltower.jpg\" height=200 width=160 alt=\"\">\n";*/
+ $rt .= "</ul>\n";
+ if($authed)
+ $rt .= "<img src=\"themes/default/images/menu_dividerblock.jpg\" border=0 width=158 height=83 alt=\"\"><br/>\n";
+ $rt .= "</div>\n";
+ $rt .= " </TD>\n";
+ $rt .= " <TD width=\"100%\" style=\"align: left; background: #ffffff;\">\n";
+ $rt .= "<div id=content class=default>\n";
+ return $rt;
+}
+
+////////////////////////////////////////////////////////////////////////////////
+///
+/// \fn getFooter()
+///
+/// \return string of html to go after the main content
+///
+/// \brief builds the html that goes after the main content
+///
+////////////////////////////////////////////////////////////////////////////////
+function getFooter() {
+ $year = date("Y");
+ $rt = "</div>\n";
+ $rt .= " </TD>\n";
+ $rt .= " <TD width=3px background=\"themes/default/images/content_border_R.jpg\" nowrap></TD>\n";
+ $rt .= " </TR>\n";
+ $rt .= " <TR>\n";
+ $rt .= " <TD width=160px nowrap><img src=\"themes/default/images/background_bottom_L.jpg\" alt=\"\"></TD>\n";
+ $rt .= " <TD background=\"themes/default/images/background_bottom_C.jpg\" width=\"100%\"></TD>\n";
+ $rt .= " <TD width=3px nowrap><img src=\"themes/default/images/background_bottom_R.jpg\" alt=\"\"></TD>\n";
+ $rt .= " </TR>\n";
+ $rt .= " </table>\n";
+ $rt .= "<div id=\"footer\">\n";
+ $rt .= "<div id=\"footer-top\">\n";
+ $rt .= "<span>This support page is for students, faculty, and staff of North Carolina State University</span>\n";
+ $rt .= "</div>\n";
+ $rt .= "<div id=\"footer-box-left\">\n";
+ $rt .= "<p>\n";
+ $rt .= "North Carolina State University, Raleigh, NC<br/>\n";
+ $rt .= "<a href=\"http://vcl.ncsu.edu/\">vcl.ncsu.edu</a> | \n";
+ $rt .= "Comments to <a href=\"mailto:vcl_help@ncsu.edu\" accesskey=9>vcl_help@ncsu.edu</a>\n";
+ $rt .= "</p>\n";
+ $rt .= "</div>\n";
+ $rt .= "<div id=\"footer-box-right\">\n";
+ $rt .= "<p>\n";
+ $rt .= "Copyright © 2004-$year by NC State University and others, All Rights Reserved.\n";
+ $rt .= "</p>\n";
+ $rt .= "</div>\n";
+ $rt .= "<div id=\"footer-padding\"><span></span></div>\n";
+ $rt .= "</div>\n";
+ $rt .= "<!-- end footer -->\n";
+ $rt .= "</TD>\n";
+ $rt .= "<TD width=8px background=\"themes/default/images/background_gradient.gif\" nowrap></TD>\n";
+ $rt .= "<TD width=6px background=\"themes/default/images/background_R.png\" nowrap></TD>\n";
+ $rt .= "<TD width=80px nowrap></TD>\n";
+ $rt .= "</TR>\n";
+ $rt .= "</table>\n";
+ $rt .= "</body>\n";
+ $rt .= "</html>\n";
+ return $rt;
+}
