+++ /dev/null
-- The "Artistic License"
--
-- Preamble
--
--The intent of this document is to state the conditions under which a
--Package may be copied, such that the Copyright Holder maintains some
--semblance of artistic control over the development of the Package,
--while giving the users of the package the right to use and distribute
--the Package in a more-or-less customary fashion, plus the right to make
--reasonable modifications.
--
--It also grants you the rights to reuse parts of a Package in your own
--programs without transferring this License to those programs, provided
--that you meet some reasonable requirements.
--
--Definitions:
--
-- "Package" refers to the collection of files distributed by the
-- Copyright Holder, and derivatives of that collection of files
-- created through textual modification.
--
-- "Standard Version" refers to such a Package if it has not been
-- modified, or has been modified in accordance with the wishes
-- of the Copyright Holder as specified below.
--
-- "Copyright Holder" is whoever is named in the copyright or
-- copyrights for the package.
--
-- "You" is you, if you're thinking about copying or distributing
-- this Package.
--
-- "Reasonable copying fee" is whatever you can justify on the
-- basis of media cost, duplication charges, time of people involved,
-- and so on. (You will not be required to justify it to the
-- Copyright Holder, but only to the computing community at large
-- as a market that must bear the fee.)
--
-- "Freely Available" means that no fee is charged for the item
-- itself, though there may be fees involved in handling the item.
-- It also means that recipients of the item may redistribute it
-- under the same conditions they received it.
--
--1. You may make and give away verbatim copies of the source form of the
--Standard Version of this Package without restriction, provided that you
--duplicate all of the original copyright notices and associated disclaimers.
--
--2. You may apply bug fixes, portability fixes and other modifications
--derived from the Public Domain or from the Copyright Holder. A Package
--modified in such a way shall still be considered the Standard Version.
--
--3. You may otherwise modify your copy of this Package in any way, provided
--that you insert a prominent notice in each changed file stating how and
--when you changed that file, and provided that you do at least ONE of the
--following:
--
-- a) place your modifications in the Public Domain or otherwise make them
-- Freely Available, such as by posting said modifications to Usenet or
-- an equivalent medium, or placing the modifications on a major archive
-- site such as uunet.uu.net, or by allowing the Copyright Holder to include
-- your modifications in the Standard Version of the Package.
--
-- b) use the modified Package only within your corporation or organization.
--
-- c) rename any non-standard executables so the names do not conflict
-- with standard executables, which must also be provided, and provide
-- a separate manual page for each non-standard executable that clearly
-- documents how it differs from the Standard Version.
--
-- d) make other distribution arrangements with the Copyright Holder.
--
--4. You may distribute the programs of this Package in object code or
--executable form, provided that you do at least ONE of the following:
--
-- a) distribute a Standard Version of the executables and library files,
-- together with instructions (in the manual page or equivalent) on where
-- to get the Standard Version.
--
-- b) accompany the distribution with the machine-readable source of
-- the Package with your modifications.
--
-- c) give non-standard executables non-standard names, and clearly
-- document the differences in manual pages (or equivalent), together
-- with instructions on where to get the Standard Version.
--
-- d) make other distribution arrangements with the Copyright Holder.
--
--5. You may charge a reasonable copying fee for any distribution of this
--Package. You may charge any fee you choose for support of this
--Package. You may not charge a fee for this Package itself. However,
--you may distribute this Package in aggregate with other (possibly
--commercial) programs as part of a larger (possibly commercial) software
--distribution provided that you do not advertise this Package as a
--product of your own.
--
--6. The scripts and library files supplied as input to or produced as
--output from the programs of this Package do not automatically fall
--under the copyright of this Package, but belong to whomever generated
--them, and may be sold commercially, and may be aggregated with this
--Package. If such scripts or library files are aggregated with this
--Package via the so-called "undump" or "unexec" methods of producing a
--binary executable image, then distribution of such an image shall
--neither be construed as a distribution of this Package nor shall it
--fall under the restrictions of Paragraphs 3 and 4, provided that you do
--not represent such an executable image as a Standard Version of this
--Package.
--
--7. You may reuse parts of this Package in your own programs, provided that
--you explicitly state where you got them from, in the source code (and, left
--to your courtesy, in the documentation), duplicating all the associated
--copyright notices and disclaimers. Besides your changes, if any, must be
--clearly marked as such. Parts reused that way will no longer fall under this
--license if, and only if, the name of your program(s) have no immediate
--connection with the name of the Package itself or its associated programs.
--You may then apply whatever restrictions you wish on the reused parts or
--choose to place them in the Public Domain--this will apply only within the
--context of your package.
--
--8. The name of the Copyright Holder may not be used to endorse or promote
--products derived from this software without specific prior written permission.
--
--9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
--IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
--WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
--
-- The End
+++ /dev/null
--Thanks to Matt Simerson <matt@michweb.net> of MichWeb Inc. for documentation
--and pre-release testing. Without his help the documentation in the first
--release would have consisted of a single screenfull of text.
--
--# Steve Cleff <cleff@yahoo.com> did the default background image and is also
--# the creator of Freeside's mascot, Snakeman.
--
--Jerry St. Pierre <jstpi@city.timmins.on.ca> did the "SISD" graphic.
--
--Brian McCane? <bmccane@maxbaud.net> contributed PostgreSQL support, HTML
--style enhancements and many, many bugfixes.
--
--Everything else is my (Ivan Kohler <ivan@sisd.com>) fault.
--
+++ /dev/null
-- GNU GENERAL PUBLIC LICENSE
-- Version 2, June 1991
--
-- Copyright (C) 1989, 1991 Free Software Foundation, Inc.
-- 675 Mass Ave, Cambridge, MA 02139, USA
-- Everyone is permitted to copy and distribute verbatim copies
-- of this license document, but changing it is not allowed.
--
-- Preamble
--
-- The licenses for most software are designed to take away your
--freedom to share and change it. By contrast, the GNU General Public
--License is intended to guarantee your freedom to share and change free
--software--to make sure the software is free for all its users. This
--General Public License applies to most of the Free Software
--Foundation's software and to any other program whose authors commit to
--using it. (Some other Free Software Foundation software is covered by
--the GNU Library General Public License instead.) You can apply it to
--your programs, too.
--
-- When we speak of free software, we are referring to freedom, not
--price. Our General Public Licenses are designed to make sure that you
--have the freedom to distribute copies of free software (and charge for
--this service if you wish), that you receive source code or can get it
--if you want it, that you can change the software or use pieces of it
--in new free programs; and that you know you can do these things.
--
-- To protect your rights, we need to make restrictions that forbid
--anyone to deny you these rights or to ask you to surrender the rights.
--These restrictions translate to certain responsibilities for you if you
--distribute copies of the software, or if you modify it.
--
-- For example, if you distribute copies of such a program, whether
--gratis or for a fee, you must give the recipients all the rights that
--you have. You must make sure that they, too, receive or can get the
--source code. And you must show them these terms so they know their
--rights.
--
-- We protect your rights with two steps: (1) copyright the software, and
--(2) offer you this license which gives you legal permission to copy,
--distribute and/or modify the software.
--
-- Also, for each author's protection and ours, we want to make certain
--that everyone understands that there is no warranty for this free
--software. If the software is modified by someone else and passed on, we
--want its recipients to know that what they have is not the original, so
--that any problems introduced by others will not reflect on the original
--authors' reputations.
--
-- Finally, any free program is threatened constantly by software
--patents. We wish to avoid the danger that redistributors of a free
--program will individually obtain patent licenses, in effect making the
--program proprietary. To prevent this, we have made it clear that any
--patent must be licensed for everyone's free use or not licensed at all.
--
-- The precise terms and conditions for copying, distribution and
--modification follow.
--\f
-- GNU GENERAL PUBLIC LICENSE
-- TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
--
-- 0. This License applies to any program or other work which contains
--a notice placed by the copyright holder saying it may be distributed
--under the terms of this General Public License. The "Program", below,
--refers to any such program or work, and a "work based on the Program"
--means either the Program or any derivative work under copyright law:
--that is to say, a work containing the Program or a portion of it,
--either verbatim or with modifications and/or translated into another
--language. (Hereinafter, translation is included without limitation in
--the term "modification".) Each licensee is addressed as "you".
--
--Activities other than copying, distribution and modification are not
--covered by this License; they are outside its scope. The act of
--running the Program is not restricted, and the output from the Program
--is covered only if its contents constitute a work based on the
--Program (independent of having been made by running the Program).
--Whether that is true depends on what the Program does.
--
-- 1. You may copy and distribute verbatim copies of the Program's
--source code as you receive it, in any medium, provided that you
--conspicuously and appropriately publish on each copy an appropriate
--copyright notice and disclaimer of warranty; keep intact all the
--notices that refer to this License and to the absence of any warranty;
--and give any other recipients of the Program a copy of this License
--along with the Program.
--
--You may charge a fee for the physical act of transferring a copy, and
--you may at your option offer warranty protection in exchange for a fee.
--
-- 2. You may modify your copy or copies of the Program or any portion
--of it, thus forming a work based on the Program, and copy and
--distribute such modifications or work under the terms of Section 1
--above, provided that you also meet all of these conditions:
--
-- a) You must cause the modified files to carry prominent notices
-- stating that you changed the files and the date of any change.
--
-- b) You must cause any work that you distribute or publish, that in
-- whole or in part contains or is derived from the Program or any
-- part thereof, to be licensed as a whole at no charge to all third
-- parties under the terms of this License.
--
-- c) If the modified program normally reads commands interactively
-- when run, you must cause it, when started running for such
-- interactive use in the most ordinary way, to print or display an
-- announcement including an appropriate copyright notice and a
-- notice that there is no warranty (or else, saying that you provide
-- a warranty) and that users may redistribute the program under
-- these conditions, and telling the user how to view a copy of this
-- License. (Exception: if the Program itself is interactive but
-- does not normally print such an announcement, your work based on
-- the Program is not required to print an announcement.)
--\f
--These requirements apply to the modified work as a whole. If
--identifiable sections of that work are not derived from the Program,
--and can be reasonably considered independent and separate works in
--themselves, then this License, and its terms, do not apply to those
--sections when you distribute them as separate works. But when you
--distribute the same sections as part of a whole which is a work based
--on the Program, the distribution of the whole must be on the terms of
--this License, whose permissions for other licensees extend to the
--entire whole, and thus to each and every part regardless of who wrote it.
--
--Thus, it is not the intent of this section to claim rights or contest
--your rights to work written entirely by you; rather, the intent is to
--exercise the right to control the distribution of derivative or
--collective works based on the Program.
--
--In addition, mere aggregation of another work not based on the Program
--with the Program (or with a work based on the Program) on a volume of
--a storage or distribution medium does not bring the other work under
--the scope of this License.
--
-- 3. You may copy and distribute the Program (or a work based on it,
--under Section 2) in object code or executable form under the terms of
--Sections 1 and 2 above provided that you also do one of the following:
--
-- a) Accompany it with the complete corresponding machine-readable
-- source code, which must be distributed under the terms of Sections
-- 1 and 2 above on a medium customarily used for software interchange; or,
--
-- b) Accompany it with a written offer, valid for at least three
-- years, to give any third party, for a charge no more than your
-- cost of physically performing source distribution, a complete
-- machine-readable copy of the corresponding source code, to be
-- distributed under the terms of Sections 1 and 2 above on a medium
-- customarily used for software interchange; or,
--
-- c) Accompany it with the information you received as to the offer
-- to distribute corresponding source code. (This alternative is
-- allowed only for noncommercial distribution and only if you
-- received the program in object code or executable form with such
-- an offer, in accord with Subsection b above.)
--
--The source code for a work means the preferred form of the work for
--making modifications to it. For an executable work, complete source
--code means all the source code for all modules it contains, plus any
--associated interface definition files, plus the scripts used to
--control compilation and installation of the executable. However, as a
--special exception, the source code distributed need not include
--anything that is normally distributed (in either source or binary
--form) with the major components (compiler, kernel, and so on) of the
--operating system on which the executable runs, unless that component
--itself accompanies the executable.
--
--If distribution of executable or object code is made by offering
--access to copy from a designated place, then offering equivalent
--access to copy the source code from the same place counts as
--distribution of the source code, even though third parties are not
--compelled to copy the source along with the object code.
--\f
-- 4. You may not copy, modify, sublicense, or distribute the Program
--except as expressly provided under this License. Any attempt
--otherwise to copy, modify, sublicense or distribute the Program is
--void, and will automatically terminate your rights under this License.
--However, parties who have received copies, or rights, from you under
--this License will not have their licenses terminated so long as such
--parties remain in full compliance.
--
-- 5. You are not required to accept this License, since you have not
--signed it. However, nothing else grants you permission to modify or
--distribute the Program or its derivative works. These actions are
--prohibited by law if you do not accept this License. Therefore, by
--modifying or distributing the Program (or any work based on the
--Program), you indicate your acceptance of this License to do so, and
--all its terms and conditions for copying, distributing or modifying
--the Program or works based on it.
--
-- 6. Each time you redistribute the Program (or any work based on the
--Program), the recipient automatically receives a license from the
--original licensor to copy, distribute or modify the Program subject to
--these terms and conditions. You may not impose any further
--restrictions on the recipients' exercise of the rights granted herein.
--You are not responsible for enforcing compliance by third parties to
--this License.
--
-- 7. If, as a consequence of a court judgment or allegation of patent
--infringement or for any other reason (not limited to patent issues),
--conditions are imposed on you (whether by court order, agreement or
--otherwise) that contradict the conditions of this License, they do not
--excuse you from the conditions of this License. If you cannot
--distribute so as to satisfy simultaneously your obligations under this
--License and any other pertinent obligations, then as a consequence you
--may not distribute the Program at all. For example, if a patent
--license would not permit royalty-free redistribution of the Program by
--all those who receive copies directly or indirectly through you, then
--the only way you could satisfy both it and this License would be to
--refrain entirely from distribution of the Program.
--
--If any portion of this section is held invalid or unenforceable under
--any particular circumstance, the balance of the section is intended to
--apply and the section as a whole is intended to apply in other
--circumstances.
--
--It is not the purpose of this section to induce you to infringe any
--patents or other property right claims or to contest validity of any
--such claims; this section has the sole purpose of protecting the
--integrity of the free software distribution system, which is
--implemented by public license practices. Many people have made
--generous contributions to the wide range of software distributed
--through that system in reliance on consistent application of that
--system; it is up to the author/donor to decide if he or she is willing
--to distribute software through any other system and a licensee cannot
--impose that choice.
--
--This section is intended to make thoroughly clear what is believed to
--be a consequence of the rest of this License.
--\f
-- 8. If the distribution and/or use of the Program is restricted in
--certain countries either by patents or by copyrighted interfaces, the
--original copyright holder who places the Program under this License
--may add an explicit geographical distribution limitation excluding
--those countries, so that distribution is permitted only in or among
--countries not thus excluded. In such case, this License incorporates
--the limitation as if written in the body of this License.
--
-- 9. The Free Software Foundation may publish revised and/or new versions
--of the General Public License from time to time. Such new versions will
--be similar in spirit to the present version, but may differ in detail to
--address new problems or concerns.
--
--Each version is given a distinguishing version number. If the Program
--specifies a version number of this License which applies to it and "any
--later version", you have the option of following the terms and conditions
--either of that version or of any later version published by the Free
--Software Foundation. If the Program does not specify a version number of
--this License, you may choose any version ever published by the Free Software
--Foundation.
--
-- 10. If you wish to incorporate parts of the Program into other free
--programs whose distribution conditions are different, write to the author
--to ask for permission. For software which is copyrighted by the Free
--Software Foundation, write to the Free Software Foundation; we sometimes
--make exceptions for this. Our decision will be guided by the two goals
--of preserving the free status of all derivatives of our free software and
--of promoting the sharing and reuse of software generally.
--
-- NO WARRANTY
--
-- 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
--FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
--OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
--PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
--OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
--MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
--TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
--PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
--REPAIR OR CORRECTION.
--
-- 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
--WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
--REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
--INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
--OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
--TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
--YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
--PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
--POSSIBILITY OF SUCH DAMAGES.
--
-- END OF TERMS AND CONDITIONS
--\f
-- How to Apply These Terms to Your New Programs
--
-- If you develop a new program, and you want it to be of the greatest
--possible use to the public, the best way to achieve this is to make it
--free software which everyone can redistribute and change under these terms.
--
-- To do so, attach the following notices to the program. It is safest
--to attach them to the start of each source file to most effectively
--convey the exclusion of warranty; and each file should have at least
--the "copyright" line and a pointer to where the full notice is found.
--
-- <one line to give the program's name and a brief idea of what it does.>
-- Copyright (C) 19yy <name of author>
--
-- 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., 675 Mass Ave, Cambridge, MA 02139, USA.
--
--Also add information on how to contact you by electronic and paper mail.
--
--If the program is interactive, make it output a short notice like this
--when it starts in an interactive mode:
--
-- Gnomovision version 69, Copyright (C) 19yy name of author
-- Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
-- This is free software, and you are welcome to redistribute it
-- under certain conditions; type `show c' for details.
--
--The hypothetical commands `show w' and `show c' should show the appropriate
--parts of the General Public License. Of course, the commands you use may
--be called something other than `show w' and `show c'; they could even be
--mouse-clicks or menu items--whatever suits your program.
--
--You should also get your employer (if you work as a programmer) or your
--school, if any, to sign a "copyright disclaimer" for the program, if
--necessary. Here is a sample; alter the names:
--
-- Yoyodyne, Inc., hereby disclaims all copyright interest in the program
-- `Gnomovision' (which makes passes at compilers) written by James Hacker.
--
-- <signature of Ty Coon>, 1 April 1989
-- Ty Coon, President of Vice
--
--This General Public License does not permit incorporating your program into
--proprietary programs. If your program is a subroutine library, you may
--consider it more useful to permit linking proprietary applications with the
--library. If this is what you want to do, use the GNU Library General
--Public License instead of this License.
+++ /dev/null
--See htdocs/docs/index.html
+++ /dev/null
- Freeside, (pre) 1.1.4
-Freeside, 1.1.5
--
--Copyright (C) 1998 Silicon Interactive Software Design. All rights reserved.
--
-- This program is free software; you can redistribute it and/or modify
-- it under the terms of either:
--
-- a) the GNU General Public License as published by the Free
-- Software Foundation; either version 2, or (at your option) any
-- later version, or
--
-- b) the "Artistic License"
--
-- 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 either the
-- GNU General Public License or the Artistic License for more details.
--
-- You should have received a copy of the GNU General Public
-- License along with this program, in the file `GPL'; if not,
-- write to the Free Software Foundation, Inc., 59 Temple Place - Suite
-- 330, Boston, MA 02111-1307, USA.
--
-- You should have received a copy of the Artistic License along with
-- this program, in the file `Artistic'; if not, download it from
-- http://www.perl.com/CPAN/doc/misc/license/Artistic
--
--Freeside is a billing and administration package for Internet Service
--Providers.
--
--The Freeside home page is at `http://www.sisd.com/freeside'.
--
--The documentation is in `htdocs/docs'.
--
--A mailing list for users and developers is available. Send a blank message to
--<ivan-freeside-subscribe@sisd.com> to subscribe.
--
--Commercial support is available from Ivan Kohler <ivan@sisd.com>. Please
--subscribe to the the mailing list to request free support!
--
--Ivan Kohler
--ivan@sisd.com
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# create dbdef file for existing mySQL database (needs SHOW|DESCRIBE command
--# not in Pg) based on fs-setup
--#
--# ivan@sisd.com 98-jun-2
--
--use strict;
--use DBI;
--use FS::dbdef;
--use FS::UID qw(adminsuidsetup datasrc);
--
--#needs to match FS::Record
--my($dbdef_file) = "/var/spool/freeside/dbdef.". datasrc;
--
--my($dbh)=adminsuidsetup;
--
--my($tables_sth)=$dbh->prepare("SHOW TABLES");
--my($tables_rv)=$tables_sth->execute;
--
--my(@tables);
--foreach ( @{$tables_sth->fetchall_arrayref} ) {
-- my($table)=${$_}[0];
-- #print "TABLE\t$table\n";
--
-- my($index_sth)=$dbh->prepare("SHOW INDEX FROM $table");
-- my($primary_key)='';
-- my(%index,%unique);
-- for ( 1 .. $index_sth->execute ) {
-- my($row)=$index_sth->fetchrow_hashref;
-- if ( ${$row}{'Key_name'} eq "PRIMARY" ) {
-- $primary_key=${$row}{'Column_name'};
-- next;
-- }
-- if ( ${$row}{'Non_unique'} ) { #index
-- push @{$index{${$row}{'Key_name'}}}, ${$row}{'Column_name'};
-- } else { #unique
-- push @{$unique{${$row}{'Key_name'}}}, ${$row}{'Column_name'};
-- }
-- }
--
-- my(@index)=values %index;
-- my(@unique)=values %unique;
-- #print "\tPRIMARY KEY $primary_key\n";
-- foreach (@index) {
-- #print "\tINDEX\t", join(', ', @{$_}), "\n";
-- }
-- foreach (@unique) {
-- #print "\tUNIQUE\t", join(', ', @{$_}), "\n";
-- }
--
-- my($columns_sth)=$dbh->prepare("SHOW COLUMNS FROM $table");
-- my(@columns);
-- for ( 1 .. $columns_sth->execute ) {
-- my($row)=$columns_sth->fetchrow_hashref;
-- #print "\t", ${$row}{'Field'}, "\n";
-- ${$row}{'Type'} =~ /^(\w+)\(?([\d\,]+)?\)?( unsigned)?$/
-- or die "Illegal type ${$row}{'Type'}\n";
-- my($type,$length)=($1,$2);
-- my($null)=${$row}{'Null'};
-- $null =~ s/YES/NULL/;
-- push @columns, new FS::dbdef_column (
-- ${$row}{'Field'},
-- $type,
-- $null,
-- $length,
-- );
-- }
--
-- #print "\n";
-- push @tables, new FS::dbdef_table (
-- $table,
-- $primary_key,
-- new FS::dbdef_unique (\@unique),
-- new FS::dbdef_index (\@index),
-- @columns,
-- );
--
--}
--
--my($dbdef) = new FS::dbdef ( @tables );
--
--#important
--$dbdef->save($dbdef_file);
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# create database and necessary tables, etc. DBI version.
--#
--# ivan@sisd.com 97-nov-8,9
--#
--# agent_type and type_pkgs added.
--# (index need to be declared, & primary keys shoudln't have mysql syntax)
--# ivan@sisd.com 97-nov-13
--#
--# pulled modified version back out of register.cgi ivan@sisd.com 98-feb-21
--#
--# removed extraneous sample data ivan@sisd.com 98-mar-23
--#
--# gained the big hash from dbdef.pm, dbdef.pm usage rewrite ivan@sisd.com
--# 98-apr-19 - 98-may-11 plus
--#
--# finished up ivan@sisd.com 98-jun-1
--#
--# part_svc fields are all forced NULL, not the opposite
--# hmm: also are forced varchar($char_d) as fixed '0' for things like
--# uid is Not Good. will this break anything else?
--# ivan@sisd.com 98-jun-29
--#
--# ss is 11 chars ivan@sisd.com 98-jul-20
--#
--# setup of arbitrary radius fields ivan@sisd.com 98-aug-9
--#
--# ouch, removed index on company name that wasn't supposed to be there
--# ivan@sisd.com 98-sep-4
--#
--# fix radius attributes ivan@sisd.com 98-sep-27
-#
-# $Log: fs-setup,v $
-# Revision 1.4 1998-10-22 15:51:23 ivan
-# also varchar with no length specified - postgresql fix broke mysql.
-#
-# Revision 1.3 1998/10/22 15:46:28 ivan
-# now smallint is illegal, so remove that too.
-#
--
--#to delay loading dbdef until we're ready
--BEGIN { $FS::Record::setup_hack = 1; }
--
--use strict;
--use DBI;
--use FS::dbdef;
--use FS::UID qw(adminsuidsetup datasrc);
--use FS::Record;
--use FS::cust_main_county;
--
--#needs to match FS::Record
--my($dbdef_file) = "/var/spool/freeside/dbdef.". datasrc;
--
--###
--
--print "\nEnter the maximum username length: ";
--my($username_len)=&getvalue;
--
--print "\n\n", <<END, ":";
--Freeside tracks the RADIUS attributes User-Name, Password and Framed-IP-Address
--for each user. Enter any additional RADIUS attributes you need to track for
--each user, separated by whitespace.
--END
--my @attributes = map { s/\-/_/g; $_; } split(" ",&getvalue);
--
--sub getvalue {
-- my($x)=scalar(<STDIN>);
-- chop $x;
-- $x;
--}
--
--###
--
--my($char_d) = 80; #default maxlength for text fields
--
--#my(@date_type) = ( 'timestamp', '', '' );
--my(@date_type) = ( 'int', 'NULL', '' );
- my(@perl_type) = ( 'long varchar', 'NULL', '' );
-my(@perl_type) = ( 'varchar', 'NULL', 255 );
--my(@money_type);
--if (datasrc =~ m/Pg/) { #Pg can't do decimal(10,2)
-- @money_type = ( 'money', '', '' );
--} else {
-- @money_type = ( 'decimal', '', '10,2' );
--}
--
--###
--# create a dbdef object from the old data structure
--###
--
--my(%tables)=&tables_hash_hack;
--
--#turn it into objects
--my($dbdef) = new FS::dbdef ( map {
-- my(@columns);
-- while (@{$tables{$_}{'columns'}}) {
-- my($name,$type,$null,$length)=splice @{$tables{$_}{'columns'}}, 0, 4;
-- push @columns, new FS::dbdef_column ( $name,$type,$null,$length );
-- }
-- FS::dbdef_table->new(
-- $_,
-- $tables{$_}{'primary_key'},
-- #FS::dbdef_unique->new(@{$tables{$_}{'unique'}}),
-- #FS::dbdef_index->new(@{$tables{$_}{'index'}}),
-- FS::dbdef_unique->new($tables{$_}{'unique'}),
-- FS::dbdef_index->new($tables{$_}{'index'}),
-- @columns,
-- );
--} (keys %tables) );
--
--#add radius attributes to svc_acct
--
--my($svc_acct)=$dbdef->table('svc_acct');
--
--my($attribute);
--foreach $attribute (@attributes) {
-- $svc_acct->addcolumn ( new FS::dbdef_column (
-- 'radius_'. $attribute,
-- 'varchar',
-- 'NULL',
-- $char_d,
-- ));
--}
--
--#make part_svc table (but now as object)
--
--my($part_svc)=$dbdef->table('part_svc');
--
--#because of svc_acct_pop
--#foreach (grep /^svc_/, $dbdef->tables) {
--#foreach (qw(svc_acct svc_acct_sm svc_charge svc_domain svc_wo)) {
--foreach (qw(svc_acct svc_acct_sm svc_domain)) {
-- my($table)=$dbdef->table($_);
-- my($col);
-- foreach $col ( $table->columns ) {
-- next if $col =~ /^svcnum$/;
-- $part_svc->addcolumn( new FS::dbdef_column (
-- $table->name. '__' . $table->column($col)->name,
-- 'varchar', #$table->column($col)->type,
-- 'NULL',
-- $char_d, #$table->column($col)->length,
-- ));
-- $part_svc->addcolumn ( new FS::dbdef_column (
-- $table->name. '__'. $table->column($col)->name . "_flag",
-- 'char',
-- 'NULL',
-- 1,
-- ));
-- }
--}
--
--#important
--$dbdef->save($dbdef_file);
--FS::Record::reload_dbdef;
--
--###
--# create 'em
--###
--
--my($dbh)=adminsuidsetup;
--
--#create tables
--$|=1;
--
--my($table);
--foreach ($dbdef->tables) {
-- my($table)=$dbdef->table($_);
-- print "Creating $_...";
--
-- my($statement);
--
-- #create table
-- foreach $statement ($table->sql_create_table(datasrc)) {
-- #print $statement, "\n";
-- $dbh->do( $statement )
-- or die "CREATE error: ",$dbh->errstr, "\ndoing statement: $statement";
-- }
--
-- print "\n";
--}
--
--#not really sample data (and shouldn't default to US)
--
--#cust_main_county
--foreach ( qw(
--AL AK AS AZ AR CA CO CT DC DE FM FL GA GU HI ID IL IN IA KS KY LA
--ME MH MD MA MI MN MS MO MT NC ND NE NH NJ NM NV NY MP OH OK OR PA PW PR RI
--SC SD TN TX TT UT VT VI VA WA WV WI WY AE AA AP
--) ) {
-- my($cust_main_county)=create FS::cust_main_county({
-- 'state' => $_,
-- 'tax' => 0,
-- });
-- my($error);
-- $error=$cust_main_county->insert;
-- die $error if $error;
--}
--
--$dbh->disconnect or die $dbh->errstr;
--
--###
--# Now it becomes an object. much better.
--###
--sub tables_hash_hack {
--
-- #note that s/(date|change)/_$1/; to avoid keyword conflict.
-- #put a kludge in FS::Record to catch this or? (pry need some date-handling
-- #stuff anyway also)
--
-- my(%tables)=( #yech.}
--
-- 'agent' => {
-- 'columns' => [
-- 'agentnum', 'int', '', '',
-- 'agent', 'varchar', '', $char_d,
-- 'typenum', 'int', '', '',
- 'freq', 'smallint', 'NULL', '',
- 'freq', 'int', 'NULL', '',
-- 'prog', @perl_type,
-- ],
-- 'primary_key' => 'agentnum',
-- 'unique' => [ [] ],
-- 'index' => [ ['typenum'] ],
-- },
--
-- 'agent_type' => {
-- 'columns' => [
-- 'typenum', 'int', '', '',
-- 'atype', 'varchar', '', $char_d,
-- ],
-- 'primary_key' => 'typenum',
-- 'unique' => [ [] ],
-- 'index' => [ [] ],
-- },
--
-- 'type_pkgs' => {
-- 'columns' => [
-- 'typenum', 'int', '', '',
-- 'pkgpart', 'int', '', '',
-- ],
-- 'primary_key' => '',
-- 'unique' => [ ['typenum', 'pkgpart'] ],
-- 'index' => [ ['typenum'] ],
-- },
--
-- 'cust_bill' => {
-- 'columns' => [
-- 'invnum', 'int', '', '',
-- 'custnum', 'int', '', '',
-- '_date', @date_type,
-- 'charged', @money_type,
-- 'owed', @money_type,
-- 'printed', 'int', '', '',
-- ],
-- 'primary_key' => 'invnum',
-- 'unique' => [ [] ],
-- 'index' => [ ['custnum'] ],
-- },
--
-- 'cust_bill_pkg' => {
-- 'columns' => [
-- 'pkgnum', 'int', '', '',
-- 'invnum', 'int', '', '',
-- 'setup', @money_type,
-- 'recur', @money_type,
-- 'sdate', @date_type,
-- 'edate', @date_type,
-- ],
-- 'primary_key' => '',
-- 'unique' => [ ['pkgnum', 'invnum'] ],
-- 'index' => [ ['invnum'] ],
-- },
--
-- 'cust_credit' => {
-- 'columns' => [
-- 'crednum', 'int', '', '',
-- 'custnum', 'int', '', '',
-- '_date', @date_type,
-- 'amount', @money_type,
-- 'credited', @money_type,
-- 'otaker', 'varchar', '', 8,
-- 'reason', 'varchar', '', 255,
-- ],
-- 'primary_key' => 'crednum',
-- 'unique' => [ [] ],
-- 'index' => [ ['custnum'] ],
-- },
--
-- 'cust_main' => {
-- 'columns' => [
-- 'custnum', 'int', '', '',
-- 'agentnum', 'int', '', '',
-- 'last', 'varchar', '', $char_d,
-- 'first', 'varchar', '', $char_d,
-- 'ss', 'char', 'NULL', 11,
-- 'company', 'varchar', 'NULL', $char_d,
-- 'address1', 'varchar', '', $char_d,
-- 'address2', 'varchar', 'NULL', $char_d,
-- 'city', 'varchar', '', $char_d,
-- 'county', 'varchar', 'NULL', $char_d,
-- 'state', 'char', '', 2,
-- 'zip', 'varchar', '', 10,
-- 'country', 'char', '', 2,
-- 'daytime', 'varchar', 'NULL', 20,
-- 'night', 'varchar', 'NULL', 20,
-- 'fax', 'varchar', 'NULL', 12,
-- 'payby', 'char', '', 4,
-- 'payinfo', 'varchar', 'NULL', 16,
-- 'paydate', @date_type,
-- 'payname', 'varchar', 'NULL', $char_d,
-- 'tax', 'char', 'NULL', 1,
-- 'otaker', 'varchar', '', 8,
-- 'refnum', 'int', '', '',
-- ],
-- 'primary_key' => 'custnum',
-- 'unique' => [ [] ],
-- #'index' => [ ['last'], ['company'] ],
-- 'index' => [ ['last'], ],
-- },
--
-- 'cust_main_county' => { #county+state are checked off the cust_main_county
-- #table for validation and to provide a tax rate.
-- #add country?
-- 'columns' => [
-- 'taxnum', 'int', '', '',
-- 'state', 'char', '', 2, #two letters max in US... elsewhere?
- 'county', 'varchar', '', $char_d,
- 'county', 'varchar', 'NULL', $char_d,
-- 'tax', 'real', '', '', #tax %
-- ],
-- 'primary_key' => 'taxnum',
-- 'unique' => [ [] ],
-- # 'unique' => [ ['taxnum'], ['state', 'county'] ],
-- 'index' => [ [] ],
-- },
--
-- 'cust_pay' => {
-- 'columns' => [
-- 'paynum', 'int', '', '',
-- 'invnum', 'int', '', '',
-- 'paid', @money_type,
-- '_date', @date_type,
-- 'payby', 'char', '', 4, # CARD/BILL/COMP, should be index into
-- # payment type table.
-- 'payinfo', 'varchar', 'NULL', 16, #see cust_main above
-- 'paybatch', 'varchar', 'NULL', $char_d, #for auditing purposes.
-- ],
-- 'primary_key' => 'paynum',
-- 'unique' => [ [] ],
-- 'index' => [ ['invnum'] ],
-- },
--
-- 'cust_pay_batch' => { #what's this used for again? list of customers
-- #in current CARD batch? (necessarily CARD?)
-- 'columns' => [
-- 'invnum', 'int', '', '',
-- 'custnum', 'int', '', '',
-- 'last', 'varchar', '', $char_d,
-- 'first', 'varchar', '', $char_d,
-- 'address1', 'varchar', '', $char_d,
-- 'address2', 'varchar', 'NULL', $char_d,
-- 'city', 'varchar', '', $char_d,
-- 'state', 'char', '', 2,
-- 'zip', 'varchar', '', 10,
-- 'country', 'char', '', 2,
- 'trancode', 'TINYINT', '', '',
- 'trancode', 'int', '', '',
-- 'cardnum', 'varchar', '', 16,
-- 'exp', @date_type,
-- 'payname', 'varchar', 'NULL', $char_d,
-- 'amount', @money_type,
-- ],
-- 'primary_key' => '',
-- 'unique' => [ [] ],
-- 'index' => [ ['invnum'], ['custnum'] ],
-- },
--
-- 'cust_pkg' => {
-- 'columns' => [
-- 'pkgnum', 'int', '', '',
-- 'custnum', 'int', '', '',
-- 'pkgpart', 'int', '', '',
-- 'otaker', 'varchar', '', 8,
-- 'setup', @date_type,
-- 'bill', @date_type,
-- 'susp', @date_type,
-- 'cancel', @date_type,
-- 'expire', @date_type,
-- ],
-- 'primary_key' => 'pkgnum',
-- 'unique' => [ [] ],
-- 'index' => [ ['custnum'] ],
-- },
--
-- 'cust_refund' => {
-- 'columns' => [
-- 'refundnum', 'int', '', '',
-- 'crednum', 'int', '', '',
-- '_date', @date_type,
-- 'refund', @money_type,
-- 'otaker', 'varchar', '', 8,
-- 'reason', 'varchar', '', $char_d,
-- 'payby', 'char', '', 4, # CARD/BILL/COMP, should be index
-- # into payment type table.
-- 'payinfo', 'varchar', 'NULL', 16, #see cust_main above
-- ],
-- 'primary_key' => 'refundnum',
-- 'unique' => [ [] ],
-- 'index' => [ ['crednum'] ],
-- },
--
-- 'cust_svc' => {
-- 'columns' => [
-- 'svcnum', 'int', '', '',
-- 'pkgnum', 'int', '', '',
-- 'svcpart', 'int', '', '',
-- ],
-- 'primary_key' => 'svcnum',
-- 'unique' => [ [] ],
-- 'index' => [ ['svcnum'], ['pkgnum'], ['svcpart'] ],
-- },
--
-- 'part_pkg' => {
-- 'columns' => [
-- 'pkgpart', 'int', '', '',
-- 'pkg', 'varchar', '', $char_d,
-- 'comment', 'varchar', '', $char_d,
-- 'setup', @perl_type,
- 'freq', 'smallint', '', '', #billing frequency (months)
- 'freq', 'int', '', '', #billing frequency (months)
-- 'recur', @perl_type,
-- ],
-- 'primary_key' => 'pkgpart',
-- 'unique' => [ [] ],
-- 'index' => [ [] ],
-- },
--
-- 'pkg_svc' => {
-- 'columns' => [
-- 'pkgpart', 'int', '', '',
-- 'svcpart', 'int', '', '',
-- 'quantity', 'int', '', '',
-- ],
-- 'primary_key' => '',
-- 'unique' => [ ['pkgpart', 'svcpart'] ],
-- 'index' => [ ['pkgpart'] ],
-- },
--
-- 'part_referral' => {
-- 'columns' => [
-- 'refnum', 'int', '', '',
-- 'referral', 'varchar', '', $char_d,
-- ],
-- 'primary_key' => 'refnum',
-- 'unique' => [ [] ],
-- 'index' => [ [] ],
-- },
--
-- 'part_svc' => {
-- 'columns' => [
-- 'svcpart', 'int', '', '',
-- 'svc', 'varchar', '', $char_d,
-- 'svcdb', 'varchar', '', $char_d,
-- ],
-- 'primary_key' => 'svcpart',
-- 'unique' => [ [] ],
-- 'index' => [ [] ],
-- },
--
-- #(this should be renamed to part_pop)
-- 'svc_acct_pop' => {
-- 'columns' => [
-- 'popnum', 'int', '', '',
-- 'city', 'varchar', '', $char_d,
-- 'state', 'char', '', 2,
-- 'ac', 'char', '', 3,
-- 'exch', 'char', '', 3,
-- #rest o' number?
-- ],
-- 'primary_key' => 'popnum',
-- 'unique' => [ [] ],
-- 'index' => [ [] ],
-- },
--
-- 'svc_acct' => {
-- 'columns' => [
-- 'svcnum', 'int', '', '',
-- 'username', 'varchar', '', $username_len, #unique (& remove dup code)
-- '_password', 'varchar', '', 25, #13 for encryped pw's plus ' *SUSPENDED*
-- 'popnum', 'int', 'NULL', '',
- 'uid', 'bigint', 'NULL', '',
- 'gid', 'bigint', 'NULL', '',
- 'uid', 'int', 'NULL', '',
- 'gid', 'int', 'NULL', '',
-- 'finger', 'varchar', 'NULL', $char_d,
-- 'dir', 'varchar', 'NULL', $char_d,
-- 'shell', 'varchar', 'NULL', $char_d,
-- 'quota', 'varchar', 'NULL', $char_d,
-- 'slipip', 'varchar', 'NULL', 15, #four TINYINTs, bah.
-- ],
-- 'primary_key' => 'svcnum',
-- 'unique' => [ [] ],
-- 'index' => [ ['username'] ],
-- },
--
-- 'svc_acct_sm' => {
-- 'columns' => [
-- 'svcnum', 'int', '', '',
-- 'domsvc', 'int', '', '',
- 'domuid', 'bigint', '', '',
- 'domuid', 'int', '', '',
-- 'domuser', 'varchar', '', $char_d,
-- ],
-- 'primary_key' => 'svcnum',
-- 'unique' => [ [] ],
-- 'index' => [ ['domsvc'], ['domuid'] ],
-- },
--
-- #'svc_charge' => {
-- # 'columns' => [
-- # 'svcnum', 'int', '', '',
-- # 'amount', @money_type,
-- # ],
-- # 'primary_key' => 'svcnum',
-- # 'unique' => [ [] ],
-- # 'index' => [ [] ],
-- #},
--
-- 'svc_domain' => {
-- 'columns' => [
-- 'svcnum', 'int', '', '',
-- 'domain', 'varchar', '', $char_d,
-- ],
-- 'primary_key' => 'svcnum',
-- 'unique' => [ ['domain'] ],
-- 'index' => [ [] ],
-- },
--
-- #'svc_wo' => {
-- # 'columns' => [
-- # 'svcnum', 'int', '', '',
-- # 'svcnum', 'int', '', '',
-- # 'svcnum', 'int', '', '',
-- # 'worker', 'varchar', '', $char_d,
-- # '_date', @date_type,
-- # ],
-- # 'primary_key' => 'svcnum',
-- # 'unique' => [ [] ],
-- # 'index' => [ [] ],
-- #},
--
-- );
--
-- %tables;
--
--}
--
+++ /dev/null
--#!/usr/bin/perl
--
--#use Pod::Text;
--#$Pod::Text::termcap=1;
--
--my $site_perl = "./site_perl";
--#my $catman = "./catman";
--my $catman = "./htdocs/docs/man";
--#my $html = "./htdocs/docs/man";
--
--$|=1;
--
--die "Can't find $site_perl and $catman"
-- unless [ -d $site_perl ] && [ -d $catman ] && [ -d $html ];
--
--foreach my $file (glob("$site_perl/*.pm")) {
-- $file =~ /\/([\w\-]+)\.pm$/ or die "oops file $file";
-- my $name = $1;
-- print "$name\n";
-- system "pod2text $file >$catman/$name.txt";
--# system "pod2html --podpath=$site_perl $file >$html/$name.html";
--# system "pod2html $file >$html/$name.html";
--}
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# Create and export password files: passwd, passwd.adjunct, shadow,
--# acp_passwd, acp_userinfo, acp_dialup, users
--#
--# ivan@voicenet.com late august/september 96
--# (the password encryption bits were from melody)
--#
--# use a temporary copy of svc_acct to minimize lock time on the real file,
--# and skip blank entries.
--#
--# ivan@voicenet.com 96-Oct-6
--#
--# change users / acp_dialup file formats
--# ivan@voicenet.com 97-jan-28-31
--#
--# change priority (after copies) to 19, not 10
--# ivan@voicenet.com 97-feb-5
--#
--# added exit if stuff is already locked 97-apr-15
--#
--# rewrite ivan@sisd.com 98-mar-9
--#
--# Changed 'password' to '_password' because Pg6.3 reserves this word
--# Added code to create a FreeBSD style master.passwd file
--# bmccane@maxbaud.net 98-Apr-3
--#
--# don't export non-root 0 UID's, even if they get put in the database
--# ivan@sisd.com 98-jul-14
--#
--# Uses Idle_Timeout, Port_Limit, Framed_Netmask and Framed_Route if they
--# exist; need some way to support arbitrary radius fields. also
--# /var/spool/freeside/conf/ ivan@sisd.com 98-jul-26, aug-9
--#
--# OOPS! added arbitrary radius fields (pry 98-aug-16) but forgot to say so.
--# ivan@sisd.com 98-sep-18
--
--use strict;
--use Fcntl qw(:flock);
--use FS::SSH qw(scp ssh);
--use FS::UID qw(adminsuidsetup);
--use FS::Record qw(qsearch fields);
--
--my($fshellmachines)="/var/spool/freeside/conf/shellmachines";
--my(@shellmachines);
--if ( -e $fshellmachines ) {
-- open(SHELLMACHINES,$fshellmachines);
-- @shellmachines=map {
-- /^(.*)$/ or die "Illegal line in conf/shellmachines"; #we trust the file
-- $1;
-- } grep $_ !~ /^(#|$)/, <SHELLMACHINES>;
-- close SHELLMACHINES;
--}
--
--my($fbsdshellmachines)="/var/spool/freeside/conf/bsdshellmachines";
--my(@bsdshellmachines);
--if ( -e $fbsdshellmachines ) {
-- open(BSDSHELLMACHINES,$fbsdshellmachines);
-- @bsdshellmachines=map {
-- /^(.*)$/ or die "Illegal line in conf/bsdshellmachines"; #we trust the file
-- $1;
-- } grep $_ !~ /^(#|$)/, <BSDSHELLMACHINES>;
-- close BSDSHELLMACHINES;
--}
--
--my($fnismachines)="/var/spool/freeside/conf/nismachines";
--my(@nismachines);
--if ( -e $fnismachines ) {
-- open(NISMACHINES,$fnismachines);
-- @nismachines=map {
-- /^(.*)$/ or die "Illegal line in conf/nismachines"; #we trust the file
-- $1;
-- } grep $_ !~ /^(#|$)/, <NISMACHINES>;
-- close NISMACHINES;
--}
--
--my($ferpcdmachines)="/var/spool/freeside/conf/erpcdmachines";
--my(@erpcdmachines);
--if ( -e $ferpcdmachines ) {
-- open(ERPCDMACHINES,$ferpcdmachines);
-- @erpcdmachines=map {
-- /^(.*)$/ or die "Illegal line in conf/erpcdmachines"; #we trust the file
-- $1;
-- } grep $_ !~ /^(#|$)/, <ERPCDMACHINES>;
-- close ERPCDMACHINES;
--}
--
--my($fradiusmachines)="/var/spool/freeside/conf/radiusmachines";
--my(@radiusmachines);
--if ( -e $fradiusmachines ) {
-- open(RADIUSMACHINES,$fradiusmachines);
-- @radiusmachines=map {
-- /^(.*)$/ or die "Illegal line in conf/radiusmachines"; #we trust the file
-- $1;
-- } grep $_ !~ /^(#|$)/, <RADIUSMACHINES>;
-- close RADIUSMACHINES;
--}
--
--my($spooldir)="/var/spool/freeside/export";
--my($spoollock)="/var/spool/freeside/svc_acct.export.lock";
--
--adminsuidsetup;
--
--my(@saltset)= ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
--srand(time|$$);
--
--open(EXPORT,"+>>$spoollock") or die "Can't open $spoollock: $!";
--select(EXPORT); $|=1; select(STDOUT);
--unless ( flock(EXPORT,LOCK_EX|LOCK_NB) ) {
-- seek(EXPORT,0,0);
-- my($pid)=<EXPORT>;
-- chop($pid);
-- #no reason to start loct of blocking processes
-- die "Is another export process running under pid $pid?\n";
--}
--seek(EXPORT,0,0);
--print EXPORT $$,"\n";
--
--my(@svc_acct)=qsearch('svc_acct',{});
--
--( open(MASTER,">$spooldir/master.passwd")
-- and flock(MASTER,LOCK_EX|LOCK_NB)
--) or die "Can't open $spooldir/master.passwd: $!";
--( open(PASSWD,">$spooldir/passwd")
-- and flock(PASSWD,LOCK_EX|LOCK_NB)
--) or die "Can't open $spooldir/passwd: $!";
--( open(SHADOW,">$spooldir/shadow")
-- and flock(SHADOW,LOCK_EX|LOCK_NB)
--) or die "Can't open $spooldir/shadow: $!";
--( open(ACP_PASSWD,">$spooldir/acp_passwd")
-- and flock (ACP_PASSWD,LOCK_EX|LOCK_NB)
--) or die "Can't open $spooldir/acp_passwd: $!";
--( open (ACP_DIALUP,">$spooldir/acp_dialup")
-- and flock(ACP_DIALUP,LOCK_EX|LOCK_NB)
--) or die "Can't open $spooldir/acp_dialup: $!";
--( open (USERS,">$spooldir/users")
-- and flock(USERS,LOCK_EX|LOCK_NB)
--) or die "Can't open $spooldir/users: $!";
--
--chmod 0644, "$spooldir/passwd",
-- "$spooldir/acp_dialup",
--;
--chmod 0600, "$spooldir/master.passwd",
-- "$spooldir/acp_passwd",
-- "$spooldir/shadow",
-- "$spooldir/users",
--;
--
--setpriority(0,0,10);
--
--my($svc_acct);
--foreach $svc_acct (@svc_acct) {
--
-- my($password)=$svc_acct->getfield('_password');
-- my($cpassword,$rpassword);
-- if ( ( length($password) <= 8 )
-- && ( $password ne '*' )
-- && ( $password ne '' )
-- ) {
-- $cpassword=crypt($password,
-- $saltset[int(rand(64))].$saltset[int(rand(64))]
-- );
-- $rpassword=$password;
-- } else {
-- $cpassword=$password;
-- $rpassword='UNIX';
-- }
--
-- if ( $svc_acct->uid =~ /^(\d+)$/ ) {
--
-- die "Non-root user ". $svc_acct->username. " has 0 UID!"
-- if $svc_acct->uid == 0 && $svc_acct->username ne 'root';
--
-- ###
-- # FORMAT OF FreeBSD MASTER PASSWD FILE HERE
-- print MASTER join(":",
-- $svc_acct->username, # User name
-- $cpassword, # Encrypted password
-- $svc_acct->uid, # User ID
-- $svc_acct->gid, # Group ID
-- "", # Login Class
-- "0", # Password Change Time
-- "0", # Password Expiration Time
-- $svc_acct->finger, # Users name
-- $svc_acct->dir, # Users home directory
-- $svc_acct->shell, # shell
-- ), "\n" ;
--
-- ###
-- # FORMAT OF THE PASSWD FILE HERE
-- print PASSWD join(":",
-- $svc_acct->username,
-- 'x', # "##". $svc_acct->$username,
-- $svc_acct->uid,
-- $svc_acct->gid,
-- $svc_acct->finger,
-- $svc_acct->dir,
-- $svc_acct->shell,
-- ), "\n";
--
-- ###
-- # FORMAT OF THE SHADOW FILE HERE
-- print SHADOW join(":",
-- $svc_acct->username,
-- $cpassword,
-- '',
-- '',
-- '',
-- '',
-- '',
-- '',
-- '',
-- ), "\n";
--
-- }
--
-- if ( $svc_acct->slipip ne '' ) {
--
-- ###
-- # FORMAT OF THE ACP_* FILES HERE
-- print ACP_PASSWD join(":",
-- $svc_acct->username,
-- $cpassword,
-- "0",
-- "0",
-- "",
-- "",
-- "",
-- ), "\n";
--
-- my($ip)=$svc_acct->slipip;
--
-- unless ( $ip eq '0.0.0.0' || $svc_acct->slipip eq '0e0' ) {
-- print ACP_DIALUP $svc_acct->username, "\t*\t", $svc_acct->slipip, "\n";
-- }
--
-- ###
-- # FORMAT OF THE USERS FILE HERE
-- print USERS
-- $svc_acct->username, qq(\tPassword = "$rpassword"\n\t),
--
-- join ",\n\t",
-- map {
-- /^(radius_(.*))$/;
-- my($field,$attrib)=($1,$2);
-- $attrib =~ s/_/\-/g;
-- "$attrib = \"". $svc_acct->getfield($field). "\"";
-- } grep /^radius_/ && $svc_acct->getfield($_), fields('svc_acct')
-- ;
-- if ( $ip && $ip ne '0e0' ) {
-- print USERS qq(,\n\tFramed-Address = "$ip"\n\n);
-- } else {
-- print USERS qq(\n\n);
-- }
--
-- }
--
--}
--
--flock(MASTER,LOCK_UN);
--flock(PASSWD,LOCK_UN);
--flock(SHADOW,LOCK_UN);
--flock(ACP_DIALUP,LOCK_UN);
--flock(ACP_PASSWD,LOCK_UN);
--flock(USERS,LOCK_UN);
--
--close MASTER;
--close PASSWD;
--close SHADOW;
--close ACP_DIALUP;
--close ACP_PASSWD;
--close USERS;
--
--###
--# export stuff
--#
--
--my($shellmachine);
--foreach $shellmachine (@shellmachines) {
-- scp("$spooldir/passwd","root\@$shellmachine:/etc/passwd.new")
-- == 0 or die "scp error: $!";
-- scp("$spooldir/shadow","root\@$shellmachine:/etc/shadow.new")
-- == 0 or die "scp error: $!";
-- ssh("root\@$shellmachine",
-- "( ".
-- "mv /etc/passwd.new /etc/passwd; ".
-- "mv /etc/shadow.new /etc/shadow; ".
-- " )"
-- )
-- == 0 or die "ssh error: $!";
--}
--
--my($bsdshellmachine);
--foreach $bsdshellmachine (@bsdshellmachines) {
-- scp("$spooldir/passwd","root\@$bsdshellmachine:/etc/passwd.new")
-- == 0 or die "scp error: $!";
-- scp("$spooldir/master.passwd","root\@$bsdshellmachine:/etc/master.passwd.new")
-- == 0 or die "scp error: $!";
-- ssh("root\@$bsdshellmachine",
-- "( ".
-- "mv /etc/passwd.new /etc/passwd; ".
-- "mv /etc/master.passwd.new /etc/master.passwd; ".
-- " )"
-- )
-- == 0 or die "ssh error: $!";
--}
--
--my($nismachine);
--foreach $nismachine (@nismachines) {
-- scp("$spooldir/passwd","root\@$nismachine:/etc/global/passwd")
-- == 0 or die "scp error: $!";
-- scp("$spooldir/shadow","root\@$nismachine:/etc/global/shadow")
-- == 0 or die "scp error: $!";
-- ssh("root\@$nismachine",
-- "( ".
-- "cd /var/yp; make; ".
-- " )"
-- )
-- == 0 or die "ssh error: $!";
--}
--
--my($erpcdmachine);
--foreach $erpcdmachine (@erpcdmachines) {
-- scp("$spooldir/acp_passwd","root\@$erpcdmachine:/usr/annex/acp_passwd")
-- == 0 or die "scp error: $!";
-- scp("$spooldir/acp_dialup","root\@$erpcdmachine:/usr/annex/acp_dialup")
-- == 0 or die "scp error: $!";
-- ssh("root\@$erpcdmachine",
-- "( ".
-- "kill -USR1 \`cat /usr/annex/erpcd.pid\'".
-- " )"
-- )
-- == 0 or die "ssh error: $!";
--}
--
--my($radiusmachine);
--foreach $radiusmachine (@radiusmachines) {
-- scp("$spooldir/users","root\@$radiusmachine:/etc/raddb/users")
-- == 0 or die "scp error: $!";
-- ssh("root\@$erpcdmachine",
-- "( ".
-- "builddbm".
-- " )"
-- )
-- == 0 or die "ssh error: $!";
--}
--
--unlink $spoollock;
--flock(EXPORT,LOCK_UN);
--close EXPORT;
--
+++ /dev/null
--#!/usr/bin/perl -Tw
-#
-# $Id: svc_acct.import,v 1.2 1998-10-13 12:07:51 ivan Exp $
--#
--# ivan@sisd.com 98-mar-9
--#
--# changed 'password' field to '_password' because PgSQL 6.3 reserves this word
--# bmccane@maxbaud.net 98-Apr-3
--#
--# generalized svcparts (still needs radius import) ivan@sisd.com 98-mar-23
--#
--# radius import, now an interactive script. still needs erpcd import?
--# ivan@sisd.com 98-jun-24
--#
--# arbitrary radius attributes ivan@sisd.com 98-aug-9
--#
--# don't import /var/spool/freeside/conf/shells! ivan@sisd.com 98-aug-13
-#
-# $Log: svc_acct.import,v $
-# Revision 1.2 1998-10-13 12:07:51 ivan
-# Assigns password from the shadow file for RADIUS password "UNIX"
-#
--
--use strict;
--use vars qw(%part_svc);
--use Date::Parse;
--use FS::SSH qw(iscp);
--use FS::UID qw(adminsuidsetup);
--use FS::Record qw(qsearch);
--use FS::svc_acct;
--
--adminsuidsetup;
--
--#my($spooldir)="/var/spool/freeside/export";
--my($spooldir)="unix/";
--
--$FS::svc_acct::nossh_hack = 1;
--
--###
--
--%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
--
--print "\n\n", &menu_svc, "\n", <<END;
--Most accounts probably have entries in passwd and users (with Port-Limit
--nonexistant or 1).
--END
--my($ppp_svcpart)=&getpart;
--
--print "\n\n", &menu_svc, "\n", <<END;
--Some accounts have entries in passwd and users, but with Port-Limit 2 (or
--more).
--END
--my($isdn_svcpart)=&getpart;
--
--print "\n\n", &menu_svc, "\n", <<END;
--Some accounts might have entries in users only (Port-Limit 1)
--END
--my($oppp_svcpart)=&getpart;
--
--print "\n\n", &menu_svc, "\n", <<END;
--Some accounts might have entries in users only (Port-Limit >= 2)
--END
--my($oisdn_svcpart)=&getpart;
--
--print "\n\n", &menu_svc, "\n", <<END;
--POP mail accounts have entries in passwd only, and have a particular shell.
--END
--print "Enter that shell: ";
--my($pop_shell)=&getvalue;
--my($popmail_svcpart)=&getpart;
--
--print "\n\n", &menu_svc, "\n", <<END;
--Everything else in passwd is a shell account.
--END
--my($shell_svcpart)=&getpart;
--
--print "\n\n", <<END;
--Enter the location and name of your _user_ passwd file, for example
--"mail.isp.com:/etc/passwd" or "nis.isp.com:/etc/global/passwd"
--END
--print ":";
--my($loc_passwd)=&getvalue;
--iscp("root\@$loc_passwd", "$spooldir/passwd.import");
--
--print "\n\n", <<END;
--Enter the location and name of your _user_ shadow file, for example
--"mail.isp.com:/etc/shadow" or "bsd.isp.com:/etc/master.passwd"
--END
--print ":";
--my($loc_shadow)=&getvalue;
--iscp("root\@$loc_shadow", "$spooldir/shadow.import");
--
--print "\n\n", <<END;
--Enter the location and name of your radius "users" file, for example
--"radius.isp.com:/etc/raddb/users"
--END
--print ":";
--my($loc_users)=&getvalue;
--iscp("root\@$loc_users", "$spooldir/users.import");
--
--sub menu_svc {
-- ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n";
--}
--sub getpart {
-- print "Enter part number, or 0 for none: ";
-- &getvalue;
--}
--sub getvalue {
-- my($x)=scalar(<STDIN>);
-- chop $x;
-- $x;
--}
--
--print "\n\n";
--
--###
--
--open(PASSWD,"<$spooldir/passwd.import");
--open(SHADOW,"<$spooldir/shadow.import");
--open(USERS,"<$spooldir/users.import");
--
--my(%upassword,%ip,%allparam);
--my(%param,$username);
--while (<USERS>) {
-- chop;
-- next if /^$/;
-- if ( /^\S/ ) {
-- /^(\w+)\s+Password\s+=\s+"([^"]+)"(,\s+Expiration\s+=\s+"([^"]*")\s*)?$/
-- or die "1Unexpected line in users.import: $_";
-- my($password,$expiration);
-- ($username,$password,$expiration)=(lc($1),$2,$4);
- $password = '' if $password eq 'UNIX';
-- $upassword{$username}=$password;
-- undef %param;
-- } else {
-- die "2Unexpected line in users.import: $_";
-- }
-- while (<USERS>) {
-- chop;
-- if ( /^\s*$/ ) {
-- $ip{$username}=$param{'radius_Framed_IP_Address'}||'0e0';
-- delete $param{'radius_Framed_IP_Address'};
-- $allparam{$username}={ %param };
-- last;
-- } elsif ( /^\s+([\w\-]+)\s=\s"?([\w\.\-\s]+)"?,?\s*$/ ) {
-- my($attribute,$value)=($1,$2);
-- $attribute =~ s/\-/_/g;
-- $param{'radius_'.$attribute}=$value;
-- } else {
-- die "3Unexpected line in users.import: $_";
-- }
-- }
--}
--#? incase there isn't a terminating blank line ?
--$ip{$username}=$param{'radius_Framed_IP_Address'}||'0e0';
--delete $param{'radius_Framed_IP_Address'};
--$allparam{$username}={ %param };
--
--my(%password);
--while (<SHADOW>) {
-- chop;
-- my($username,$password)=split(/:/);
-- $password{$username}=$password;
--}
--
--while (<PASSWD>) {
-- chop;
-- my($username,$x,$uid,$gid,$finger,$dir,$shell)=split(/:/);
-- my($password)=$upassword{$username} || $password{$username};
--
-- my($maxb)=${$allparam{$username}}{'radius_Port_Limit'};
-- my($svcpart);
-- if ( exists $upassword{$username} ) {
-- if ( $maxb >= 2 ) {
-- $svcpart = $isdn_svcpart
-- } elsif ( ! $maxb || $maxb == 1 ) {
-- $svcpart = $ppp_svcpart
-- } else {
-- die "Illegal Port-Limit in users ($username)!\n";
-- }
-- } elsif ( $shell eq $pop_shell ) {
-- $svcpart = $popmail_svcpart;
-- } else {
-- $svcpart = $shell_svcpart;
-- }
--
-- my($svc_acct) = create FS::svc_acct ({
-- 'svcpart' => $svcpart,
-- 'username' => $username,
-- 'password' => $password,
-- 'uid' => $uid,
-- 'gid' => $gid,
-- 'finger' => $finger,
-- 'dir' => $dir,
-- 'shell' => $shell,
-- 'slipip' => $ip{$username},
-- %{$allparam{$username}},
-- });
-- my($error);
-- $error=$svc_acct->insert;
-- die $error if $error;
--
-- delete $allparam{$username};
-- delete $upassword{$username};
--}
--
--#my($username);
--foreach $username ( keys %upassword ) {
-- my($password)=$upassword{$username};
--
-- my($maxb)=${$allparam{$username}}{'radius_Port_Limit'} || 0;
-- my($svcpart);
-- if ( $maxb == 2 ) {
-- $svcpart = $oisdn_svcpart
-- } elsif ( ! $maxb || $maxb == 1 ) {
-- $svcpart = $oppp_svcpart
-- } else {
-- die "Illegal Port-Limit in users!\n";
-- }
--
-- my($svc_acct) = create FS::svc_acct ({
-- 'svcpart' => $svcpart,
-- 'username' => $username,
-- 'password' => $password,
-- 'slipip' => $ip{$username},
-- %{$allparam{$username}},
-- });
-- my($error);
-- $error=$svc_acct->insert;
-- die $error, if $error;
--
-- delete $allparam{$username};
-- delete $upassword{$username};
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# Create and export VoiceNet_quasar.m4
--#
--# ivan@voicenet.com late oct 96
--#
--# change priority (after copies) to 19, not 10
--# ivan@voicenet.com 97-feb-5
--#
--# put file in different place and run different script, as per matt and
--# mohamed
--# ivan@voicenet.com 97-mar-10
--#
--# added exit if stuff is already locked ivan@voicenet.com 97-apr-15
--#
--# removed mail2
--# ivan@voicenet.com 97-jul-10
--#
--# rewrote lots of the bits, now exports qmail "virtualdomain",
--# "recipientmap" and "rcpthosts" files as well
--#
--# ivan@voicenet.com 97-sep-4
--#
--# adds ".extra" files
--#
--# ivan@voicenet.com 97-sep-29
--#
--# added ".pp" files, ugh.
--#
--# ivan@voicenet.com 97-oct-1
--#
--# rewrite ivan@sisd.com 98-mar-9
--#
--# now can create .qmail-default files ivan@sisd.com 98-mar-10
--#
--# put example $my_domain declaration in ivan@sisd.com 98-mar-23
--#
--# /var/spool/freeside/conf and sendmail updates ivan@sisd.com 98-aug-14
--
--use strict;
--use Fcntl qw(:flock);
--use FS::SSH qw(ssh scp);
--use FS::UID qw(adminsuidsetup);
--use FS::Record qw(qsearch qsearchs);
--
--my($conf_shellm)="/var/spool/freeside/conf/shellmachine";
--my($fqmailmachines)="/var/spool/freeside/conf/qmailmachines";
--my($shellmachine);
--my(@qmailmachines);
--if ( -e $fqmailmachines ) {
-- open(SHELLMACHINE,$conf_shellm) or die "Can't open $conf_shellm: $!";
-- <SHELLMACHINE> =~ /^([\w\.\-]+)$/ or die "Illegal $conf_shellm";
-- $shellmachine = $1;
-- close SHELLMACHINE;
-- open(QMAILMACHINES,$fqmailmachines);
-- @qmailmachines=map {
-- /^(.*)$/ or die "Illegal line in conf/qmailmachines"; #we trust the file
-- $1;
-- } grep $_ !~ /^(#|$)/, <QMAILMACHINES>;
-- close QMAILMACHINES;
--}
--
--my($fsendmailmachines)="/var/spool/freeside/conf/sendmailmachines";
--my(@sendmailmachines);
--if ( -e $fsendmailmachines ) {
-- open(SENDMAILMACHINES,$fsendmailmachines);
-- @sendmailmachines=map {
-- /^(.*)$/ or die "Illegal line in conf/sendmailmachines"; #we trust the file
-- $1;
-- } grep $_ !~ /^(#|$)/, <SENDMAILMACHINES>;
-- close SENDMAILMACHINES;
--}
--
--my($conf_domain)="/var/spool/freeside/conf/domain";
--open(DOMAIN,$conf_domain) or die "Can't open $conf_domain: $!";
--my($mydomain)=map {
-- /^(.*)$/ or die "Illegal line in $conf_domain!"; #yes, we trust the file
-- $1
--} grep $_ !~ /^(#|$)/, <DOMAIN>;
--close DOMAIN;
--
--my($spooldir)="/var/spool/freeside/export";
--my($spoollock)="/var/spool/freeside/svc_acct_sm.export.lock";
--
--adminsuidsetup;
--umask 066;
--
--open(EXPORT,"+>>$spoollock") or die "Can't open $spoollock: $!";
--select(EXPORT); $|=1; select(STDOUT);
--unless ( flock(EXPORT,LOCK_EX|LOCK_NB) ) {
-- seek(EXPORT,0,0);
-- my($pid)=<EXPORT>;
-- chop($pid);
-- #no reason to start locks of blocking processes
-- die "Is another export process running under pid $pid?\n";
--}
--seek(EXPORT,0,0);
--print EXPORT $$,"\n";
--
--my(@svc_acct_sm)=qsearch('svc_acct_sm',{});
--
--( open(RCPTHOSTS,">$spooldir/rcpthosts")
-- and flock(RCPTHOSTS,LOCK_EX|LOCK_NB)
--) or die "Can't open $spooldir/rcpthosts: $!";
--( open(RECIPIENTMAP,">$spooldir/recipientmap")
-- and flock(RECIPIENTMAP,LOCK_EX|LOCK_NB)
--) or die "Can't open $spooldir/recipientmap: $!";
--( open(VIRTUALDOMAINS,">$spooldir/virtualdomains")
-- and flock(VIRTUALDOMAINS,LOCK_EX|LOCK_NB)
--) or die "Can't open $spooldir/virtualdomains: $!";
--( open(VIRTUSERTABLE,">$spooldir/virtusertable")
-- and flock(VIRTUSERTABLE,LOCK_EX|LOCK_NB)
--) or die "Can't open $spooldir/virtusertable: $!";
--( open(SENDMAIL_CW,">$spooldir/sendmail.cw")
-- and flock(SENDMAIL_CW,LOCK_EX|LOCK_NB)
--) or die "Can't open $spooldir/sendmail.cw: $!";
--
--setpriority(0,0,10);
--
--my($svc_domain,%domain);
--foreach $svc_domain ( qsearch('svc_domain',{}) ) {
-- my($domain)=$svc_domain->domain;
-- $domain{$svc_domain->svcnum}=$domain;
-- print RCPTHOSTS "$domain\n.$domain\n";
-- print SENDMAIL_CW "$domain\n";
--}
--
--my(@sendmail);
--
--my($svc_acct_sm);
--foreach $svc_acct_sm ( qsearch('svc_acct_sm') ) {
-- my($domsvc,$domuid,$domuser)=(
-- $svc_acct_sm->domsvc,
-- $svc_acct_sm->domuid,
-- $svc_acct_sm->domuser,
-- );
-- my($domain)=$domain{$domsvc};
-- my($svc_acct)=qsearchs('svc_acct',{'uid'=>$domuid});
-- my($username,$dir,$uid,$gid)=(
-- $svc_acct->username,
-- $svc_acct->dir,
-- $svc_acct->uid,
-- $svc_acct->gid,
-- );
-- next unless $username && $domain && $domuser;
--
-- if ($domuser eq '*') {
-- push @sendmail, "\@$domain\t$username\n";
-- print VIRTUALDOMAINS "$domain:$username-$domain\n",
-- ".$domain:$username-$domain\n",
-- ;
-- ###
-- # qmail
-- ssh("root\@$shellmachine",
-- "[ -e $dir/.qmail-default ] || { touch $dir/.qmail-default; chown $uid:$gid $dir/.qmail-default; }"
-- ) if ( $shellmachine && $dir && $uid );
--
-- } else {
-- print VIRTUSERTABLE "$domuser\@$domain\t$username\n";
-- print RECIPIENTMAP "$domuser\@$domain:$username\@$mydomain\n";
-- }
--
-- print VIRTUSERTABLE @sendmail;
--
--}
--
--chmod 0644, "$spooldir/sendmail.cw",
-- "$spooldir/virtusertable",
-- "$spooldir/rcpthosts",
-- "$spooldir/recipientmap",
-- "$spooldir/virtualdomains",
--;
--
--flock(SENDMAIL_CW,LOCK_UN);
--flock(VIRTUSERTABLE,LOCK_UN);
--flock(RCPTHOSTS,LOCK_UN);
--flock(RECIPIENTMAP,LOCK_UN);
--flock(VIRTUALDOMAINS,LOCK_UN);
--
--close SENDMAIL_CW;
--close VIRTUSERTABLE;
--close RCPTHOSTS;
--close RECIPIENTMAP;
--close VIRTUALDOMAINS;
--
--###
--# export stuff
--#
--
--my($sendmailmachine);
--foreach $sendmailmachine (@sendmailmachines) {
-- scp("$spooldir/sendmail.cw","root\@$sendmailmachine:/etc/sendmail.cw.new")
-- == 0 or die "scp error: $!";
-- scp("$spooldir/virtusertable","root\@$sendmailmachine:/etc/virtusertable.new")
-- == 0 or die "scp error: $!";
-- ssh("root\@$sendmailmachine",
-- "( ".
-- "mv /etc/sendmail.cw.new /etc/sendmail.cw; ".
-- "mv /etc/virtusertable.new /etc/virtusertable; ".
-- #"/etc/init.d/sendmail restart; ".
-- " )"
-- )
-- == 0 or die "ssh error: $!";
--}
--
--my($qmailmachine);
--foreach $qmailmachine (@qmailmachines) {
-- scp("$spooldir/recipientmap","root\@$qmailmachine:/var/qmail/control/recipientmap")
-- == 0 or die "scp error: $!";
-- scp("$spooldir/virtualdomains","root\@$qmailmachine:/var/qmail/control/virtualdomains")
-- == 0 or die "scp error: $!";
-- scp("$spooldir/rcpthosts","root\@$qmailmachine:/var/qmail/control/rcpthosts")
-- == 0 or die "scp error: $!";
-- #ssh("root\@$qmailmachine","/etc/init.d/qmail restart")
-- # == 0 or die "ssh error: $!";
--}
--
--unlink $spoollock;
--flock(EXPORT,LOCK_UN);
--close EXPORT;
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# ivan@sisd.com 98-mar-9
--#
--# generalized svcparts ivan@sisd.com 98-mar-23
--
--# You really need to enable ssh into a shell machine as this needs to rename
--# .qmail-extension files.
--#
--# now an interactive script ivan@sisd.com 98-jun-30
--#
--# has an (untested) section for sendmail, s/warn/die/g and generates a program
--# to run on your mail machine _later_ instead of ssh'ing for each user
--# ivan@sisd.com 98-jul-13
--
--use strict;
--use vars qw(%d_part_svc %m_part_svc);
--use FS::SSH qw(iscp);
--use FS::UID qw(adminsuidsetup);
--use FS::Record qw(qsearch qsearchs);
--use FS::svc_acct_sm;
--use FS::svc_domain;
--
--adminsuidsetup;
--
--#my($spooldir)="/var/spool/freeside/export";
--my($spooldir)="unix";
--
--my(%mta) = (
-- 1 => "qmail",
-- 2 => "sendmail",
--);
--
--###
--
--%d_part_svc =
-- map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_domain'});
--%m_part_svc =
-- map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct_sm'});
--
--print "\n\n",
-- ( join "\n", map "$_: ".$d_part_svc{$_}->svc, sort keys %d_part_svc ),
-- "\n\nEnter part number for domains: ";
--my($domain_svcpart)=&getvalue;
--
--print "\n\n",
-- ( join "\n", map "$_: ".$m_part_svc{$_}->svc, sort keys %m_part_svc ),
-- "\n\nEnter part number for mail aliases: ";
--my($mailalias_svcpart)=&getvalue;
--
--print "\n\n", <<END;
--Select your MTA from the following list.
--END
--print join "\n", map "$_: $mta{$_}", sort keys %mta;
--print "\n\n:";
--my($mta)=&getvalue;
--
--if ( $mta{$mta} eq "qmail" ) {
--
-- print "\n\n", <<END;
--Enter the location and name of your qmail control directory, for example
--"mail.isp.com:/var/qmail/control"
--END
-- print ":";
-- my($control)=&getvalue;
-- iscp("root\@$control/rcpthosts","$spooldir/rcpthosts.import");
--# iscp("root\@$control/recipientmap","$spooldir/recipientmap.import");
-- iscp("root\@$control/virtualdomains","$spooldir/virtualdomains.import");
--
--# print "\n\n", <<END;
--#Enter the name of the machine with your user .qmail files, for example
--#"mail.isp.com"
--#END
--# print ":";
--# my($shellmachine)=&getvalue;
--
--} elsif ( $mta{$mta} eq "sendmail" ) {
--
-- print "\n\n", <<END;
--Enter the location and name of your sendmail virtual user table, for example
--"mail.isp.com:/etc/virtusertable"
--END
-- print ":";
-- my($virtusertable)=&getvalue;
-- iscp("root\@$virtusertable","$spooldir/virtusertable.import");
--
-- print "\n\n", <<END;
--Enter the location and name of your sendmail.cw file, for example
--"mail.isp.com:/etc/sendmail.cw"
--END
-- print ":";
-- my($sendmail_cw)=&getvalue;
-- iscp("root\@$sendmail_cw","$spooldir/sendmail.cw.import");
--
--} else {
-- die "Unknown MTA!\n";
--}
--
--sub getvalue {
-- my($x)=scalar(<STDIN>);
-- chop $x;
-- $x;
--}
--
--print "\n\n";
--
--###
--
--$FS::svc_domain::whois_hack=1;
--$FS::svc_acct_sm::nossh_hack=1;
--
--if ( $mta{$mta} eq "qmail" ) {
-- open(RCPTHOSTS,"<$spooldir/rcpthosts.import")
-- or die "Can't open $spooldir/rcpthosts.import: $!";
--} elsif ( $mta{$mta} eq "sendmail" ) {
-- open(RCPTHOSTS,"<$spooldir/sendmail.cw.import")
-- or die "Can't open $spooldir/sendmail.cw.import: $!";
--} else {
-- die "Unknown MTA!\n";
--}
--
--my(%svcnum);
--
--while (<RCPTHOSTS>) {
-- next if /^(#|$)/;
-- /^\.?([\w\-\.]+)$/
-- #or do { warn "Strange rcpthosts/sendmail.cw line: $_"; next; };
-- or die "Strange rcpthosts/sendmail.cw line: $_";
-- my $domain = $1;
-- my($svc_domain);
-- unless ( $svc_domain = qsearchs('svc_domain', {'domain'=>$domain} ) ) {
-- $svc_domain = create FS::svc_domain ({
-- 'domain' => $domain,
-- 'svcpart' => $domain_svcpart,
-- 'action' => 'N',
-- });
-- my $error = $svc_domain->insert;
-- #warn $error if $error;
-- die $error if $error;
-- }
-- $svcnum{$domain}=$svc_domain->svcnum;
--}
--close RCPTHOSTS;
--
--#these two loops have enough similar parts they should probably be merged
--if ( $mta{$mta} eq "qmail" ) {
--
-- open(VD_FIX,">$spooldir/virtualdomains.FIX");
-- print VD_FIX "#!/usr/bin/perl\n";
--
-- open(VIRTUALDOMAINS,"<$spooldir/virtualdomains.import")
-- or die "Can't open $spooldir/virtualdomains.import: $!";
-- while (<VIRTUALDOMAINS>) {
-- next if /^#/;
-- /^\.?([\w\-\.]+):(\w+)(\-([\w\-\.]+))?$/
-- #or do { warn "Strange virtualdomains line: $_"; next; };
-- or die "Strange virtualdomains line: $_";
-- my($domain,$username,$dash_ext,$extension)=($1,$2,$3,$4);
-- $dash_ext ||= '';
-- $extension ||= '';
-- my($svc_acct)=qsearchs('svc_acct',{'username'=>$username});
-- unless ( $svc_acct ) {
-- #warn "Unknown user $username in virtualdomains; skipping\n";
-- #die "Unknown user $username in virtualdomains; skipping\n";
-- next;
-- }
-- if ( $domain ne $extension ) {
-- #warn "virtualdomains line $domain:$username$dash_ext changed to $domain:$username-$domain\n";
-- my($dir)=$svc_acct->dir;
-- my($qdomain)=$domain;
-- $qdomain =~ s/\./:/g; #see manpage for 'dot-qmail': EXTENSION ADDRESSES
-- #example to move .qmail files for virtual domains to their new location
-- #dry run
-- #issh("root\@$shellmachine",'perl -e \'foreach $a (<'. $dir. '/.qmail'. $dash_ext. '-*>) { $old=$a; $a =~ s/\\.qmail'. $dash_ext. '\\-/\\.qmail\\-'. $qdomain. '\\-/; print " $old -> $a\n"; }\'');
-- #the real thing
-- #issh("root\@$shellmachine",'perl -e \'foreach $a (<'. $dir. '/.qmail'. $dash_ext. '-*>) { $old=$a; $a =~ s/\\.qmail'. $dash_ext. '\\-/\\.qmail\\-'. $qdomain. '\\-/; rename $old, $a; }\'');
-- print VD_FIX <<END;
--foreach \$file (<$dir/.qmail$dash_ext-*>) {
-- \$old = \$file;
-- \$file =~ s/\.qmail$dash_ext\-/\.qmail\-$qdomain\-/;
-- rename \$old, \$file;
--}
--END
-- }
--
-- unless ( exists $svcnum{$domain} ) {
-- my($svc_domain) = create FS::svc_domain ({
-- 'domain' => $domain,
-- 'svcpart' => $domain_svcpart,
-- 'action' => 'N',
-- });
-- my $error = $svc_domain->insert;
-- #warn $error if $error;
-- die $error if $error;
-- $svcnum{$domain}=$svc_domain->svcnum;
-- }
--
-- my($svc_acct_sm)=create FS::svc_acct_sm ({
-- 'domsvc' => $svcnum{$domain},
-- 'domuid' => $svc_acct->uid,
-- 'domuser' => '*',
-- 'svcpart' => $mailalias_svcpart,
-- });
-- my($error)='';
-- $error=$svc_acct_sm->insert;
-- #warn $error if $error;
-- die $error, ", domain $domain" if $error;
-- }
-- close VIRTUALDOMAINS;
-- close VD_FIX;
--
--} elsif ( $mta{$mta} eq "sendmail" ) {
--
-- open(VIRTUSERTABLE,"<$spooldir/virtusertable.import")
-- or die "Can't open $spooldir/virtusertable.import: $!";
-- while (<VIRTUSERTABLE>) {
-- next if /^#/; #comments?
-- /^([\w\-\.]+)?\@([\w\-\.]+)\t([\w\-\.]+)$/
-- #or do { warn "Strange virtusertable line: $_"; next; };
-- or die "Strange virtusertable line: $_";
-- my($domuser,$domain,$username)=($1,$2,$3);
-- my($svc_acct)=qsearchs('svc_acct',{'username'=>$username});
-- unless ( $svc_acct ) {
-- #warn "Unknown user $username in virtusertable";
-- die "Unknown user $username in virtusertable";
-- next;
-- }
-- my($svc_acct_sm)=create FS::svc_acct_sm ({
-- 'domsvc' => $svcnum{$domain},
-- 'domuid' => $svc_acct->uid,
-- 'domuser' => $domuser || '*',
-- 'svcpart' => $mailalias_svcpart,
-- });
-- my($error)='';
-- $error=$svc_acct_sm->insert;
-- #warn $error if $error;
-- die $error if $error;
-- }
-- close VIRTUSERTABLE;
--
--} else {
-- die "Unknown MTA!\n";
--}
--
--#open(RECIPIENTMAP,"<$spooldir/recipientmap.import");
--#close RECIPIENTMAP;
--
--print "\n\n", <<END if $mta{$mta} eq "qmail";
--Don\'t forget to run $spooldir/virtualdomains.FIX before using
--$spooldir/virtualdomains !
--END
--
+++ /dev/null
--#!/usr/bin/perl -w
--
--# Template for importing legacy customer data
--#
--# ivan@sisd.com 98-aug-17 - 20
--
--use strict;
--use FS::UID qw(adminsuidsetup datasrc);
--use FS::Record qw(fields qsearch qsearchs);
--use FS::cust_main;
--use FS::cust_pkg;
--use Date::Parse;
--
--adminsuidsetup;
--
--# use these for the imported cust_main records (unless you have these in legacy
--# data)
--my($agentnum)=4;
--my($refnum)=5;
--
--# map from legacy billing data to pkgpart, maps imported field
--# LegacyBillingData to pkgpart. your names and pkgparts will be different
--my(%pkgpart)=(
-- 'Employee' => 10,
-- 'Business' => 11,
-- 'Individual' => 12,
-- 'Basic PPP' => 13,
-- 'Slave' => 14,
-- 'Co-Located Server' => 15,
-- 'Virtual Web' => 16,
-- 'Perk Mail' => 17,
-- 'Credit Hold' => 18,
--);
--
--my($file)="legacy_file";
--
--open(CLIENT,$file)
-- or die "Can't open $file: $!";
--
--# put a tab-separated header atop the file, or define @fields
--# (use these names or change them below)
--#
--# for cust_main
--# custnum - unique
--# last - (name)
--# first - (name)
--# company
--# address1
--# address2
--# city
--# state
--# zip
--# country
--# daytime - (phone)
--# night - (phone)
--# fax
--# payby - CARD, BILL or COMP
--# payinfo - Credit card #, P.O. # or COMP authorization
--# paydate - Expiration
--# tax - 'Y' for tax exempt
--# for cust_pkg
--# LegacyBillingData - maps via %pkgpart above to a pkgpart
--# for svc_acct
--# username
--
--my($header);
--$header=<CLIENT>;
--chop $header;
--my(@fields)=map { /^\s*(.*[^\s]+)\s*$/; $1 } split(/\t/,$header);
--#print join("\n",@fields);
--
--my($error);
--my($link,$line)=(0,0);
--while (<CLIENT>) {
-- chop;
-- next if /^[\s\t]*$/; #skip any blank lines
--
-- #define %svc hash for this record
-- my(@record)=split(/\t/);
-- my(%svc);
-- foreach (@fields) {
-- $svc{$_}=shift @record;
-- }
--
-- # might need to massage some data like this
-- $svc{'payby'} =~ s/^Credit Card$/CARD/io;
-- $svc{'payby'} =~ s/^Check$/BILL/io;
-- $svc{'payby'} =~ s/^Cash$/BILL/io;
-- $svc{'payby'} =~ s/^$/BILL/o;
-- $svc{'First'} =~ s/&/and/go;
-- $svc{'Zip'} =~ s/\s+$//go;
--
-- my($cust_main) = create FS::cust_main ( {
-- 'custnum' => $svc{'custnum'},
-- 'agentnum' => $agentnum,
-- 'last' => $svc{'last'},
-- 'first' => $svc{'first'},
-- 'company' => $svc{'company'},
-- 'address1' => $svc{'address1'},
-- 'address2' => $svc{'address2'},
-- 'city' => $svc{'city'},
-- 'state' => $svc{'state'},
-- 'zip' => $svc{'zip'},
-- 'country' => $svc{'country'},
-- 'daytime' => $svc{'daytime'},
-- 'night' => $svc{'night'},
-- 'fax' => $svc{'fax'},
-- 'payby' => $svc{'payby'},
-- 'payinfo' => $svc{'payinfo'},
-- 'paydate' => $svc{'paydate'},
-- 'payname' => $svc{'payname'},
-- 'tax' => $svc{'tax'},
-- 'refnum' => $refnum,
-- } );
--
-- $error=$cust_main->insert;
--
-- if ( $error ) {
-- warn $cust_main->_dump;
-- warn map "$_: ". $svc{$_}. "|\n", keys %svc;
-- die $error;
-- }
--
-- my($cust_pkg)=create FS::cust_pkg ( {
-- 'custnum' => $svc{'custnum'},
-- 'pkgpart' => $pkgpart{$svc{'LegacyBillingData'}},
-- 'setup' => '',
-- 'bill' => '',
-- 'susp' => '',
-- 'expire' => '',
-- 'cancel' => '',
-- } );
--
-- $error=$cust_pkg->insert;
-- if ( $error ) {
-- warn $svc{'LegacyBillingData'};
-- die $error;
-- }
--
-- unless ( $svc{'username'} ) {
-- warn "Empty login";
-- } else {
-- #find svc_acct record (imported with bin/svc_acct.import) for this username
-- my($svc_acct)=qsearchs('svc_acct',{'username'=>$svc{'username'}});
-- unless ( $svc_acct ) {
-- warn "username ", $svc{'username'}, " not found\n";
-- } else {
-- #link to the cust_pkg record we created above
--
-- #find cust_svc record for this svc_acct record
-- my($o_cust_svc)=qsearchs('cust_svc',{
-- 'svcnum' => $svc_acct->svcnum,
-- 'pkgnum' => '',
-- } );
-- unless ( $o_cust_svc ) {
-- warn "No unlinked cust_svc for svcnum ", $svc_acct->svcnum;
-- } else {
--
-- #make sure this svcpart is in pkgpart
-- my($pkg_svc)=qsearchs('pkg_svc',{
-- 'pkgpart' => $pkgpart{$svc{'LegacyBillingData'}},
-- 'svcpart' => $o_cust_svc->svcpart,
-- 'quantity' => 1,
-- });
-- unless ( $pkg_svc ) {
-- warn "login ", $svc{'username'}, ": No svcpart ", $o_cust_svc->svcpart,
-- " for pkgpart ", $pkgpart{$svc{'Acct. Type'}}, "\n" ;
-- } else {
--
-- #create new cust_svc record linked to cust_pkg record
-- my($n_cust_svc) = create FS::cust_svc ({
-- 'svcnum' => $o_cust_svc->svcnum,
-- 'pkgnum' => $cust_pkg->pkgnum,
-- 'svcpart' => $pkg_svc->svcpart,
-- });
-- my($error) = $n_cust_svc->replace($o_cust_svc);
-- die $error if $error;
-- $link++;
-- }
-- }
-- }
-- }
--
-- $line++;
--
--}
--
--warn "\n$link of $line lines linked\n";
--
+++ /dev/null
--#!/usr/bin/perl
--
--###
--# WHO WROTE THIS???
--###
--
--#require "perldb.pl";
--
--# Compute SLIP/PPP log times
--# Arguments -a Process entire file with totals
--# -t Process only totals
--# -f File to be processed if not current
--# -d processing start date (default is entire file)
--# -l to return all totals for dayuse
--# -w name of tmp work file for dayuse
--# user names
--
--require "time.pl";
--
--$space=' ';
--
--unless (@ARGV[0]) {
-- print "Missing Arguments\n";
-- print "-a - entire file\n";
-- print "-t - totals only\n";
-- print "-f - file name to be processed\n";
-- print "-d - processing start date (yymmdd)\n";
-- print "-l - return totals for dayuse\n";
-- print "-w - tmp work file for dayuse\n";
-- exit;
--} # end if test for missing arguments
--
--$infile = "/usr/annex/acp_logfile";
--$tmpfile = "/tmp/ppp";
--$n = $#ARGV;
--$start_yymmdd = "";
--for ($i = 0; $i <= $n; $i++) {
-- if ($ARGV[$i] eq "-a") {
-- $allflag = "true";
-- }
-- elsif ($ARGV[$i] eq "-t") {
-- $totalflag = "true";
-- }
-- elsif ($ARGV[$i] eq "-f") {
-- $i++;
-- $infile = $ARGV[$i];
-- }
-- elsif ($ARGV[$i] eq "-d") {
-- $i++;
-- $start_yymmdd = $ARGV[$i];
-- } #end start yymmdd
-- elsif ($ARGV[$i] eq "-l") {
-- $logflag = "true";
-- $totalflag = "true";
-- } # end log
-- elsif ($ARGV[$i] eq "-w") {
-- $i++;
-- $tmpfile = $ARGV[$i];
-- } # end tmp file
-- else {
-- ($arg_user,$arg_yymmdd) = split (/:/, $ARGV[$i]);
-- $ip_user_date {$arg_user} = $ARGV[$i];
-- $userflag = "true";
-- } # end else
-- } # end for 1 = 1 to n
--
--open (IN,$infile)
-- || die "Can't open acp_logfile";
--
--NEXTUSER: while (<IN>) {
-- chop;
-- ($add,$ether,$port,$date,$time,$type,$action,$user) = split(/:/);
--
-- if ($logflag) {
-- $start_yymmdd = '';
-- if ($ip_user_date{$user}) {
-- ($ip_user, $start_yymmdd) =
-- split (/:/, $ip_user_date{$user});
-- } # end get date
-- } # end log flag
-- if ($start_yymmdd) {
-- if ($date < $start_yymmdd) {
-- next NEXTUSER;
-- } #end date compare
-- } #end if date
-- if ($userflag){
-- if (!$ip_user_date{$user}) {
-- next NEXTUSER;
-- } # end user test
-- } # end by user or all
-- if (($totalflag) ||
-- ($allflag) ||
-- ($ip_user_date{$user})) {
-- if (($type eq 'ppp') || ($type eq 'slip')) {
--
-- if ($action eq 'login') {
-- $login{$user} = "$time:$date";
--
-- }
-- elsif ($action eq 'logout') {
-- if (!$login{$user}) {
-- $login{$user} = "010101:$date";
-- } #end pad user if carry over
-- ($stime,$sdate) = split(':',$login{$user});
-- $start = &annex2sec($stime);
-- $end = &annex2sec($time);
--
-- #If we went through midnight, add a day;
-- if ($end < $start) {$end += 86400;}
-- $timeon = $end - $start;
--
-- $elapsed{$user} += $timeon;
--
-- if (!$totalflag) {
-- print (&fmt_user($user),
-- ' ', &fmt_date($sdate), ' In: ',
-- &fmt_time($stime),' Out: ',
-- &fmt_time($time),
-- ' Elapsed: ', &fmt_sec($timeon), "\n");
-- } # end total test
-- } #end elsif action
-- } # type = ppp of slip
-- } # check arguments
--}
--close IN;
--
--if ($logflag) {
-- open (TMPPPP, ">$tmpfile")
-- || die "Can't open ppp tmp file";
-- foreach $user ( sort((keys(%elapsed))) ) {
-- $log_time = &fmt_sec($elapsed{$user});
-- $tmp = join (':',
-- $user,
-- $log_time);
-- print (TMPPPP "$tmp\n");
-- }
-- close (TMPPPP);
--}
-- else {
-- print "\n\nTotal Time On For Period:\n";
-- print "-------------------------\n";
--
-- foreach $user ( sort((keys(%elapsed))) ) {
-- print (&fmt_user($user), " ",&fmt_sec($elapsed{$user}), "\n");
-- }
-- }
--exit(0);
--
--#-------------------------------------------------------
--#--------------- Subroutines Start Here ----------------
--#-------------------------------------------------------
--
--sub annex2sec {
-- local($time) = @_;
-- return( &time2sec( &break_annex($time) ) );
--}
--
--sub fmt_date {
-- local($date) = @_;
--
-- return( substr($date,2,2).'/'.substr($date,4,2).'/'.substr($date,0,2) );
--}
--
--sub fmt_time {
-- local($time) = @_;
-- local($s,$m,$h) = &break_annex($time);
-- return ("$h:$m:$s");
--}
--
--
--sub break_annex {
-- local($time) = @_;
-- local($h,$m,$s);
--
-- $h=substr($time,0,2);
-- $m=substr($time,2,2);
-- $s=substr($time,4,2);
--
-- return ($s,$m,$h);
--}
--
--sub fmt_sec {
-- local(@t) = &sec2time(@_);
-- @t[2] += (@t[3]*24);
--
-- foreach $a (@t) {
-- if ($a < 10) {$a = "0$a";}
-- }
--
-- return ("@t[2]:@t[1]:@t[0]");
--}
--
--sub fmt_user {
-- local($user) = @_;
-- return( $user.substr($space,0,8 - length($user) ).' ' );
--}
--
+++ /dev/null
--AFGHANISTAN AF AFG 004
--ALBANIA AL ALB 008
--ALGERIA DZ DZA 012
--AMERICAN SAMOA AS ASM 016
--ANDORRA AD AND 020
--ANGOLA AO AGO 024
--ANGUILLA AI AIA 660
--ANTARCTICA AQ ATA 010
--ANTIGUA AND BARBUDA AG ATG 028
--ARGENTINA AR ARG 032
--ARMENIA AM ARM 051
--ARUBA AW ABW 533
--AUSTRALIA AU AUS 036
--AUSTRIA AT AUT 040
--AZERBAIJAN AZ AZE 031
--BAHAMAS BS BHS 044
--BAHRAIN BH BHR 048
--BANGLADESH BD BGD 050
--BARBADOS BB BRB 052
--BELARUS BY BLR 112
--BELGIUM BE BEL 056
--BELIZE BZ BLZ 084
--BENIN BJ BEN 204
--BERMUDA BM BMU 060
--BHUTAN BT BTN 064
--BOLIVIA BO BOL 068
--BOSNIA AND HERZEGOWINA BA BIH 070
--BOTSWANA BW BWA 072
--BOUVET ISLAND BV BVT 074
--BRAZIL BR BRA 076
--BRITISH INDIAN OCEAN TERRITORY IO IOT 086
--BRUNEI DARUSSALAM BN BRN 096
--BULGARIA BG BGR 100
--BURKINA FASO BF BFA 854
--BURUNDI BI BDI 108
--CAMBODIA KH KHM 116
--CAMEROON CM CMR 120
--CANADA CA CAN 124
--CAPE VERDE CV CPV 132
--CAYMAN ISLANDS KY CYM 136
--CENTRAL AFRICAN REPUBLIC CF CAF 140
--CHAD TD TCD 148
--CHILE CL CHL 152
--CHINA CN CHN 156
--CHRISTMAS ISLAND CX CXR 162
--COCOS (KEELING) ISLANDS CC CCK 166
--COLOMBIA CO COL 170
--COMOROS KM COM 174
--CONGO CG COG 178
--COOK ISLANDS CK COK 184
--COSTA RICA CR CRI 188
--COTE D'IVOIRE CI CIV 384
--CROATIA (local name: Hrvatska) HR HRV 191
--CUBA CU CUB 192
--CYPRUS CY CYP 196
--CZECH REPUBLIC CZ CZE 203
--DENMARK DK DNK 208
--DJIBOUTI DJ DJI 262
--DOMINICA DM DMA 212
--DOMINICAN REPUBLIC DO DOM 214
--EAST TIMOR TP TMP 626
--ECUADOR EC ECU 218
--EGYPT EG EGY 818
--EL SALVADOR SV SLV 222
--EQUATORIAL GUINEA GQ GNQ 226
--ERITREA ER ERI 232
--ESTONIA EE EST 233
--ETHIOPIA ET ETH 231
--FALKLAND ISLANDS (MALVINAS) FK FLK 238
--FAROE ISLANDS FO FRO 234
--FIJI FJ FJI 242
--FINLAND FI FIN 246
--FRANCE FR FRA 250
--FRANCE, METROPOLITAN FX FXX 249
--FRENCH GUIANA GF GUF 254
--FRENCH POLYNESIA PF PYF 258
--FRENCH SOUTHERN TERRITORIES TF ATF 260
--GABON GA GAB 266
--GAMBIA GM GMB 270
--GEORGIA GE GEO 268
--GERMANY DE DEU 276
--GHANA GH GHA 288
--GIBRALTAR GI GIB 292
--GREECE GR GRC 300
--GREENLAND GL GRL 304
--GRENADA GD GRD 308
--GUADELOUPE GP GLP 312
--GUAM GU GUM 316
--GUATEMALA GT GTM 320
--GUINEA GN GIN 324
--GUINEA-BISSAU GW GNB 624
--GUYANA GY GUY 328
--HAITI HT HTI 332
--HEARD AND MC DONALD ISLANDS HM HMD 334
--HONDURAS HN HND 340
--HONG KONG HK HKG 344
--HUNGARY HU HUN 348
--ICELAND IS ISL 352
--INDIA IN IND 356
--INDONESIA ID IDN 360
--IRAN (ISLAMIC REPUBLIC OF) IR IRN 364
--IRAQ IQ IRQ 368
--IRELAND IE IRL 372
--ISRAEL IL ISR 376
--ITALY IT ITA 380
--JAMAICA JM JAM 388
--JAPAN JP JPN 392
--JORDAN JO JOR 400
--KAZAKHSTAN KZ KAZ 398
--KENYA KE KEN 404
--KIRIBATI KI KIR 296
--KOREA, DEMOCRATIC PEOPLE'S REPUBLIC OF KP PRK 408
--KOREA, REPUBLIC OF KR KOR 410
--KUWAIT KW KWT 414
--KYRGYZSTAN KG KGZ 417
--LAO PEOPLE'S DEMOCRATIC REPUBLIC LA LAO 418
--LATVIA LV LVA 428
--LEBANON LB LBN 422
--LESOTHO LS LSO 426
--LIBERIA LR LBR 430
--LIBYAN ARAB JAMAHIRIYA LY LBY 434
--LIECHTENSTEIN LI LIE 438
--LITHUANIA LT LTU 440
--LUXEMBOURG LU LUX 442
--MACAU MO MAC 446
--MACEDONIA, THE FORMER YUGOSLAV REPUBLIC OF MK MKD 807
--MADAGASCAR MG MDG 450
--MALAWI MW MWI 454
--MALAYSIA MY MYS 458
--MALDIVES MV MDV 462
--MALI ML MLI 466
--MALTA MT MLT 470
--MARSHALL ISLANDS MH MHL 584
--MARTINIQUE MQ MTQ 474
--MAURITANIA MR MRT 478
--MAURITIUS MU MUS 480
--MAYOTTE YT MYT 175
--MEXICO MX MEX 484
--MICRONESIA, FEDERATED STATES OF FM FSM 583
--MOLDOVA, REPUBLIC OF MD MDA 498
--MONACO MC MCO 492
--MONGOLIA MN MNG 496
--MONTSERRAT MS MSR 500
--MOROCCO MA MAR 504
--MOZAMBIQUE MZ MOZ 508
--MYANMAR MM MMR 104
--NAMIBIA NA NAM 516
--NAURU NR NRU 520
--NEPAL NP NPL 524
--NETHERLANDS NL NLD 528
--NETHERLANDS ANTILLES AN ANT 530
--NEW CALEDONIA NC NCL 540
--NEW ZEALAND NZ NZL 554
--NICARAGUA NI NIC 558
--NIGER NE NER 562
--NIGERIA NG NGA 566
--NIUE NU NIU 570
--NORFOLK ISLAND NF NFK 574
--NORTHERN MARIANA ISLANDS MP MNP 580
--NORWAY NO NOR 578
--OMAN OM OMN 512
--PAKISTAN PK PAK 586
--PALAU PW PLW 585
--PANAMA PA PAN 591
--PAPUA NEW GUINEA PG PNG 598
--PARAGUAY PY PRY 600
--PERU PE PER 604
--PHILIPPINES PH PHL 608
--PITCAIRN PN PCN 612
--POLAND PL POL 616
--PORTUGAL PT PRT 620
--PUERTO RICO PR PRI 630
--QATAR QA QAT 634
--REUNION RE REU 638
--ROMANIA RO ROM 642
--RUSSIAN FEDERATION RU RUS 643
--RWANDA RW RWA 646
--SAINT KITTS AND NEVIS KN KNA 659
--SAINT LUCIA LC LCA 662
--SAINT VINCENT AND THE GRENADINES VC VCT 670
--SAMOA WS WSM 882
--SAN MARINO SM SMR 674
--SAO TOME AND PRINCIPE ST STP 678
--SAUDI ARABIA SA SAU 682
--SENEGAL SN SEN 686
--SEYCHELLES SC SYC 690
--SIERRA LEONE SL SLE 694
--SINGAPORE SG SGP 702
--SLOVAKIA (Slovak Republic) SK SVK 703
--SLOVENIA SI SVN 705
--SOLOMON ISLANDS SB SLB 090
--SOMALIA SO SOM 706
--SOUTH AFRICA ZA ZAF 710
--SOUTH GEORGIA AND THE SOUTH SANDWICH ISLANDS GS SGS 239
--SPAIN ES ESP 724
--SRI LANKA LK LKA 144
--ST. HELENA SH SHN 654
--ST. PIERRE AND MIQUELON PM SPM 666
--SUDAN SD SDN 736
--SURINAME SR SUR 740
--SVALBARD AND JAN MAYEN ISLANDS SJ SJM 744
--SWAZILAND SZ SWZ 748
--SWEDEN SE SWE 752
--SWITZERLAND CH CHE 756
--SYRIAN ARAB REPUBLIC SY SYR 760
--TAIWAN, PROVINCE OF CHINA TW TWN 158
--TAJIKISTAN TJ TJK 762
--TANZANIA, UNITED REPUBLIC OF TZ TZA 834
--THAILAND TH THA 764
--TOGO TG TGO 768
--TOKELAU TK TKL 772
--TONGA TO TON 776
--TRINIDAD AND TOBAGO TT TTO 780
--TUNISIA TN TUN 788
--TURKEY TR TUR 792
--TURKMENISTAN TM TKM 795
--TURKS AND CAICOS ISLANDS TC TCA 796
--TUVALU TV TUV 798
--UGANDA UG UGA 800
--UKRAINE UA UKR 804
--UNITED ARAB EMIRATES AE ARE 784
--UNITED KINGDOM GB GBR 826
--UNITED STATES US USA 840
--UNITED STATES MINOR OUTLYING ISLANDS UM UMI 581
--URUGUAY UY URY 858
--UZBEKISTAN UZ UZB 860
--VANUATU VU VUT 548
--VATICAN CITY STATE (HOLY SEE) VA VAT 336
--VENEZUELA VE VEN 862
--VIET NAM VN VNM 704
--VIRGIN ISLANDS (BRITISH) VG VGB 092
--VIRGIN ISLANDS (U.S.) VI VIR 850
--WALLIS AND FUTUNA ISLANDS WF WLF 876
--WESTERN SAHARA EH ESH 732
--YEMEN YE YEM 887
--YUGOSLAVIA YU YUG 891
--ZAIRE ZR ZAR 180
--ZAMBIA ZM ZMB 894
--ZIMBABWE ZW ZWE 716
+++ /dev/null
--[ URL ftp://rs.internic.net/templates/domain-template.txt ] [ 03/98 ]
--
--******* Please DO NOT REMOVE Version Number or Sections A-Q ********
--
--Domain Version Number: 4.0
--
--******* Email completed agreement to hostmaster@internic.net *******
--
-- NETWORK SOLUTIONS, INC.
--
-- DOMAIN NAME REGISTRATION AGREEMENT
--
--
--A. Introduction. This domain name registration agreement
--("Registration Agreement") is submitted to NETWORK SOLUTIONS, INC.
--("NSI") for the purpose of applying for and registering a domain name
--on the Internet. If this Registration Agreement is accepted by NSI,
--and a domain name is registered in NSI's domain name database and
--assigned to the Registrant, Registrant ("Registrant") agrees to be
--bound by the terms of this Registration Agreement and the terms of
--NSI's Domain Name Dispute Policy ("Dispute Policy") which is
--incorporated herein by reference and made a part of this Registration
--Agreement. This Registration Agreement shall be accepted at the
--offices of NSI.
--
--B. Fees and Payments.
--
--1) Registration or renewal (re-registration) date through March 31, 1998:
--Registrant agrees to pay a registration fee of One Hundred United States
--Dollars (US$100) as consideration for the registration of each new domain
--name or Fifty United States Dollars (US$50) to renew (re-register) an
--existing registration.
--2) Registration or renewal date on and after April 1, 1998: Registrant
--agrees to pay a registration fee of Seventy United States Dollars (US$70)
--as consideration for the registration of each new domain name or the
--applicable renewal (re-registration) fee (currently Thirty-Five United
--States Dollars (US$35)) at the time of renewal (re-registration).
--3) Period of Service: The non-refundable fee covers a period of two (2)
--years for each new registration, and one (1) year for each renewal,
--and includes any permitted modification(s) to the domain name record
--during the covered period.
--4) Payment: Payment is due to Network Solutions within thirty (30)
--days from the date of the invoice.
--
--C. Dispute Policy. Registrant agrees, as a condition to
--submitting this Registration Agreement, and if the Registration
--Agreement is accepted by NSI, that the Registrant shall be bound by
--NSI's current Dispute Policy. The current version of the Dispute
--Policy may be found at the InterNIC Registration Services web site:
--"http://www.netsol.com/rs/dispute-policy.html".
--
--D. Dispute Policy Changes or Modifications. Registrant agrees
--that NSI, in its sole discretion, may change or modify the Dispute
--Policy, incorporated by reference herein, at any time. Registrant
--agrees that Registrant's maintaining the registration of a domain name
--after changes or modifications to the Dispute Policy become effective
--constitutes Registrant's continued acceptance of these changes or
--modifications. Registrant agrees that if Registrant considers any such
--changes or modifications to be unacceptable, Registrant may request
--that the domain name be deleted from the domain name database.
--
--E. Disputes. Registrant agrees that, if the registration of its
--domain name is challenged by any third party, the Registrant will be
--subject to the provisions specified in the Dispute Policy.
--
--F. Agents. Registrant agrees that if this Registration Agreement
--is completed by an agent for the Registrant, such as an ISP or
--Administrative Contact/Agent, the Registrant is nonetheless bound as a
--principal by all terms and conditions herein, including the Dispute
--Policy.
--
--G. Limitation of Liability. Registrant agrees that NSI shall have
--no liability to the Registrant for any loss Registrant may incur in
--connection with NSI's processing of this Registration Agreement, in
--connection with NSI's processing of any authorized modification to the
--domain name's record during the covered period, as a result of the
--Registrant's ISP's failure to pay either the initial registration fee
--or renewal fee, or as a result of the application of the provisions of
--the Dispute Policy. Registrant agrees that in no event shall the
--maximum liability of NSI under this Agreement for any matter exceed
--Five Hundred United States Dollars (US$500).
--
--H. Indemnity. Registrant agrees, in the event the Registration
--Agreement is accepted by NSI and a subsequent dispute arises with any
--third party, to indemnify and hold NSI harmless pursuant to the terms
--and conditions contained in the Dispute Policy.
--
--I. Breach. Registrant agrees that failure to abide by any
--provision of this Registration Agreement or the Dispute Policy may be
--considered by NSI to be a material breach and that NSI may provide a
--written notice, describing the breach, to the Registrant. If, within
--thirty (30) days of the date of mailing such notice, the Registrant
--fails to provide evidence, which is reasonably satisfactory to NSI,
--that it has not breached its obligations, then NSI may delete
--Registrant's registration of the domain name. Any such breach by a
--Registrant shall not be deemed to be excused simply because NSI did
--not act earlier in response to that, or any other, breach by the
--Registrant.
--
--J. No Guaranty. Registrant agrees that, by registration of a
--domain name, such registration does not confer immunity from objection
--to either the registration or use of the domain name.
--
--K. Warranty. Registrant warrants by submitting this Registration
--Agreement that, to the best of Registrant's knowledge and belief, the
--information submitted herein is true and correct, and that any future
--changes to this information will be provided to NSI in a timely manner
--according to the domain name modification procedures in place at that
--time. Breach of this warranty will constitute a material breach.
--
--L. Revocation. Registrant agrees that NSI may delete a
--Registrant's domain name if this Registration Agreement, or subsequent
--modification(s) thereto, contains false or misleading information, or
--conceals or omits any information NSI would likely consider material
--to its decision to approve this Registration Agreement.
--
--M. Right of Refusal. NSI, in its sole discretion, reserves the
--right to refuse to approve the Registration Agreement for any
--Registrant. Registrant agrees that the submission of this Registration
--Agreement does not obligate NSI to accept this Registration Agreement.
--Registrant agrees that NSI shall not be liable for loss or damages
--that may result from NSI's refusal to accept this Registration
--Agreement.
--
--N. Severability. Registrant agrees that the terms of this
--Registration Agreement are severable. If any term or provision is
--declared invalid, it shall not affect the remaining terms or
--provisions which shall continue to be binding.
--
--O. Entirety. Registrant agrees that this Registration Agreement
--and the Dispute Policy is the complete and exclusive agreement between
--Registrant and NSI regarding the registration of Registrant's domain
--name. This Registration Agreement and the Dispute Policy supersede all
--prior agreements and understandings, whether established by custom,
--practice, policy, or precedent.
--
--P. Governing Law. Registrant agrees that this Registration
--Agreement shall be governed in all respects by and construed in
--accordance with the laws of the Commonwealth of Virginia, United
--States of America. By submitting this Registration Agreement,
--Registrant consents to the exclusive jurisdiction and venue of the
--United States District Court for the Eastern District of Virginia,
--Alexandria Division. If there is no jurisdiction in the United States
--District Court for the Eastern District of Virginia, Alexandria
--Division, then jurisdiction shall be in the Circuit Court of Fairfax
--County, Fairfax, Virginia.
--
--Q. This is Domain Name Registration Agreement Version
--Number 4.0. This Registration Agreement is only for registrations
--under top-level domains: COM, ORG, NET, and EDU. By completing
--and submitting this Registration Agreement for consideration and
--acceptance by NSI, the Registrant agrees that he/she has read and
--agrees to be bound by A through P above.
--
--
--Authorization
--0a. (N)ew (M)odify (D)elete....:###action###
--0b. Auth Scheme................:
--0c. Auth Info..................:
--
--1. Comments...................:###purpose###
--
--2. Complete Domain Name.......:###domain###
--
--Organization Using Domain Name
--
--3a. Organization Name..........:###company###
--###LOOP###
--3b. Street Address.............:###address###
--###ENDLOOP###
--3c. City.......................:###city###
--3d. State......................:###state###
--3e. Postal Code................:###zip###
--3f. Country....................:###country###
--
--Administrative Contact
--4a. NIC Handle (if known)......:
--4b. (I)ndividual (R)ole........:I
--4c. Name (Last, First).........:###last###, ###first###
--4d. Organization Name..........:###company###
--###LOOP###
--4e. Street Address.............:###address###
--###ENDLOOP###
--4f. City.......................:###city###
--4g. State......................:###state###
--4h. Postal Code................:###zip###
--4i. Country....................:###country###
--4j. Phone Number...............:###daytime###
--4k. Fax Number.................:###fax###
--4l. E-Mailbox..................:###email###
--
--Technical Contact
--5a. NIC Handle (if known)......:###tech_contact###
--5b. (I)ndividual (R)ole........:
--5c. Name (Last, First).........:
--5d. Organization Name..........:
--5e. Street Address.............:
--5f. City.......................:
--5g. State......................:
--5h. Postal Code................:
--5i. Country....................:
--5j. Phone Number...............:
--5k. Fax Number.................:
--5l. E-Mailbox..................:
--
--Billing Contact
--6a. NIC Handle (if known)......:
--6b. (I)ndividual (R)ole........:
--6c. Name (Last, First).........:
--6d. Organization Name..........:
--6e. Street Address.............:
--6f. City.......................:
--6g. State......................:
--6h. Postal Code................:
--6i. Country....................:
--6j. Phone Number...............:
--6k. Fax Number.................:
--6l. E-Mailbox..................:
--
--Prime Name Server
--7a. Primary Server Hostname....:###primary###
--7b. Primary Server Netaddress..:###primary_ip###
--
--Secondary Name Server(s)
--###LOOP###
--8a. Secondary Server Hostname..:###secondary###
--8b. Secondary Server Netaddress:###secondary_ip###
--###ENDLOOP###
--
--END OF AGREEMENT
--
+++ /dev/null
--#!/usr/local/bin/perl
--
--###
--# THIS IS FROM CYBERCASH (is there a newer version?)
--###
--
--$paymentserverhost = 'localhost';
--$paymentserverport = 8000;
--$paymentserversecret = 'two-turntables';
--use CCLib qw(sendmserver);
--
--# first lets fake up some data
--# use time of day and pid to give me my pretend
--# order number
--# you obviously need to get real data from somewhere...
--
--$oid = "test$$"; #fake order number.
--$amount = 'usd 42.42';
--$ramount = 'usd 24.24';
--$pan = '4111111111111111';
--$name = 'John Q. Doe';
--$addr = '17 Richard Rd.';
--$city = 'Ivyland';
--$state = 'PA';
--$zip = '18974';
--$country = 'USA';
--$exp = '7/97';
--
--
--%result = &sendmserver('mauthcapture',
-- 'Order-ID', $oid,
-- 'Amount', $amount,
-- 'Card-Number', $pan,
-- 'Card-Name', $name,
-- 'Card-Address', $addr,
-- 'Card-City', $city,
-- 'Card-State', $state,
-- 'Card-Zip', $zip,
-- 'Card-Country', $country,
-- 'Card-Exp', $exp);
--
--#
--# just dump results to stdout.
--# you should process them...
--# to allow results to affect operation of your fulfillment...
--#
--foreach (keys(%result)) {
-- print " $_ ==> $result{$_}\n";
--}
--
--print "\n";
--
--exit;
--
--$trans=$result{'MTransactionNumber'};
--$code=$result{'MRetrievalCode'};
--
--%result = &sendmserver('return',
-- 'Order-ID', $oid,
-- 'Return-Amount',$ramount,
-- 'Amount',$amount,
-- );
--
--foreach (keys(%result)) {
-- print " $_ ==> $result{$_}\n";
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# fs_passwd
--#
--# portions of this script are copied from the `passwd' script in the original
--# (perl 4) camel book, now archived at
--# http://www.perl.com/CPAN/scripts/nutshell/ch6/passwd
--#
--# ivan@sisd.com 98-mar-8
--#
--# password lengths 0,255 instead of 6,8 - we'll let the server process
--# check the data ivan@sisd.com 98-jul-17
--
--use strict;
--use Getopt::Std;
--use Socket;
--use IO::Handle;
--use vars qw($opt_f $opt_s);
--
--my($fs_passwdd_socket)="/usr/local/freeside/fs_passwdd_socket";
--my($freeside_uid)=scalar(getpwnam('freeside'));
--
--$ENV{'PATH'} ='/usr/bin:/usr/ucb:/bin';
--$ENV{'SHELL'} = '/bin/sh';
--$ENV{'IFS'} = " \t\n";
--$ENV{'CDPATH'} = '';
--$ENV{'ENV'} = '';
--$ENV{'BASH_ENV'} = '';
--
--$SIG{__DIE__}= sub { system '/bin/stty', 'echo'; };
--
--die "passwd program isn't running setuid to freeside\n" if $> != $freeside_uid;
--
--unshift @ARGV, "-f" if $0 =~ /chfn$/;
--unshift @ARGV, "-s" if $0 =~ /chsh$/;
--
--getopts('fs');
--
--my($me)='';
--if ( $_ = shift(@ARGV) ) {
-- /^(\w{2,8})$/;
-- $me = $1;
--}
--die "You can't change the password for $me." if $me && $<;
--$me = (getpwuid($<))[0] unless $me;
--
--my($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$dir,$shell)=
-- getpwnam $me;
--
--my($old_password,$new_password,$new_gecos,$new_shell);
--
--if ( $opt_f || $opt_s ) {
-- system '/bin/stty', '-echo';
-- print "Password:";
-- $old_password=<STDIN>;
-- system '/bin/stty', 'echo';
-- chop($old_password);
-- #$old_password =~ /^(.{6,8})$/ or die "\nIllegal password.\n";
-- $old_password =~ /^(.{0,255})$/ or die "\nIllegal password.\n";
-- $old_password = $1;
--
-- $new_password = '';
--
-- if ( $opt_f ) {
-- print "\nChanging gecos for $me.\n";
-- print "Gecos [", $gcos, "]: ";
-- $new_gecos=<STDIN>;
-- chop($new_gecos);
-- $new_gecos ||= $gcos;
-- $new_gecos =~ /^(.{0,255})$/ or die "\nIllegal gecos.\n";
-- } else {
-- $new_gecos = '';
-- }
--
-- if ( $opt_s ) {
-- print "\nChanging shell for $me.\n";
-- print "Shell [", $shell, "]: ";
-- $new_shell=<STDIN>;
-- chop($new_shell);
-- $new_shell ||= $shell;
-- $new_shell =~ /^(.{0,255})$/ or die "\nIllegal shell.\n";
-- } else {
-- $new_shell = '';
-- }
--
--} else {
--
-- print "Changing password for $me.\n";
-- print "Old password:";
-- system '/bin/stty', '-echo';
-- $old_password=<STDIN>;
-- chop $old_password;
-- #$old_password =~ /^(.{6,8})$/ or die "\nIllegal password.\n";
-- $old_password =~ /^(.{0,255})$/ or die "\nIllegal password.\n";
-- $old_password = $1;
-- print "\nEnter the new password (minimum of 6, maximum of 8 characters)\n";
-- print "Please use a combination of upper and lowercase letters and numbers.\n";
-- print "New password:";
-- $new_password=<STDIN>;
-- chop($new_password);
-- #$new_password =~ /^(.{6,8})$/ or die "\nIllegal password.\n";
-- $new_password =~ /^(.{0,255})$/ or die "\nIllegal password.\n";
-- $new_password = $1;
-- print "\nRe-enter new password:";
-- my($check_new_password);
-- $check_new_password=<STDIN>;
-- chop($check_new_password);
-- die "\nThey don't match; try again.\n" unless $check_new_password eq $new_password;
--
-- $new_gecos='';
-- $new_shell='';
--}
--print "\n";
--
--system '/bin/stty', 'echo';
--
--socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
--connect(SOCK, sockaddr_un($fs_passwdd_socket)) or die "connect: $!";
--print SOCK join("\n",$me,$old_password,$new_password,$new_gecos,$new_shell),"\n";
--SOCK->flush;
--my($error);
--$error = <SOCK>;
--chop $error;
--
--if ($error) {
-- print "\nUpdate error: $error\n";
--} else {
-- print "\nUpdate sucessful.\n";
--}
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# fs_passwd_server
--#
--# portions of this script are copied from the `passwd' script in the original
--# (perl 4) camel book, now archived at
--# http://www.perl.com/CPAN/scripts/nutshell/ch6/passwd
--#
--# ivan@sisd.com 98-mar-9
--#
--# crypt-aware, s/password/_password/; ivan@sisd.com 98-aug-23
--
--use strict;
--use IO::Handle;
--use FS::SSH qw(sshopen2);
--use FS::UID qw(adminsuidsetup);
--use FS::Record qw(qsearchs);
--use FS::svc_acct;
--
--$SIG{CHLD} = sub { wait() };
--
--&adminsuidsetup;
--
--my($fs_passwdd)="/usr/local/sbin/fs_passwdd";
--
--my($shellmachine)=shift;
--die "Usage: fs_passwd_server shellmachine\n" unless $shellmachine;
--
--while (1) {
-- my($reader,$writer)=(new IO::Handle, new IO::Handle);
-- $writer->autoflush(1);
-- sshopen2($shellmachine,$reader,$writer,$fs_passwdd);
-- while (1) {
-- my($username,$old_password,$new_password,$new_gecos,$new_shell);
-- defined($username=<$reader>) or last;
-- defined($old_password=<$reader>) or last;
-- defined($new_password=<$reader>) or last;
-- defined($new_gecos=<$reader>) or last;
-- defined($new_shell=<$reader>) or last;
-- chop($username);
-- chop($old_password);
-- chop($new_password);
-- chop($new_gecos);
-- chop($new_shell);
-- my($svc_acct);
--
-- #need to try both $old_password and encrypted $old_password
-- #maybe the crypt function in svc_acct.export needs to be a library?
-- my $salt = substr($old_password,0,2);
-- my $cold_password = crypt($old_password,$salt);
-- $svc_acct=qsearchs('svc_acct',{'username'=>$username,
-- '_password'=>$old_password,
-- } )
-- || qsearchs('svc_acct',{'username'=>$username,
-- '_password'=>$cold_password,
-- } );
-- unless ( $svc_acct ) { print $writer "Incorrect password.\n"; next; }
--
-- my(%hash)=$svc_acct->hash;
-- my($new_svc_acct) = create FS::svc_acct ( \%hash );
-- $new_svc_acct->setfield('_password',$new_password)
-- if $new_password && $new_password ne $old_password;
-- $new_svc_acct->setfield('finger',$new_gecos) if $new_gecos;
-- $new_svc_acct->setfield('shell',$new_shell) if $new_shell;
-- my($error)=$new_svc_acct->replace($svc_acct);
-- print $writer $error,"\n";
-- }
-- close $writer;
-- close $reader;
-- sleep 60;
-- warn "Connection to $shellmachine lost! Reconnecting...\n";
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# fs_passwdd
--#
--# This is run REMOTELY over ssh by fs_passwd_server.
--#
--# ivan@sisd.com 98-mar-9
--
--use strict;
--use Socket;
--
--my($fs_passwdd_socket)="/usr/local/freeside/fs_passwdd_socket";
--
--$ENV{'PATH'} ='/usr/bin:/usr/ucb:/bin';
--$ENV{'SHELL'} = '/bin/sh';
--$ENV{'IFS'} = " \t\n";
--$ENV{'CDPATH'} = '';
--$ENV{'ENV'} = '';
--$ENV{'BASH_ENV'} = '';
--
--$|=1;
--
--my $uaddr = sockaddr_un($fs_passwdd_socket);
--my $proto = getprotobyname('tcp');
--
--socket(Server,PF_UNIX,SOCK_STREAM,0) or die "socket: $!";
--unlink($fs_passwdd_socket);
--bind(Server, $uaddr) or die "bind: $!";
--listen(Server,SOMAXCONN) or die "listen: $!";
--
--my($paddr);
--for ( ; $paddr = accept(Client,Server); close Client) {
-- my($me,$old_password,$new_password,$new_gecos,$new_shell);
--
-- $me=<Client>;
-- $old_password=<Client>;
-- $new_password=<Client>;
-- $new_gecos=<Client>;
-- $new_shell=<Client>;
--
-- print $me,$old_password,$new_password,$new_gecos,$new_shell;
-- my($error);
--
-- $error=<STDIN>;
--
-- print Client $error;
-- close Client;
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# ivan@sisd.com 98-mar-23
--
--use strict;
--use Date::Parse; #but hopefully not
--
--$|=1;
--
--my($file,$pos)=@_;
--open(FILE,"<$file") or die "Can't open $file: $!";
--seek(FILE,$pos,0) or die "Can't seek: $!";
--
--my($datestr);
--my(%param);
--
--$SIG{'HUP'} = sub { print "EOF\n"; exit; };
--
--while (1) {
--
-- while (<FILE>) {
-- next if /^$/;
-- if ( /^\S/ ) {
-- chop($datestr=$_);
-- undef %param;
-- } else {
-- warn "Unexpected line: $_";
-- }
-- while (<FILE>) {
-- if ( /^$/ ) {
-- #if ( $param{'Acct-Status-Type'} eq 'Stop' ) {
-- print join("\t",
-- tell FILE,
-- %param,
-- ),"\n";
-- #}
-- last;
-- } elsif ( /^\s+([\w\-]+)\s\=\s\"?([\w\.\-]+)\"?\s*$/ ) {
-- $param{$1}=$2;
-- } else {
-- warn "Unexpected line: $_";
-- }
--
-- }
--
-- }
-- sleep 1;
-- seek(FILE,0,1);
--}
--
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# agent.cgi: browse agent
--#
--# ivan@sisd.com 97-dec-12
--#
--# changes to allow pages to load from a relative location in the web tree.
--# bmccane@maxbaud.net 98-mar-25
--#
--# changed 'type' to 'atype' because type is reserved word in Pg6.3
--# bmccane@maxbaud.net 98-apr-3
--#
--# agent type was linking to wrong cgi ivan@sisd.com 98-jul-18
--#
--# lose background, FS::CGI ivan@sisd.com 98-sep-2
-#
-# $Log: agent.cgi,v $
-# Revision 1.2 1998-11-07 10:24:22 ivan
-# don't use depriciated FS::Bill and FS::Invoice, other miscellania
-#
--
--use strict;
--use CGI::Base;
--use FS::UID qw(cgisuidsetup swapuid);
--use FS::Record qw(qsearch qsearchs);
--use FS::CGI qw(header menubar);
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--
--&cgisuidsetup($cgi);
--
--SendHeaders(); # one guess.
--print header('Agent Listing', menubar(
- 'Main Menu' => '../',
- 'Add new agent' => '../edit/agent.cgi'
- 'Main Menu' => '../',
- 'Agent Types' => 'agent_type.cgi',
-# 'Add new agent' => '../edit/agent.cgi'
--)), <<END;
- <BR>
- Click on agent number to edit.
-Agents are resellers of your service. Agents may be limited to a subset of your
-full offerings (via their type).<BR><BR>
-- <TABLE BORDER>
-- <TR>
- <TH><FONT SIZE=-1>Agent #</FONT></TH>
- <TH>Agent</TH>
- <TH COLSPAN=2>Agent</TH>
-- <TH>Type</TH>
-- <TH><FONT SIZE=-1>Freq. (unimp.)</FONT></TH>
-- <TH><FONT SIZE=-1>Prog. (unimp.)</FONT></TH>
-- </TR>
--END
-# <TH><FONT SIZE=-1>Agent #</FONT></TH>
-# <TH>Agent</TH>
--
--my($agent);
--foreach $agent ( sort {
-- $a->getfield('agentnum') <=> $b->getfield('agentnum')
--} qsearch('agent',{}) ) {
-- my($hashref)=$agent->hashref;
-- my($typenum)=$hashref->{typenum};
-- my($agent_type)=qsearchs('agent_type',{'typenum'=>$typenum});
-- my($atype)=$agent_type->getfield('atype');
-- print <<END;
-- <TR>
-- <TD><A HREF="../edit/agent.cgi?$hashref->{agentnum}">
-- $hashref->{agentnum}</A></TD>
- <TD>$hashref->{agent}</TD>
- <TD><A HREF="../edit/agent.cgi?$hashref->{agentnum}">
- $hashref->{agent}</A></TD>
-- <TD><A HREF="../edit/agent_type.cgi?$typenum">$atype</A></TD>
-- <TD>$hashref->{freq}</TD>
-- <TD>$hashref->{prog}</TD>
-- </TR>
--END
--
--}
--
--print <<END;
- <TR>
- <TD COLSPAN=2><A HREF="../edit/agent.cgi"><I>Add new agent</I></A></TD>
- <TD><A HREF="../edit/agent_type.cgi"><I>Add new agent type</I></A></TD>
- </TR>
-- </TABLE>
- </CENTER>
-
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# agent_type.cgi: browse agent_type
--#
--# ivan@sisd.com 97-dec-10
--#
--# Changes to allow page to work at a relative position in server
--# Changes to make "Packages" display 2-wide in table (old way was too vertical)
--# bmccane@maxbaud.net 98-apr-3
--#
--# lose background, FS::CGI ivan@sisd.com 98-sep-2
--
--use strict;
--use CGI::Base;
--use FS::UID qw(cgisuidsetup swapuid);
--use FS::Record qw(qsearch qsearchs);
--use FS::CGI qw(header menubar);
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--
--&cgisuidsetup($cgi);
--
--SendHeaders(); # one guess.
--
--print header("Agent Type Listing", menubar(
-- 'Main Menu' => '../',
-- 'Add new agent type' => "../edit/agent_type.cgi",
--)), <<END;
-- <BR>Click on agent type number to edit.
-- <TABLE BORDER>
-- <TR>
-- <TH><FONT SIZE=-1>Type #</FONT></TH>
-- <TH>Type</TH>
-- <TH colspan="2">Packages</TH>
-- </TR>
--END
--
--my($agent_type);
--foreach $agent_type ( sort {
-- $a->getfield('typenum') <=> $b->getfield('typenum')
--} qsearch('agent_type',{}) ) {
-- my($hashref)=$agent_type->hashref;
-- my(@type_pkgs)=qsearch('type_pkgs',{'typenum'=> $hashref->{typenum} });
-- my($rowspan)=scalar(@type_pkgs);
-- $rowspan = int($rowspan/2+0.5) ;
-- print <<END;
-- <TR>
-- <TD ROWSPAN=$rowspan><A HREF="../edit/agent_type.cgi?$hashref->{typenum}">
-- $hashref->{typenum}
-- </A></TD>
-- <TD ROWSPAN=$rowspan>$hashref->{atype}</TD>
--END
--
-- my($type_pkgs);
-- my($tdcount) = -1 ;
-- foreach $type_pkgs ( @type_pkgs ) {
-- my($pkgpart)=$type_pkgs->getfield('pkgpart');
-- my($part_pkg) = qsearchs('part_pkg',{'pkgpart'=> $pkgpart });
-- print qq!<TR>! if ($tdcount == 0) ;
-- $tdcount = 0 if ($tdcount == -1) ;
-- print qq!<TD><A HREF="../edit/part_pkg.cgi?$pkgpart">!,
-- $part_pkg->getfield('pkg'),"</A></TD>";
-- $tdcount ++ ;
-- if ($tdcount == 2)
-- {
-- print qq!</TR>\n! ;
-- $tdcount = 0 ;
-- }
-- }
--
-- print "</TR>";
--}
--
--print <<END;
-- </TR></TABLE>
-- </CENTER>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# cust_main_county.cgi: browse cust_main_county
--#
--# ivan@sisd.com 97-dec-13
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# lose background, FS::CGI ivan@sisd.com 98-sep-2
--
--use strict;
--use CGI::Base;
--use FS::UID qw(cgisuidsetup swapuid);
--use FS::Record qw(qsearch qsearchs);
--use FS::CGI qw(header menubar);
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--
--&cgisuidsetup($cgi);
--
--SendHeaders(); # one guess.
--print header("Tax Rate Listing", menubar(
-- 'Main Menu' => '../',
-- 'Edit tax rates' => "../edit/cust_main_county.cgi",
--)),<<END;
-- <BR>Click on <u>expand</u> to specify tax rates by county.
-- <P><TABLE BORDER>
-- <TR>
-- <TH><FONT SIZE=-1>State</FONT></TH>
-- <TH>County</TH>
-- <TH><FONT SIZE=-1>Tax</FONT></TH>
-- </TR>
--END
--
--my($cust_main_county);
--foreach $cust_main_county ( qsearch('cust_main_county',{}) ) {
-- my($hashref)=$cust_main_county->hashref;
-- print <<END;
-- <TR>
-- <TD>$hashref->{state}</TD>
--END
--
-- print "<TD>", $hashref->{county}
-- ? $hashref->{county}
-- : qq!(ALL) <FONT SIZE=-1>!.
-- qq!<A HREF="../edit/cust_main_county-expand.cgi?!. $hashref->{taxnum}.
-- qq!">expand</A></FONT>!
-- , "</TD>";
--
-- print <<END;
-- <TD>$hashref->{tax}%</TD>
-- </TR>
--END
--
--}
--
--print <<END;
-- </TABLE>
-- </CENTER>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# part_svc.cgi: browse part_pkg
--#
--# ivan@sisd.com 97-dec-5,9
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# lose background, FS::CGI ivan@sisd.com 98-sep-2
--
--use strict;
--use CGI::Base;
--use FS::UID qw(cgisuidsetup swapuid);
--use FS::Record qw(qsearch qsearchs);
--use FS::CGI qw(header menubar);
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--
--&cgisuidsetup($cgi);
--
--SendHeaders(); # one guess.
--
--print header("Package Part Listing",menubar(
-- 'Main Menu' => '../',
-- 'Add new package' => "../edit/part_pkg.cgi",
--)), <<END;
-- <BR>Click on package part number to edit.
-- <TABLE BORDER>
-- <TR>
-- <TH><FONT SIZE=-1>Part #</FONT></TH>
-- <TH>Package</TH>
-- <TH>Comment</TH>
-- <TH><FONT SIZE=-1>Setup Fee</FONT></TH>
-- <TH><FONT SIZE=-1>Freq.</FONT></TH>
-- <TH><FONT SIZE=-1>Recur. Fee</FONT></TH>
-- <TH>Service</TH>
-- <TH><FONT SIZE=-1>Quan.</FONT></TH>
-- </TR>
--END
--
--my($part_pkg);
--foreach $part_pkg ( sort {
-- $a->getfield('pkgpart') <=> $b->getfield('pkgpart')
--} qsearch('part_pkg',{}) ) {
-- my($hashref)=$part_pkg->hashref;
-- my(@pkg_svc)=grep $_->getfield('quantity'),
-- qsearch('pkg_svc',{'pkgpart'=> $hashref->{pkgpart} });
-- my($rowspan)=scalar(@pkg_svc);
-- print <<END;
-- <TR>
-- <TD ROWSPAN=$rowspan><A HREF="../edit/part_pkg.cgi?$hashref->{pkgpart}">
-- $hashref->{pkgpart}
-- </A></TD>
-- <TD ROWSPAN=$rowspan>$hashref->{pkg}</TD>
-- <TD ROWSPAN=$rowspan>$hashref->{comment}</TD>
-- <TD ROWSPAN=$rowspan>$hashref->{setup}</TD>
-- <TD ROWSPAN=$rowspan>$hashref->{freq}</TD>
-- <TD ROWSPAN=$rowspan>$hashref->{recur}</TD>
--END
--
-- my($pkg_svc);
-- foreach $pkg_svc ( @pkg_svc ) {
-- my($svcpart)=$pkg_svc->getfield('svcpart');
-- my($part_svc) = qsearchs('part_svc',{'svcpart'=> $svcpart });
-- print qq!<TD><A HREF="../edit/part_svc.cgi?$svcpart">!,
-- $part_svc->getfield('svc'),"</A></TD><TD>",
-- $pkg_svc->getfield('quantity'),"</TD></TR><TR>\n";
-- }
--
-- print "</TR>";
--}
--
--print <<END;
-- </TR></TABLE>
-- </CENTER>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# part_referral.cgi: Browse part_referral
--#
--# ivan@sisd.com 98-feb-23
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# lose background, FS::CGI ivan@sisd.com 98-sep-2
--
--use strict;
--use CGI::Base;
--use FS::UID qw(cgisuidsetup swapuid);
--use FS::Record qw(qsearch);
--use FS::CGI qw(header menubar);
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--
--&cgisuidsetup($cgi);
--
--SendHeaders(); # one guess.
--print header("Referral Listing", menubar(
-- 'Main Menu' => '../',
-- 'Add new referral' => "../edit/part_referral.cgi",
--)), <<END;
-- <BR>Click on referral number to edit.
-- <TABLE BORDER>
-- <TR>
-- <TH><FONT SIZE=-1>Referral #</FONT></TH>
-- <TH>Referral</TH>
-- </TR>
--END
--
--my($part_referral);
--foreach $part_referral ( sort {
-- $a->getfield('refnum') <=> $b->getfield('refnum')
--} qsearch('part_referral',{}) ) {
-- my($hashref)=$part_referral->hashref;
-- print <<END;
-- <TR>
-- <TD><A HREF="../edit/part_referral.cgi?$hashref->{refnum}">
-- $hashref->{refnum}</A></TD>
-- <TD>$hashref->{referral}</TD>
-- </TR>
--END
--
--}
--
--print <<END;
-- </TABLE>
-- </CENTER>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# part_svc.cgi: browse part_svc
--#
--# ivan@sisd.com 97-nov-14, 97-dec-9
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# lose background, FS::CGI ivan@sisd.com 98-sep-2
--
--use strict;
--use CGI::Base;
--use FS::UID qw(cgisuidsetup swapuid);
--use FS::Record qw(qsearch);
--use FS::part_svc qw(fields);
--use FS::CGI qw(header menubar);
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--
--&cgisuidsetup($cgi);
--
--SendHeaders(); # one guess.
--print header('Service Part Listing', menubar(
-- 'Main Menu' => '../',
-- 'Add new service' => "../edit/part_svc.cgi",
--)),<<END;
-- <BR>Click on service part number to edit.
-- <TABLE BORDER>
-- <TR>
-- <TH>Part #</TH>
-- <TH>Service</TH>
-- <TH>Table</TH>
-- <TH>Field</TH>
-- <TH>Action</TH>
-- <TH>Value</TH>
-- </TR>
--END
--
--my($part_svc);
--foreach $part_svc ( sort {
-- $a->getfield('svcpart') <=> $b->getfield('svcpart')
--} qsearch('part_svc',{}) ) {
-- my($hashref)=$part_svc->hashref;
-- my($svcdb)=$hashref->{svcdb};
-- my(@rows)=
-- grep $hashref->{${svcdb}.'__'.$_.'_flag'},
-- map { /^${svcdb}__(.*)$/; $1 }
-- grep ! /_flag$/,
-- grep /^${svcdb}__/,
-- fields('part_svc')
-- ;
-- my($rowspan)=scalar(@rows);
-- print <<END;
-- <TR>
-- <TD ROWSPAN=$rowspan><A HREF="../edit/part_svc.cgi?$hashref->{svcpart}">
-- $hashref->{svcpart}
-- </A></TD>
-- <TD ROWSPAN=$rowspan>$hashref->{svc}</TD>
-- <TD ROWSPAN=$rowspan>$hashref->{svcdb}</TD>
--END
-- my($row);
-- foreach $row ( @rows ) {
-- my($flag)=$part_svc->getfield($svcdb.'__'.$row.'_flag');
-- print "<TD>$row</TD><TD>";
-- if ( $flag eq "D" ) { print "Default"; }
-- elsif ( $flag eq "F" ) { print "Fixed"; }
-- else { print "(Unknown!)"; }
-- print "</TD><TD>",$part_svc->getfield($svcdb."__".$row),"</TD></TR><TR>";
-- }
--print "</TR>";
--}
--
--print <<END;
-- </TABLE>
-- </CENTER>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# svc_acct_pop.cgi: browse pops
--#
--# ivan@sisd.com 98-mar-8
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# lose background, FS::CGI ivan@sisd.com 98-sep-2
--
--use strict;
--use CGI::Base;
--use FS::UID qw(cgisuidsetup swapuid);
--use FS::Record qw(qsearch qsearchs);
--use FS::CGI qw(header menubar);
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--
--&cgisuidsetup($cgi);
--
--SendHeaders(); # one guess.
--print header('POP Listing', menubar(
-- 'Main Menu' => '../',
-- 'Add new POP' => "../edit/svc_acct_pop.cgi",
--)), <<END;
-- <BR>Click on pop number to edit.
-- <TABLE BORDER>
-- <TR>
-- <TH><FONT SIZE=-1>POP #</FONT></TH>
-- <TH>City</TH>
-- <TH>State</TH>
-- <TH>Area code</TH>
-- <TH>Exchange</TH>
-- </TR>
--END
--
--my($svc_acct_pop);
--foreach $svc_acct_pop ( sort {
-- $a->getfield('popnum') <=> $b->getfield('popnum')
--} qsearch('svc_acct_pop',{}) ) {
-- my($hashref)=$svc_acct_pop->hashref;
-- print <<END;
-- <TR>
-- <TD><A HREF="../edit/svc_acct_pop.cgi?$hashref->{popnum}">
-- $hashref->{popnum}</A></TD>
-- <TD>$hashref->{city}</TD>
-- <TD>$hashref->{state}</TD>
-- <TD>$hashref->{ac}</TD>
-- <TD>$hashref->{exch}</TD>
-- </TR>
--END
--
--}
--
--print <<END;
-- </TABLE>
-- </CENTER>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--<head>
-- <title>Administration</title>
--</head>
--<body>
-- <h1>Administration</h1>
--</body>
+++ /dev/null
--<head>
-- <title>Billing</title>
--</head>
--<body>
-- <h1>Billing</h1>
-- The bin/bill script can be run daily to bill all customers. Usage: bill [ -c [ i ] ] [ -d <i>date</i> ] [ -b ]
-- <ul>
-- <li>-c: Turn on collecting (you probably want this).
-- <li>-i: Real-time billing (as opposed to bacth billing). Only relevant for credit cards. Not available without modifying site_perl/Bill.pm
-- <li>-d: Pretend it is <i>date</i> (parsed by Date::Parse)
-- <li>-b: N/A
-- </ul>
-- Printing should be configured on your freeside machine to print invoices.
-- <br><br>Batch credit card processing
-- <ul>
-- <li>After this script is run, a credit card batch will be in the <a href="schema.html#cust_pay_batch">cust_pay_batch</a> table. Export this table to your credit card batching.
-- <li>When your batch completes, erase the cust_pay_batch records in that batch and add any necessary paymants to the <a href="schema.html#cust_pay">cust_pay</a> table. Example code to add payments is:
-- <pre>use FS::cust_pay;
--
--# loop over all records in batch
--
--my $payment=create FS::cust_pay (
-- 'invnum' => $invnum,
-- 'paid' => $paid,
-- '_date' => $_date,
-- 'payby' => $payby,
-- 'payinfo' => $payinfo,
-- 'paybatch' => $paybatch,
--);
--
--my $error=$payment->insert;
--if ( $error ) {
-- #process error
--}
--
--# end loop
--</pre>
--All fields except paybatch are contained in the cust_pay_batch table. You can use paybatch field to track particular batches and/or particular transactions within a batch.
-- </ul>
--</body>
+++ /dev/null
--<head>
-- <title>Configuration files</title>
--</head>
--<body>
-- <h1>Configuration files</h1>
--Configuration files and directories are located in `/var/spool/freeside/conf'.
--<ul>
-- <li>address - Your company name and address, four lines.
-- <li>bsdshellmachines - Your BSD flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd' and `/etc/master.passwd'.
-- <li>cybercash2 - <a href="http://www.cybercash.com/cybercash/services/cashreg214.html">CyberCash v2</a> support, four lines: paymentserverhost, paymentserverport, paymentserversecret, and transaction type (`mauthonly' or `mauthcapture'). CCLib.pm is required.
-- <li>cybercash3.2 - <a href="http://www.cybercash.com/cybercash/services/technology.html">CyberCash v3.2</a> support. Two lines: the full path and name of your merchant_conf file, and the transaction type (`mauthonly' or `mauthcapture'). CCMckLib3_2.pm, CCMckDirectLib3_2.pm and CCMckErrno3_2 are required.
-- <li>domain - Your domain name.
-- <li>erpcdmachines - Your ERPCD authenticaion machines, one per line. This enables export of `/usr/annex/acp_passwd' and `/usr/annex/acp_dialup'.
-- <li>home - For new users, prefixed to usrename to create a directory name. Should have a leading but not a trailing slash.
-- <li>lpr - Print command for paper invoices, for example `lpr -h'.
-- <li>nismachines - Your NIS master (not slave master) machines, one per line. This enables export of `/etc/global/passwd' and `/etc/global/shadow'.
-- <li>qmailmachines - Your qmail machines, one per line. This enables export of `/var/qmail/control/virtualdomains', `/var/qmail/control/recipientmap', and `/var/qmail/control/rcpthosts'. The existance of this file (even if empty) also turns on user `.qmail-extension' file maintenance in conjunction with `shellmachine'.
-- <li>radiusmachines - Your RADIUS authentication machines, one per line. This enables export of `/etc/raddb/users'.
-- <li>registries - Directory which contains domain registry information. Each registry is a directory.
-- <ul>
-- <li>registries/internic - Currently the only supported registry
-- <ul>
-- <li>registries/internic/from - Email address from which InterNIC domain registrations are sent.
-- <li>regestries/internic/nameservers - The nameservers for InterNIC domain registrations, one per line. Each line contains an IP address and hostname, separated by whitespace.
-- <li>registries/internic/tech_contact - Technical contact NIC handle for domain registrations.
-- <li>registries/internic/template - Template for InterNIC domain registrations with special markup. A suitable copy of the InterNIC domain template v4.0 is in `fs-x.y.z/etc/domain-template.txt'.
-- <li>registries/internic/to - Email address to which InterNIC domain registrations are sent.
-- </ul>
-- </ul>
-- <li>secrets - Three lines: Database engine datasource (for example, `DBI:mysql:freeside' or `DBI:Pg:dbname=freeside'), username, and password. This file should not be world readable.
-- <li>sendmailmachines - Your sendmail machines, one per line. This enables export of `/etc/virtusertable' and `/etc/sendmail.cw'.
-- <li>shellmachine - A single machine with user home directories mounted. This enables home directory creation, renaming and archiving/deletion. In conjunction with `qmailmachines', it also enables `.qmail-extension' file maintenance.
-- <li>shellmachines - Your Linux and System V flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd' and `/etc/shadow' files.
-- <li>shells - Legal shells (think /etc/shells). You probably want to `cut -d: -f7 /etc/passwd | sort | uniq' initially so that importing doesn't fail with `Illegal shell' errors, then remove any special entries afterwords. A blank line specifies that an empty shell is permitted.
-- <li>smtpmachine - SMTP relay for Freeside's outgoing mail.
--</ul>
--</body>
--
+++ /dev/null
--<head>
-- <title>File exporting</title>
--</head>
--<body>
-- <h1>File exporting</h1>
-- <ul>
-- <li>bin/svc_acct.export will create UNIX `passwd', `shadow' and `master.passwd' files, ERPCD `acp_passwd' and `acp_dialup' files and a RADIUS `users' file in the `/var/spool/freeside/export' directory. Using the appropriate <a href="config.html">configuration files</a>, you can export these files to your remote machines unattended; see below.
-- <ul>
-- <li>shellmachines - passwd and shadow are copied to the remote machine as /etc/passwd.new and /etc/shadow.net and then moved to /etc/passwd and /etc/shadow if no errors occur.
-- <li>bsdshellmachines - passwd and master.passwd are copied to the remote machine as /etc/passwd.new and /etc/master.passwd.new and moved to /etc/passwd and /etc/master.passwd if no errors occur.
-- <li>nismachines - passwd and shadow are copied to the `/etc/global' directory on the remote machine. If no errors occur, the command `( cd /var/yp; make; )' is executed on the remote machine.
-- <li>erpcdmachines - acp_passwd and acp_dialup are copied to the `/usr/annex' directory on the remote machine. If no errors occur, the command `( kill -USR1 `cat /usr/annex/erpcd.pid` )' is executed on the remote machine.
-- <li>radiusmachines - users is copied to the `/etc/raddb' directory on the remote machine. If no errors occur, the command `( builddbm )' is executed on the remote machine.
-- </ul>
-- <li>site_perl/svc_acct.pm - If a shellmachine is defined, users can be created, modified and deleted remotely; see below.
-- <ul>
-- <li>The command `useradd -d <i>homedir</i> -s <i>shell</i> -u <i>uid</i> <i>username</i>' is executed when a user is added.
-- <li>The command `userdel <i>username</i>' is executed with a user is deleted.
-- <li>If a user's home directory changes, the command `[ -d <i>old_homedir</i> && ( chmod u+t <i>old_homedir</i>; umask 022; mkdir <i>new_homedir</i>; cd <i>old_homedir</i>; find . -depth -print | cpio -pdm <i>new_homedir</i>; chmod u-t <i>new_homedir</i>; chown -R <i>uid</i>.<i>gid</i> <i>new_homedir</i>; rm -rf <i>old_homedir</i> )' is executed.
-- </ul>
-- <li>bin/svc_acct_sm.export will create <a href="http://www.qmail.org">Qmail</a> `rcpthosts', `recipientmap' and `virtualdomains' files and <a href="http://www.sendmail.org">Sendmail</a> `virtusertable' and `sendmail.cw' files in the `/var/spool/freeside/export' directory. Using the appropriate <a href="config.html">configuration files</a>, you can export these files to your remote machines unattemded; see below.
-- <ul>
-- <li>qmailmachines - recipientmap, virtualdomains and rcpthosts are copied to the `/var/qmail/control' directory on the remote machine. Note: If you <a href="legacy.html#svc_acct_sm">imported</a> qmail configuration files, run the generated `/var/spool/freeside/export/virtualdomains.FIX' on a machine with your user home directories before exporting qmail configuration files.
-- <li>shellmachine - The command `[ -e <i>homedir</i>/.qmail-default ] || { touch <i>homedir</i>/.qmail-default; chown <i>uid</i>.<i>gid</i> <i>homedir</i>/.qmail-default; }' will be run on this machine for users in the virtualdomains file.
-- <li>sendmailmachines - sendmail.cw and virtusertable are copied to the remote machine as /etc/sendmail.cw.new and /etc/virtusertable.new and moved to /etc/sendmail.cw and /etc/virtusertable if no errors occur.
-- </ul>
-- <li>site_perl/svc_acct_sm.pm - If the qmailmachines configuration file exists and a shellmachine is defined, user `.qmail-' files can be updated.
-- <ul>
-- <li>The command `[ -e <i>homedir</i>/.qmail-<i>domain</i>-default ] || { touch <i>homedir</i>/.qmail-<i>domain</i>-default; chown <i>uid</i>.<i>gid</i> <i>homedir</i>/.qmail-<i>domain</i>-default; }' is run.
-- </ul>
-- </ul>
-- <br><a name=ssh>Unattended remote login</a> - Freeside can login to remote machines unattended using SSH. This can pose a security risk if not configured correctly, and will allow an intruder who breaks into your freeside machine full access to your remote machines. <b>Do not use this feature unless you understand what you are doing!</b>
-- <ul>
-- <li>As the freeside user (on your freeside machine), generate an authentication key using <a href="http://www.tac.nyc.ny.us/cgi-bin/man-cgi?ssh-keygen+1">ssh-keygen</a>. Since this is for unattended operation, you need to use a blank passphrase.
-- <li>Append the newly-created identity.pub file to root's authorized_keys on the remote machine(s).
-- </ul>
--
--</body>
--
+++ /dev/null
--<head>
-- <title>Documentation</title>
--</head>
--<body>
-- <h1>Documentation</h1>
--<ul>
-- <li><a href="install.html">New Installation</a>
-- <li><a href="upgrade.html">Upgrading from 1.0.x to 1.1.x</a>
- <li><a href="upgrade2.html">Upgrading from 1.1.x to 1.1.3</a>
- <li><a href="upgrade2.html">Upgrading from 1.1.x to 1.1.4</a>
-- <li><a href="config.html">Configuration files</a>
--<!--
-- <li><a href="admin.html">Administration</a>
--!-->
-- <li><a href="../index.html#admin">Administration</a>
-- <li><a href="legacy.html">Importing legacy data</a>
-- <li><a href="export.html">File exporting and remote setup</a>
-- <li><a href="passwd.html">fs_passwd</a>
-- <li><a href="billing.html">Billing</a>
-- <li><a href="trouble.html">Troubleshooting</a>
-- <li><a href="schema.html">Schema reference</a>
-- <li><a href="man/">Perl API</a>
--</ul>
--</body>
+++ /dev/null
--<head>
-- <title>Installation</title>
--</head>
--<body>
--<h1>Installation</h1>
--Before installing, you need:
--<ul>
-- <li>A web server, such as <a href="http://www.apache-ssl.org">Apache-SSL</a> or <a href="http://www.apache.org">Apache</a>
-- <li><a href="ftp://ftp.cs.hut.fi/pub/ssh/">SSH</a>
-- <li>agrep from the <a href="http://glimpse.cs.arizona.edu">Glimpse</a> distribution, if you want fuzzy searching capability
-- <li><a href="http://www.perl.com/CPANl/doc/relinfo/INSTALL.html">Perl</a> (at least 5.004_04)
-- <li>A database engine supported by Perl's <a href="http://www.hermetica.com/technologia/DBI/">DBI</a>, such as <a href="http://www.tcx.se/">MySQL</a> or <a href="http://www.postgresql.org/">PostgreSQL</a>
-- <li>Perl modules
-- <ul>
-- <li><a href="http://www.perl.com/CPAN/modules/by-module/MIME/">MIME-Base64</a>
-- <li><a href="http://www.perl.com/CPAN/modules/by-module/Data">Data-Dumper</a>
-- <li><a href="http://www.perl.com/CPAN/modules/by-module/MD5">MD5</a>
-- <li><a href="http://www.perl.com/CPAN/modules/by-module/Net">libnet</a>
-- <li><a href="http://www.perl.com/CPAN/modules/by-module/LWP/">libwww-perl</a>
-- <li><a href="http://www.perl.com/CPAN/modules/by-module/CGI/">CGI-modules</a> (<b>NOT</b> CGI.pm) with this <a href="CGI-modules-2.76-patch.txt">patch</a> applied
-- <li><a href="http://www.perl.com/CPAN/modules/by-module/Business/">Business-CreditCard</a>
-- <li><a href="http://www.perl.com/CPAN/modules/by-module/Data/">Data-ShowTable</a>
-- <li><a href="http://www.perl.com/CPAN/modules/by-module/Mail/">MailTools</a>
-- <li><a href="http://www.perl.com/CPAN/modules/by-module/Time/">TimeDate</a>
-- <li><a href="http://www.perl.com/CPAN/modules/by-module/Date/">DateManip</a>
-- <li><a href="http://www.perl.com/CPAN/modules/by-module/File/">File-CounterFile</a>
-- <li><a href="http://www.perl.com/CPAN/modules/by-module/FreezeThaw/">FreezeThaw</a>
-- <li><a href="http://www.perl.com/CPAN/modules/by-module/DBI/">DBI
-- <li><a href="http://www.perl.com/CPAN/modules/by-module/DBD/">DBD for your database engine</a>
-- </ul>
--</ul>
--Install the Freeside distribution:
--<ul>
-- <li>Add the user `freeside' to your system.
-- <li>Add the freeside database to your database engine. (with <a href="http://www.mysql.com/Manual_chapter/manual_Syntax.html#Create database">MySQL</a>) (with <a href="http://www.postgresql.org/docs/admin/manage-ag.htm#AEN854">PostgreSQL</a>)
-- <li>Allow the freeside user full access to the freeside database. (with <a href="http://www.mysql.com/Manual_chapter/manual_Privilege_system.html#Privilege system">MySQL</a>) (with <a href="http://www.postgresql.org/docs/admin/newuser.htm">PostgreSQL</a>)
-- <li>Unpack the tarball: <pre>gunzip -c fs-x.y.z.tar.gz | tar xvf -</pre>
-- <li>Copy or link fs-x.y.z/site_perl to FS in your site_perl directory. (try `<code>perl -V</code>' if unsure) <pre>mkdir /usr/local/lib/site_perl/FS
--cp fs-x.y.z/site_perl/* /usr/local/lib/site_perl/FS</pre> or <pre>ln -s /full/path/to/fs-x.y.z/site_perl /usr/local/lib/site_perl/FS</pre>
-- <li>Copy or link fs-x.y.z/htdocs to your web server's document space. <pre>mkdir /usr/local/apache/htdocs/freeside
--cp -r fs-x.y.z/htdocs/* /usr/local/apache/htdocs/freeside</pre> or <pre>ln -s /full/path/to/fs-x.y.z/htdocs /usr/local/apache/htdocs/freeside</pre>
-- <li>Restrict access to this web interface. (with <a href="http://www.apache.org/docs/misc/FAQ.html#user-authentication">Apache</a>)
-- <li>Enable CGI execution for files with the `.cgi' extension. (with <a href="http://www.apache.org/docs/mod/mod_mime.html#addhandler">Apache</a>)
-- <li>Set ownership and permissions for the web interface. Your system should support secure setuid scripts or Perl's emulation, see <a href="http://www.perl.com/CPAN-local/doc/manual/html/pod/perlsec.html#Security_Bugs">perlsec: Security Bugs</a> for information and workarounds.
--<pre>cd /usr/local/apache/htdocs/freeside
--chown -R freeside .
--chmod 4755 browse/*.cgi edit/*.cgi edit/process/*.cgi misc/*.cgi misc/process/*.cgi search/*.cgi view/*.cgi</pre>
--<li>Create the base Freeside directory `/var/spool/freeside', and the subdirectories `conf', `counters', and `export'. <pre>mkdir /var/spool/freeside
--mkdir /var/spool/freeside/conf
--mkdir /var/spool/freeside/counters
--mkdir /var/spool/freeside/export
--chown -R freeside /var/spool/freeside</pre>
-- <li>Create the necessary <a href="config.html">configuration files</a>.
-- <li>Run bin/fs-setup to create the database tables.
--</ul>
--</body>
+++ /dev/null
--<head>
-- <title>Importing legacy data</title>
--</head>
--<body>
-- <h1>Importing legacy data</h1>
--<ul>
-- <li><a name="svc_acct">bin/svc_acct.import</a> - Import `passwd', ( `shadow' or `master.passwd' ) and RADIUS `users'. Before running bin/svc_acct.import, you need <a href="http://rootwood.sisd.com/freeside/browse/part_svc.cgi">services</a> (with table svc_acct) as follows:
-- <ul>
-- <li>Most accounts probably have entries in passwd and users (with Port-Limit nonexistant or 1)
-- <li>Some accounts have entries in passwd and users, but with Port-Limit 2 (or more)
-- <li>Some accounts might have entries in users only (Port-Limit 1)
-- <li>Some accounts might have entries in users only (Port-Limit >= 2)
-- <li>POP mail accounts have entries in passwd only, and have a particular shell.
-- <li>Everything else in passwd is a shell account.
-- </ul>
-- <li><a name="svc_acct_sm">bin/svc_acct_sm.import</a> - Import qmail ( `virtualdomains' and `rcpthosts' ), or sendmail ( `virtusertable' and `sendmail.cw' ) files. Before running bin/svc_acct_sm.import, you need <a href="http://rootwood.sisd.com/freeside/browse/part_svc.cgi">services</a> as follows:
-- <ul>
-- <li>Domain (table svc_acct)
-- <li>Mail alias (table svc_acct_sm)
-- </ul>
-- <li><a name="cust_main">Importing customer data</a>
-- <ul>
-- <li>Manually
-- <ul>
-- <li>Add a <a href="../edit/cust_main.cgi">new customer</a>
-- <li>Add one or more packages for this customer
-- <li>Enter a package by clicking on the package number
-- <li>Pick the `Link to existing' option
-- </ul>
-- <li>Batch - You will need to write a script to import your particular legacy data. You can use eg/TEMPLATE_cust_main.import as a starting point.
-- </ul>
--</ul>
--</body>
--
+++ /dev/null
--<head>
-- <title>fs_passwd</title>
--</head>
--<body>
-- <h1>fs_passwd</h1>
--You may use fs_passwd/fs_passwd as a "passwd", "chfn" and "chsh" replacement on your shell machine(s) to cause password, gecos and shell changes to update your freeside machine. This can pose a security risk if not configured correctly. <b>Do not use this feature unless you understand what you are doing!</b>
--<br><br>Currently it is assumed that the the crypt(3) function in the C library is the same on the Freeside machine as on the target machine.
--<ul>
-- <li>Create a freeside account on the shell machine(s).
-- <li>Append the identity.pub from the freeside user on your freeside machine to the authorized_keys file of the newly created freeside user on the shell machine(s).
-- <li>Copy fs_passwd/fs_passwd to /usr/local/bin on the shell machine(s). (chown freeside, chmod 4755). You may link it to passwd, chfn and chsh as well.
-- <li>Copy fs_passwd/fs_passwdd to /usr/local/sbin on the shell machine(s). (chown freeside, chmod 500)
-- <li>Create /usr/local/freeside on the shell machine(s). (chown freeside, chmod 700)
-- <li>Run an iteration of "fs_passwd/fs_passwd_server shell.machine" as the freeside user for each shell machine (this is a daemon process).
--</ul>
--</body>
+++ /dev/null
--<head>
-- <title>Schema reference</title>
--</head>
--<body>
-- <h1>Schema reference</h1>
-- <ul>
-- <li><a name="agent">agent</a> - Agents are resellers of your service. Agents may be limited to a subset of your full offerings (via their agent type).
-- <ul>
-- <li>agentnum - primary key
-- <li>agent - name of this agent
-- <li>typenum - <a href="#agent_type">agent type</a>
-- <li>prog - (unimplemented)
-- <li>freq - (unimplemented)
-- </ul>
-- <li><a name="agent_type">agent_type</a> - Agent types define groups of packages that you can then assign to particular agents.
-- <ul>
-- <li>typenum - primary key
-- <li>atype - name of this agent type
-- </ul>
-- <li><a name="cust_bill">cust_bill</a> - Invoices
-- <ul>
-- <li>invnum - primary key
-- <li>custnum - <a href="#cust_main">customer</a>
-- <li>_date
-- <li>charged - amount of this invoice
-- <li>owed - amount still outstanding on this invoice
-- <li>printed - how many times this invoice has been printed automatically
-- </ul>
-- <li><a name="cust_bill_pkg">cust_bill_pkg</a> - Invoice line items
-- <ul>
-- <li>invnum - (multiple) key
-- <li>pkgnum - <a href="#cust_pkg">package</a>
-- <li>setup - setup fee
-- <li>recur - recurring fee
-- <li>sdate - starting date
-- <li>edate - ending date
-- </ul>
-- <li><a name="cust_credit">cust_credit</a> - Credits
-- <ul>
-- <li>crednum - primary key
-- <li>custnum - <a href="#cust_main">customer</a>
-- <li>amount - amount credited
-- <li>credited - amount still outstanding (not yet refunded) on this credit
-- <li>_date
-- <li>otaker - order taker
-- <li>reason
-- </ul>
-- <li><a name="cust_main">cust_main</a> - Customers
-- <ul>
-- <li>custnum - primary key
-- <li>agentnum - <a href="#agent">agent</a>
-- <li>refnum - <a href="#part_referral">referral</a>
-- <li>first - name
-- <li>last - name
-- <li>ss - social security number
-- <li>company
-- <li>address1
-- <li>address2
-- <li>city
-- <li>county
-- <li>state
-- <li>zip
-- <li>country
-- <li>daytime - phone
-- <li>night - phone
-- <li>payby - CARD, BILL, or COMP
-- <li>payinfo - card number, P.O.#, or comp issuer
-- <li>paydate - expiration date
-- <li>payname - billing name (name on card)
-- <li>tax - tax exempt, Y or null
-- <li>otaker - order taker
-- </ul>
-- <li><a name="cust_main_county">cust_main_county</a> - Tax rates
-- <ul>
-- <li>taxnum - primary key
-- <li>state
-- <li>county
-- <li>tax - % rate
-- </ul>
-- <li><a name="cust_pay">cust_pay</a> - Payments
-- <ul>
-- <li>paynum - primary key
-- <li>invnum - <a href="#cust_bill">invoice</a>
-- <li>paid - amount
-- <li>_date
-- <li>payby - CARD, BILL, or COMP
-- <li>payinfo - card number, P.O.#, or comp issuer
-- <li>paybatch - text field for tracking card processor batches
-- </ul>
-- <li><a name="cust_pay_batch">cust_pay_batch</a> - Pending batch
-- <ul>
-- <li>trancode - 77 for charges
-- <li>cardnum
-- <li>exp - card expiration
-- <li>amount
-- <li>invnum - <a href="#cust_bill">invoice</a>
-- <li>custnum - <a href="#cust_main">customer</a>
-- <li>payname - name on card
-- <li>first - name
-- <li>last - name
-- <li>address1
-- <li>address2
-- <li>city
-- <li>state
-- <li>zip
-- <li>country
-- </ul>
-- <li><a name="cust_pkg">cust_pkg</a> - Customer billing items
-- <ul>
-- <li>pkgnum - primary key
-- <li>custnum - <a href="#cust_main">customer</a>
-- <li>pkgpart - <a href="#part_pkg">Package definition</a>
-- <li>setup - date
-- <li>bill - next bill date
-- <li>susp - (past) suspension date
-- <li>expire - (future) cancellation date
-- <li>cancel - (past) cancellation date
-- <li>otaker - order taker
-- </ul>
-- <li><a name="cust_refund">cust_refund</a> - Refunds
-- <ul>
-- <li>refundnum - primary key
-- <li>crednum - <a href="#cust_credit">credit</a>
-- <li>refund - amount
-- <li>_date
-- <li>payby - CARD, BILL or COMP
-- <li>payinfo - card number, P.O.#, or comp issuer
-- <li>otaker - order taker
-- </ul>
-- <li><a name="cust_svc">cust_svc</a> - Customer services
-- <ul>
-- <li>svcnum - primary key
-- <li>pkgnum - <a href="#cust_pkg">package</a>
-- <li>svcpart - <a href="#part_svc">Service definition</a>
-- </ul>
-- <li><a name="part_pkg">part_pkg</a> - Package definitions
-- <ul>
-- <li>pkgpart - primary key
-- <li>pkg - package name
-- <li>comment - non-customer visable package comment
-- <li>setup - setup fee
-- <li>freq - recurring frequency (months)
-- <li>recur - recurring fee
-- </ul>
-- <li><a name="part_referral">part_referral</a> - Referral listing
-- <ul>
-- <li>refnum</li> - primary key
-- <li>referral</li> - referral
-- </ul>
-- <li><a name="part_svc">part_svc</a> - Service definitions
-- <ul>
-- <li>svcpart - primary key
-- <li>svc - name of this service
-- <li>svcdb - table used for this service: svc_acct, svc_acct_sm, svc_domain, svc_charge or svc_wo
-- <li><i>table</i>__<i>field</i> - Default or fixed value for <i>field</i> in <i>table</i>
-- <li><i>table</i>__<i>field</i>_flag - null, D or F
-- </ul>
-- <li><a name="pkg_svc">pkg_svc</a>
-- <ul>
-- <li>pkgpart - <a href="#part_pkg">Package definition</a>
-- <li>svcpart - <a href="#part_svc">Service definition</a>
-- <li>quantity - quantity of this service that this package includes
-- </ul>
-- <li><a name="svc_acct">svc_acct</a> - Accounts
-- <ul>
-- <li>svcnum - <a href="#cust_svc">primary key</a>
-- <li>username
-- <li>_password
-- <li>popnum - <a href="#svc_acct_pop">Point of Presence</a>
-- <li>uid
-- <li>gid
-- <li>finger - GECOS
-- <li>dir
-- <li>shell
-- <li>quota - (unimplementd)
-- <li>slipip - IP address
-- <li>radius_<i>Radius_Attribute</i> - Radius-Attribute
-- </ul>
-- <li><a name="svc_acct_pop">svc_acct_pop</a> - Points of Presence
-- <ul>
-- <li>popnum - primary key
-- <li>city
-- <li>state
-- <li>ac - area code
-- <li>exch - exchange
-- </ul>
-- <li><a name="svc_acct_sm">svc_acct_sm</a> - Domain mail aliases
-- <ul>
-- <li>svcnum - <a href="#cust_svc">primary key</a>
-- <li>domsvc - <a href="#svc_domain">Domain</a> (by svcnum)
-- <li>domuid - <a href="#svc_acct">Account</a> (by uid)
-- <li>domuser - domuser @ <a href="#svc_domain">Domain</a> forwards to <a href="#svc_acct">Account</a>
-- </ul>
-- <li><a name="svc_domain">svc_domain</a> - Domains
-- <ul>
-- <li>svcnum - <a href="#cust_svc">primary key</a>
-- <li>domain
-- </ul>
-- <li><a name="type_pkgs">type_pkgs</a>
-- <ul>
-- <li>typenum - <a href="#agent_type">agent type</a>
-- <li>pkgpart - <a href="#part_pkg">Package definition</a>
-- </ul>
-- </ul>
--</body>
+++ /dev/null
--<head>
-- <title>Troubleshooting</title>
--</head>
--<body>
-- <h1>Troubleshooting</h1>
-- <ul>
-- <li>When troubleshooting the web interface, helpful information is often in your web server's error log.
-- <li>Internet Explorer will not work with Freeside's HTML interface.
--<a HREF="http://www.netscape.com">Netscape</a>,
--<a HREF="http://lynx.browser.org">Lynx</a>, and
--<a HREF="http://www.cs.indiana.edu/elisp/w3/docs.html">Emacs/W3</a>,
--among others, should work fine.
-- <li>If bin/svc_acct.import fails with an "Out of memory!" error using MySQL, upgrede MySQL and recompile the Perl DBD. There was a memory leak in some older versions of MySQL.
-- <li>If you get tons of errors in your web server's error log like this:
--<pre>
--Ambiguous use of value => resolved to "value" =>
--at /usr/lib/perl5/site_perl/File/CounterFile.pm line 132.
--</pre>
-- This clutters up your log files but is otherwise harmless. Upgrade to the latest File::CounterFile.
-- <li>If you get an Internal Server Error when adding or editing, but find that the update has occured, and you get something like the following in your web server's error log:
--<pre>
--access to <i>/your/path</i>/edit/process/<i>some_table</i>.cgi failed for
--<i>machine.domain.tld</i>, reason: malformed header from script.
--Bad header=HTTP/1.0 302 Moved Temporarily
--</pre>
-- Then you forgot to apply this <a href="CGI-modules-2.76-patch.txt">patch</a> as mentioned in the <a href="install.html">New Installation</a> section of the documentation.
-- <li>If you get errors like this:
--<pre>
--UID.pm: Can't open /var/spool/freeside/conf/secrets: Permission denied
--at <i>/your/path</i>/site_perl/FS/UID.pm line 26.
--BEGIN failed--compilation aborted at
--<i>/your/path</i>/edit/process/part_svc.cgi line 15.
--</pre>
-- Then the scripts are not running setuid freeside. If you were editing
--the files, it is possible you inadvertantly removed the setuid bit.
--As mentioned in the <a href="install.html">New Installation</a> section of the documentation, set ownership and permissions for the web interface. Your system should support secure setuid scripts or Perl's emulation, see <a href="http://www.perl.com/CPAN-local/doc/manual/html/pod/perlsec.html#Security_Bugs">perlsec: Security Bugs</a> for information and workarounds.
--<pre>cd /usr/local/apache/htdocs/freeside
--chown -R freeside .
--chmod 4755 browse/*.cgi edit/*.cgi edit/process/*.cgi misc/*.cgi misc/process/*.cgi search/*.cgi view/*.cgi</pre>
-- </ul>
--</body>
+++ /dev/null
--<head>
-- <title>Upgrading to 1.1.x</title>
--</head>
--<body>
--<h1>Upgrading to 1.1.x</h1>
--<ul>
-- <li>Back up your data and current Freeside installation.
-- <li>Unpack a copy of the 1.0.0 distribution in a separate location.
-- <li>Diff your current installation against the 1.0.0 distribution.
-- <li>Apply all the diffs you found above, if applicable.
-- <li>Apply (at least) the following changes to your database:
--<pre>
--ALTER TABLE cust_main CHANGE ss ss char(11) NULL;
--ALTER TABLE cust_main CHANGE day daytime varchar(20) NULL;
--ALTER TABLE svc_acct CHANGE password _password varchar(25) NOT NULL;
--ALTER TABLE part_svc CHANGE svc_acct__password svc_acct___password varchar(25) NULL;
--ALTER TABLE part_svc CHANGE svc_acct__password_flag svc_acct___password_flag char(1) NULL;
--ALTER TABLE agent_type CHANGE type atype varchar(80) NOT NULL;
--</pre>
-- <li>Optionally change the field lengths and types to match a 1.1.x install; see `bin/fs-setup'.
-- <li>Create the necessary <a href="config.html">configuration files</a>,
-- <li>Copy or symlink htdocs and site_perl to the new 1.1.x copies.
-- <li>Run bin/dbdef-create. This file uses MySQL-specific syntax. If you are running a different database engine you will need to modify it slightly.
--</body>
+++ /dev/null
--<head>
- <title>Upgrading to 1.1.3</title>
- <title>Upgrading to 1.1.4</title>
--</head>
--<body>
- <h1>Upgrading to 1.1.3 from 1.1.x</h1>
-<h1>Upgrading to 1.1.4 from 1.1.x</h1>
--<ul>
-- <li>If migrating from 1.0.0, see these <a href="upgrade.html">instructions</a> first.
-- <li>Back up your data and current Freeside installation.
-- <li>If applicable, create the new <a href="config.html">configuration files</a>: lpr, cybercash2, cybercash3.2
-- <li>Copy or symlink htdocs and site_perl to the new copies.
--</body>
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# agent.cgi: Add/Edit agent (output form)
--#
--# ivan@sisd.com 97-dec-12
--#
--# Changes to allow page to work at a relative position in server
--# Changed 'type' to 'atype' because Pg6.3 reserves the type word
--# bmccane@maxbaud.net 98-apr-3
--#
--# use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12
--
--use strict;
--use CGI::Base;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearch qsearchs);
--use FS::agent;
--use FS::CGI qw(header menubar);
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--
--&cgisuidsetup($cgi);
--
--SendHeaders(); # one guess.
--
--my($agent,$action);
--if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
-- $agent=qsearchs('agent',{'agentnum'=>$1});
-- $action='Edit';
--} else { #adding
-- $agent=create FS::agent {};
-- $action='Add';
--}
--my($hashref)=$agent->hashref;
--
--print header("$action Agent", menubar(
-- 'Main Menu' => '../',
-- 'View all agents' => '../browse/agent.cgi',
--)), '<FORM ACTION="process/agent.cgi" METHOD=POST>';
--
--print qq!<INPUT TYPE="hidden" NAME="agentnum" VALUE="$hashref->{agentnum}">!,
-- "Agent #", $hashref->{agentnum} ? $hashref->{agentnum} : "(NEW)";
--
--print <<END;
--<PRE>
--Agent <INPUT TYPE="text" NAME="agent" SIZE=32 VALUE="$hashref->{agent}">
--Agent type <SELECT NAME="typenum" SIZE=1>
--END
--
--my($agent_type);
--foreach $agent_type (qsearch('agent_type',{})) {
-- print "<OPTION";
-- print " SELECTED"
-- if $hashref->{typenum} == $agent_type->getfield('typenum');
-- print ">", $agent_type->getfield('typenum'), ": ",
-- $agent_type->getfield('atype'),"\n";
--}
--
--print <<END;
--</SELECT>
--Frequency (unimplemented) <INPUT TYPE="text" NAME="freq" VALUE="$hashref->{freq}">
--Program (unimplemented) <INPUT TYPE="text" NAME="prog" VALUE="$hashref->{prog}">
--</PRE>
--END
--
--print qq!<BR><INPUT TYPE="submit" VALUE="!,
-- $hashref->{agentnum} ? "Apply changes" : "Add agent",
-- qq!">!;
--
--print <<END;
-- </FORM>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# agent_type.cgi: Add/Edit agent type (output form)
--#
--# ivan@sisd.com 97-dec-10
--#
--# Changes to allow page to work at a relative position in server
--# Changed 'type' to 'atype' because Pg6.3 reserves the type word
--# bmccane@maxbaud.net 98-apr-3
--#
--# use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12
--
--use strict;
--use CGI::Base;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearch qsearchs);
--use FS::agent_type;
--use FS::CGI qw(header menubar);
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--
--&cgisuidsetup($cgi);
--
--SendHeaders(); # one guess.
--
--my($agent_type,$action);
--if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
-- $agent_type=qsearchs('agent_type',{'typenum'=>$1});
-- $action='Edit';
--} else { #adding
-- $agent_type=create FS::agent_type {};
-- $action='Add';
--}
--my($hashref)=$agent_type->hashref;
--
--print header("$action Agent Type", menubar(
-- 'Main Menu' => '../',
-- 'View all agent types' => '../browse/agent_type.cgi',
--)), '<FORM ACTION="process/agent_type.cgi" METHOD=POST>';
--
--print qq!<INPUT TYPE="hidden" NAME="typenum" VALUE="$hashref->{typenum}">!,
-- "Agent Type #", $hashref->{typenum} ? $hashref->{typenum} : "(NEW)";
--
--print <<END;
--<BR>Type <INPUT TYPE="text" NAME="atype" SIZE=32 VALUE="$hashref->{atype}">
--<P>Select which packages agents of this type may sell to customers</P>
--END
--
--my($part_pkg);
--foreach $part_pkg ( qsearch('part_pkg',{}) ) {
-- print qq!<BR><INPUT TYPE="checkbox" NAME="pkgpart!,
-- $part_pkg->getfield('pkgpart'), qq!" !,
-- # ( 'CHECKED 'x scalar(
-- qsearchs('type_pkgs',{
-- 'typenum' => $agent_type->getfield('typenum'),
-- 'pkgpart' => $part_pkg->getfield('pkgpart'),
-- })
-- ? 'CHECKED '
-- : '',
-- qq!"VALUE="ON"> !,$part_pkg->getfield('pkg')
-- ;
--}
--
--print qq!<BR><INPUT TYPE="submit" VALUE="!,
-- $hashref->{typenum} ? "Apply changes" : "Add agent type",
-- qq!">!;
--
--print <<END;
-- </FORM>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# cust_credit.cgi: Add a credit (output form)
--#
--# Usage: cust_credit.cgi custnum [ -paybatch ]
--# http://server.name/path/cust_credit?custnum [ -paybatch ]
--#
--# Note: Should be run setuid root as user nobody.
--#
--# some hooks in here for modifications as well as additions, but needs (lots) more work.
--# also see process/cust_credit.cgi, the script that processes the form.
--#
--# ivan@voicenet.com 96-dec-05
--#
--# paybatch field, differentiates between credits & credits+refunds by commandline
--# ivan@voicenet.com 96-dec-08
--#
--# added (but commented out) sprintf("%.2f" in amount field. Hmm.
--# ivan@voicenet.com 97-jan-3
--#
--# paybatch stuff thrown out - has checkbox now instead.
--# (well, sort of. still passed around for backward compatability and possible editing hook)
--# ivan@voicenet.com 97-apr-21
--#
--# rewrite ivan@sisd.com 98-mar-16
--
--use strict;
--use Date::Format;
--use CGI::Base qw(:DEFAULT :CGI); #CGI module
--use FS::UID qw(cgisuidsetup getotaker);
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--cgisuidsetup($cgi);
--
--#untaint custnum
--$QUERY_STRING =~ /^(\d+)$/;
--my($custnum)=$1;
--
--#untaint otaker
--my($otaker)=getotaker;
--
--SendHeaders(); # one guess.
--print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Post Credit</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H1>Post Credit</H1>
-- </CENTER>
-- <FORM ACTION="process/cust_credit.cgi" METHOD=POST>
-- <HR><PRE>
--END
--
--#crednum
--my($crednum)="";
--print qq!Credit #<B>!, $crednum ? $crednum : " <I>(NEW)</I>", qq!</B><INPUT TYPE="hidden" NAME="crednum" VALUE="$crednum">!;
--
--#custnum
--print qq!\nCustomer #<B>$custnum</B><INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!;
--
--#paybatch
--print qq!<INPUT TYPE="hidden" NAME="paybatch" VALUE="">!;
--
--#date
--my($date)=time;
--print qq!\nDate: <B>!, time2str("%D",$date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="$date">!;
--
--#amount
--my($amount)='';
--print qq!\nAmount \$<INPUT TYPE="text" NAME="amount" VALUE="$amount" SIZE=8 MAXLENGTH=8>!;
--
--#refund?
--#print qq! <INPUT TYPE="checkbox" NAME="refund" VALUE="yes">Also post refund!;
--
--#otaker (hidden)
--print qq!<INPUT TYPE="hidden" NAME="otaker" VALUE="$otaker">!;
--
--#reason
--my($reason)='';
--print qq!\nReason <INPUT TYPE="text" NAME="reason" VALUE="$reason" SIZE=72>!;
--
--print <<END;
--</PRE>
--<BR>
--<CENTER><INPUT TYPE="submit" VALUE="Post"></CENTER>
--END
--
--print <<END;
--
-- </FORM>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# cust_main.cgi: Edit a customer (output form)
--#
--# Usage: cust_main.cgi custnum
--# http://server.name/path/cust_main.cgi?custnum
--#
--# Note: Should be run setuid freeside as user nobody.
--#
--# ivan@voicenet.com 96-nov-29 -> 96-dec-04
--#
--# Blank custnum for new customer.
--# ivan@voicenet.com 96-dec-16
--#
--# referral defaults to blank, to force people to pick something
--# ivan@voicenet.com 97-jun-4
--#
--# rewrote for new API
--# ivan@voicenet.com 97-jul-28
--#
--# new customer is null, not '#'
--# otaker gotten from &getotaker instead of $ENV{REMOTE_USER}
--# ivan@sisd.com 97-nov-12
--#
--# cgisuidsetup($cgi);
--# no need for old_ fields.
--# now state+county is a select field (took out PA hack)
--# used autoloaded $cust_main->field methods
--# ivan@sisd.com 97-dec-17
--#
--# fixed quoting problems ivan@sisd.com 98-feb-23
--#
--# paydate sql update ivan@sisd.com 98-mar-5
--#
--# Changes to allow page to work at a relative position in server
--# Changed 'day' to 'daytime' because Pg6.3 reserves the day word
--# Added test for paydate in mm-dd-yyyy format for Pg6.3 default format
--# bmccane@maxbaud.net 98-apr-3
--#
--# fixed one missed day->daytime ivan@sisd.com 98-jul-13
--
--use strict;
--use CGI::Base;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup getotaker);
--use FS::Record qw(qsearch qsearchs);
--use FS::cust_main;
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--
--cgisuidsetup($cgi);
--
--SendHeaders(); # one guess.
--
--#get record
--my($custnum,$action,$cust_main);
--if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
-- $custnum=$1;
-- $cust_main = qsearchs('cust_main',{'custnum'=>$custnum});
-- $action='Edit';
--} else {
-- $custnum='';
-- $cust_main = create FS::cust_main ( {} );
-- $cust_main->setfield('otaker',&getotaker);
-- $cust_main->setfield('country','US');
-- $action='Add';
--}
--
--print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Customer $action</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H1>Customer $action</H1>
-- </CENTER>
-- <FORM ACTION="process/cust_main.cgi" METHOD=POST>
-- <PRE>
--END
--
--print qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!,
-- qq!Customer #<FONT SIZE="+1"><B>!;
--print $custnum ? $custnum : " (NEW)" , "</B></FONT>";
--
--#agentnum
--my($agentnum)=$cust_main->agentnum || 1; #set to first agent by default
--my(@agents) = qsearch('agent',{});
--print qq!\n\nAgent # <SELECT NAME="agentnum" SIZE="1">!;
--my($agent);
--foreach $agent (sort {
-- $a->agent cmp $b->agent;
--} @agents) {
-- print "<OPTION" . " SELECTED"x($agent->agentnum==$agentnum),
-- ">", $agent->agentnum,": ", $agent->agent, "\n";
--}
--print "</SELECT>";
--
--#referral
--#unless ($custnum) {
-- my($refnum)=$cust_main->refnum || 0; #to avoid "arguement not numeric" error
-- my(@referrals) = qsearch('part_referral',{});
-- print qq!\nReferral <SELECT NAME="refnum" SIZE="1">!;
-- print "<OPTION> \n";
-- my($referral);
-- foreach $referral (sort {
-- $a->refnum <=> $b->refnum;
-- } @referrals) {
-- print "<OPTION" . " SELECTED"x($referral->refnum==$refnum),
-- ">", $referral->refnum, ": ", $referral->referral,"\n";
-- }
-- print "</SELECT>";
--#}
--
--my($last,$first,$ss,$company,$address1,$address2,$city)=(
-- $cust_main->last,
-- $cust_main->first,
-- $cust_main->ss,
-- $cust_main->company,
-- $cust_main->address1,
-- $cust_main->address2,
-- $cust_main->city,
--);
--
--print <<END;
--
--
--Name (last)<INPUT TYPE="text" NAME="last" VALUE="$last"> (first)<INPUT TYPE="text" NAME="first" VALUE="$first"> SS# <INPUT TYPE="text" NAME="ss" VALUE="$ss" SIZE=11 MAXLENGTH=11>
--Company <INPUT TYPE="text" NAME="company" VALUE="$company">
--Address <INPUT TYPE="text" NAME="address1" VALUE="$address1" SIZE=40 MAXLENGTH=40>
-- <INPUT TYPE="text" NAME="address2" VALUE="$address2" SIZE=40 MAXLENGTH=40>
--City <INPUT TYPE="text" NAME="city" VALUE="$city"> State (county) <SELECT NAME="state" SIZE="1">
--END
--
--foreach ( qsearch('cust_main_county',{}) ) {
-- print "<OPTION";
-- print " SELECTED" if ( $cust_main->state eq $_->state
-- && $cust_main->county eq $_->county );
-- print ">",$_->state;
-- print " (",$_->county,")" if $_->county;
--}
--print "</SELECT>";
--
--my($zip,$country,$daytime,$night,$fax)=(
-- $cust_main->zip,
-- $cust_main->country,
-- $cust_main->daytime,
-- $cust_main->night,
-- $cust_main->fax,
--);
--
--print <<END;
-- Zip <INPUT TYPE="text" NAME="zip" VALUE="$zip" SIZE=10 MAXLENGTH=10>
--Country: <FONT SIZE="+1"><B>$country</B></FONT><INPUT TYPE="hidden" NAME="country" VALUE="$country">
--
--Phone (daytime)<INPUT TYPE="text" NAME="daytime" VALUE="$daytime" SIZE=18 MAXLENGTH=20> (night)<INPUT TYPE="text" NAME="night" VALUE="$night" SIZE=18 MAXLENGTH=20> (fax)<INPUT TYPE="text" NAME="fax" VALUE="$fax" SIZE=12 MAXLENGTH=12>
--
--END
--
--my(%payby)=(
-- 'CARD' => "Credit card ",
-- 'BILL' => "Billing ",
-- 'COMP' => "Complimentary",
--);
--for (qw(CARD BILL COMP)) {
-- print qq!<INPUT TYPE="radio" NAME="payby" VALUE="$_"!;
-- print qq! CHECKED! if ($cust_main->payby eq "$_");
-- print qq!>$payby{$_}!;
--}
--
--
--my($payinfo,$payname,$otaker)=(
-- $cust_main->payinfo,
-- $cust_main->payname,
-- $cust_main->otaker,
--);
--
--my($paydate);
--if ( $cust_main->paydate =~ /^(\d{4})-(\d{2})-\d{2}$/ ) {
-- $paydate="$2/$1"
--} elsif ( $cust_main->paydate =~ /^(\d{2})-\d{2}-(\d{4}$)/ ) {
-- $paydate="$1/$2"
--}
--else {
-- $paydate='';
--}
--
--print <<END;
--
-- Card number , P.O. # or Authorization <INPUT TYPE="text" NAME="payinfo" VALUE="$payinfo" SIZE=19 MAXLENGTH=19>
--END
--
--print qq!Exp. date (MM/YY or MM/YYYY)<INPUT TYPE="text" NAME="paydate" VALUE="$paydate" SIZE=8 MAXLENGTH=7> Billing name <INPUT TYPE="text" NAME="payname" VALUE="$payname">\n<INPUT TYPE="checkbox" NAME="tax" VALUE="Y"!;
--print qq! CHECKED! if $cust_main->tax eq "Y";
--print qq!> Tax Exempt!;
--
--print <<END;
--
--
--Order taken by: <FONT SIZE="+1"><B>$otaker</B></FONT><INPUT TYPE="hidden" NAME="otaker" VALUE="$otaker">
--</PRE>
--END
--
--print qq!<CENTER><INPUT TYPE="submit" VALUE="!,
-- $custnum ? "Apply Changes" : "Add Customer", qq!"></CENTER>!;
--
--print <<END;
--
-- </FORM>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# cust_main_county-expand.cgi: Expand a state into counties (output form)
--#
--# ivan@sisd.com 97-dec-16
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# lose background, FS::CGI ivan@sisd.com 98-sep-2
--
--use strict;
--use CGI::Base;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearch qsearchs);
--use FS::CGI qw(header menubar);
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--
--&cgisuidsetup($cgi);
--
--SendHeaders(); # one guess.
--
--$cgi->var('QUERY_STRING') =~ /^(\d+)$/
-- or die "Illegal taxnum!";
--my($taxnum)=$1;
--
--my($cust_main_county)=qsearchs('cust_main_county',{'taxnum'=>$taxnum});
--die "Can't expand entry!" if $cust_main_county->getfield('county');
--
--print header("Tax Rate (expand state)", menubar(
-- 'Main Menu' => '../',
--)), <<END;
-- <FORM ACTION="process/cust_main_county-expand.cgi" METHOD=POST>
-- <INPUT TYPE="hidden" NAME="taxnum" VALUE="$taxnum">
-- Separate counties by
-- <INPUT TYPE="radio" NAME="delim" VALUE="n" CHECKED>line
-- (rumor has it broken on some browsers) or
-- <INPUT TYPE="radio" NAME="delim" VALUE="s">whitespace.
-- <BR><INPUT TYPE="submit" VALUE="Submit">
-- <BR><TEXTAREA NAME="counties" ROWS=100></TEXTAREA>
-- </FORM>
-- </CENTER>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# cust_main_county.cgi: Edit tax rates (output form)
--#
--# ivan@sisd.com 97-dec-13-16
--#
--# Changes to allow page to work at a relative position in server
--# Changed tax field to accept 6 chars (MO uses 6.1%)
--# bmccane@maxbaud.net 98-apr-3
--#
--# lose background, FS::CGI ivan@sisd.com 98-sep-2
--
--use strict;
--use CGI::Base;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearch qsearchs);
--use FS::CGI qw(header menubar);
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--
--&cgisuidsetup($cgi);
--
--SendHeaders(); # one guess.
--
--print header("Edit tax rates", menubar(
-- 'Main Menu' => '../',
--)),<<END;
-- <FORM ACTION="process/cust_main_county.cgi" METHOD=POST>
-- <TABLE BORDER>
-- <TR>
-- <TH><FONT SIZE=-1>State</FONT></TH>
-- <TH>County</TH>
-- <TH><FONT SIZE=-1>Tax</FONT></TH>
-- </TR>
--END
--
--my($cust_main_county);
--foreach $cust_main_county ( qsearch('cust_main_county',{}) ) {
-- my($hashref)=$cust_main_county->hashref;
-- print <<END;
-- <TR>
-- <TD>$hashref->{state}</TD>
--END
--
-- print "<TD>", $hashref->{county}
-- ? $hashref->{county}
-- : '(ALL)'
-- , "</TD>";
--
-- print qq!<TD><INPUT TYPE="text" NAME="tax!, $hashref->{taxnum},
-- qq!" VALUE="!, $hashref->{tax}, qq!" SIZE=6 MAXLENGTH=6>%</TD></TR>!;
--END
--
--}
--
--print <<END;
-- </TABLE>
-- <INPUT TYPE="submit" VALUE="Apply changes">
-- </FORM>
-- </CENTER>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# cust_pay.cgi: Add a payment (output form)
--#
--# Usage: cust_pay.cgi invnum
--# http://server.name/path/cust_pay.cgi?invnum
--#
--# Note: Should be run setuid as user nobody.
--#
--# some hooks for modifications as well as additions, but needs work.
--#
--# ivan@voicenet.com 96-dec-11
--#
--# rewrite ivan@sisd.com 98-mar-16
--
--use strict;
--use Date::Format;
--use CGI::Base qw(:DEFAULT :CGI);
--use FS::UID qw(cgisuidsetup);
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--cgisuidsetup($cgi);
--
--#untaint invnum
--$QUERY_STRING =~ /^(\d+)$/;
--my($invnum)=$1;
--
--SendHeaders(); # one guess.
--print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Enter payment</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H1>Enter payment</H1>
-- </CENTER>
-- <FORM ACTION="process/cust_pay.cgi" METHOD=POST>
-- <HR><PRE>
--END
--
--#invnum
--print qq!Invoice #<B>$invnum</B><INPUT TYPE="hidden" NAME="invnum" VALUE="$invnum">!;
--
--#date
--my($date)=time;
--print qq!<BR>Date: <B>!, time2str("%D",$date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="$date">!;
--
--#paid
--print qq!<BR>Amount \$<INPUT TYPE="text" NAME="paid" VALUE="" SIZE=8 MAXLENGTH=8>!;
--
--#payby
--my($payby)="BILL";
--print qq!<BR>Payby: <B>$payby</B><INPUT TYPE="hidden" NAME="payby" VALUE="$payby">!;
--
--#payinfo (check # now as payby="BILL" hardcoded.. what to do later?)
--my($payinfo)="";
--print qq!<BR>Check #<INPUT TYPE="text" NAME="payinfo" VALUE="$payinfo">!;
--
--#paybatch
--print qq!<INPUT TYPE="hidden" NAME="paybatch" VALUE="">!;
--
--print <<END;
--</PRE>
--<BR>
--<CENTER><INPUT TYPE="submit" VALUE="Post"></CENTER>
--END
--
--print <<END;
--
-- </FORM>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# cust_pkg.cgi: Add/edit packages (output form)
--#
--# this is for changing packages around, not editing things within the package
--#
--# Usage: cust_pkg.cgi custnum
--# http://server.name/path/cust_pkg.cgi?custnum
--#
--# Note: Should be run setuid freeside as user nobody
--#
--# started with /sales/add/cust_pkg.cgi, which added packages
--# ivan@voicenet.com 97-jan-5, 97-mar-21
--#
--# Rewrote for new API
--# ivan@voicenet.com 97-jul-7
--#
--# FS::Search is no more, &cgisuidsetup needs $cgi, ivan@sisd.com 98-mar-7
--#
--# Changes to allow page to work at a relative position in server
--# Changed to display packages 2-wide in a table
--# bmccane@maxbaud.net 98-apr-3
--#
--# fixed a pretty cool bug from above which caused a visual glitch ivan@sisd.com
--# 98-jun-1
--
--use strict;
--use CGI::Base qw(:DEFAULT :CGI); # CGI module
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup getotaker);
--use FS::Record qw(qsearch qsearchs);
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--&cgisuidsetup($cgi);
--
--my(%pkg,%comment);
--foreach (qsearch('part_pkg', {})) {
-- $pkg{ $_ -> getfield('pkgpart') } = $_->getfield('pkg');
-- $comment{ $_ -> getfield('pkgpart') } = $_->getfield('comment');
--}
--
--#untaint custnum
--$QUERY_STRING =~ /^(\d+)$/;
--my($custnum)=$1;
--
--my($otaker)=&getotaker;
--
--SendHeaders();
--print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Add/Edit Packages</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H1>Add/Edit Packages</H1>
-- </CENTER>
-- <FORM ACTION="process/cust_pkg.cgi" METHOD=POST>
-- <HR>
--END
--
--#custnum
--print qq!<INPUT TYPE="hidden" NAME="new_custnum" VALUE="$custnum">!;
--
--#current packages (except cancelled packages)
--my(@cust_pkg) = grep ! $_->getfield('cancel'),
-- qsearch('cust_pkg',{'custnum'=>$custnum});
--
--if (@cust_pkg) {
-- print <<END;
--<CENTER><FONT SIZE="+2">Current packages</FONT></CENTER>
--These are packages the customer currently has. Select those packages you
--wish to remove (if any).<BR><BR>
--END
--
-- my ($count) = 0 ;
-- print qq!<CENTER><TABLE>! ;
-- foreach (@cust_pkg) {
-- print qq!<TR>! if ($count ==0) ;
-- my($pkgnum,$pkgpart)=( $_->getfield('pkgnum'), $_->getfield('pkgpart') );
-- print qq!<TD><INPUT TYPE="checkbox" NAME="remove_pkg" VALUE="$pkgnum">!,
-- #qq!$pkgnum: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n!,
-- #now you've got to admit this bug was pretty cool
-- qq!$pkgnum: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n!;
-- $count ++ ;
-- if ($count == 2)
-- {
-- $count = 0 ;
-- print qq!</TR>\n! ;
-- }
-- }
-- print qq!</TABLE></CENTER>! ;
--
-- print "<HR>";
--}
--
--print <<END;
--<CENTER><FONT SIZE="+2">New packages</FONT></CENTER>
--These are packages the customer can purchase. Specify the quantity to add
--of each package.<BR><BR>
--END
--
--my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
--my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
--
--my($type_pkgs);
--my ($count) = 0 ;
--print qq!<CENTER><TABLE>! ;
--foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) {
-- my($pkgpart)=$type_pkgs->pkgpart;
-- print qq!<TR>! if ($count == 0) ;
-- print <<END;
-- <TD>
-- <INPUT TYPE="text" NAME="pkg$pkgpart" VALUE="0" SIZE="2" MAXLENGTH="2">
-- $pkgpart: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n
--END
-- $count ++ ;
-- if ($count == 2)
-- {
-- print qq!</TR>\n! ;
-- $count = 0 ;
-- }
--}
--print qq!</TABLE></CENTER>! ;
--
--#otaker
--print qq!<INPUT TYPE="hidden" NAME="new_otaker" VALUE="$otaker">\n!;
--
--#submit
--print qq!<P><CENTER><INPUT TYPE="submit" VALUE="Order"></CENTER>\n!;
--
--print <<END;
-- </FORM>
-- </BODY>
--</HTML>
--END
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# part_pkg.cgi: Add/Edit package (output form)
--#
--# ivan@sisd.com 97-dec-10
--#
--# Changes to allow page to work at a relative position in server
--# Changed to display services 2-wide in table
--# bmccane@maxbaud.net 98-apr-3
--#
--# use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12
--
--use strict;
--use CGI::Base;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearch qsearchs);
--use FS::part_pkg;
--use FS::pkg_svc;
--use FS::CGI qw(header menubar);
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--
--&cgisuidsetup($cgi);
--
--SendHeaders(); # one guess.
--
--my($part_pkg,$action);
--if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
-- $part_pkg=qsearchs('part_pkg',{'pkgpart'=>$1});
-- $action='Edit';
--} else { #adding
-- $part_pkg=create FS::part_pkg {};
-- $action='Add';
--}
--my($hashref)=$part_pkg->hashref;
--
--print header("$action Package Definition", menubar(
-- 'Main Menu' => '../',
-- 'View all packages' => '../browse/part_pkg.cgi',
--)), '<FORM ACTION="process/part_pkg.cgi" METHOD=POST>';
--
--print qq!<INPUT TYPE="hidden" NAME="pkgpart" VALUE="$hashref->{pkgpart}">!,
-- "Package Part #", $hashref->{pkgpart} ? $hashref->{pkgpart} : "(NEW)";
--
--print <<END;
--<PRE>
--Package (customer-visable) <INPUT TYPE="text" NAME="pkg" SIZE=32 VALUE="$hashref->{pkg}">
--Comment (customer-hidden) <INPUT TYPE="text" NAME="comment" SIZE=32 VALUE="$hashref->{comment}">
--Setup fee for this package <INPUT TYPE="text" NAME="setup" VALUE="$hashref->{setup}">
--Recurring fee for this package <INPUT TYPE="text" NAME="recur" VALUE="$hashref->{recur}">
--Frequency (months) of recurring fee <INPUT TYPE="text" NAME="freq" VALUE="$hashref->{freq}">
--
--</PRE>
--
--Enter the quantity of each service this package includes.<BR><BR>
--<TABLE BORDER><TR><TH><FONT SIZE=-1>Quan.</FONT></TH><TH>Service</TH>
-- <TH><FONT SIZE=-1>Quan.</FONT></TH><TH>Service</TH></TR>
--END
--
--my($part_svc);
--my($count) = 0 ;
--foreach $part_svc ( qsearch('part_svc',{}) ) {
--
-- my($svcpart)=$part_svc->getfield('svcpart');
-- my($pkg_svc)=qsearchs('pkg_svc',{
-- 'pkgpart' => $part_pkg->getfield('pkgpart'),
-- 'svcpart' => $svcpart,
-- }) || create FS::pkg_svc({
-- 'pkgpart' => $part_pkg->getfield('pkgpart'),
-- 'svcpart' => $svcpart,
-- 'quantity' => 0,
-- });
-- next unless $pkg_svc;
--
-- print qq!<TR>! if $count == 0 ;
-- print qq!<TD><INPUT TYPE="text" NAME="pkg_svc$svcpart" SIZE=3 VALUE="!,
-- $pkg_svc->getfield('quantity') || 0,qq!"></TD>!,
-- qq!<TD><A HREF="part_svc.cgi?!,$part_svc->getfield('svcpart'),
-- qq!">!, $part_svc->getfield('svc'), "</A></TD>";
-- $count ++ ;
-- if ($count == 2)
-- {
-- print qq!</TR>! ;
-- $count = 0 ;
-- }
--}
--print qq!</TR>! if ($count != 0) ;
--
--print "</TABLE>";
--
--print qq!<BR><INPUT TYPE="submit" VALUE="!,
-- $hashref->{pkgpart} ? "Apply changes" : "Add package",
-- qq!">!;
--
--print <<END;
-- </FORM>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# agent.cgi: Add/Edit referral (output form)
--#
--# ivan@sisd.com 98-feb-23
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# confisuing typo on submit button ivan@sisd.com 98-jun-14
--#
--# lose background, FS::CGI ivan@sisd.com 98-sep-2
--
--use strict;
--use CGI::Base;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearch qsearchs);
--use FS::part_referral;
--use FS::CGI qw(header menubar);
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--
--&cgisuidsetup($cgi);
--
--SendHeaders(); # one guess.
--
--my($part_referral,$action);
--if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
-- $part_referral=qsearchs('part_referral',{'refnum'=>$1});
-- $action='Edit';
--} else { #adding
-- $part_referral=create FS::part_referral {};
-- $action='Add';
--}
--my($hashref)=$part_referral->hashref;
--
--print header("$action Referral", menubar(
-- 'Main Menu' => '../',
-- 'View all referrals' => "../browse/part_referral.cgi",
--)), <<END;
-- <FORM ACTION="process/part_referral.cgi" METHOD=POST>
--END
--
--#display
--
--print qq!<INPUT TYPE="hidden" NAME="refnum" VALUE="$hashref->{refnum}">!,
-- "Referral #", $hashref->{refnum} ? $hashref->{refnum} : "(NEW)";
--
--print <<END;
--<PRE>
--Referral <INPUT TYPE="text" NAME="referral" SIZE=32 VALUE="$hashref->{referral}">
--</PRE>
--END
--
--print qq!<BR><INPUT TYPE="submit" VALUE="!,
-- $hashref->{refnum} ? "Apply changes" : "Add referral",
-- qq!">!;
--
--print <<END;
-- </FORM>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# part_svc.cgi: Add/Edit service (output form)
--#
--# ivan@sisd.com 97-nov-14
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12
--
--use strict;
--use CGI::Base;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearchs);
--use FS::part_svc qw(fields);
--use FS::CGI qw(header menubar);
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--
--&cgisuidsetup($cgi);
--
--SendHeaders(); # one guess.
--
--my($part_svc,$action);
--if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
-- $part_svc=qsearchs('part_svc',{'svcpart'=>$1});
-- $action='Edit';
--} else { #adding
-- $part_svc=create FS::part_svc {};
-- $action='Add';
--}
--my($hashref)=$part_svc->hashref;
--
--print header("$action Service Definition", menubar(
-- 'Main Menu' => '../',
-- 'View all services' => '../browse/part_svc.cgi',
--)), '<FORM ACTION="process/part_svc.cgi" METHOD=POST>';
--
--
--
--print qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$hashref->{svcpart}">!,
-- "Service Part #", $hashref->{svcpart} ? $hashref->{svcpart} : "(NEW)";
--
--print <<END;
--<PRE>
--Service <INPUT TYPE="text" NAME="svc" VALUE="$hashref->{svc}">
--Table <SELECT NAME="svcdb" SIZE=1>
--END
--
--print map '<OPTION'. ' SELECTED'x($_ eq $hashref->{svcdb}). ">$_\n", qw(
-- svc_acct svc_domain svc_acct_sm svc_charge svc_wo
--);
--
--print <<END;
--</SELECT></PRE>
--Services are items you offer to your customers.
--<UL><LI>svc_acct - Shell accounts, POP mailboxes, SLIP/PPP and ISDN accounts
-- <LI>svc_domain - Virtual domains
-- <LI>svc_acct_sm - Virtual domain mail aliasing
-- <LI>svc_charge - One-time charges (Partially unimplemented)
-- <LI>svc_wo - Work orders (Partially unimplemented)
--</UL>
--For the columns in the table selected above, you can set default or fixed
--values. For example, a SLIP/PPP account may have a default (or perhaps fixed)
--<B>slipip</B> of <B>0.0.0.0</B>, while a POP mailbox will probably have a fixed
--blank <B>slipip</B> as well as a fixed shell something like <B>/bin/true</B> or
--<B>/usr/bin/passwd</B>.
--<BR><BR>
--<TABLE BORDER CELLPADDING=4><TR><TH>Table</TH><TH>Field</TH>
--<TH COLSPAN=2>Modifier</TH></TR>
--END
--
--#these might belong somewhere else for other user interfaces
--#pry need to eventually create stuff that's shared amount UIs
--my(%defs)=(
-- 'svc_acct' => {
-- 'dir' => 'Home directory',
-- 'uid' => 'UID (set to fixed and blank for dial-only)',
-- 'slipip' => 'IP address',
-- 'popnum' => '<A HREF="../browse/svc_acct_pop.cgi/">POP number</A>',
-- 'username' => 'Username',
-- 'quota' => '(unimplemented)',
-- '_password' => 'Password',
-- 'gid' => 'GID (when blank, defaults to UID)',
-- 'shell' => 'Shell',
-- 'finger' => 'GECOS',
-- },
-- 'svc_domain' => {
-- 'domain' => 'Domain',
-- },
-- 'svc_acct_sm' => {
-- 'domuser' => 'domuser@virtualdomain.com',
-- 'domuid' => 'UID where domuser@virtualdomain.com mail is forwarded',
-- 'domsvc' => 'svcnum from svc_domain for virtualdomain.com',
-- },
-- 'svc_charge' => {
-- 'amount' => 'amount',
-- },
-- 'svc_wo' => {
-- 'worker' => 'Worker',
-- '_date' => 'Date',
-- },
--);
--
--my($svcdb);
--foreach $svcdb ( qw(
-- svc_acct svc_domain svc_acct_sm svc_charge svc_wo
--) ) {
--
-- my(@rows)=map { /^${svcdb}__(.*)$/; $1 }
-- grep ! /_flag$/,
-- grep /^${svcdb}__/,
-- fields('part_svc');
-- my($rowspan)=scalar(@rows);
--
-- my($ptmp)="<TD ROWSPAN=$rowspan>$svcdb</TD>";
-- my($row);
-- foreach $row (@rows) {
-- my($value)=$part_svc->getfield($svcdb.'__'.$row);
-- my($flag)=$part_svc->getfield($svcdb.'__'.$row.'_flag');
-- print "<TR>$ptmp<TD>$row - <FONT SIZE=-1>$defs{$svcdb}{$row}</FONT></TD>";
-- print qq!<TD><INPUT TYPE="radio" NAME="${svcdb}__${row}_flag" VALUE=""!.
-- ' CHECKED'x($flag eq ''). "><BR>Off</TD>";
-- print qq!<TD><INPUT TYPE="radio" NAME="${svcdb}__${row}_flag" VALUE="D"!.
-- ' CHECKED'x($flag eq 'D'). ">Default ";
-- print qq!<INPUT TYPE="radio" NAME="${svcdb}__${row}_flag" VALUE="F"!.
-- ' CHECKED'x($flag eq 'F'). ">Fixed ";
-- print qq!<BR><INPUT TYPE="text" NAME="${svcdb}__${row}" VALUE="$value">!,
-- "</TD></TR>";
-- $ptmp='';
-- }
--}
--print "</TABLE>";
--
--print qq!\n<CENTER><BR><INPUT TYPE="submit" VALUE="!,
-- $hashref->{svcpart} ? "Apply changes" : "Add service",
-- qq!"></CENTER>!;
--
--print <<END;
--
-- </FORM>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# process/agent.cgi: Edit agent (process form)
--#
--# ivan@sisd.com 97-dec-12
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# lose background, FS::CGI ivan@sisd.com 98-sep-2
--
--use strict;
--use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearch qsearchs);
--use FS::agent qw(fields);
--use FS::CGI qw(idiot);
--
--my($req)=new CGI::Request; # create form object
--
--&cgisuidsetup($req->cgi);
--
--my($agentnum)=$req->param('agentnum');
--
--my($old)=qsearchs('agent',{'agentnum'=>$agentnum}) if $agentnum;
--
--#unmunge typenum
--$req->param('typenum') =~ /^(\d+)(:.*)?$/;
--$req->param('typenum',$1);
--
--my($new)=create FS::agent ( {
-- map {
-- $_, $req->param($_);
-- } fields('agent')
--} );
--
--my($error);
--if ( $agentnum ) {
-- $error=$new->replace($old);
--} else {
-- $error=$new->insert;
-- $agentnum=$new->getfield('agentnum');
--}
--
--if ( $error ) {
-- &idiot($error);
--} else {
-- #$req->cgi->redirect("../../view/agent.cgi?$agentnum");
-- #$req->cgi->redirect("../../edit/agent.cgi?$agentnum");
-- $req->cgi->redirect("../../browse/agent.cgi");
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# process/agent_type.cgi: Edit agent type (process form)
--#
--# ivan@sisd.com 97-dec-11
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# lose background, FS::CGI ivan@sisd.com 98-sep-2
--
--use strict;
--use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearch qsearchs);
--use FS::agent_type qw(fields);
--use FS::type_pkgs;
--use FS::CGI qw(idiot);
--
--my($req)=new CGI::Request;
--&cgisuidsetup($req->cgi);
--
--my($typenum)=$req->param('typenum');
--my($old)=qsearchs('agent_type',{'typenum'=>$typenum}) if $typenum;
--
--my($new)=create FS::agent_type ( {
-- map {
-- $_, $req->param($_);
-- } fields('agent_type')
--} );
--
--my($error);
--if ( $typenum ) {
-- $error=$new->replace($old);
--} else {
-- $error=$new->insert;
-- $typenum=$new->getfield('typenum');
--}
--
--if ( $error ) {
-- idiot($error);
-- exit;
--}
--
--my($part_pkg);
--foreach $part_pkg (qsearch('part_pkg',{})) {
-- my($pkgpart)=$part_pkg->getfield('pkgpart');
--
-- my($type_pkgs)=qsearchs('type_pkgs',{
-- 'typenum' => $typenum,
-- 'pkgpart' => $pkgpart,
-- });
-- if ( $type_pkgs && ! $req->param("pkgpart$pkgpart") ) {
-- my($d_type_pkgs)=$type_pkgs; #need to save $type_pkgs for below.
-- $error=$d_type_pkgs->del; #FS::Record not FS::type_pkgs,
-- #so ->del not ->delete. hmm. hmm.
-- if ( $error ) {
-- idiot($error);
-- exit;
-- }
--
-- } elsif ( $req->param("pkgpart$pkgpart")
-- && ! $type_pkgs
-- ) {
-- #ok to clobber it now (but bad form nonetheless?)
-- $type_pkgs=create FS::type_pkgs ({
-- 'typenum' => $typenum,
-- 'pkgpart' => $pkgpart,
-- });
-- $error= $type_pkgs->insert;
-- if ( $error ) {
-- idiot($error);
-- exit;
-- }
-- }
--
--}
--
--#$req->cgi->redirect("../../view/agent_type.cgi?$typenum");
--#$req->cgi->redirect("../../edit/agent_type.cgi?$typenum");
--$req->cgi->redirect("../../browse/agent_type.cgi");
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# process/cust_credit.cgi: Add a credit (process form)
--#
--# Usage: post form to:
--# http://server.name/path/cust_credit.cgi
--#
--# Note: Should be run setuid root as user nobody.
--#
--# ivan@voicenet.com 96-dec-05 -> 96-dec-08
--#
--# post a refund if $new_paybatch
--# ivan@voicenet.com 96-dec-08
--#
--# refunds are no longer applied against a specific payment (paybatch)
--# paybatch field removed
--# ivan@voicenet.com 97-apr-22
--#
--# rewrite ivan@sisd.com 98-mar-16
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--
--use strict;
--use CGI::Request;
--use FS::UID qw(cgisuidsetup getotaker);
--use FS::cust_credit;
--
--my($req)=new CGI::Request; # create form object
--cgisuidsetup($req->cgi);
--
--$req->param('custnum') =~ /^(\d*)$/ or die "Illegal custnum!";
--my($custnum)=$1;
--
--$req->param('otaker',getotaker);
--
--my($new) = create FS::cust_credit ( {
-- map {
-- $_, $req->param($_);
-- } qw(custnum _date amount otaker reason)
--} );
--
--my($error);
--$error=$new->insert;
--&idiot($error) if $error;
--
--#no errors, no refund, so view our credit.
--$req->cgi->redirect("../../view/cust_main.cgi?$custnum#history");
--
--sub idiot {
-- my($error)=@_;
-- CGI::Base::SendHeaders(); # one guess
-- print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Error posting credit/refund</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H4>Error posting credit/refund</H4>
-- </CENTER>
-- Your update did not occur because of the following error:
-- <P><B>$error</B>
-- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and press the <I>Post</I> button again.
-- </BODY>
--</HTML>
--END
--
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# process/cust_main.cgi: Edit a customer (process form)
--#
--# Usage: post form to:
--# http://server.name/path/cust_main.cgi
--#
--# Note: Should be run setuid root as user nobody.
--#
--# ivan@voicenet.com 96-dec-04
--#
--# added referral check
--# ivan@voicenet.com 97-jun-4
--#
--# rewrote for new API
--# ivan@voicenet.com 97-jul-28
--#
--# same as above (again) and clean up some stuff ivan@sisd.com 98-feb-23
--#
--# Changes to allow page to work at a relative position in server
--# Changed 'day' to 'daytime' because Pg6.3 reserves the day word
--# bmccane@maxbaud.net 98-apr-3
--
--use strict;
--use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearchs);
--use FS::cust_main;
--
--my($req)=new CGI::Request; # create form object
--
--&cgisuidsetup($req->cgi);
--
--#create new record object
--
--#unmunge agentnum
--$req->param('agentnum',
-- (split(/:/, ($req->param('agentnum'))[0] ))[0]
--);
--
--#unmunge tax
--$req->param('tax','') unless defined($req->param('tax'));
--
--#unmunge refnum
--$req->param('refnum',
-- (split(/:/, ($req->param('refnum'))[0] ))[0]
--);
--
--#unmunge state/county
--$req->param('state') =~ /^(\w+)( \((\w+)\))?$/;
--$req->param('state', $1);
--$req->param('county', $3 || '');
--
--my($new) = create FS::cust_main ( {
-- map {
-- $_, $req->param("$_") || ''
-- } qw(custnum agentnum last first ss company address1 address2 city county
-- state zip country daytime night fax payby payinfo paydate payname tax
-- otaker refnum)
--} );
--
--if ( $new->custnum eq '' ) {
--
-- my($error)=$new->insert;
-- &idiot($error) if $error;
--
--} else { #create old record object
--
-- my($old) = qsearchs( 'cust_main', { 'custnum', $new->custnum } );
-- &idiot("Old record not found!") unless $old;
-- my($error)=$new->replace($old);
-- &idiot($error) if $error;
--
--}
--
--my($custnum)=$new->custnum;
--$req->cgi->redirect("../../view/cust_main.cgi?$custnum#cust_main");
--
--sub idiot {
-- my($error)=@_;
-- CGI::Base::SendHeaders(); # one guess
-- print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Error updating customer information</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H4>Error updating customer information</H4>
-- </CENTER>
-- Your update did not occur because of the following error:
-- <P><B>$error</B>
-- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again.
-- </BODY>
--</HTML>
--END
--
-- exit;
--
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# process/cust_main_county-expand.cgi: Expand counties (process form)
--#
--# ivan@sisd.com 97-dec-16
--#
--# Changes to allow page to work at a relative position in server
--# Added import of datasrc from UID.pm for Pg6.3
--# Default tax to 0.0 if using Pg6.3
--# bmccane@maxbaud.net 98-apr-3
--#
--# lose background, FS::CGI
--# undo default tax to 0.0 if using Pg6.3: comes from pre-expanded record
--# for that state
--#ivan@sisd.com 98-sep-2
--
--use strict;
--use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup datasrc);
--use FS::Record qw(qsearch qsearchs);
--use FS::cust_main_county;
--use FS::CGI qw(eidiot);
--
--my($req)=new CGI::Request; # create form object
--
--&cgisuidsetup($req->cgi);
--
--$req->param('taxnum') =~ /^(\d+)$/ or die "Illegal taxnum!";
--my($taxnum)=$1;
--my($cust_main_county)=qsearchs('cust_main_county',{'taxnum'=>$taxnum})
-- or die ("Unknown taxnum!");
--
--my(@counties);
--if ( $req->param('delim') eq 'n' ) {
-- @counties=split(/\n/,$req->param('counties'));
--} elsif ( $req->param('delim') eq 's' ) {
-- @counties=split(/\s+/,$req->param('counties'));
--} else {
-- die "Illegal delim!";
--}
--
--@counties=map {
-- /^\s*([\w\- ]+)\s*$/ or eidiot("Illegal county");
-- $1;
--} @counties;
--
--my($county);
--foreach ( @counties) {
-- my(%hash)=$cust_main_county->hash;
-- my($new)=create FS::cust_main_county \%hash;
-- $new->setfield('taxnum','');
-- $new->setfield('county',$_);
-- #if (datasrc =~ m/Pg/)
-- #{
-- # $new->setfield('tax',0.0);
-- #}
-- my($error)=$new->insert;
-- die $error if $error;
--}
--
--unless ( qsearch('cust_main',{
-- 'state' => $cust_main_county->getfield('state'),
-- 'county' => $cust_main_county->getfield('county'),
--} ) ) {
-- my($error)=($cust_main_county->delete);
-- die $error if $error;
--}
--
--$req->cgi->redirect("../../edit/cust_main_county.cgi");
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# process/agent.cgi: Edit cust_main_county (process form)
--#
--# ivan@sisd.com 97-dec-16
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# lose background, FS::CGI ivan@sisd.com 98-sep-2
--
--use strict;
--use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearch qsearchs);
--use FS::cust_main_county;
--use FS::CGI qw(eidiot);
--
--my($req)=new CGI::Request; # create form object
--
--&cgisuidsetup($req->cgi);
--
--foreach ( $req->params ) {
-- /^tax(\d+)$/ or die "Illegal form $_!";
-- my($taxnum)=$1;
-- my($old)=qsearchs('cust_main_county',{'taxnum'=>$taxnum})
-- or die "Couldn't find taxnum $taxnum!";
-- next unless $old->getfield('tax') ne $req->param("tax$taxnum");
-- my(%hash)=$old->hash;
-- $hash{tax}=$req->param("tax$taxnum");
-- my($new)=create FS::cust_main_county \%hash;
-- my($error)=$new->replace($old);
-- eidiot($error) if $error;
--}
--
--$req->cgi->redirect("../../browse/cust_main_county.cgi");
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# process/cust_pay.cgi: Add a payment (process form)
--#
--# Usage: post form to:
--# http://server.name/path/cust_pay.cgi
--#
--# Note: Should be run setuid root as user nobody.
--#
--# ivan@voicenet.com 96-dec-11
--#
--# rewrite ivan@sisd.com 98-mar-16
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--
--use strict;
--use CGI::Request;
--use FS::UID qw(cgisuidsetup);
--use FS::cust_pay qw(fields);
--
--my($req)=new CGI::Request;
--&cgisuidsetup($req->cgi);
--
--$req->param('invnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
--my($invnum)=$1;
--
--my($new) = create FS::cust_pay ( {
-- map {
-- $_, $req->param($_);
-- } qw(invnum paid _date payby payinfo paybatch)
--} );
--
--my($error);
--$error=$new->insert;
--
--if ($error) { #error!
-- CGI::Base::SendHeaders(); # one guess
-- print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Error posting payment</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H4>Error posting payment</H4>
-- </CENTER>
-- Your update did not occur because of the following error:
-- <P><B>$error</B>
-- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and press the <I>Post</I> button again.
-- </BODY>
--</HTML>
--END
--} else { #no errors!
-- $req->cgi->redirect("../../view/cust_bill.cgi?$invnum");
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# process/cust_pkg.cgi: Add/edit packages (process form)
--#
--# this is for changing packages around, not for editing things within the
--# package
--#
--# Usage: post form to:
--# http://server.name/path/cust_pkg.cgi
--#
--# Note: Should be run setuid root as user nobody.
--#
--# ivan@voicenet.com 97-mar-21 - 97-mar-24
--#
--# rewrote for new API
--# ivan@voicenet.com 97-jul-7 - 15
--#
--# &cgisuidsetup($cgi) ivan@sisd.com 98-mar-7
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--
--use strict;
--use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::cust_pkg;
--
--my($req)=new CGI::Request; # create form object
--
--&cgisuidsetup($req->cgi);
--
--#untaint custnum
--$req->param('new_custnum') =~ /^(\d+)$/;
--my($custnum)=$1;
--
--my(@remove_pkgnums) = map {
-- /^(\d+)$/ or die "Illegal remove_pkg value!";
-- $1;
--} $req->param('remove_pkg');
--
--my(@pkgparts);
--my($pkgpart);
--foreach $pkgpart ( map /^pkg(\d+)$/ ? $1 : (), $req->params ) {
-- my($num_pkgs)=$req->param("pkg$pkgpart");
-- while ( $num_pkgs-- ) {
-- push @pkgparts,$pkgpart;
-- }
--}
--
--my($error) = FS::cust_pkg::order($custnum,\@pkgparts,\@remove_pkgnums);
--
--if ($error) {
-- CGI::Base::SendHeaders();
-- print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Error updating packages</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H4>Error updating packages</H4>
-- </CENTER>
-- Your update did not occur because of the following error:
-- <P><B>$error</B>
-- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again.
-- </BODY>
--</HTML>
--END
--} else {
-- $req->cgi->redirect("../../view/cust_main.cgi?$custnum#cust_pkg");
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# process/part_pkg.cgi: Edit package definitions (process form)
--#
--# ivan@sisd.com 97-dec-10
--#
--# don't update non-changing records in part_svc (causing harmless but annoying
--# "Records identical" errors). ivan@sisd.com 98-feb-19
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# Added `|| 0 ' when getting quantity off web page ivan@sisd.com 98-jun-4
--#
--# lose background, FS::CGI ivan@sisd.com 98-sep-2
--
--use strict;
--use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearch qsearchs);
--use FS::part_pkg qw(fields);
--use FS::pkg_svc;
--use FS::CGI qw(eidiot);
--
--my($req)=new CGI::Request; # create form object
--
--&cgisuidsetup($req->cgi);
--
--my($pkgpart)=$req->param('pkgpart');
--
--my($old)=qsearchs('part_pkg',{'pkgpart'=>$pkgpart}) if $pkgpart;
--
--my($new)=create FS::part_pkg ( {
-- map {
-- $_, $req->param($_);
-- } fields('part_pkg')
--} );
--
--if ( $pkgpart ) {
-- my($error)=$new->replace($old);
-- eidiot($error) if $error;
--} else {
-- my($error)=$new->insert;
-- eidiot($error) if $error;
-- $pkgpart=$new->getfield('pkgpart');
--}
--
--my($part_svc);
--foreach $part_svc (qsearch('part_svc',{})) {
--# don't update non-changing records in part_svc (causing harmless but annoying
--# "Records identical" errors). ivan@sisd.com 98-jan-19
-- #my($quantity)=$req->param('pkg_svc'. $part_svc->getfield('svcpart')),
-- my($quantity)=$req->param('pkg_svc'. $part_svc->svcpart) || 0,
-- my($old_pkg_svc)=qsearchs('pkg_svc',{
-- 'pkgpart' => $pkgpart,
-- 'svcpart' => $part_svc->getfield('svcpart'),
-- });
-- my($old_quantity)=$old_pkg_svc ? $old_pkg_svc->quantity : 0;
-- next unless $old_quantity != $quantity; #!here
-- my($new_pkg_svc)=create FS::pkg_svc({
-- 'pkgpart' => $pkgpart,
-- 'svcpart' => $part_svc->getfield('svcpart'),
-- #'quantity' => $req->param('pkg_svc'. $part_svc->getfield('svcpart')),
-- 'quantity' => $quantity,
-- });
-- if ($old_pkg_svc) {
-- my($error)=$new_pkg_svc->replace($old_pkg_svc);
-- eidiot($error) if $error;
-- } else {
-- my($error)=$new_pkg_svc->insert;
-- eidiot($error) if $error;
-- }
--}
--
--#$req->cgi->redirect("../../view/part_pkg.cgi?$pkgpart");
--#$req->cgi->redirect("../../edit/part_pkg.cgi?$pkgpart");
--$req->cgi->redirect("../../browse/part_pkg.cgi");
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# process/part_referral.cgi: Edit referrals (process form)
--#
--# ivan@sisd.com 98-feb-23
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# lose background, FS::CGI ivan@sisd.com 98-sep-2
--
--use strict;
--use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearchs);
--use FS::part_referral qw(fields);
--use FS::CGI qw(eidiot);
--use FS::CGI qw(eidiot);
--
--my($req)=new CGI::Request; # create form object
--
--&cgisuidsetup($req->cgi);
--
--my($refnum)=$req->param('refnum');
--
--my($new)=create FS::part_referral ( {
-- map {
-- $_, $req->param($_);
-- } fields('part_referral')
--} );
--
--if ( $refnum ) {
-- my($old)=qsearchs('part_referral',{'refnum'=>$refnum});
-- eidiot("(Old) Record not found!") unless $old;
-- my($error)=$new->replace($old);
-- eidiot($error) if $error;
--} else {
-- my($error)=$new->insert;
-- eidiot($error) if $error;
--}
--
--$refnum=$new->getfield('refnum');
--$req->cgi->redirect("../../browse/part_referral.cgi");
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# process/part_svc.cgi: Edit service definitions (process form)
--#
--# ivan@sisd.com 97-nov-14
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# lose background, FS::CGI ivan@sisd.com 98-sep-2
--
--use strict;
--use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearchs);
--use FS::part_svc qw(fields);
--use FS::CGI qw(eidiot);
--
--my($req)=new CGI::Request; # create form object
--
--&cgisuidsetup($req->cgi);
--
--my($svcpart)=$req->param('svcpart');
--
--my($old)=qsearchs('part_svc',{'svcpart'=>$svcpart}) if $svcpart;
--
--my($new)=create FS::part_svc ( {
-- map {
-- $_, $req->param($_);
--# } qw(svcpart svc svcdb)
-- } fields('part_svc')
--} );
--
--if ( $svcpart ) {
-- my($error)=$new->replace($old);
-- eidiot($error) if $error;
--} else {
-- my($error)=$new->insert;
-- eidiot($error) if $error;
-- $svcpart=$new->getfield('svcpart');
--}
--
--#$req->cgi->redirect("../../view/part_svc.cgi?$svcpart");
--#$req->cgi->redirect("../../edit/part_svc.cgi?$svcpart");
--$req->cgi->redirect("../../browse/part_svc.cgi");
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# process/svc_acct.cgi: Add/edit a customer (process form)
--#
--# Usage: post form to:
--# http://server.name/path/svc_acct.cgi
--#
--# Note: Should br run setuid root as user nobody.
--#
--# ivan@voicenet.com 96-dec-18
--#
--# Changed /u to /u2
--# ivan@voicenet.com 97-may-6
--#
--# rewrote for new API
--# ivan@voicenet.com 97-jul-17 - 21
--#
--# no FS::Search, FS::svc_acct creates FS::cust_svc record, used for adding
--# and editing ivan@sisd.com 98-mar-8
--#
--# Changes to allow page to work at a relative position in server
--# Changed 'password' to '_password' because Pg6.3 reserves the password word
--# bmccane@maxbaud.net 98-apr-3
--
--use strict;
--use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearchs);
--use FS::svc_acct;
--
--my($req) = new CGI::Request; # create form object
--&cgisuidsetup($req->cgi);
--
--$req->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
--my($svcnum)=$1;
--
--my($old)=qsearchs('svc_acct',{'svcnum'=>$svcnum}) if $svcnum;
--
--#unmunge popnum
--$req->param('popnum', (split(/:/, $req->param('popnum') ))[0] );
--
--#unmunge passwd
--if ( $req->param('_password') eq '*HIDDEN*' ) {
-- $req->param('_password',$old->getfield('_password'));
--}
--
--my($new) = create FS::svc_acct ( {
-- map {
-- $_, $req->param($_);
-- } qw(svcnum pkgnum svcpart username _password popnum uid gid finger dir
-- shell quota slipip)
--} );
--
--if ( $svcnum ) {
-- my($error) = $new->replace($old);
-- &idiot($error) if $error;
--} else {
-- my($error) = $new->insert;
-- &idiot($error) if $error;
-- $svcnum = $new->getfield('svcnum');
--}
--
--#no errors, view account
--$req->cgi->redirect("../../view/svc_acct.cgi?" . $svcnum );
--
--sub idiot {
-- my($error)=@_;
-- CGI::Base::SendHeaders(); # one guess
-- print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Error adding/updating account</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H4>Error adding/updating account</H4>
-- </CENTER>
-- Your update did not occur because of the following error:
-- <P><B>$error</B>
-- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again.
-- </BODY>
--</HTML>
--END
-- exit;
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# process/svc_acct_pop.cgi: Edit POP (process form)
--#
--# ivan@sisd.com 98-mar-8
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# lose background, FS::CGI ivan@sisd.com 98-sep-2
--
--use strict;
--use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearch qsearchs);
--use FS::svc_acct_pop qw(fields);
--use FS::CGI qw(eidiot);
--
--my($req)=new CGI::Request; # create form object
--
--&cgisuidsetup($req->cgi);
--
--my($popnum)=$req->param('popnum');
--
--my($old)=qsearchs('svc_acct_pop',{'popnum'=>$popnum}) if $popnum;
--
--my($new)=create FS::svc_acct_pop ( {
-- map {
-- $_, $req->param($_);
-- } fields('svc_acct_pop')
--} );
--
--if ( $popnum ) {
-- my($error)=$new->replace($old);
-- eidiot($error) if $error;
--} else {
-- my($error)=$new->insert;
-- eidiot($error) if $error;
-- $popnum=$new->getfield('popnum');
--}
--$req->cgi->redirect("../../browse/svc_acct_pop.cgi");
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# process/svc_acct_sm.cgi: Add/edit a mail alias (process form)
--#
--# Usage: post form to:
--# http://server.name/path/svc_acct_sm.cgi
--#
--# Note: Should br run setuid root as user nobody.
--#
--# lots of crufty stuff from svc_acct still in here, and modifications are (unelegantly) disabled.
--#
--# ivan@voicenet.com 97-jan-6
--#
--# enabled modifications
--#
--# ivan@voicenet.com 97-may-7
--#
--# fixed removal of cust_svc record on modifications!
--# ivan@voicenet.com 97-jun-5
--#
--# rewrite ivan@sisd.com 98-mar-15
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--
--use strict;
--use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearchs);
--use FS::svc_acct_sm;
--
--my($req)=new CGI::Request; # create form object
--cgisuidsetup($req->cgi);
--
--$req->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
--my($svcnum)=$1;
--
--my($old)=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) if $svcnum;
--
--#unmunge domsvc and domuid
--$req->param('domsvc',(split(/:/, $req->param('domsvc') ))[0] );
--$req->param('domuid',(split(/:/, $req->param('domuid') ))[0] );
--
--my($new) = create FS::svc_acct_sm ( {
-- map {
-- ($_, scalar($req->param($_)));
-- } qw(svcnum pkgnum svcpart domuser domuid domsvc)
--} );
--
--my($error);
--if ( $svcnum ) {
-- $error = $new->replace($old);
--} else {
-- $error = $new->insert;
-- $svcnum = $new->getfield('svcnum');
--}
--
--unless ($error) {
-- $req->cgi->redirect("../../view/svc_acct_sm.cgi?$svcnum");
--} else {
-- CGI::Base::SendHeaders(); # one guess
-- print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Error adding/editing mail alias</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H4>Error adding/editing mail alias</H4>
-- </CENTER>
-- Your update did not occur because of the following error:
-- <P><B>$error</B>
-- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again.
-- </BODY>
--</HTML>
--END
--
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# process/svc_domain.cgi: Add a domain (process form)
--#
--# Usage: post form to:
--# http://server.name/path/svc_domain.cgi
--#
--# Note: Should br run setuid root as user nobody.
--#
--# lots of yucky stuff in this one... bleachlkjhui!
--#
--# ivan@voicenet.com 97-jan-6
--#
--# kludged for new domain template 3.5
--# ivan@voicenet.com 97-jul-24
--#
--# moved internic bits to svc_domain.pm ivan@sisd.com 98-mar-14
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--
--use strict;
--use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearchs);
--use FS::svc_domain;
--
--#remove this to actually test the domains!
--$FS::svc_domain::whois_hack = 1;
--
--my($req) = new CGI::Request;
--&cgisuidsetup($req->cgi);
--
--$req->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
--my($svcnum)=$1;
--
--my($new) = create FS::svc_domain ( {
-- map {
-- $_, $req->param($_);
-- } qw(svcnum pkgnum svcpart domain action purpose)
--} );
--
--my($error);
--if ($req->param('legal') ne "Yes") {
-- $error = "Customer did not agree to be bound by NSI's ".
-- qq!<A HREF="http://rs.internic.net/help/agreement.txt">!.
-- "Domain Name Resgistration Agreement</A>";
--} elsif ($req->param('svcnum')) {
-- $error="Can't modify a domain!";
--} else {
-- $error=$new->insert;
-- $svcnum=$new->svcnum;
--}
--
--unless ($error) {
-- $req->cgi->redirect("../../view/svc_domain.cgi?$svcnum");
--} else {
-- CGI::Base::SendHeaders(); # one guess
-- print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Error adding domain</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H4>Error adding domain</H4>
-- </CENTER>
-- Your update did not occur because of the following error:
-- <P><B>$error</B>
-- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again.
-- </BODY>
--</HTML>
--END
--
--}
--
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# svc_acct.cgi: Add/edit account (output form)
--#
--# Usage: svc_acct.cgi {svcnum} | pkgnum{pkgnum}-svcpart{svcpart}
--# http://server.name/path/svc_acct.cgi? {svcnum} | pkgnum{pkgnum}-svcpart{svcpart}
--#
--# Note: Should be run setuid freeside as user nobody
--#
--# ivan@voicenet.com 96-dec-18
--#
--# rewrite ivan@sisd.com 98-mar-8
--#
--# Changes to allow page to work at a relative position in server
--# Changed 'password' to '_password' because Pg6.3 reserves the password word
--# bmccane@maxbaud.net 98-apr-3
--#
--# use conf/shells and dbdef username length ivan@sisd.com 98-jul-13
--
--use strict;
--use CGI::Base qw(:DEFAULT :CGI);
--use FS::UID qw(cgisuidsetup getotaker);
--use FS::Record qw(qsearch qsearchs);
--use FS::svc_acct qw(fields);
--
--my($shells)="/var/spool/freeside/conf/shells";
--open(SHELLS,$shells) or die "Can't open $shells: $!";
--my(@shells)=map {
-- /^([\/\w]*)$/ or die "Illegal shell in conf/shells!";
-- $1;
--} grep $_ !~ /^#/, <SHELLS>;
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--&cgisuidsetup($cgi);
--
--my($action,$svcnum,$svc_acct,$pkgnum,$svcpart,$part_svc);
--
--if ( $QUERY_STRING =~ /^(\d+)$/ ) { #editing
--
-- $svcnum=$1;
-- $svc_acct=qsearchs('svc_acct',{'svcnum'=>$svcnum})
-- or die "Unknown (svc_acct) svcnum!";
--
-- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
-- or die "Unknown (cust_svc) svcnum!";
--
-- $pkgnum=$cust_svc->pkgnum;
-- $svcpart=$cust_svc->svcpart;
--
-- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
-- die "No part_svc entry!" unless $part_svc;
--
-- $action="Edit";
--
--} else { #adding
--
-- $svc_acct=create FS::svc_acct({});
--
-- foreach $_ (split(/-/,$QUERY_STRING)) {
-- $pkgnum=$1 if /^pkgnum(\d+)$/;
-- $svcpart=$1 if /^svcpart(\d+)$/;
-- }
-- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
-- die "No part_svc entry!" unless $part_svc;
--
-- $svcnum='';
--
-- #set gecos
-- my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-- if ($cust_pkg) {
-- my($cust_main)=qsearchs('cust_main',{'custnum'=> $cust_pkg->custnum } );
-- $svc_acct->setfield('finger',
-- $cust_main->getfield('first') . " " . $cust_main->getfield('last')
-- ) ;
-- }
--
-- #set fixed and default fields from part_svc
-- my($field);
-- foreach $field ( fields('svc_acct') ) {
-- if ( $part_svc->getfield('svc_acct__'. $field. '_flag') ne '' ) {
-- $svc_acct->setfield($field,$part_svc->getfield('svc_acct__'. $field) );
-- }
-- }
--
-- $action="Add";
--
--}
--
--my($svc)=$part_svc->getfield('svc');
--
--my($otaker)=getotaker;
--
--my($username,$password)=(
-- $svc_acct->username,
-- $svc_acct->_password ? "*HIDDEN*" : '',
--);
--
--my($ulen)=$svc_acct->dbdef_table->column('username')->length;
--my($ulen2)=$ulen+2;
--
--SendHeaders();
--print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>$action $svc account</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H1>$action $svc account</H1>
-- </CENTER><HR>
-- <FORM ACTION="process/svc_acct.cgi" METHOD=POST>
-- <INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum">
-- <INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">
-- <INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">
--Username:
--<INPUT TYPE="text" NAME="username" VALUE="$username" SIZE=$ulen2 MAXLENGTH=$ulen>
--<BR>Password:
--<INPUT TYPE="text" NAME="_password" VALUE="$password" SIZE=10 MAXLENGTH=8>
--(blank to generate)
--END
--
--#pop
--my($popnum)=$svc_acct->popnum || 0;
--if ( $part_svc->svc_acct__popnum_flag eq "F" ) {
-- print qq!<INPUT TYPE="hidden" NAME="popnum" VALUE="$popnum">!;
--} else {
-- print qq!<BR>POP: <SELECT NAME="popnum" SIZE=1><OPTION>\n!;
-- my($svc_acct_pop);
-- foreach $svc_acct_pop ( qsearch ('svc_acct_pop',{} ) ) {
-- print "<OPTION", $svc_acct_pop->popnum == $popnum ? ' SELECTED' : '', ">",
-- $svc_acct_pop->popnum, ": ",
-- $svc_acct_pop->city, ", ",
-- $svc_acct_pop->state,
-- "(", $svc_acct_pop->ac, ")/",
-- $svc_acct_pop->exch, "\n"
-- ;
-- }
-- print "</SELECT>";
--}
--
--my($uid,$gid,$finger,$dir)=(
-- $svc_acct->uid,
-- $svc_acct->gid,
-- $svc_acct->finger,
-- $svc_acct->dir,
--);
--
--print <<END;
--<INPUT TYPE="hidden" NAME="uid" VALUE="$uid">
--<INPUT TYPE="hidden" NAME="gid" VALUE="$gid">
--<BR>GECOS: <INPUT TYPE="text" NAME="finger" VALUE="$finger">
--<INPUT TYPE="hidden" NAME="dir" VALUE="$dir">
--END
--
--my($shell)=$svc_acct->shell;
--if ( $part_svc->svc_acct__shell_flag eq "F" ) {
-- print qq!<INPUT TYPE="hidden" NAME="shell" VALUE="$shell">!;
--} else {
-- print qq!<BR>Shell: <SELECT NAME="shell" SIZE=1>!;
-- my($etc_shell);
-- foreach $etc_shell (@shells) {
-- print "<OPTION", $etc_shell eq $shell ? ' SELECTED' : '', ">",
-- $etc_shell, "\n";
-- }
-- print "</SELECT>";
--}
--
--my($quota,$slipip)=(
-- $svc_acct->quota,
-- $svc_acct->slipip,
--);
--
--print qq!<INPUT TYPE="hidden" NAME="quota" VALUE="$quota">!;
--
--if ( $part_svc->svc_acct__slipip_flag eq "F" ) {
-- print qq!<INPUT TYPE="hidden" NAME="slipip" VALUE="$slipip">!;
--} else {
-- print qq!<BR>IP: <INPUT TYPE="text" NAME="slipip" VALUE="$slipip">!;
--}
--
--#submit
--print qq!<P><CENTER><INPUT TYPE="submit" VALUE="Submit"></CENTER>!;
--
--print <<END;
-- </FORM>
-- </BODY>
--</HTML>
--END
--
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# svc_acct_pop.cgi: Add/Edit pop (output form)
--#
--# ivan@sisd.com 98-mar-8
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# lose background, FS::CGI ivan@sisd.com 98-sep-2
--
--use strict;
--use CGI::Base;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearch qsearchs);
--use FS::svc_acct_pop;
--use FS::CGI qw(header menubar);
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--
--&cgisuidsetup($cgi);
--
--SendHeaders(); # one guess.
--
--my($svc_acct_pop,$action);
--if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
-- $svc_acct_pop=qsearchs('svc_acct_pop',{'popnum'=>$1});
-- $action='Edit';
--} else { #adding
-- $svc_acct_pop=create FS::svc_acct_pop {};
-- $action='Add';
--}
--my($hashref)=$svc_acct_pop->hashref;
--
--print header("$action POP", menubar(
-- 'Main Menu' => '../',
-- 'View all POPs' => "../browse/svc_acct_pop.cgi",
--)), <<END;
-- <FORM ACTION="process/svc_acct_pop.cgi" METHOD=POST>
--END
--
--#display
--
--print qq!<INPUT TYPE="hidden" NAME="popnum" VALUE="$hashref->{popnum}">!,
-- "POP #", $hashref->{popnum} ? $hashref->{popnum} : "(NEW)";
--
--print <<END;
--<PRE>
--City <INPUT TYPE="text" NAME="city" SIZE=32 VALUE="$hashref->{city}">
--State <INPUT TYPE="text" NAME="state" SIZE=3 MAXLENGTH=2 VALUE="$hashref->{state}">
--Area Code <INPUT TYPE="text" NAME="ac" SIZE=4 MAXLENGTH=3 VALUE="$hashref->{ac}">
--Exchange <INPUT TYPE="text" NAME="exch" SIZE=4 MAXLENGTH=3 VALUE="$hashref->{exch}">
--</PRE>
--END
--
--print qq!<BR><INPUT TYPE="submit" VALUE="!,
-- $hashref->{popnum} ? "Apply changes" : "Add POP",
-- qq!">!;
--
--print <<END;
-- </FORM>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# svc_acct_sm.cgi: Add/edit a mail alias (output form)
--#
--# Usage: svc_acct_sm.cgi {svcnum} | pkgnum{pkgnum}-svcpart{svcpart}
--# http://server.name/path/svc_acct_sm.cgi? {svcnum} | pkgnum{pkgnum}-svcpart{svcpart}
--#
--# use {svcnum} for edit, pkgnum{pkgnum}-svcpart{svcpart} for add
--#
--# Note: Should be run setuid freeside as user nobody.
--#
--# should error out in a more CGI-friendly way, and should have more error checking (sigh).
--#
--# ivan@voicenet.com 97-jan-5
--#
--# added debugging code; fixed CPU-sucking problem with trying to edit an (unaudited) mail alias (no pkgnum)
--#
--# ivan@voicenet.com 97-may-7
--#
--# fixed uid selection
--# ivan@voicenet.com 97-jun-4
--#
--# uid selection across _CUSTOMER_, not just _PACKAGE_
--#
--# ( i need to be rewritten with fast searches)
--#
--# ivan@voicenet.com 97-oct-3
--#
--# added fast searches in some of the places where it is sorely needed...
--# I see DBI::mysql in your future...
--# ivan@voicenet.com 97-oct-23
--#
--# rewrite ivan@sisd.com 98-mar-15
--#
--# /var/spool/freeside/conf/domain ivan@sisd.com 98-jul-26
--
--use strict;
--use CGI::Base qw(:DEFAULT :CGI);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearch qsearchs);
--use FS::svc_acct_sm qw(fields);
--
--my($conf_domain)="/var/spool/freeside/conf/domain";
--open(DOMAIN,$conf_domain) or die "Can't open $conf_domain: $!";
--my($mydomain)=map {
-- /^(.*)$/ or die "Illegal line in $conf_domain!"; #yes, we trust the file
-- $1
--} grep $_ !~ /^(#|$)/, <DOMAIN>;
--close DOMAIN;
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--&cgisuidsetup($cgi);
--
--SendHeaders(); # one guess.
--
--my($action,$svcnum,$svc_acct_sm,$pkgnum,$svcpart,$part_svc);
--if ( $QUERY_STRING =~ /^(\d+)$/ ) { #editing
--
-- $svcnum=$1;
-- $svc_acct_sm=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum})
-- or die "Unknown (svc_acct_sm) svcnum!";
--
-- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
-- or die "Unknown (cust_svc) svcnum!";
--
-- $pkgnum=$cust_svc->pkgnum;
-- $svcpart=$cust_svc->svcpart;
--
-- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
-- die "No part_svc entry!" unless $part_svc;
--
-- $action="Edit";
--
--} else { #adding
--
-- $svc_acct_sm=create FS::svc_acct_sm({});
--
-- foreach $_ (split(/-/,$QUERY_STRING)) { #get & untaint pkgnum & svcpart
-- $pkgnum=$1 if /^pkgnum(\d+)$/;
-- $svcpart=$1 if /^svcpart(\d+)$/;
-- }
-- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
-- die "No part_svc entry!" unless $part_svc;
--
-- $svcnum='';
--
-- #set fixed and default fields from part_svc
-- my($field);
-- foreach $field ( fields('svc_acct_sm') ) {
-- if ( $part_svc->getfield('svc_acct_sm__'. $field. '_flag') ne '' ) {
-- $svc_acct_sm->setfield($field,$part_svc->getfield('svc_acct_sm__'. $field) );
-- }
-- }
--
-- $action='Add';
--
--}
--
--my(%username,%domain);
--if ($pkgnum) {
--
-- #find all possible uids (and usernames)
--
-- my($u_part_svc,@u_acct_svcparts);
-- foreach $u_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_acct'}) ) {
-- push @u_acct_svcparts,$u_part_svc->getfield('svcpart');
-- }
--
-- my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-- my($custnum)=$cust_pkg->getfield('custnum');
-- my($i_cust_pkg);
-- foreach $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
-- my($cust_pkgnum)=$i_cust_pkg->getfield('pkgnum');
-- my($acct_svcpart);
-- foreach $acct_svcpart (@u_acct_svcparts) { #now find the corresponding
-- #record(s) in cust_svc ( for this
-- #pkgnum ! )
-- my($i_cust_svc);
-- foreach $i_cust_svc ( qsearch('cust_svc',{'pkgnum'=>$cust_pkgnum,'svcpart'=>$acct_svcpart}) ) {
-- my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$i_cust_svc->getfield('svcnum')});
-- $username{$svc_acct->getfield('uid')}=$svc_acct->getfield('username');
-- }
-- }
-- }
--
-- #find all possible domains (and domsvc's)
--
-- my($d_part_svc,@d_acct_svcparts);
-- foreach $d_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_domain'}) ) {
-- push @d_acct_svcparts,$d_part_svc->getfield('svcpart');
-- }
--
-- foreach $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
-- my($cust_pkgnum)=$i_cust_pkg->getfield('pkgnum');
-- my($acct_svcpart);
-- foreach $acct_svcpart (@d_acct_svcparts) {
-- my($i_cust_svc);
-- foreach $i_cust_svc ( qsearch('cust_svc',{'pkgnum'=>$cust_pkgnum,'svcpart'=>$acct_svcpart}) ) {
-- my($svc_domain)=qsearch('svc_domain',{'svcnum'=>$i_cust_svc->getfield('svcnum')});
-- $domain{$svc_domain->getfield('svcnum')}=$svc_domain->getfield('domain');
-- }
-- }
-- }
--
--} elsif ( $action eq 'Edit' ) {
--
-- my($svc_acct)=qsearchs('svc_acct',{'uid'=>$svc_acct_sm->domuid});
-- $username{$svc_acct_sm->uid} = $svc_acct->username;
--
-- my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$svc_acct_sm->domsvc});
-- $domain{$svc_acct_sm->domsvc} = $svc_domain->domain;
--
--} else {
-- die "\$action eq Add, but \$pkgnum is null!\n";
--}
--
--print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Mail Alias $action</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H1>Mail Alias $action</H1>
-- </CENTER>
-- <FORM ACTION="process/svc_acct_sm.cgi" METHOD=POST>
--END
--
--#display
--
-- #formatting
-- print "<PRE>";
--
--#svcnum
--print qq!<INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum">!;
--print qq!Service #<FONT SIZE=+1><B>!, $svcnum ? $svcnum : " (NEW)", "</B></FONT>";
--
--#pkgnum
--print qq!<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">!;
--
--#svcpart
--print qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">!;
--
--my($domuser,$domsvc,$domuid)=(
-- $svc_acct_sm->domuser,
-- $svc_acct_sm->domsvc,
-- $svc_acct_sm->domuid,
--);
--
--#domuser
--print qq!\n\nMail to <INPUT TYPE="text" NAME="domuser" VALUE="$domuser"> <I>( * for anything )</I>!;
--
--#domsvc
--print qq! \@ <SELECT NAME="domsvc" SIZE=1>!;
--foreach $_ (keys %domain) {
-- print "<OPTION", $_ eq $domsvc ? " SELECTED" : "", ">$_: $domain{$_}";
--}
--print "</SELECT>";
--
--#uid
--print qq!\nforwards to <SELECT NAME="domuid" SIZE=1>!;
--foreach $_ (keys %username) {
-- print "<OPTION", ($_ eq $domuid) ? " SELECTED" : "", ">$_: $username{$_}";
--}
--print "</SELECT>\@$mydomain mailbox.";
--
-- #formatting
-- print "</PRE>\n";
--
--print qq!<CENTER><INPUT TYPE="submit" VALUE="Submit"></CENTER>!;
--
--print <<END;
--
-- </FORM>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# svc_domain.cgi: Add domain (output form)
--#
--# Usage: svc_domain.cgi pkgnum{pkgnum}-svcpart{svcpart}
--# http://server.name/path/svc_domain.cgi?pkgnum{pkgnum}-svcpart{svcpart}
--#
--# Note: Should be run setuid freeside as user nobody
--#
--# ivan@voicenet.com 97-jan-5 -> 97-jan-6
--#
--# changes for domain template 3.5
--# ivan@voicenet.com 97-jul-24
--#
--# rewrite ivan@sisd.com 98-mar-14
--#
--# no GOV in instructions ivan@sisd.com 98-jul-17
--
--use strict;
--use CGI::Base qw(:DEFAULT :CGI);
--use FS::UID qw(cgisuidsetup getotaker);
--use FS::Record qw(qsearch qsearchs);
--use FS::svc_domain qw(fields);
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--&cgisuidsetup($cgi);
--
--my($action,$svcnum,$svc_domain,$pkgnum,$svcpart,$part_svc);
--
--if ( $QUERY_STRING =~ /^(\d+)$/ ) { #editing
--
-- $svcnum=$1;
-- $svc_domain=qsearchs('svc_domain',{'svcnum'=>$svcnum})
-- or die "Unknown (svc_domain) svcnum!";
--
-- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
-- or die "Unknown (cust_svc) svcnum!";
--
-- $pkgnum=$cust_svc->pkgnum;
-- $svcpart=$cust_svc->svcpart;
--
-- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
-- die "No part_svc entry!" unless $part_svc;
--
-- $action="Edit";
--
--} else { #adding
--
-- $svc_domain=create FS::svc_domain({});
--
-- foreach $_ (split(/-/,$QUERY_STRING)) {
-- $pkgnum=$1 if /^pkgnum(\d+)$/;
-- $svcpart=$1 if /^svcpart(\d+)$/;
-- }
-- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
-- die "No part_svc entry!" unless $part_svc;
--
-- $svcnum='';
--
-- #set fixed and default fields from part_svc
-- my($field);
-- foreach $field ( fields('svc_domain') ) {
-- if ( $part_svc->getfield('svc_domain__'. $field. '_flag') ne '' ) {
-- $svc_domain->setfield($field,$part_svc->getfield('svc_domain__'. $field) );
-- }
-- }
--
-- $action="Add";
--
--}
--
--my($svc)=$part_svc->getfield('svc');
--
--my($otaker)=getotaker;
--
--my($domain)=(
-- $svc_domain->domain,
--);
--
--SendHeaders();
--print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>$action $svc</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H1>$action $svc</H1>
-- </CENTER><HR>
-- <FORM ACTION="process/svc_domain.cgi" METHOD=POST>
-- <INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum">
-- <INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">
-- <INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">
-- <INPUT TYPE="radio" NAME="action" VALUE="N">New
-- <BR><INPUT TYPE="radio" NAME="action" VALUE="M">Transfer
--
--<P>Customer agrees to be bound by NSI's
--<A HREF="http://rs.internic.net/help/agreement.txt">
--Domain Name Registration Agreement</A>
--<SELECT NAME="legal" SIZE=1><OPTION SELECTED>No<OPTION>Yes</SELECT>
--<P>Domain <INPUT TYPE="text" NAME="domain" VALUE="$domain" SIZE=28 MAXLENGTH=26>
--<BR>Purpose/Description: <INPUT TYPE="text" NAME="purpose" VALUE="" SIZE=64>
--<P><CENTER><INPUT TYPE="submit" VALUE="Submit"></CENTER>
--<UL>
-- <LI>COM is for commercial, for-profit organziations
-- <LI>ORG is for miscellaneous, usually, non-profit organizations
-- <LI>NET is for network infrastructure machines and organizations
-- <LI>EDU is for 4-year, degree granting institutions
--<!-- <LI>GOV is for United States federal government agencies
--!-->
--</UL>
--US state and local government agencies, schools, libraries, museums, and individuals should register under the US domain. See RFC 1480 for a complete description of the US domain
--and registration procedures.
--<P>GOV registrations are limited to top-level US Federal Government agencies (see RFC 1816).
-- </FORM>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--<HTML>
-- <HEAD>
-- <TITLE>
-- Freeside Main Menu
-- </TITLE>
-- </HEAD>
-- <BODY BGCOLOR="#FFFFFF">
-- <table>
-- <tr><td>
-- <P ALIGN=CENTER>
-- <IMG BORDER=0 ALT="Silicon Interactive Software Design" SRC="images/small-logo.gif">
-- </td><td>
-- <center><font color="#ff0000" size=7>freeside main menu</font></center>
-- </td></tr>
-- </table>
-- <A HREF="http://www.sisd.com/freeside">
-- Information
-- </A>
-- <BR><A HREF="docs/">
-- Documentation
-- </A>
-- </P>
-- <HR>
-- <H3><A HREF="edit/cust_main.cgi">New Customer</A></H3>
-- <A NAME="search"><H3>Search</H3></A>
-- <MENU>
-- <LI><A HREF="search/cust_main.html">
-- customers (by last name and/or company)
-- </A>
-- <LI><A HREF="search/cust_main-payinfo.html">customers (by credit card number)</A>
-- <LI><A HREF="search/svc_acct.html">accounts (by username)</A>
-- <LI><A HREF="search/svc_domain.html">domains (by domain)</A>
-- <LI><A HREF="search/svc_acct_sm.html">mail aliases (by domain, and optionally username)</A>
-- <LI><A HREF="search/cust_bill.html">invoices (by invoice number)</A>
-- </MENU>
-- <A NAME="browse"><H3>Browse</H3></A>
-- <MENU>
-- <LI><A HREF="search/cust_main.cgi?custnum">customers (by customer number)</A>
-- <LI><A HREF="search/cust_main.cgi?last">customers (by last name)</A>
-- <LI><A HREF="search/cust_main.cgi?company">customers (by company)</A>
-- <LI><A HREF="search/cust_pkg.cgi?pkgnum">packages (by package number)</A>
-- <LI><A HREF="search/cust_pkg.cgi?APKG_pkgnum">packages with unconfigured services (by package number)</A>
-- <LI><A HREF="search/svc_acct.cgi?svcnum">accounts (by service number)</A>
-- <LI><A HREF="search/svc_acct.cgi?username">accounts (by username)</A>
-- <LI><A HREF="search/svc_acct.cgi?uid">accounts (by uid)</A>
-- <LI><A HREF="search/svc_acct.cgi?UN_svcnum">unlinked accounts (by service number)</A>
-- <LI><A HREF="search/svc_acct.cgi?UN_username">unlinked accounts (by username)</A>
-- <LI><A HREF="search/svc_acct.cgi?UN_uid">unlinked accounts (by uid)</A>
-- <LI><A HREF="search/svc_domain.cgi?svcnum">domains (by service number)</A>
-- <LI><A HREF="search/svc_domain.cgi?domain">domains (by domain)</A>
-- <LI><A HREF="search/svc_domain.cgi?UN_svcnum">unlinked domains (by service number)</A>
-- <LI><A HREF="search/svc_domain.cgi?UN_domain">unlinked domains (by domain)</A>
-- </MENU>
-- <A NAME="admin"><H3>Administration</H3></a>
-- <MENU>
-- <LI><A HREF="browse/part_svc.cgi">
-- View/Edit services
-- </A>
-- - Services are items you offer to your customers.
-- <LI><A HREF="browse/part_pkg.cgi">
-- View/Edit packages
-- </A>
-- - One or more services are grouped together into a package and
-- given pricing information. Customers purchase packages, not
-- services.
-- <LI><A HREF="browse/agent_type.cgi">
-- View/Edit agent types
-- </A>
-- - Agent types define groups of packages that you can then assign
-- to particular agents.
-- <LI><A HREF="browse/agent.cgi">
-- View/Edit agents
-- </A>
-- - Agents are resellers of your service. Agents may be limited
- to a subset of your full offerings (via their agent type).
- to a subset of your full offerings (via their type).
-- <BR>
-- <LI><A HREF="browse/part_referral.cgi">
-- View/Edit referrals
-- </A>
-- - Where a customer heard about your service. Tracked for
-- informational purposes.
-- <BR>
-- <LI><A HREF="browse/cust_main_county.cgi">
-- View/Edit locales and tax rates
-- </A>
-- - Change tax rates by state, or break down a state into counties
-- and assign different tax rates to each county.
-- <BR>
-- <LI><A HREF="browse/svc_acct_pop.cgi">
-- View/Edit POPs
-- </A>
-- - Points of Presence
-- </MENU>
-- </FONT>
-- </BODY>
--</HTML>
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# s/FS:Search/FS::Record/ and cgisuidsetup($cgi) ivan@sisd.com 98-mar-13
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--
--use strict;
--use CGI::Base qw(:DEFAULT :CGI);
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearchs);
--use FS::Bill;
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--&cgisuidsetup($cgi);
--
--#untaint custnum
--$QUERY_STRING =~ /^(\d*)$/;
--my($custnum)=$1;
--my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
--die "Can't find customer!\n" unless $cust_main;
--
--# ?
--bless($cust_main,"FS::Bill");
--
--my($error);
--
--$error = $cust_main->bill(
--# 'time'=>$time
-- );
--&idiot($error) if $error;
--
--$error = $cust_main->collect(
--# 'invoice-time'=>$time,
--# 'batch_card'=> 'yes',
-- 'batch_card'=> 'no',
-- 'report_badcard'=> 'yes',
-- );
--&idiot($error) if $error;
--
--$cgi->redirect("../view/cust_main.cgi?$custnum#history");
--
--sub idiot {
-- my($error)=@_;
-- CGI::Base::SendHeaders(); # one guess
-- print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Error billing customer</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H4>Error billing customer</H4>
-- </CENTER>
-- Your update did not occur because of the following error:
-- <P><B>$error</B>
-- </BODY>
--</HTML>
--END
--
-- exit;
--
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# cancel-unaudited.cgi: Cancel an unaudited account
--#
--# Usage: cancel-unaudited.cgi svcnum
--# http://server.name/path/cancel-unaudited.cgi pkgnum
--#
--# Note: Should be run setuid freeside as user nobody
--#
--# ivan@voicenet.com 97-apr-23
--#
--# rewrote for new API
--# ivan@voicenet.com 97-jul-21
--#
--# Search->Record, cgisuidsetup($cgi) ivan@sids.com 98-mar-19
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--
--use strict;
--use CGI::Base qw(:DEFAULT :CGI); # CGI module
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearchs);
--use FS::cust_svc;
--use FS::svc_acct;
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--&cgisuidsetup($cgi);
--
--#untaint svcnum
--$QUERY_STRING =~ /^(\d+)$/;
--my($svcnum)=$1;
--
--my($svc_acct) = qsearchs('svc_acct',{'svcnum'=>$svcnum});
--&idiot("Unknown svcnum!") unless $svc_acct;
--
--my($cust_svc) = qsearchs('cust_svc',{'svcnum'=>$svcnum});
--&idiot(qq!This account has already been audited. Cancel the
-- <A HREF="../view/cust_pkg.cgi?! . $cust_svc->getfield('pkgnum') .
-- qq!pkgnum"> package</A> instead.!)
-- if $cust_svc->getfield('pkgnum') ne '';
--
--local $SIG{HUP} = 'IGNORE';
--local $SIG{INT} = 'IGNORE';
--local $SIG{QUIT} = 'IGNORE';
--local $SIG{TERM} = 'IGNORE';
--local $SIG{TSTP} = 'IGNORE';
--
--my($error);
--
--bless($svc_acct,"FS::svc_acct");
--$error = $svc_acct->cancel;
--&idiot($error) if $error;
--$error = $svc_acct->delete;
--&idiot($error) if $error;
--
--bless($cust_svc,"FS::cust_svc");
--$error = $cust_svc->delete;
--&idiot($error) if $error;
--
--$cgi->redirect("../");
--
--sub idiot {
-- my($error)=@_;
-- SendHeaders();
-- print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Error cancelling account</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H1>Error cancelling account</H1>
-- </CENTER>
-- <HR>
-- There has been an error cancelling this acocunt: $error
-- </BODY>
-- </HEAD>
--</HTML>
--END
-- exit;
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# cancel_pkg.cgi: Cancel a package
--#
--# Usage: cancel_pkg.cgi pkgnum
--# http://server.name/path/cancel_pkg.cgi pkgnum
--#
--# Note: Should be run setuid freeside as user nobody
--#
--# IT DOESN'T RUN THE APPROPRIATE PROGRAMS YET!!!!
--#
--# probably should generalize this to do cancels, suspensions, unsuspensions, etc.
--#
--# ivan@voicenet.com 97-jan-2
--#
--# still kludgy, but now runs /dbin/cancel $pkgnum
--# ivan@voicenet.com 97-feb-27
--#
--# doesn't run if pkgnum doesn't match regex
--# ivan@voicenet.com 97-mar-6
--#
--# now redirects to enter comments
--# ivan@voicenet.com 97-may-8
--#
--# rewrote for new API
--# ivan@voicenet.com 97-jul-21
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--
--use strict;
--use CGI::Base qw(:DEFAULT :CGI); # CGI module
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearchs);
--use FS::cust_pkg;
--use FS::CGI qw(idiot);
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--&cgisuidsetup($cgi);
--
--#untaint pkgnum
--$QUERY_STRING =~ /^(\d+)$/ || die "Illegal pkgnum";
--my($pkgnum)=$1;
--
--my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
--
--bless($cust_pkg,'FS::cust_pkg');
--my($error)=$cust_pkg->cancel;
--idiot($error) if $error;
--
--$cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# expire_pkg.cgi: Expire a package
--#
--# Usage: post form to:
--# http://server.name/path/expire_pkg.cgi
--#
--# Note: Should be run setuid freeside as user nobody
--#
--# based on susp_pkg
--# ivan@voicenet.com 97-jul-29
--#
--# ivan@sisd.com 98-mar-17 FS::Search->FS::Record
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--
--use strict;
--use Date::Parse;
--use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearchs);
--use FS::cust_pkg;
--
--my($req) = new CGI::Request;
--&cgisuidsetup($req->cgi);
--
--#untaint date & pkgnum
--
--my($date);
--if ( $req->param('date') ) {
-- str2time($req->param('date')) =~ /^(\d+)$/ or die "Illegal date";
-- $date=$1;
--} else {
-- $date='';
--}
--
--$req->param('pkgnum') =~ /^(\d+)$/ or die "Illegal pkgnum";
--my($pkgnum)=$1;
--
--my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
--my(%hash)=$cust_pkg->hash;
--$hash{expire}=$date;
--my($new)=create FS::cust_pkg ( \%hash );
--my($error) = $new->replace($cust_pkg);
--&idiot($error) if $error;
--
--$req->cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
--
--sub idiot {
-- my($error)=@_;
-- SendHeaders();
-- print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Error expiring package</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H1>Error expiring package</H1>
-- </CENTER>
-- <HR>
-- There has been an error expiring this package: $error
-- </BODY>
-- </HEAD>
--</HTML>
--END
-- exit;
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# link: instead of adding a new account, link to an existing. (output form)
--#
--# Note: Should be run setuid freeside as user nobody
--#
--# ivan@voicenet.com 97-feb-5
--#
--# rewrite ivan@sisd.com 98-mar-17
--#
--# can also link on some other fields now (about time) ivan@sisd.com 98-jun-24
--
--use strict;
--use CGI::Base qw(:DEFAULT :CGI);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearchs);
--
--my(%link_field)=(
-- 'svc_acct' => 'username',
-- 'svc_domain' => 'domain',
-- 'svc_acct_sm' => '',
-- 'svc_charge' => '',
-- 'svc_wo' => '',
--);
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--cgisuidsetup($cgi);
--
--my($pkgnum,$svcpart);
--foreach $_ (split(/-/,$QUERY_STRING)) { #get & untaint pkgnum & svcpart
-- $pkgnum=$1 if /^pkgnum(\d+)$/;
-- $svcpart=$1 if /^svcpart(\d+)$/;
--}
--
--my($part_svc) = qsearchs('part_svc',{'svcpart'=>$svcpart});
--my($svc) = $part_svc->getfield('svc');
--my($svcdb) = $part_svc->getfield('svcdb');
--my($link_field) = $link_field{$svcdb};
--
--CGI::Base::SendHeaders();
--print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Link to existing $svc account</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H1>Link to existing $svc account</H1>
-- </CENTER><HR>
-- <FORM ACTION="process/link.cgi" METHOD=POST>
--END
--
--if ( $link_field ) {
-- print <<END;
-- <INPUT TYPE="hidden" NAME="svcnum" VALUE="">
-- <INPUT TYPE="hidden" NAME="link_field" VALUE="$link_field">
-- $link_field of existing service: <INPUT TYPE="text" NAME="link_value">
--END
--} else {
-- print qq!Service # of existing service: <INPUT TYPE="text" NAME="svcnum" VALUE="">!;
--}
--
--print <<END;
--<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">
--<INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">
--<P><CENTER><INPUT TYPE="submit" VALUE="Link"></CENTER>
-- </FORM>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# just a kludge for now, since this duplicates in a way it shouldn't stuff from
--# Bill.pm (like $lpr) ivan@sisd.com 98-jun-16
--
--use strict;
--use CGI::Base qw(:DEFAULT :CGI);
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearchs);
--use FS::Invoice;
--
--my($lpr) = "|lpr -h";
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--&cgisuidsetup($cgi);
--
--#untaint invnum
--$QUERY_STRING =~ /^(\d*)$/;
--my($invnum)=$1;
--my($cust_bill)=qsearchs('cust_bill',{'invnum'=>$invnum});
--die "Can't find invoice!\n" unless $cust_bill;
--
-- bless($cust_bill,"FS::Invoice");
-- open(LPR,$lpr) or die "Can't open $lpr: $!";
-- print LPR $cust_bill->print_text; #( date )
-- close LPR
-- or die $! ? "Error closing $lpr: $!"
-- : "Exit status $? from $lpr";
--
--my($custnum)=$cust_bill->getfield('custnum');
--
--$cgi->redirect("../view/cust_main.cgi?$custnum#history");
--
--sub idiot {
-- my($error)=@_;
-- CGI::Base::SendHeaders(); # one guess
-- print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Error printing invoice</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H4>Error printing invoice</H4>
-- </CENTER>
-- Your update did not occur because of the following error:
-- <P><B>$error</B>
-- </BODY>
--</HTML>
--END
--
-- exit;
--
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# process/link.cgi: link to existing customer (process form)
--#
--# ivan@voicenet.com 97-feb-5
--#
--# rewrite ivan@sisd.com 98-mar-18
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# can also link on some other fields now (about time) ivan@sisd.com 98-jun-24
--
--use strict;
--use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::CGI qw(idiot);
--use FS::UID qw(cgisuidsetup);
--use FS::cust_svc;
--use FS::Record qw(qsearchs);
--
--my($req)=new CGI::Request; # create form object
--cgisuidsetup($req->cgi);
--
--#$req->import_names('R'); #import CGI variables into package 'R';
--
--$req->param('pkgnum') =~ /^(\d+)$/; my($pkgnum)=$1;
--$req->param('svcpart') =~ /^(\d+)$/; my($svcpart)=$1;
--
--$req->param('svcnum') =~ /^(\d*)$/; my($svcnum)=$1;
--unless ( $svcnum ) {
-- my($part_svc) = qsearchs('part_svc',{'svcpart'=>$svcpart});
-- my($svcdb) = $part_svc->getfield('svcdb');
-- $req->param('link_field') =~ /^(\w+)$/; my($link_field)=$1;
-- my($svc_acct)=qsearchs($svcdb,{$link_field => $req->param('link_value') });
-- idiot("$link_field not found!") unless $svc_acct;
-- $svcnum=$svc_acct->svcnum;
--}
--
--my($old)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
--die "svcnum not found!" unless $old;
--my($new)=create FS::cust_svc ({
-- 'svcnum' => $svcnum,
-- 'pkgnum' => $pkgnum,
-- 'svcpart' => $svcpart,
--});
--
--my($error);
--$error = $new->replace($old);
--
--unless ($error) {
-- #no errors, so let's view this customer.
-- $req->cgi->redirect("../../view/cust_pkg.cgi?$pkgnum");
--} else {
-- CGI::Base::SendHeaders(); # one guess
-- print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Error</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H4>Error</H4>
-- </CENTER>
-- Your update did not occur because of the following error:
-- <P><B>$error</B>
-- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again.
-- </BODY>
--</HTML>
--END
--
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# susp_pkg.cgi: Suspend a package
--#
--# Usage: susp_pkg.cgi pkgnum
--# http://server.name/path/susp_pkg.cgi pkgnum
--#
--# Note: Should be run setuid freeside as user nobody
--#
--# probably should generalize this to do cancels, suspensions, unsuspensions, etc.
--#
--# ivan@voicenet.com 97-feb-27
--#
--# now redirects to enter comments
--# ivan@voicenet.com 97-may-8
--#
--# rewrote for new API
--# ivan@voicenet.com 97-jul-21
--#
--# FS::Search -> FS::Record ivan@sisd.com 98-mar-17
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--
--use strict;
--use CGI::Base qw(:DEFAULT :CGI); # CGI module
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearchs);
--use FS::cust_pkg;
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--&cgisuidsetup($cgi);
--
--#untaint pkgnum
--$QUERY_STRING =~ /^(\d+)$/ || die "Illegal pkgnum";
--my($pkgnum)=$1;
--
--my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
--
--bless($cust_pkg,'FS::cust_pkg');
--my($error)=$cust_pkg->suspend;
--&idiot($error) if $error;
--
--$cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
--
--sub idiot {
-- my($error)=@_;
-- SendHeaders();
-- print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Error suspending package</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H1>Error suspending package</H1>
-- </CENTER>
-- <HR>
-- There has been an error suspending this package: $error
-- </BODY>
-- </HEAD>
--</HTML>
--END
-- exit;
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# susp_pkg.cgi: Unsuspend a package
--#
--# Usage: susp_pkg.cgi pkgnum
--# http://server.name/path/susp_pkg.cgi pkgnum
--#
--# Note: Should be run setuid freeside as user nobody
--#
--# probably should generalize this to do cancels, suspensions, unsuspensions, etc.
--#
--# ivan@voicenet.com 97-feb-27
--#
--# now redirects to enter comments
--# ivan@voicenet.com 97-may-8
--#
--# rewrote for new API
--# ivan@voicenet.com 97-jul-21
--#
--# FS::Search -> FS::Record ivan@sisd.com 98-mar-17
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--
--use strict;
--use CGI::Base qw(:DEFAULT :CGI); # CGI module
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearchs);
--use FS::cust_pkg;
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--&cgisuidsetup($cgi);
--
--#untaint pkgnum
--$QUERY_STRING =~ /^(\d+)$/ || die "Illegal pkgnum";
--my($pkgnum)=$1;
--
--my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
--
--bless($cust_pkg,'FS::cust_pkg');
--my($error)=$cust_pkg->unsuspend;
--&idiot($error) if $error;
--
--$cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
--
--sub idiot {
-- my($error)=@_;
-- SendHeaders();
-- print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Error unsuspending package</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H1>Error unsuspending package</H1>
-- </CENTER>
-- <HR>
-- There has been an error unsuspending this package: $error
-- </BODY>
-- </HEAD>
--</HTML>
--END
-- exit;
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# cust_bill.cgi: Search for invoices (process form)
--#
--# Usage: post form to:
--# http://server.name/path/cust_bill.cgi
--#
--# Note: Should be run setuid freeside as user nobody.
--#
--# ivan@voicenet.com 97-apr-4
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--
--use strict;
--use CGI::Request;
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearchs);
--
--my($req)=new CGI::Request;
--cgisuidsetup($req->cgi);
--
--$req->param('invnum') =~ /^\s*(FS-)?(\d+)\s*$/;
--my($invnum)=$2;
--
--if ( qsearchs('cust_bill',{'invnum'=>$invnum}) ) {
-- $req->cgi->redirect("../view/cust_bill.cgi?$invnum"); #redirect
--} else { #error
-- CGI::Base::SendHeaders(); # one guess
-- print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Invoice Search Error</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H3>Invoice Search Error</H3>
-- <HR>
-- Invoice not found.
-- </CENTER>
-- </BODY>
--</HTML>
--END
--
--}
--
+++ /dev/null
--<HTML>
-- <HEAD>
-- <TITLE>Invoice Search</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H1>Invoice Search</H1>
-- </CENTER>
-- <HR>
-- <FORM ACTION="cust_bill.cgi" METHOD="post">
-- Search for <B>invoice #</B>:
-- <INPUT TYPE="text" NAME="invnum">
--
-- <P><INPUT TYPE="submit" VALUE="Search">
--
-- </FORM>
--
-- <HR>
-- </BODY>
--</HTML>
--
+++ /dev/null
--<HTML>
-- <HEAD>
-- <TITLE>Customer Search</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H1>Customer Search</H1>
-- </CENTER>
-- <HR>
-- <FORM ACTION="cust_main.cgi" METHOD="post">
-- Search for <B>Credit card #</B>:
-- <INPUT TYPE="hidden" NAME="card_on" VALUE="TRUE">
-- <INPUT TYPE="text" NAME="card">
--
-- <P><INPUT TYPE="submit" VALUE="Search">
--
-- </FORM>
-- <HR>
-- </BODY>
--</HTML>
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# process/cust_main.cgi: Search for customers (process form)
--#
--# Usage: post form to:
--# http://server.name/path/cust_main.cgi
--#
--# Note: Should be run setuid freeside as user nobody.
--#
--# ivan@voicenet.com 96-dec-12
--#
--# rewrite ivan@sisd.com 98-mar-4
--#
--# now does browsing too ivan@sisd.com 98-mar-6
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# display total, use FS::CGI ivan@sisd.com 98-jul-17
--
--use strict;
--use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use IO::Handle;
--use IPC::Open2;
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearch qsearchs);
--use FS::CGI qw(header idiot);
--
--my($fuzziness)=2; #fuzziness for fuzzy searches, see man agrep
-- #0-4: 0=no fuzz, 4=very fuzzy (too much fuzz!)
--
--my($req)=new CGI::Request;
--&cgisuidsetup($req->cgi);
--
--my(@cust_main);
--my($sortby);
--
--my($query)=$req->cgi->var('QUERY_STRING');
--if ( $query eq 'custnum' ) {
-- $sortby=\*custnum_sort;
-- @cust_main=qsearch('cust_main',{});
--} elsif ( $query eq 'last' ) {
-- $sortby=\*last_sort;
-- @cust_main=qsearch('cust_main',{});
--} elsif ( $query eq 'company' ) {
-- $sortby=\*company_sort;
-- @cust_main=qsearch('cust_main',{});
--} else {
-- &cardsearch if ($req->param('card_on') );
-- &lastsearch if ($req->param('last_on') );
-- &companysearch if ($req->param('company_on') );
--}
--
--if ( scalar(@cust_main) == 1 ) {
-- $req->cgi->redirect("../view/cust_main.cgi?". $cust_main[0]->custnum);
-- exit;
--} elsif ( scalar(@cust_main) == 0 ) {
-- idiot "No matching customers found!\n";
-- exit;
--} else {
--
-- my($total)=scalar(@cust_main);
-- CGI::Base::SendHeaders(); # one guess
-- print header("Customer Search Results",''), <<END;
--
-- $total matching customers found
-- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
-- <TR>
-- <TH>Cust. #</TH>
-- <TH>Contact name</TH>
-- <TH>Company</TH>
-- </TR>
--END
--
-- my($lines)=16;
-- my($lcount)=$lines;
-- my(%saw,$cust_main);
-- foreach $cust_main (
-- sort $sortby grep(!$saw{$_->custnum}++, @cust_main)
-- ) {
-- my($custnum,$last,$first,$company)=(
-- $cust_main->custnum,
-- $cust_main->getfield('last'),
-- $cust_main->getfield('first'),
-- $cust_main->company,
-- );
-- print <<END;
-- <TR>
-- <TD><A HREF="../view/cust_main.cgi?$custnum"><FONT SIZE=-1>$custnum</FONT></A></TD>
-- <TD><FONT SIZE=-1>$last, $first</FONT></TD>
-- <TD><FONT SIZE=-1>$company</FONT></TD>
-- </TR>
--END
-- if ($lcount-- == 0) { # lots of little tables instead of one big one
-- $lcount=$lines;
-- print <<END;
-- </TABLE>
-- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
-- <TR>
-- <TH>Cust. #</TH>
-- <TH>Contact name</TH>
-- <TH>Company<TH>
-- </TR>
--END
-- }
-- }
--
-- print <<END;
-- </TABLE>
-- </CENTER>
-- </BODY>
--</HTML>
--END
--
--}
--
--#
--
--sub last_sort {
-- $a->getfield('last') cmp $b->getfield('last');
--}
--
--sub company_sort {
-- $a->getfield('company') cmp $b->getfield('company');
--}
--
--sub custnum_sort {
-- $a->getfield('custnum') <=> $b->getfield('custnum');
--}
--
--sub cardsearch {
--
-- my($card)=$req->param('card');
-- $card =~ s/\D//g;
-- $card =~ /^(\d{13,16})$/ or do { idiot "Illegal card number\n"; exit; };
-- my($payinfo)=$1;
--
-- push @cust_main, qsearch('cust_main',{'payinfo'=>$payinfo, 'payby'=>'CARD'});
--
--}
--
--sub lastsearch {
-- my(%last_type);
-- foreach ( $req->param('last_type') ) {
-- $last_type{$_}++;
-- }
--
-- $req->param('last_text') =~ /^([\w \,\.\-\']*)$/
-- or do { idiot "Illegal last name"; exit; };
-- my($last)=$1;
--
-- if ( $last_type{'Exact'}
-- && ! $last_type{'Fuzzy'}
-- # && ! $last_type{'Sound-alike'}
-- ) {
--
-- push @cust_main, qsearch('cust_main',{'last'=>$last});
--
-- } else {
--
-- my(%last);
--
-- my(@all_last)=map $_->getfield('last'), qsearch('cust_main',{});
-- if ($last_type{'Fuzzy'}) {
-- my($reader,$writer) = ( new IO::Handle, new IO::Handle );
-- open2($reader,$writer,'agrep',"-$fuzziness",'-i','-k',
-- substr($last,0,30));
-- print $writer join("\n",@all_last),"\n";
-- close $writer;
-- while (<$reader>) {
-- chop;
-- $last{$_}++;
-- }
-- close $reader;
-- }
--
-- #if ($last_type{'Sound-alike'}) {
-- #}
--
-- foreach ( keys %last ) {
-- push @cust_main, qsearch('cust_main',{'last'=>$_});
-- }
--
-- }
-- $sortby=\*last_sort;
--}
--
--sub companysearch {
--
-- my(%company_type);
-- foreach ( $req->param('company_type') ) {
-- $company_type{$_}++
-- };
--
-- $req->param('company_text') =~ /^([\w \,\.\-\']*)$/
-- or do { idiot "Illegal company"; exit; };
-- my($company)=$1;
--
-- if ( $company_type{'Exact'}
-- && ! $company_type{'Fuzzy'}
-- # && ! $company_type{'Sound-alike'}
-- ) {
--
-- push @cust_main, qsearch('cust_main',{'company'=>$company});
--
-- } else {
--
-- my(%company);
-- my(@all_company)=map $_->company, qsearch('cust_main',{});
--
-- if ($company_type{'Fuzzy'}) {
-- my($reader,$writer) = ( new IO::Handle, new IO::Handle );
-- open2($reader,$writer,'agrep',"-$fuzziness",'-i','-k',
-- substr($company,0,30));
-- print $writer join("\n",@all_company),"\n";
-- close $writer;
-- while (<$reader>) {
-- chop;
-- $company{$_}++;
-- }
-- close $reader;
-- }
--
-- #if ($company_type{'Sound-alike'}) {
-- #}
--
-- foreach ( keys %company ) {
-- push @cust_main, qsearch('cust_main',{'company'=>$_});
-- }
--
-- }
-- $sortby=\*company_sort;
--
--}
+++ /dev/null
--<HTML>
-- <HEAD>
-- <TITLE>Customer Search</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H1>Customer Search</H1>
-- </CENTER>
-- <HR>
-- <FORM ACTION="cust_main.cgi" METHOD="post">
-- <INPUT TYPE="checkbox" NAME="last_on"> Search for <B>last name</B>:
-- <INPUT TYPE="text" NAME="last_text">
-- using search method(s): <SELECT NAME="last_type" MULTIPLE>
-- <OPTION SELECTED>Fuzzy
-- <OPTION>Exact
-- </SELECT>
--
-- <P><INPUT TYPE="checkbox" NAME="company_on"> Search for <B>company</B>:
-- <INPUT TYPE="text" NAME="company_text">
-- using search methods(s): <SELECT NAME="company_type" MULTIPLE>
-- <OPTION SELECTED>Fuzzy
-- <OPTION>Exact
-- </SELECT>
--
-- <P><INPUT TYPE="submit" VALUE="Search"> Note: Fuzzy searching can take a while. Please be patient.
--
-- </FORM>
--
-- <HR>Explanation of search methods:
-- <UL>
-- <LI><B>Fuzzy</B> - Searches for matches that are close to your text.
-- <LI><B>Exact</B> - Finds exact matches only, but much faster than the other search methods.
-- </UL>
-- </BODY>
--</HTML>
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# cust_pkg.cgi: search/browse for packages
--#
--# based on search/svc_acct.cgi ivan@sisd.com 98-jul-17
--
--use strict;
--use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearch qsearchs);
--use FS::CGI qw(header idiot);
--
--my($req)=new CGI::Request;
--&cgisuidsetup($req->cgi);
--
--my(@cust_pkg,$sortby);
--
--my($query)=$req->cgi->var('QUERY_STRING');
--#this tree is a little bit redundant
--if ( $query eq 'pkgnum' ) {
-- $sortby=\*pkgnum_sort;
-- @cust_pkg=qsearch('cust_pkg',{});
--} elsif ( $query eq 'APKG_pkgnum' ) {
-- $sortby=\*pkgnum_sort;
--
-- #perhaps this should go in cust_pkg as a qsearch-like constructor?
-- my($cust_pkg);
-- foreach $cust_pkg (qsearch('cust_pkg',{})) {
-- my($flag)=0;
-- my($pkg_svc);
-- PKG_SVC:
-- foreach $pkg_svc (qsearch('pkg_svc',{ 'pkgpart' => $cust_pkg->pkgpart })) {
-- if ( $pkg_svc->quantity
-- > scalar(qsearch('cust_svc',{
-- 'pkgnum' => $cust_pkg->pkgnum,
-- 'svcpart' => $pkg_svc->svcpart,
-- }))
-- )
-- {
-- $flag=1;
-- last PKG_SVC;
-- }
-- }
-- push @cust_pkg, $cust_pkg if $flag;
-- }
--} else {
-- die "Empty QUERY_STRING!";
--}
--
--if ( scalar(@cust_pkg) == 1 ) {
-- my($pkgnum)=$cust_pkg[0]->pkgnum;
-- $req->cgi->redirect("../view/cust_pkg.cgi?$pkgnum");
-- exit;
--} elsif ( scalar(@cust_pkg) == 0 ) { #error
-- &idiot("No packages found");
-- exit;
--} else {
-- my($total)=scalar(@cust_pkg);
-- CGI::Base::SendHeaders(); # one guess
-- print header('Package Search Results',''), <<END;
-- $total matching packages found
-- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
-- <TR>
-- <TH>Package #</TH>
-- <TH>Customer #</TH>
-- <TH>Name</TH>
-- <TH>Company</TH>
-- </TR>
--END
--
-- my($lines)=16;
-- my($lcount)=$lines;
-- my(%saw,$cust_pkg);
-- foreach $cust_pkg (
-- sort $sortby grep(!$saw{$_->pkgnum}++, @cust_pkg)
-- ) {
-- my($cust_main)=qsearchs('cust_main',{'custnum'=>$cust_pkg->custnum});
-- my($pkgnum,$custnum,$name,$company)=(
-- $cust_pkg->pkgnum,
-- $cust_main->custnum,
-- $cust_main->last. ', '. $cust_main->first,
-- $cust_main->company,
-- );
-- print <<END;
-- <TR>
-- <TD><A HREF="../view/cust_pkg.cgi?$pkgnum"><FONT SIZE=-1>$pkgnum</FONT></A></TD>
-- <TD><FONT SIZE=-1>$custnum</FONT></TD>
-- <TD><FONT SIZE=-1>$name</FONT></TD>
-- <TD><FONT SIZE=-1>$company</FONT></TD>
-- </TR>
--END
-- if ($lcount-- == 0) { # lots of little tables instead of one big one
-- $lcount=$lines;
-- print <<END;
-- </TABLE>
-- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
-- <TR>
-- <TH>Package #</TH>
-- <TH>Customer #</TH>
-- <TH>Name</TH>
-- <TH>Company</TH>
-- <TH>
-- </TR>
--END
-- }
-- }
--
-- print <<END;
-- </TABLE>
-- </CENTER>
-- </BODY>
--</HTML>
--END
-- exit;
--
--}
--
--sub pkgnum_sort {
-- $a->getfield('pkgnum') <=> $b->getfield('pkgnum');
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# svc_acct.cgi: Search for customers (process form)
--#
--# Usage: post form to:
--# http://server.name/path/svc_acct.cgi
--#
--# Note: Should be run setuid freeside as user nobody.
--#
--# loosely (sp?) based on search/cust_main.cgi
--#
--# ivan@voicenet.com 96-jan-3 -> 96-jan-4
--#
--# rewrite (now does browsing too) ivan@sisd.com 98-mar-9
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# show unlinked accounts ivan@sisd.com 98-jun-22
--#
--# use FS::CGI, show total ivan@sisd.com 98-jul-17
--#
--# give service and customer info too ivan@sisd.com 98-aug-16
--
--use strict;
--use CGI::Request; # form processing module
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearch qsearchs);
--use FS::CGI qw(header idiot);
--
--my($req)=new CGI::Request; # create form object
--&cgisuidsetup($req->cgi);
--
--my(@svc_acct,$sortby);
--
--my($query)=$req->cgi->var('QUERY_STRING');
--#this tree is a little bit redundant
--if ( $query eq 'svcnum' ) {
-- $sortby=\*svcnum_sort;
-- @svc_acct=qsearch('svc_acct',{});
--} elsif ( $query eq 'username' ) {
-- $sortby=\*username_sort;
-- @svc_acct=qsearch('svc_acct',{});
--} elsif ( $query eq 'uid' ) {
-- $sortby=\*uid_sort;
-- @svc_acct=grep $_->uid ne '', qsearch('svc_acct',{});
--} elsif ( $query eq 'UN_svcnum' ) {
-- $sortby=\*svcnum_sort;
-- @svc_acct = grep qsearchs('cust_svc',{
-- 'svcnum' => $_->svcnum,
-- 'pkgnum' => '',
-- }), qsearch('svc_acct',{});
--} elsif ( $query eq 'UN_username' ) {
-- $sortby=\*username_sort;
-- @svc_acct = grep qsearchs('cust_svc',{
-- 'svcnum' => $_->svcnum,
-- 'pkgnum' => '',
-- }), qsearch('svc_acct',{});
--} elsif ( $query eq 'UN_uid' ) {
-- $sortby=\*uid_sort;
-- @svc_acct = grep qsearchs('cust_svc',{
-- 'svcnum' => $_->svcnum,
-- 'pkgnum' => '',
-- }), qsearch('svc_acct',{});
--} else {
-- &usernamesearch;
--}
--
--if ( scalar(@svc_acct) == 1 ) {
-- my($svcnum)=$svc_acct[0]->svcnum;
-- $req->cgi->redirect("../view/svc_acct.cgi?$svcnum"); #redirect
-- exit;
--} elsif ( scalar(@svc_acct) == 0 ) { #error
-- idiot("Account not found");
-- exit;
--} else {
-- my($total)=scalar(@svc_acct);
-- CGI::Base::SendHeaders(); # one guess
-- print header("Account Search Results",''), <<END;
-- $total matching accounts found
-- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
-- <TR>
-- <TH>Service #</TH>
-- <TH>Username</TH>
-- <TH>UID</TH>
-- <TH>Service</TH>
-- <TH>Customer #</TH>
-- <TH>Contact name</TH>
-- <TH>Company</TH>
-- </TR>
--END
--
-- my($lines)=16;
-- my($lcount)=$lines;
-- my(%saw,$svc_acct);
-- foreach $svc_acct (
-- sort $sortby grep(!$saw{$_->svcnum}++, @svc_acct)
-- ) {
-- my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_acct->svcnum })
-- or die "No cust_svc record for svcnum ". $svc_acct->svcnum;
-- my $part_svc = qsearchs('part_svc', { 'svcpart' => $cust_svc->svcpart })
-- or die "No part_svc record for svcpart ". $cust_svc->svcpart;
-- my($cust_pkg,$cust_main);
-- if ( $cust_svc->pkgnum ) {
-- $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $cust_svc->pkgnum })
-- or die "No cust_pkg record for pkgnum ". $cust_svc->pkgnum;
-- $cust_main = qsearchs('cust_main', { 'custnum' => $cust_pkg->custnum })
-- or die "No cust_main record for custnum ". $cust_pkg->custnum;
-- }
-- my($svcnum,$username,$uid,$svc,$custnum,$last,$first,$company)=(
-- $svc_acct->svcnum,
-- $svc_acct->getfield('username'),
-- $svc_acct->getfield('uid'),
-- $part_svc->svc,
-- $cust_svc->pkgnum ? $cust_main->custnum : '',
-- $cust_svc->pkgnum ? $cust_main->getfield('last') : '',
-- $cust_svc->pkgnum ? $cust_main->getfield('first') : '',
-- $cust_svc->pkgnum ? $cust_main->company : '',
-- );
-- my($pcustnum) = $custnum
-- ? "<A HREF=\"../view/cust_main.cgi?$custnum\"><FONT SIZE=-1>$custnum</FONT></A>"
-- : "<I>(unlinked)</I>"
-- ;
-- my($pname) = $custnum ? "$last, $first" : '';
-- print <<END;
-- <TR>
-- <TD><A HREF="../view/svc_acct.cgi?$svcnum"><FONT SIZE=-1>$svcnum</FONT></A></TD>
-- <TD><FONT SIZE=-1>$username</FONT></TD>
-- <TD><FONT SIZE=-1>$uid</FONT></TD>
-- <TD><FONT SIZE=-1>$svc</FONT></TH>
-- <TD><FONT SIZE=-1>$pcustnum</FONT></TH>
-- <TD><FONT SIZE=-1>$pname<FONT></TH>
-- <TD><FONT SIZE=-1>$company</FONT></TH>
-- </TR>
--END
-- if ($lcount-- == 0) { # lots of little tables instead of one big one
-- $lcount=$lines;
-- print <<END;
-- </TABLE>
-- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
-- <TR>
-- <TH>Service #</TH>
-- <TH>Userame</TH>
-- <TH>UID</TH>
-- <TH>Service</TH>
-- <TH>Customer #</TH>
-- <TH>Contact name</TH>
-- <TH>Company</TH>
-- </TR>
--END
-- }
-- }
--
-- print <<END;
-- </TABLE>
-- </CENTER>
-- </BODY>
--</HTML>
--END
-- exit;
--
--}
--
--sub svcnum_sort {
-- $a->getfield('svcnum') <=> $b->getfield('svcnum');
--}
--
--sub username_sort {
-- $a->getfield('username') cmp $b->getfield('username');
--}
--
--sub uid_sort {
-- $a->getfield('uid') <=> $b->getfield('uid');
--}
--
--sub usernamesearch {
--
-- $req->param('username') =~ /^([\w\d\-]{2,8})$/; #untaint username_text
-- my($username)=$1;
--
-- @svc_acct=qsearch('svc_acct',{'username'=>$username});
--
--}
--
--
+++ /dev/null
--<HTML>
-- <HEAD>
-- <TITLE>Account Search</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H1>Account Search</H1>
-- </CENTER>
-- <HR>
-- <FORM ACTION="svc_acct.cgi" METHOD="post">
-- Search for <B>username</B>:
-- <INPUT TYPE="text" NAME="username">
--
-- <P><INPUT TYPE="submit" VALUE="Search">
--
-- </FORM>
--
-- <HR>
-- </BODY>
--</HTML>
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# svc_acct_sm.cgi: Search for domains (process form)
--#
--# Usage: post form to:
--# http://server.name/path/svc_domain.cgi
--#
--# Note: Should be run setuid freeside as user nobody.
--#
--# ivan@voicenet.com 96-mar-5
--#
--# need to look at table in results to make it more readable
--#
--# ivan@voicenet.com
--#
--# rewrite ivan@sisd.com 98-mar-15
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--
--use strict;
--use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearch qsearchs);
--
--my($conf_domain)="/var/spool/freeside/conf/domain";
--open(DOMAIN,$conf_domain) or die "Can't open $conf_domain: $!";
--my($mydomain)=map {
-- /^(.*)$/ or die "Illegal line in $conf_domain!"; #yes, we trust the file
-- $1
--} grep $_ !~ /^(#|$)/, <DOMAIN>;
--close DOMAIN;
--
--my($req)=new CGI::Request; # create form object
--&cgisuidsetup($req->cgi);
--
--$req->param('domuser') =~ /^([a-z0-9_\-]{0,32})$/;
--my($domuser)=$1;
--
--$req->param('domain') =~ /^([\w\-\.]+)$/ or die "Illegal domain";
--my($svc_domain)=qsearchs('svc_domain',{'domain'=>$1})
-- or die "Unknown domain";
--my($domsvc)=$svc_domain->svcnum;
--
--my(@svc_acct_sm);
--if ($domuser) {
-- @svc_acct_sm=qsearch('svc_acct_sm',{
-- 'domuser' => $domuser,
-- 'domsvc' => $domsvc,
-- });
--} else {
-- @svc_acct_sm=qsearch('svc_acct_sm',{'domsvc' => $domsvc});
--}
--
--if ( scalar(@svc_acct_sm) == 1 ) {
-- my($svcnum)=$svc_acct_sm[0]->svcnum;
-- $req->cgi->redirect("../view/svc_acct_sm.cgi?$svcnum"); #redirect
--} elsif ( scalar(@svc_acct_sm) > 1 ) {
-- CGI::Base::SendHeaders();
-- print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Mail Alias Search Results</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H4>Mail Alias Search Results</H4>
-- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
-- <TR>
-- <TH>Mail to<BR><FONT SIZE=-2>(click here to view mail alias)</FONT></TH>
-- <TH>Forwards to<BR><FONT SIZE=-2>(click here to view account)</FONT></TH>
-- </TR>
--END
--
-- my($svc_acct_sm);
-- foreach $svc_acct_sm (@svc_acct_sm) {
-- my($svcnum,$domuser,$domuid,$domsvc)=(
-- $svc_acct_sm->svcnum,
-- $svc_acct_sm->domuser,
-- $svc_acct_sm->domuid,
-- $svc_acct_sm->domsvc,
-- );
-- my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$domsvc});
-- my($domain)=$svc_domain->domain;
-- my($svc_acct)=qsearchs('svc_acct',{'uid'=>$domuid});
-- my($username)=$svc_acct->username;
-- my($svc_acct_svcnum)=$svc_acct->svcnum;
--
-- print <<END;
--<TR>\n <TD> <A HREF="../view/svc_acct_sm.cgi?$svcnum">
--END
--
-- print '', ( ($domuser eq '*') ? "<I>(anything)</I>" : $domuser );
--
-- print <<END;
--\@$domain</A> </TD>\n
--<TD> <A HREF="../view/svc_acct.cgi?$svc_acct_svcnum">$username\@$mydomain</A> </TD>\n </TR>\n
--END
--
-- }
--
-- print <<END;
-- </TABLE>
-- </CENTER>
-- </BODY>
--</HTML>
--END
--
--} else { #error
-- CGI::Base::SendHeaders(); # one guess
-- print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Mail Alias Search Error</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H3>Mail Alias Search Error</H3>
-- <HR>
-- Mail Alias not found.
-- </CENTER>
-- </BODY>
--</HTML>
--END
--
--}
--
+++ /dev/null
--<HTML>
-- <HEAD>
-- <TITLE>Mail Alias Search</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H1>Mail Alias Search</H1>
-- </CENTER>
-- <HR>
-- <FORM ACTION="svc_acct_sm.cgi" METHOD="post">
-- Search for <B>mail alias</B>:
-- <INPUT TYPE="text" NAME="domuser"><FONT SIZE=-1>(opt.)</FONT> @
-- <INPUT TYPE="text" NAME="domain"><FONT SIZE=-1>(req.)</FONT>
--
-- <P><INPUT TYPE="submit" VALUE="Search">
--
-- </FORM>
--
-- <HR>
--
-- </BODY>
--</HTML>
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# svc_domain.cgi: Search for domains (process form)
--#
--# Usage: post form to:
--# http://server.name/path/svc_domain.cgi
--#
--# Note: Should be run setuid freeside as user nobody.
--#
--# ivan@voicenet.com 97-mar-5
--#
--# rewrite ivan@sisd.com 98-mar-14
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# display total, use FS::CGI now does browsing too ivan@sisd.com 98-jul-17
--
--use strict;
--use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearch qsearchs);
--use FS::CGI qw(header idiot);
--
--my($req)=new CGI::Request;
--&cgisuidsetup($req->cgi);
--
--my(@svc_domain);
--my($sortby);
--
--my($query)=$req->cgi->var('QUERY_STRING');
--if ( $query eq 'svcnum' ) {
-- $sortby=\*svcnum_sort;
-- @svc_domain=qsearch('svc_domain',{});
--} elsif ( $query eq 'domain' ) {
-- $sortby=\*domain_sort;
-- @svc_domain=qsearch('svc_domain',{});
--} elsif ( $query eq 'UN_svcnum' ) {
-- $sortby=\*svcnum_sort;
-- @svc_domain = grep qsearchs('cust_svc',{
-- 'svcnum' => $_->svcnum,
-- 'pkgnum' => '',
-- }), qsearch('svc_domain',{});
--} elsif ( $query eq 'UN_domain' ) {
-- $sortby=\*domain_sort;
-- @svc_domain = grep qsearchs('cust_svc',{
-- 'svcnum' => $_->svcnum,
-- 'pkgnum' => '',
-- }), qsearch('svc_domain',{});
--} else {
-- $req->param('domain') =~ /^([\w\-\.]+)$/;
-- my($domain)=$1;
-- push @svc_domain, qsearchs('svc_domain',{'domain'=>$domain});
--}
--
--if ( scalar(@svc_domain) == 1 ) {
-- $req->cgi->redirect("../view/svc_domain.cgi?". $svc_domain[0]->svcnum);
-- exit;
--} elsif ( scalar(@svc_domain) == 0 ) {
-- idiot "No matching domains found!\n";
-- exit;
--} else {
-- CGI::Base::SendHeaders(); # one guess
--
-- my($total)=scalar(@svc_domain);
-- CGI::Base::SendHeaders(); # one guess
-- print header("Domain Search Results",''), <<END;
--
-- $total matching domains found
-- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
-- <TR>
-- <TH>Service #</TH>
-- <TH>Domain</TH>
-- <TH></TH>
-- </TR>
--END
--
-- my($lines)=16;
-- my($lcount)=$lines;
-- my(%saw,$svc_domain);
-- foreach $svc_domain (
-- sort $sortby grep(!$saw{$_->svcnum}++, @svc_domain)
-- ) {
-- my($svcnum,$domain)=(
-- $svc_domain->svcnum,
-- $svc_domain->domain,
-- );
-- my($malias);
-- if ( qsearch('svc_acct_sm',{'domsvc'=>$svcnum}) ) {
-- $malias=(
-- qq|<FORM ACTION="svc_acct_sm.cgi" METHOD="post">|.
-- qq|<INPUT TYPE="hidden" NAME="domuser" VALUE="">|.
-- qq|<INPUT TYPE="hidden" NAME="domain" VALUE="$domain">|.
-- qq|<INPUT TYPE="submit" VALUE="(mail aliases)">|.
-- qq|</FORM>|
-- );
-- } else {
-- $malias='';
-- }
-- print <<END;
-- <TR>
-- <TD><A HREF="../view/svc_domain.cgi?$svcnum"><FONT SIZE=-1>$svcnum</FONT></A></TD>
-- <TD><FONT SIZE=-1>$domain</FONT></TD>
-- <TD><FONT SIZE=-1>$malias</FONT></TD>
-- </TR>
--END
-- if ($lcount-- == 0) { # lots of little tables instead of one big one
-- $lcount=$lines;
-- print <<END;
-- </TABLE>
-- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
-- <TR>
-- <TH>Service #</TH>
-- <TH>Domain</TH>
-- <TH></TH>
-- </TR>
--END
-- }
-- }
--
-- print <<END;
-- </TABLE>
-- </CENTER>
-- </BODY>
--</HTML>
--END
--
--}
--
--sub svcnum_sort {
-- $a->getfield('svcnum') <=> $b->getfield('svcnum');
--}
--
--sub domain_sort {
-- $a->getfield('domain') cmp $b->getfield('doimain');
--}
--
--
+++ /dev/null
--<HTML>
-- <HEAD>
-- <TITLE>Domain Search</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H1>Domain Search</H1>
-- </CENTER>
-- <HR>
-- <FORM ACTION="svc_domain.cgi" METHOD="post">
-- Search for <B>domain</B>:
-- <INPUT TYPE="text" NAME="domain">
--
-- <P><INPUT TYPE="submit" VALUE="Search">
--
-- </FORM>
--
-- <HR>
--
-- </BODY>
--</HTML>
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# Usage: cust_bill.cgi invnum
--# http://server.name/path/cust_bill.cgi?invnum
--#
--# Note: Should be run setuid freeside as user nobody.
--#
--# this is a quick & ugly hack which does little more than add some formatting to the ascii output from /dbin/print-invoice
--#
--# ivan@voicenet.com 96-dec-05
--#
--# added navigation bar
--# ivan@voicenet.com 97-jan-30
--#
--# now uses Invoice.pm
--# ivan@voicenet.com 97-jun-30
--#
--# what to do if cust_bill search errors?
--# ivan@voicenet.com 97-jul-7
--#
--# s/FS::Search/FS::Record/; $cgisuidsetup($cgi); ivan@sisd.com 98-mar-14
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# also print 'printed' field ivan@sisd.com 98-jul-10
--
--use strict;
--use IO::File;
--use CGI::Base qw(:DEFAULT :CGI); # CGI module
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearchs);
--use FS::Invoice;
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--&cgisuidsetup($cgi);
--
--#untaint invnum
--$QUERY_STRING =~ /^(\d+)$/;
--my($invnum)=$1;
--
--my($cust_bill) = qsearchs('cust_bill',{'invnum'=>$invnum});
--die "Invoice #$invnum not found!" unless $cust_bill;
--my($custnum) = $cust_bill->getfield('custnum');
--
--my($printed) = $cust_bill->printed;
--
--SendHeaders(); # one guess.
--print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Invoice View</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H1>Invoice View</H1>
-- <A HREF="../view/cust_main.cgi?$custnum">View this customer (#$custnum)</A> | <A HREF="../">Main menu</A>
-- </CENTER><HR>
-- <BASEFONT SIZE=3>
-- <CENTER>
-- <A HREF="../edit/cust_pay.cgi?$invnum">Enter payments (check/cash) against this invoice</A>
-- <BR><A HREF="../misc/print-invoice.cgi?$invnum">Reprint this invoice</A>
-- <BR><BR>(Printed $printed times)
-- </CENTER>
-- <FONT SIZE=-1><PRE>
--END
--
--bless($cust_bill,"FS::Invoice");
--print $cust_bill->print_text;
--
-- #formatting
-- print <<END;
-- </PRE></FONT>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# cust_main.cgi: View a customer
--#
--# Usage: cust_main.cgi custnum
--# http://server.name/path/cust_main.cgi?custnum
--#
--# Note: Should be run setuid freeside as user nobody.
--#
--# the payment history section could use some work, see below
--#
--# ivan@voicenet.com 96-nov-29 -> 96-dec-11
--#
--# added navigation bar (go to main menu ;)
--# ivan@voicenet.com 97-jan-30
--#
--# changes to the way credits/payments are applied (the links are here).
--# ivan@voicenet.com 97-apr-21
--#
--# added debugging code to diagnose CPU sucking problem.
--# ivan@voicenet.com 97-may-19
--#
--# CPU sucking problem was in comment code? fixed?
--# ivan@voicenet.com 97-may-22
--#
--# rewrote for new API
--# ivan@voicenet.com 97-jul-22
--#
--# Changes to allow page to work at a relative position in server
--# Changed 'day' to 'daytime' because Pg6.3 reserves the day word
--# bmccane@maxbaud.net 98-apr-3
--#
--# lose background, FS::CGI ivan@sisd.com 98-sep-2
--
--use strict;
--use CGI::Base qw(:DEFAULT :CGI); # CGI module
--use CGI::Carp qw(fatalsToBrowser);
--use Date::Format;
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearchs qsearch);
--use FS::CGI qw(header menubar);
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--&cgisuidsetup($cgi);
--
--SendHeaders(); # one guess.
--print header("Customer View", menubar(
-- 'Main Menu' => '../',
--)),<<END;
-- <BASEFONT SIZE=3>
--END
--
--#untaint custnum & get customer record
--$QUERY_STRING =~ /^(\d+)$/;
--my($custnum)=$1;
--my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
--die "Customer not found!" unless $cust_main;
--my($hashref)=$cust_main->hashref;
--
--#custnum
--print "<FONT SIZE=+1><CENTER>Customer #<B>$custnum</B></CENTER></FONT>",
-- qq!<CENTER><A HREF="#cust_main">Customer Information</A> | !,
-- qq!<A HREF="#cust_comments">Comments</A> | !,
-- qq!<A HREF="#cust_pkg">Packages</A> | !,
-- qq!<A HREF="#history">Payment History</A> </CENTER>!;
--
--#bill now linke
--print qq!<HR><CENTER><A HREF="../misc/bill.cgi?$custnum">!,
-- qq!Bill this customer now</A></CENTER>!;
--
--#formatting
--print qq!<HR><A NAME="cust_main"><CENTER><FONT SIZE=+1>Customer Information!,
-- qq!</FONT>!,
-- qq!<BR><A HREF="../edit/cust_main.cgi?$custnum!,
-- qq!">Edit this information</A></CENTER><FONT SIZE=-1>!;
--
--#agentnum
--my($agent)=qsearchs('agent',{
-- 'agentnum' => $cust_main->getfield('agentnum')
--} );
--die "Agent not found!" unless $agent;
--print "<BR>Agent #<B>" , $agent->getfield('agentnum') , ": " ,
-- $agent->getfield('agent') , "</B>";
--
--#refnum
--my($referral)=qsearchs('part_referral',{'refnum' => $cust_main->refnum});
--die "Referral not found!" unless $referral;
--print "<BR>Referral #<B>", $referral->refnum, ": ",
-- $referral->referral, "<\B>";
--
--#last, first
--print "<P><B>", $hashref->{'last'}, ", ", $hashref->{first}, "</B>";
--
--#ss
--print " (SS# <B>", $hashref->{ss}, "</B>)" if $hashref->{ss};
--
--#company
--print "<BR><B>", $hashref->{company}, "</B>" if $hashref->{company};
--
--#address1
--print "<BR><B>", $hashref->{address1}, "</B>";
--
--#address2
--print "<BR><B>", $hashref->{address2}, "</B>" if $hashref->{address2};
--
--#city
--print "<BR><B>", $hashref->{city}, "</B>";
--
--#county
--print " (<B>", $hashref->{county}, "</B> county)" if $hashref->{county};
--
--#state
--print ",<B>", $hashref->{state}, "</B>";
--
--#zip
--print " <B>", $hashref->{zip}, "</B>";
--
--#country
--print "<BR><B>", $hashref->{country}, "</B>"
-- unless $hashref->{country} eq "US";
--
--#daytime
--print "<P><B>", $hashref->{daytime}, "</B>" if $hashref->{daytime};
--print " (Day)" if $hashref->{daytime} && $hashref->{night};
--
--#night
--print "<BR><B>", $hashref->{night}, "</B>" if $hashref->{night};
--print " (Night)" if $hashref->{daytime} && $hashref->{night};
--
--#fax
--print "<BR><B>", $hashref->{fax}, "</B> (Fax)" if $hashref->{fax};
--
--#payby/payinfo/paydate/payname
--if ($hashref->{payby} eq "CARD") {
-- print "<P>Card #<B>", $hashref->{payinfo}, "</B> Exp. <B>",
-- $hashref->{paydate}, "</B>";
-- print " (<B>", $hashref->{payname}, "</B>)" if $hashref->{payname};
--} elsif ($hashref->{payby} eq "BILL") {
-- print "<P>Bill";
-- print " on P.O. #<B>", $hashref->{payinfo}, "</B>"
-- if $hashref->{payinfo};
-- print " until <B>", $hashref->{paydate}, "</B>"
-- if $hashref->{paydate};
-- print " to <B>", $hashref->{payname}, "</B> at above address"
-- if $hashref->{payname};
--} elsif ($hashref->{payby} eq "COMP") {
-- print "<P>Access complimentary";
-- print " courtesy of <B>", $hashref->{payinfo}, "</B>"
-- if $hashref->{payinfo};
-- print " until <B>", $hashref->{paydate}, "</B>"
-- if $hashref->{paydate};
--} else {
-- print "Unknown payment type ", $hashref->{payby}, "!";
--}
--
--#tax
--print "<BR>(Tax exempt)" if $hashref->{tax};
--
--#otaker
--print "<P>Order taken by <B>", $hashref->{otaker}, "</B>";
--
--#formatting
--print qq!<HR><FONT SIZE=+1><A NAME="cust_pkg"><CENTER>Packages</A></FONT>!,
-- qq!<BR>Click on package number to view/edit package.!,
-- qq!<BR><A HREF="../edit/cust_pkg.cgi?$custnum">Add/Edit packages</A>!,
-- qq!</CENTER><BR>!;
--
--#display packages
--
--#formatting
--print qq!<CENTER><TABLE BORDER=4>\n!,
-- qq!<TR><TH ROWSPAN=2>#</TH><TH ROWSPAN=2>Package</TH><TH COLSPAN=5>!,
-- qq!Dates</TH></TR>\n!,
-- qq!<TR><TH><FONT SIZE=-1>Setup</FONT></TH><TH>!,
-- qq!<FONT SIZE=-1>Next bill</FONT>!,
-- qq!</TH><TH><FONT SIZE=-1>Susp.</FONT></TH><TH><FONT SIZE=-1>Expire!,
-- qq!</FONT></TH>!,
-- qq!<TH><FONT SIZE=-1>Cancel</FONT></TH>!,
-- qq!</TR>\n!;
--
--#get package info
--my(@packages)=qsearch('cust_pkg',{'custnum'=>$custnum});
--my($package);
--foreach $package (@packages) {
-- my($pref)=$package->hashref;
-- my($part_pkg)=qsearchs('part_pkg',{
-- 'pkgpart' => $pref->{pkgpart}
-- } );
-- print qq!<TR><TD><FONT SIZE=-1><A HREF="../view/cust_pkg.cgi?!,
-- $pref->{pkgnum}, qq!">!,
-- $pref->{pkgnum}, qq!</A></FONT></TD>!,
-- "<TD><FONT SIZE=-1>", $part_pkg->getfield('pkg'), " - ",
-- $part_pkg->getfield('comment'), "</FONT></TD>",
-- "<TD><FONT SIZE=-1>",
-- $pref->{setup} ? time2str("%D",$pref->{setup} ) : "" ,
-- "</FONT></TD>",
-- "<TD><FONT SIZE=-1>",
-- $pref->{bill} ? time2str("%D",$pref->{bill} ) : "" ,
-- "</FONT></TD>",
-- "<TD><FONT SIZE=-1>",
-- $pref->{susp} ? time2str("%D",$pref->{susp} ) : "" ,
-- "</FONT></TD>",
-- "<TD><FONT SIZE=-1>",
-- $pref->{expire} ? time2str("%D",$pref->{expire} ) : "" ,
-- "</FONT></TD>",
-- "<TD><FONT SIZE=-1>",
-- $pref->{cancel} ? time2str("%D",$pref->{cancel} ) : "" ,
-- "</FONT></TD>",
-- "</TR>";
--}
--
--#formatting
--print "</TABLE></CENTER>";
--
--#formatting
--print qq!<CENTER><HR><A NAME="history"><FONT SIZE=+1>Payment History!,
-- qq!</FONT></A><BR>!,
-- qq!Click on invoice to view invoice/enter payment.<BR>!,
-- qq!<A HREF="../edit/cust_credit.cgi?$custnum">!,
-- qq!Post Credit / Refund</A></CENTER><BR>!;
--
--#get payment history
--#
--# major problem: this whole thing is way too sloppy.
--# minor problem: the description lines need better formatting.
--
--my(@history);
--
--my(@bills)=qsearch('cust_bill',{'custnum'=>$custnum});
--my($bill);
--foreach $bill (@bills) {
-- my($bref)=$bill->hashref;
-- push @history,
-- $bref->{_date} . qq!\t<A HREF="../view/cust_bill.cgi?! .
-- $bref->{invnum} . qq!">Invoice #! . $bref->{invnum} .
-- qq! (Balance \$! . $bref->{owed} . qq!)</A>\t! .
-- $bref->{charged} . qq!\t\t\t!;
--
-- my(@payments)=qsearch('cust_pay',{'invnum'=> $bref->{invnum} } );
-- my($payment);
-- foreach $payment (@payments) {
--# my($pref)=$payment->hashref;
-- my($date,$invnum,$payby,$payinfo,$paid)=($payment->getfield('_date'),
-- $payment->getfield('invnum'),
-- $payment->getfield('payby'),
-- $payment->getfield('payinfo'),
-- $payment->getfield('paid'),
-- );
-- push @history,
-- "$date\tPayment, Invoice #$invnum ($payby $payinfo)\t\t$paid\t\t";
-- }
--}
--
--my(@credits)=qsearch('cust_credit',{'custnum'=>$custnum});
--my($credit);
--foreach $credit (@credits) {
-- my($cref)=$credit->hashref;
-- push @history,
-- $cref->{_date} . "\tCredit #" . $cref->{crednum} . ", (Balance \$" .
-- $cref->{credited} . ") by " . $cref->{otaker} . " - " .
-- $cref->{reason} . "\t\t\t" . $cref->{amount} . "\t";
--
-- my(@refunds)=qsearch('cust_refund',{'crednum'=> $cref->{crednum} } );
-- my($refund);
-- foreach $refund (@refunds) {
-- my($rref)=$refund->hashref;
-- push @history,
-- $rref->{_date} . "\tRefund, Credit #" . $rref->{crednum} . " (" .
-- $rref->{payby} . " " . $rref->{payinfo} . ") by " .
-- $rref->{otaker} . " - ". $rref->{reason} . "\t\t\t\t" .
-- $rref->{refund};
-- }
--}
--
-- #formatting
-- print <<END;
--<CENTER><TABLE BORDER=4>
--<TR>
-- <TH>Date</TH>
-- <TH>Description</TH>
-- <TH><FONT SIZE=-1>Charge</FONT></TH>
-- <TH><FONT SIZE=-1>Payment</FONT></TH>
-- <TH><FONT SIZE=-1>In-house<BR>Credit</FONT></TH>
-- <TH><FONT SIZE=-1>Refund</FONT></TH>
-- <TH><FONT SIZE=-1>Balance</FONT></TH>
--</TR>
--END
--
--#display payment history
--
--my($balance)=0;
--my($item);
--foreach $item (sort keyfield_numerically @history) {
-- my($date,$desc,$charge,$payment,$credit,$refund)=split(/\t/,$item);
-- $charge ||= 0;
-- $payment ||= 0;
-- $credit ||= 0;
-- $refund ||= 0;
-- $balance += $charge - $payment;
-- $balance -= $credit - $refund;
--
-- print "<TR><TD><FONT SIZE=-1>",time2str("%D",$date),"</FONT></TD>",
-- "<TD><FONT SIZE=-1>$desc</FONT></TD>",
-- "<TD><FONT SIZE=-1>",
-- ( $charge ? "\$".sprintf("%.2f",$charge) : '' ),
-- "</FONT></TD>",
-- "<TD><FONT SIZE=-1>",
-- ( $payment ? "- \$".sprintf("%.2f",$payment) : '' ),
-- "</FONT></TD>",
-- "<TD><FONT SIZE=-1>",
-- ( $credit ? "- \$".sprintf("%.2f",$credit) : '' ),
-- "</FONT></TD>",
-- "<TD><FONT SIZE=-1>",
-- ( $refund ? "\$".sprintf("%.2f",$refund) : '' ),
-- "</FONT></TD>",
-- "<TD><FONT SIZE=-1>\$" . sprintf("%.2f",$balance),
-- "</FONT></TD>",
-- "\n";
--}
--
--#formatting
--print "</TABLE></CENTER>";
--
--#end
--
--#formatting
--print <<END;
--
-- </BODY>
--</HTML>
--END
--
--#subroutiens
--sub keyfield_numerically { (split(/\t/,$a))[0] <=> (split(/\t/,$b))[0] ; }
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# cust_pkg.cgi: View a package
--#
--# Usage: cust_pkg.cgi pkgnum
--# http://server.name/path/cust_pkg.cgi?pkgnum
--#
--# Note: Should be run setuid freeside as user nobody.
--#
--# ivan@voicenet.com 96-dec-15
--#
--# services section needs to be cleaned up, needs to display extraneous
--# entries in cust_pkg!
--# ivan@voicenet.com 96-dec-31
--#
--# added navigation bar
--# ivan@voicenet.com 97-jan-30
--#
--# changed and fixed up suspension and cancel stuff, now you can't add
--# services to a cancelled package
--# ivan@voicenet.com 97-feb-27
--#
--# rewrote for new API, still needs to be cleaned up!
--# ivan@voicenet.com 97-jul-29
--#
--# no FS::Search ivan@sisd.com 98-mar-7
--
--use strict;
--use Date::Format;
--use CGI::Base qw(:DEFAULT :CGI); # CGI module
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearch qsearchs);
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--&cgisuidsetup($cgi);
--
--my(%uiview,%uiadd);
--my($part_svc);
--foreach $part_svc ( qsearch('part_svc',{}) ) {
-- $uiview{$part_svc->svcpart}="../view/". $part_svc->svcdb . ".cgi";
-- $uiadd{$part_svc->svcpart}="../edit/". $part_svc->svcdb . ".cgi";
--}
--
--SendHeaders(); # one guess.
--print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Package View</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H1>Package View</H1>
-- </CENTER>
-- <BASEFONT SIZE=3>
--END
--
--#untaint pkgnum
--$QUERY_STRING =~ /^(\d+)$/;
--my($pkgnum)=$1;
--
--#get package record
--my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
--die "No package!" unless $cust_pkg;
--my($part_pkg)=qsearchs('part_pkg',{'pkgpart'=>$cust_pkg->getfield('pkgpart')});
--
--#nav bar
--my($custnum)=$cust_pkg->getfield('custnum');
--print qq!<CENTER><A HREF="../view/cust_main.cgi?$custnum">View this customer!,
-- qq! (#$custnum)</A> | <A HREF="../">Main menu</A></CENTER><BR>!;
--
--#print info
--my($susp,$cancel,$expire)=(
-- $cust_pkg->getfield('susp'),
-- $cust_pkg->getfield('cancel'),
-- $cust_pkg->getfield('expire'),
--);
--print "<FONT SIZE=+1><CENTER>Package #<B>$pkgnum</B></FONT>";
--print qq!<BR><A HREF="#package">Package Information</A>!;
--print qq! | <A HREF="#services">Service Information</A>! unless $cancel;
--print qq!</CENTER><HR>\n!;
--
--my($pkg,$comment)=($part_pkg->getfield('pkg'),$part_pkg->getfield('comment'));
--print qq!<A NAME="package"><CENTER><FONT SIZE=+1>Package Information!,
-- qq!</FONT></A>!;
--print qq!<BR><A HREF="../unimp.html">Edit this information</A></CENTER>!;
--print "<P>Package: <B>$pkg - $comment</B>";
--
--my($setup,$bill)=($cust_pkg->getfield('setup'),$cust_pkg->getfield('bill'));
--print "<BR>Setup: <B>", $setup ? time2str("%D",$setup) : "(Not setup)" ,"</B>";
--print "<BR>Next bill: <B>", $bill ? time2str("%D",$bill) : "" ,"</B>";
--
--if ($susp) {
-- print "<BR>Suspended: <B>", time2str("%D",$susp), "</B>";
-- print qq! <A HREF="../misc/unsusp_pkg.cgi?$pkgnum">Unsuspend</A>! unless $cancel;
--} else {
-- print qq!<BR><A HREF="../misc/susp_pkg.cgi?$pkgnum">Suspend</A>! unless $cancel;
--}
--
--if ($expire) {
-- print "<BR>Expire: <B>", time2str("%D",$expire), "</B>";
--}
-- print <<END;
--<FORM ACTION="../misc/expire_pkg.cgi" METHOD="post">
--<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">
--Expire (date): <INPUT TYPE="text" NAME="date" VALUE="" >
--<INPUT TYPE="submit" VALUE="Cancel later">
--END
--
--if ($cancel) {
-- print "<BR>Cancelled: <B>", time2str("%D",$cancel), "</B>";
--} else {
-- print qq!<BR><A HREF="../misc/cancel_pkg.cgi?$pkgnum">Cancel now</A>!;
--}
--
--#otaker
--my($otaker)=$cust_pkg->getfield('otaker');
--print "<P>Order taken by <B>$otaker</B>";
--
--unless ($cancel) {
--
-- #services
-- print <<END;
--<HR><A NAME="services"><CENTER><FONT SIZE=+1>Service Information</FONT></A>
--<BR>Click on service to view/edit/add service.</CENTER><BR>
--<CENTER><B>Do NOT pick the "Link to existing" option unless you are auditing!!!</B></CENTER>
--<CENTER><TABLE BORDER=4>
--<TR><TH>Service</TH>
--END
--
-- #list of services this pkgpart includes
-- my($pkg_svc,%pkg_svc);
-- foreach $pkg_svc ( qsearch('pkg_svc',{'pkgpart'=> $cust_pkg->pkgpart }) ) {
-- $pkg_svc{$pkg_svc->svcpart} = $pkg_svc->quantity if $pkg_svc->quantity;
-- }
--
-- #list of records from cust_svc
-- my($svcpart);
-- foreach $svcpart (sort {$a <=> $b} keys %pkg_svc) {
--
-- my($svc)=qsearchs('part_svc',{'svcpart'=>$svcpart})->getfield('svc');
--
-- my(@cust_svc)=qsearch('cust_svc',{'pkgnum'=>$pkgnum,
-- 'svcpart'=>$svcpart,
-- });
--
-- my($enum);
-- for $enum ( 1 .. $pkg_svc{$svcpart} ) {
--
-- my($cust_svc);
-- if ( $cust_svc=shift @cust_svc ) {
-- my($svcnum)=$cust_svc->svcnum;
-- print <<END;
--<TR><TD><A HREF="$uiview{$svcpart}?$svcnum">(View) $svc<A></TD></TR>
--END
-- } else {
-- print <<END;
--<TR>
-- <TD><A HREF="$uiadd{$svcpart}?pkgnum$pkgnum-svcpart$svcpart">
-- (Add) $svc</A>
-- or <A HREF="../misc/link.cgi?pkgnum$pkgnum-svcpart$svcpart">
-- (Link to existing) $svc</A>
-- </TD>
--</TR>
--END
-- }
--
-- }
-- warn "WARNING: Leftover services pkgnum $pkgnum!" if @cust_svc;;
-- }
--
-- print "</TABLE></CENTER>";
--
--}
--
--#formatting
--print <<END;
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# View svc_acct records
--#
--# Usage: svc_acct.cgi svcnum
--# http://server.name/path/svc_acct.cgi?svcnum
--#
--# Note: Should be run setuid freeside as user nobody.
--#
--# ivan@voicenet.com 96-dec-17
--#
--# added link to send info
--# ivan@voicenet.com 97-jan-4
--#
--# added navigation bar and ability to change username, etc.
--# ivan@voicenet.com 97-jan-30
--#
--# activate 800 service
--# ivan@voicenet.com 97-feb-10
--#
--# modified navbar code (should be a subroutine?), added link to cancel account (only if not audited)
--# ivan@voicenet.com 97-apr-16
--#
--# INCOMPLETELY rewrote some things for new API
--# ivan@voicenet.com 97-jul-29
--#
--# FS::Search became FS::Record, use strict, etc. ivan@sisd.com 98-mar-9
--#
--# Changes to allow page to work at a relative position in server
--# Changed 'password' to '_password' because Pg6.3 reserves the password word
--# bmccane@maxbaud.net 98-apr-3
--#
--# /var/spool/freeside/conf/domain ivan@sisd.com 98-jul-17
--#
--# displays arbitrary radius attributes ivan@sisd.com 98-aug-16
--
--use strict;
--use CGI::Base qw(:DEFAULT :CGI);
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearchs fields);
--
--my($conf_domain)="/var/spool/freeside/conf/domain";
--open(DOMAIN,$conf_domain) or die "Can't open $conf_domain: $!";
--my($mydomain)=map {
-- /^(.*)$/ or die "Illegal line in $conf_domain!"; #yes, we trust the file
-- $1;
--} grep $_ !~ /^(#|$)/, <DOMAIN>;
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--&cgisuidsetup($cgi);
--
--#untaint svcnum
--$QUERY_STRING =~ /^(\d+)$/;
--my($svcnum)=$1;
--my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$svcnum});
--die "Unkonwn svcnum" unless $svc_acct;
--
--my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
--my($pkgnum)=$cust_svc->getfield('pkgnum');
--my($cust_pkg,$custnum);
--if ($pkgnum) {
-- $cust_pkg=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-- $custnum=$cust_pkg->getfield('custnum');
--}
--
--my($part_svc)=qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
--die "Unkonwn svcpart" unless $part_svc;
--
--SendHeaders(); # one guess.
--print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Account View</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER><H1>Account View</H1>
-- <BASEFONT SIZE=3>
--<CENTER>
--END
--
--if ($pkgnum || $custnum) {
-- print <<END;
--<A HREF="../view/cust_pkg.cgi?$pkgnum">View this package (#$pkgnum)</A> |
--<A HREF="../view/cust_main.cgi?$custnum">View this customer (#$custnum)</A> |
--END
--} else {
-- print <<END;
--<A HREF="../misc/cancel-unaudited.cgi?$svcnum">Cancel this (unaudited)account</A> |
--END
--}
--
--print <<END;
--<A HREF="../">Main menu</A></CENTER><BR>
--<FONT SIZE=+1>Service #$svcnum</FONT>
--END
--
--print qq!<BR><A HREF="../edit/svc_acct.cgi?$svcnum">Edit this information</A>!;
--#print qq!<BR><A HREF="../misc/sendconfig.cgi?$svcnum">Send account information</A>!;
--print qq!<BR><BR><A HREF="#general">General</A> | <A HREF="#shell">Shell account</A> | !;
--print qq!<A HREF="#slip">SLIP/PPP account</A></CENTER>!;
--
--#formatting
--print qq!<HR><CENTER><FONT SIZE=+1><A NAME="general">General</A></FONT></CENTER>!;
--
--#svc
--print "Service: <B>", $part_svc->svc, "</B>";
--
--#username
--print "<BR>Username: <B>", $svc_acct->username, "</B>";
--
--#password
--if (substr($svc_acct->_password,0,1) eq "*") {
-- print "<BR>Password: <I>(Login disabled)</I><BR>";
--} else {
-- print "<BR>Password: <I>(hidden)</I><BR>";
--}
--
--# popnum -> svc_acct_pop record
--my($svc_acct_pop)=qsearchs('svc_acct_pop',{'popnum'=>$svc_acct->popnum});
--
--#pop
--print "POP: <B>", $svc_acct_pop->city, ", ", $svc_acct_pop->state,
-- " (", $svc_acct_pop->ac, ")/", $svc_acct_pop->exch, "<\B>"
-- if $svc_acct_pop;
--
--#shell account
--print qq!<HR><CENTER><FONT SIZE=+1><A NAME="shell">!;
--if ($svc_acct->uid ne '') {
-- print "Shell account";
-- print "</A></FONT></CENTER>";
-- print "Uid: <B>", $svc_acct->uid, "</B>";
-- print "<BR>Gid: <B>", $svc_acct->gid, "</B>";
--
-- print qq!<BR>Finger name: <B>!, $svc_acct->finger, qq!</B><BR>!;
--
-- print "Home directory: <B>", $svc_acct->dir, "</B><BR>";
--
-- print "Shell: <B>", $svc_acct->shell, "</B><BR>";
--
-- print "Quota: <B>", $svc_acct->quota, "</B> <I>(unimplemented)</I>";
--} else {
-- print "No shell account.</A></FONT></CENTER>";
--}
--
--# SLIP/PPP
--print qq!<HR><CENTER><FONT SIZE=+1><A NAME="slip">!;
--if ($svc_acct->slipip) {
-- print "SLIP/PPP account</A></FONT></CENTER>";
-- print "IP address: <B>", ( $svc_acct->slipip eq "0.0.0.0" || $svc_acct->slipip eq '0e0' ) ? "<I>(Dynamic)</I>" : $svc_acct->slipip ,"</B>";
-- my($attribute);
-- foreach $attribute ( grep /^radius_/, fields('svc_acct') ) {
-- #warn $attribute;
-- $attribute =~ /^radius_(.*)$/;
-- my($pattribute) = ($1);
-- $pattribute =~ s/_/-/g;
-- print "<BR>Radius $pattribute: <B>". $svc_acct->getfield($attribute), "</B>";
-- }
--} else {
-- print "No SLIP/PPP account</A></FONT></CENTER>"
--}
--
--print "<HR>";
--
-- #formatting
-- print <<END;
--
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# View svc_acct_sm records
--#
--# Usage: svc_acct_sm.cgi svcnum
--# http://server.name/path/svc_acct_sm.cgi?svcnum
--#
--# Note: Should be run setuid freeside as user nobody.
--#
--# based on view/svc_acct.cgi
--#
--# ivan@voicenet.com 97-jan-5
--#
--# added navigation bar
--# ivan@voicenet.com 97-jan-30
--#
--# rewrite ivan@sisd.com 98-mar-15
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# /var/spool/freeside/conf/domain ivan@sisd.com 98-jul-17
--
--use strict;
--use CGI::Base qw(:DEFAULT :CGI);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearchs);
--
--my($conf_domain)="/var/spool/freeside/conf/domain";
--open(DOMAIN,$conf_domain) or die "Can't open $conf_domain: $!";
--my($mydomain)=map {
-- /^(.*)$/ or die "Illegal line in $conf_domain!"; #yes, we trust the file
-- $1
--} grep $_ !~ /^(#|$)/, <DOMAIN>;
--close DOMAIN;
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--cgisuidsetup($cgi);
--
--#untaint svcnum
--$QUERY_STRING =~ /^(\d+)$/;
--my($svcnum)=$1;
--my($svc_acct_sm)=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum});
--die "Unknown svcnum" unless $svc_acct_sm;
--
--my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
--my($pkgnum)=$cust_svc->getfield('pkgnum');
--my($cust_pkg,$custnum);
--if ($pkgnum) {
-- $cust_pkg=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-- $custnum=$cust_pkg->getfield('custnum');
--}
--
--my($part_svc)=qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
--die "Unkonwn svcpart" unless $part_svc;
--
--SendHeaders(); # one guess.
--print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Mail Alias View</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER><H1>Mail Alias View</H1>
--END
--if ($pkgnum || $custnum) {
-- print <<END;
--<A HREF="../view/cust_pkg.cgi?$pkgnum">View this package (#$pkgnum)</A> |
--<A HREF="../view/cust_main.cgi?$custnum">View this customer (#$custnum)</A> |
--END
--} else {
-- print <<END;
--<A HREF="../misc/cancel-unaudited.cgi?$svcnum">Cancel this (unaudited)account</A> |
--END
--}
--
--print <<END;
-- <A HREF="../">Main menu</A></CENTER><BR<
-- <FONT SIZE=+1>Service #$svcnum</FONT>
-- <P><A HREF="../edit/svc_acct_sm.cgi?$svcnum">Edit this information</A>
-- <BASEFONT SIZE=3>
--END
--
--my($domsvc,$domuid,$domuser)=(
-- $svc_acct_sm->domsvc,
-- $svc_acct_sm->domuid,
-- $svc_acct_sm->domuser,
--);
--my($svc) = $part_svc->svc;
--my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$domsvc});
--my($domain)=$svc_domain->domain;
--my($svc_acct)=qsearchs('svc_acct',{'uid'=>$domuid});
--my($username)=$svc_acct->username;
--
--#formatting
--print qq!<HR>!;
--
--#svc
--print "Service: <B>$svc</B>";
--
--print "<HR>";
--
--print qq!Mail to <B>!, ( ($domuser eq '*') ? "<I>(anything)</I>" : $domuser ) , qq!</B>\@<B>$domain</B> forwards to <B>$username</B>\@$mydomain mailbox.!;
--
--print "<HR>";
--
-- #formatting
-- print <<END;
--
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# View svc_domain records
--#
--# Usage: svc_domain svcnum
--# http://server.name/path/svc_domain.cgi?svcnum
--#
--# Note: Should be run setuid freeside as user nobody.
--#
--# ivan@voicenet.com 97-jan-6
--#
--# rewrite ivan@sisd.com 98-mar-14
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--
--use strict;
--use CGI::Base qw(:DEFAULT :CGI);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearchs);
--
--my($cgi) = new CGI::Base;
--$cgi->get;
--cgisuidsetup($cgi);
--
--#untaint svcnum
--$QUERY_STRING =~ /^(\d+)$/;
--my($svcnum)=$1;
--my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$svcnum});
--die "Unknown svcnum" unless $svc_domain;
--my($domain)=$svc_domain->domain;
--
--my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
--my($pkgnum)=$cust_svc->getfield('pkgnum');
--my($cust_pkg,$custnum);
--if ($pkgnum) {
-- $cust_pkg=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-- $custnum=$cust_pkg->getfield('custnum');
--}
--
--my($part_svc)=qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
--die "Unkonwn svcpart" unless $part_svc;
--
--SendHeaders(); # one guess.
--print <<END;
--<HTML>
-- <HEAD>
-- <TITLE>Domain View</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER><H1>Domain View</H1>
-- <BASEFONT SIZE=3>
--<CENTER>
--<A HREF="../view/cust_pkg.cgi?$pkgnum">View this package (#$pkgnum)</A> |
--<A HREF="../view/cust_main.cgi?$custnum">View this customer (#$custnum)</A> |
--<A HREF="../">Main menu</A></CENTER><BR>
-- <FONT SIZE=+1>Service #$svcnum</FONT>
-- </CENTER>
--END
--
--print "<HR>";
--print "Service: <B>", $part_svc->svc, "</B>";
--print "<HR>";
--
--print qq!Domain name <B>$domain</B>.!;
--print qq!<P><A HREF="http://rs.internic.net/cgi-bin/whois?do+$domain">View whois information.</A>!;
--
--print "<HR>";
--
-- #formatting
-- print <<END;
--
-- </BODY>
--</HTML>
--END
--
projects / freeside.git / commitdiff
