bike/dswim
1
0
Fork 0
mirror of https://github.com/fspc/dswim.git synced 2026-06-18 04:30:21 -04:00
Code Issues Projects Releases Wiki Activity

*** empty log message ***

Browse Source
This commit is contained in:
freesource 2001-01-27 00:03:46 +00:00
commit 26c15dd62f
87 changed files with 34128 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
.gitignore vendored Normal file
View File

@ -0,0 +1,28 @@
# CVS default ignores begin
tags
TAGS
.make.state
.nse_depinfo
*~
#*
.#*
,*
_$*
*$
*.old
*.bak
*.BAK
*.orig
*.rej
.del-*
*.a
*.olb
*.o
*.obj
*.so
*.exe
*.Z
*.elc
*.ln
core
# CVS default ignores end

8
BUGS Normal file
View File

@ -0,0 +1,8 @@
* Permissions of some directories are weird using mkdir().
* ftp()/qftp() doesn't handle timeout problems very well, if alarm()
and SIG{ALRM} are used program quits with stdout "Alarm Bell".
* Debian md5sum program has different output than non-Debian md5sum
programs, will probably switch to MD5 module.
* --ftp, swimz.list, for non-US using the dists/arch/ notation doesn't
work on all sites, normal notation works if the site is set-up
this way.

340
COPYING Normal file
View File

@ -0,0 +1,340 @@
GNU GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (C) 1989, 1991 Free Software Foundation, Inc.
59 Temple Place, Suite 330, Boston, MA 02111-1307 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.
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.)
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.
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.
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
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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 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.

672
Conf.pm Normal file
View File

@ -0,0 +1,672 @@
# Package administration and research tool for Debian
# Copyright (C) 1999-2000 Jonathan D. Rosenbaum
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
package SWIM::Conf;
use vars qw(@ISA @EXPORT %EXPORT_TAGS);
use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw($my_number $tmp $architecture $distribution @user_defined_section
$default_directory $default_root_directory $permission $dpkg
$dpkg_deb $ar $gcc $apt_get $apt_cache $sources @FTP $spl $cat
$sort $md5sum $zcat $tar $grep $gzip $fastswim $slowswim $longswim
$mount $umount $mke2fs $copy $pager $base $pwd $parent $library
$splt $mv $imswim $swim_conf $debug $port $timeout
$firewall $passive $apt_sources $HISTORY $alt);
%EXPORT_TAGS = (
Path => [ qw($tmp $parent $base $library) ],
Deb => [ qw($pwd $dpkg_deb $ar $tar $grep $tmp $md5sum $cat $mv) ],
Qftp => [ qw($default_root_directory $permission @FTP
$default_directory $swim_conf) ],
Info => [ qw($parent $base $zcat) ]
);
#############################
# DEFAULT PROGRAM VARIABLES #
#############################
# You can change this to how many lines you would like "swim -qf <>" to
# print out, before asking for -t or --total, it will automatically ask
# though, if there is more than one package and you used the option -i.
# Remember -t can be used with --scripts family members to view the
# title of the script file regardless of this setting, and if -t has to be
# used, the titles will be displayed, which makes sense.
$my_number = 23;
# Just like a shell, you can keep a history of whatever length you want.
$HISTORY = 10;
# For not-installed:
# This part supplies the default value for --arch.
#
# You can determine the default architecture used when -n is
# called or a not-installed database is made. Architectures are always
# being added so check with Debian to find a list. There is alpha, arm,
# hurd (alternative kernel to linux), i386, m68k, powerpc, sparc. Just use
# the arch found after the hyphen in the Contents-(arch) file.
$architecture = "i386";
# For not-installed:
# This part supplies the default value for --dists.
#
# The default distribution can be either stable, unstable, frozen, or
# experimental (rare). These represent the state of development that the
# packages are under. The unstable distribution can have lot's of changes
# within a very short time period, and frozen may or may not be available.
$distribution = "unstable";
#For not-installed:
#This part supplies the default value for --main, --contrib, --non-free,
#and --non-us.
# Distributions are divided into the sections. These sections are called
# distributions in the version 2.4.1.0 packaging manual, because they were at
# one time separate distributions, but this has since changed. You can
# determine which of these sections (main, non-free, contrib or non-US) to
# pull out of the Contents file if you don't want to use --main, --contrib,
# --non-free, and --non-us to selectively pick sections. Basically, whatever
# you pull out should match the Package(s) file(s) you are targetting, this
# program is friendly if you make a mistake, but it's more effecient to pull
# out just what you want. If the same package happens to exist in two
# different sections, main and non-us for example (which is really a
# situation that shouldn't exist, yet it does), you will still be able to
# find this package in the non-us group, but its section and locations will be
# the one which main recognizes assuming that you use the order in the example
# below.
# Setting it up:
# Example: You just want to pull out main and contrib every time you run
# --initndb, --rebuildndb, or --ndb.
# @user_defined_section = qw(main contrib non-US);
# remember "non-US" not "non-us".
# untill non-US is fixed the second is better
#@user_defined_section = qw(main contrib non-free non-US);
@user_defined_section = qw(main contrib non-free);
# Usually, this is
$alt = "debian";
################
# DF LOCATION #
################
# A little philosophy:
# swim was developed for maximum versatility, so whether you are just
# interested in researching, and keeping tabs on the newest packages,
# or maintaining a Debian virtual distribution on a non-Debian real
# distribution, or you are a using swim for distribution development, swim
# provides a way. The default directory (DF - which can also mean
# directory/file) keeps track of Contents and Packages files downloaded
# using --ftp, and gives the files names specific to the distribution and
# architectures they represent. But, you also have the freedom not to use
# the default directory in this case swim will still do the renaming and
# keeping track of the mtime, but you will have to remember where you put
# the files. On the other hand, if you use apt, you won't even have to use
# the DF directory for Packages files because you can get the ones specific
# to your own systems architecture from apt, but if you want to look at
# other architectures you will need to use the DF directory or one of your
# own choice.
# Naming Convention: Contents = Contents-dist.gz
# Packages = Packages-arch-dist-section.gz
$default_directory = '/root/.swim';
# The default root directory is the key to easy management of packages
# downloaded through --ftp and --file, and provides an easy way to put together
# a personalized distribution. Future implementations of swim will provide
# a distribution called personal..Packages and Contents files specific to
# this distribution will automatically be made. This directory can be a
# real ftp site on your computer, or put where ever else you are allowed
# to have directories. dists/distribution/section/architecture/subject will be
# placed above this directory. No matter what, debian must be the final
# directory before dists. Other distributions are placed alongside debian,
# like debian-non-US or personal.
# Feel free to change the permissions. This directory is above your default_
# directory.
$default_root_directory = '/pub/debian';
# Because you may be using a real ftp site, this configuration allows you
# to determine what permissions swim will set for directories it creates
# above the default root directory.
$permission = '0755';
###############
# AR or DPKG? #
###############
# NOTE: users set these next two with the $package_tool variable.
# packaging friends dpkg and dpkg-deb come from the essential and
# required dpkg package. ar from the package binutils can also be used (below).
# This is the archival program used for deb packages, but binutils is just
# a standard non-essential package, and the ar capabilities are built into
# dpkg-deb, and it's better not to assume that the standard packages are
# even established, yet.
$dpkg = ();
$dpkg_deb = ();
# If you don't have the dpkg package on your system then you can use ar
# from the package binutils. This would be a standard, but not an essential
# package in Debian, but this package is also fairly standard amongst all
# distributions, and can even be found in the free djgpp for M$ Oses.
# Since people who have both dpkg and ar may want to try the ar method,
# rather than creating an automatic check, just assign a value to either
# ($dpkg & $dpkg_deb) or just $ar.
#my $ar = '/usr/bin/ar'; # same for RH
$ar = '/usr/bin/ar';
#######
# APT #
#######
# NOTE: users set apt-get and apt-cache with the $apt variable
# If you have apt you are in luck.
$apt_get = ();
$apt_cache = ();
$sources = '/etc/apt/sources.list';
$apt_sources = '/var/state/apt/lists';
#########
# PAGER #
#########
# less is a nice pager, unless you like more! There is an option
# --nopager or -n. Pager is used for --help and swim called without any
# options. more comes from the required package util-linux, whereas
# less comes from a standard package called less. In the future there is
# a possiblity that a large percentage of swim may use an internal pager.
# less, more, or most or...
#$ENV{PAGER} = "/usr/bin/less"; # same RH
$ENV{PAGER} = "less";
$pager = $ENV{PAGER};
#################
# SWIM PROGRAMS #
#################
# This is replaced by the Makefile.
$pre="/usr";
# This is the hash making program fastswim.
$fastswim = "$pre/lib/SWIM/fastswim";
# imswim in an alternative to fastswim for --lowmem
$imswim = "$pre/lib/SWIM/imswim";
# This is the low memory program slowswim.
$slowswim = "$pre/lib/SWIM/slowswim";
# This is the dir/file making program longswim.
$longswim = "$pre/lib/SWIM/longswim";
############
# TEMP DIR #
############
# If you want to set an alternative directory for the temporary files
# created when the databases are made, change here. You may want to make
# $tmp a RAM disk. See package loadlin for initrd documentation and an
# explanation for making such a disk. There is also
# /usr/src/kernel-source.version/Documentation. Whether this will speed
# things up is a subject of experimentation.
$tmp = '/tmp';
##################
# MAIN CONFFILES #
##################
# if configuration files are not kept in /etc change this
# and set up the directories by hand.
$swim_conf = '/etc/swim';
#############
# UTILITIES #
#############
# This probably never will have to be changed.
$pwd = `pwd`;
chomp $pwd;
# If the command split is somewhere else besides /usr/bin change this.
# The required package textutils provides this.
#my $splt = '/usr/bin/split'; # same RH
$splt = 'split';
# cat comes from the essential and required package textutils.
#my $cat = '/bin/cat'; # same RH
$cat = 'cat';
# This command also omes from the required and essential package textutils.
#my $sort = '/usr/bin/sort'; # same RH
$sort = 'sort';
# This program uses md5sum from the dpkg package, it can also use md5sum
# from the RH package.
#my $md5sum = '/usr/bin/md5sum'; # same RH
$md5sum = 'md5sum';
# If you want to view compressed files make sure this is correct.
# The required package gzip provides this.
#my $zcat = '/bin/zcat'; # same RH
$zcat = 'zcat';
# tar comes from the essential and required package tar.
#my $tar = '/bin/tar'; # same RH
$tar = 'tar';
# grep comes from the essential and required package grep. This seems
# to require a path.
$grep = '/bin/grep'; # same RH
# gzip comes from the essential and required package gzip.
#my $gzip = "/bin/gzip"; # same RH
$gzip = "gzip";
# mount comes from the essential and required package mount.
#my $mount = '/bin/mount'; # same RH
#my $umount = '/bin/umount'; # same RH
$mount = 'mount';
$umount = 'umount';
# If your file system isn't an ext2 filesystem, you may want to change
# this. mke2fs comes from the essential and required package e2fsprogs.
#my $mke2fs = '/sbin/mke2fs'; # same RH
$mke2fs = 'mke2fs';
# cp and mv from the essential and required package fileutils
#my $copy = '/bin/cp'; # same RH
$copy = 'cp';
$mv = 'mv';
# Your system definitely has gcc if you have ar. gcc is a standard package
# in debian.
$gcc = 'gcc';
######
# FTP #
#######
# Major mode --ftp and --file automates the download of Contents and Packages
# files. Even if you have apt installed, you may still want to download Packages
# from alternative architectures, and the Contents file for your own architecture
# or other architectures. If you want virtual and/or -ld capabilities you need
# the Contents file. You specify a list of ftp or file sites using urls (like
# apt). For your system's architecture specify the type deb, for other
# architectures specify deb(hyphen)architecture (ex: deb-alpha). Regardless of
# whether or not you specify an architecture, deb implies /dist* found under the
# base directory specified by the ftp url, except in the case of experimental,
# and to a degree non-us. minor mode --ftp, and --file will use the sites in this
# configuration as well, on a fifo (first in first out) basis, so choose the
# order of sites based on which are closest, most current, as well as fast.
# IMPORTANT: It is a BIG MISTAKE to use the distributions name (slink,po,etc)
# anywhere in the sources list, or in swim's configuration file..in fact swim
# won't work properly, not to mention the fact that someday your favorite name
# will suddenly disappear. This is because swim thinks in terms of the real
# distribution name (stable,unstable,frozen, experimental). The problem goes
# like this - slink remains slink, but goes from unstable to frozen to stable.
# At first, using the distributions alias may seem appropriate, but the
# purpose of swim is to keep tabs on the dists, and not to ignore changes in
# the states, this also makes managing swim's databases much easier and
# intuitive...more about this later.
# Fun experiments: Swim uses the naming conventions of apt, but leaves the
# Package files compressed in the DF directory. So you can always decompress
# the databases and move them to /var/state/apt/lists. This ofcourse assumes
# that the appropriate changes to the sources.list reflecting these Packages
# (need to be the same architecture as your system) existed before you
# update. (author needs to do this experiment :*)
$ftp1 = "deb ftp://localhost/pub/debian unstable main contrib non-free non-US";
$ftp2 = "deb ftp://localhost/pub/debian unstable main contrib non-free";
$ftp3 = "deb ftp://localhost/pub/debian project/experimental/";
@FTP = ($ftp1,$ftp2,$ftp3);
# These next variables allow some characteristics of the ftp client
# to be altered. See Net::FTP for ways of altering some of these
# variables through the environment.
$firewall = 0;
$port = 0;
$timeout = 120;
$debug = 0;
$passive = 0;
########################################
# STUFF THAT NEVER NEEDS TO BE CHANGED #
########################################
# You will never need to change this unless for some weird reason all the
# files under dpkg are somewhere else (including /info*) , see --dbpath as
# an alternative if you decide to access or make the databases somewhere
# else.
$base = '/var/lib/dpkg';
# --dbpath takes care of this so don't touch.
$parent = '/';
$library = '/var/lib/dpkg';
#############################
# LOAD CUSTOM CONFIGURATION #
#############################
# Here we load in the customized configuration which override the defaults
# Might as well use do, let the world learn Perl ... compare this to apt's
# configuation file with scopes. Swim's sources.list file (/etc/swim/swimz.list),
# will be grabbed at SWIM::Apt and SWIM::Qftp if it exists.
do "$swim_conf/swimrc";
do "$ENV{HOME}/.swim/swimrc";
if ((defined $dpkg && !defined $dpkg_deb) ||
(!defined $dpkg && defined $dpkg_deb)) {
print "swim: need to give both \$dpkg and \$dpkg_deb a value if you want dpkg\n";
exit;
}
if (defined $package_tool) {
if ($package_tool =~ /ar/) {
$ar = $ar;
}
else {
$dpkg = 'dpkg';
$dpkg_deb = 'dpkg-deb';
undef $ar;
}
}
if (defined $apt) {
$apt_get = 'apt-get';
$apt_cache = 'apt-cache';
}
###############################
# MAKE ANY NEEDED DIRECTORIES #
###############################
# make sure all the appropriate directories are made
if (!-d $default_directory) {
if (-e $default_directory) {
print "swim: can not create default directory because a file exists\n";
exit;
}
my @DRD = split(m,/,,$default_directory);
my $placement = "/";
for (1 .. $#DRD) {
$_ == 1 ? ($placement = "/$DRD[$_]")
: ($placement = $placement . "/" . $DRD[$_]);
-d $placement or mkdir("$placement",0755);
}
}
if (!-d "$default_directory$default_root_directory") {
my @DRD = split(m,/,,$default_root_directory);
print "swim: debian must be the final directory before dists\n"
if $DRD[$#DRD] ne "debian";
exit if $DRD[$#DRD] ne "debian";
my $placement = "/";
for (1 .. $#DRD) {
$_ == 1 ? ($placement = "/$DRD[$_]")
: ($placement = $placement . "/" . $DRD[$_]);
unless (-d "$default_directory$placement") {
mkdir("$default_directory$placement",0755)
or die "swim: could not create root default directory\n";
}
}
}
# Makefile will make sure these directories exist, unless for some strange
# reason you have to change them.
if (!-d $library) {
mkdir($library,0755) or die "Couldn't create default directory\n";
}
if (!-d $base) {
mkdir($base,0755) or die "Couldn't create default directory\n";
}
if (!-d $swim_conf) {
mkdir($swim_conf,0666) or die "Couldn't create configuration file directory,
please make the directories which are needed.\n";
}
1;
__END__
=head1 NAME
swimrc - swim configuration file
=head1 DESCRIPTION
B<swimrc> is the configuartion file for swim allowing many default values
to be set so that they do not have to be mentioned on the command line.
Swimrc interacts directly with Perl allowing a wide variety of variables
found in B<SWIW::Conf> to be altered.
=cut
=head1 USAGE
Values for variable can be altered for B<swim> by assigning different
values enclosed in quotes or quoted whitespace (qw()), and ended with a
semi-colon.
$variable = "value";
$variable = "qw(value1 value2 ..)";
=head1 VARIABLES
This is a list of variables with explanations. The default values for
B<swim> are shown.
=head2 OUTPUT VARIABLE
$my_number can be changed to how many lines you would like "swim -qf <>"
to print out, before the program asks for C<-t> or C<--total>. Exception:
If C<-i> is used in the query and there is more than one package then the
total will be presented.
Hint: C<-t> can be used with all the various C<--scripts> family members
to view the title of the script file regardless of this variable setting,
and if C<-t> has to be used, the titles will be displayed, which makes
sense.
B<$my_number = 23;>
=head2 HISTORY
This is a shell-like history kept in relation to searches and the most
recent edit when C<--stdin> is used.
B<$HISTORY = 10;>
=head2 AR or DPKG?
Debian packages are ar archives. If you are using a Debian Distribution
assign "dpkg" to $package_tool, otherwise assign "ar" to $package_tool.
B<$package_tool = "/usr/bin/ar";>
=head2 APT
B<Swim> does not assign a value for apt. To use C<--apt> and C<-xyz>
assign $apt the value "yes".
Example: B<$apt = "yes";>
=head2 PAGER
less is a nice pager, unless you like more! Pager is used for C<--help>
and B<swim> called without any options. There is an option C<--nopager> or
C<-n>. more comes from the required package util-linux, whereas less
comes from a standard package called less. Values: "less", "more", or
"most" or...
B<$ENV{PAGER} = "less";>
=head2 NOT-INSTALLED VARIABLES
Assign values for $architecture and/or $distribution to avoid having to
use C<--arch> and C<--dists> everytime the not-installed databases are
accessed with C<-n> or made or altered.
Architectures are always being added so check with Debian to find a list.
There is I<alpha, arm, hurd-i386 (alternative kernel to linux), i386,
m68k, powerpc, sparc>. Just use the arch found after the hyphen in the
Contents-(arch) file.
B<$architecture = "i386";>
The distribution can be either I<stable, unstable, frozen, or experimental
(rare)>. These represent the state of development that the packages are
under. The unstable distribution can have lot's of changes within a very
short time period, and frozen may or may not be available.
B<$distribution = "unstable";>
Distributions are divided into sections. These sections were called
distributions in the version 2.4.1.0 packaging manual, because they were
at one time separate distributions, but this has since changed.
You can determine which of the sections I<main, non-free, contrib or
non-US> to pull out of the Contents file if you don't want to use
C<--main>, C<--contrib>, C<--non-free>, and C<--non-us> to selectively
pick the sections.
For efficiency, you should choose the sections which you will be pulling
out of the Packages file(s) being targetted.
Rule: Use "non-US" not "non-us".
B<@user_defined_section = qw(main contrib non-free non-US);>
=head2 DF LOCATION
A little philosophy: B<swim> was developed for maximum versatility, so
whether you are just interested in researching, and keeping tabs on the
newest packages, or maintaining a Debian virtual distribution on a
non-Debian distribution, or you are a using B<swim> for distribution
development, B<swim> provides a way.
The next two variables determine the location of the DF (default
directory/file system)
The default directory keeps track of Contents and/or Packages databases
retrieved with --ftp. The Contents and Packages databases and Release
file are give names specific to the distribution and architectures they
represent using the naming convention found in apt's sources directory.
You also have the freedom not to use the default directory, in which case
swim will still do the renaming and keeping track of the mtime, but you
will have to remember where you put the files.
B<$default_directory = '/root/.swim';>
The default root directory (DRD) is the key to easy management of binary
packages, source, dsc, and diff files received from --ftp, and provides an
easy way to put together a personalized distribution. This directory can
be a real ftp site on your computer, or put wherever else you are
allowed to have directories. The DRD is always placed below the value
assigned to $default_directory. According to the previous assignment to
$default_directory, if the DRD is "/pub/a/debian" then the full path
would be "/root/.swim/pub/a/debian".
Example: When a package is downloaded it will be placed in
dists/distribution/section/architecture/subject below the DRD.
Rule: debian must be the final directory before dists, this is because
other distributions are placed alongside debian, like debian-non-US or
personal (specialized distribution).
B<$default_root_directory = '/pub/debian';>
Because you may be using a real ftp site, this variable allows you to
determine what permissions B<swim> will assign for directories it creates
below the DRD.
B<$permission = '0755';>
=head2 TEMPORARY DIRECTORY
If you want to set an alternative directory for the temporary files
created when the databases are made, change here. You may want to make
$tmp a RAM disk. See package loadlin for initrd documentation and an
explanation for making such a disk. There is also documentation in
/usr/src/kernel-source.version/Documentation. Whether this will speed
things up is a subject of experimentation.
B<$tmp = "/tmp";>
=head2 FTP
You can alter the Firewall, Port, Timeout, Debug and Passive
characteristics of the ftp client as defined in Net::FTP(3pm) by providing
arguments to these variables. All variables but $timeout are set to untrue
by default.
$firewall = 0; (FTP firewall machine name)
$port = 0; (defaults to 23)
$timeout = 120; (120 seconds)
$debug = 0; (1 will turn on STDERR)
$passive = 0; (1 will enable)
=head1 OTHER VARIABLES
see SWIM::Conf
=head1 FILES
/etc/swim/swimrc
~/.swim/swimrc
=head1 SEE ALSO
swim(8), Net::FTP(3pm)
=head1 BUGS
Send directly to mttrader@access.mountain.net.
=head1 AUTHOR
Jonathan D. Rosenbaum <mttrader@access.mountain.net>
=head1 COPYRIGHT
Copyright (c) 1999 Jonathan Rosenbaum. All rights reserved. This program
is free software; you can redistribute it and/or modify it under the GPL.
=cut

672
Conf.pm.alternative Normal file
View File

@ -0,0 +1,672 @@
# Package administration and research tool for Debian
# Copyright (C) 1999-2000 Jonathan D. Rosenbaum
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
package SWIM::Conf;
use vars qw(@ISA @EXPORT %EXPORT_TAGS);
use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw($my_number $tmp $architecture $distribution @user_defined_section
$default_directory $default_root_directory $permission $dpkg
$dpkg_deb $ar $gcc $apt_get $apt_cache $sources @FTP $spl $cat
$sort $md5sum $zcat $tar $grep $gzip $fastswim $slowswim $longswim
$mount $umount $mke2fs $copy $pager $base $pwd $parent $library
$splt $mv $imswim $swim_conf $debug $port $timeout
$firewall $passive $apt_sources $HISTORY $alt);
%EXPORT_TAGS = (
Path => [ qw($tmp $parent $base $library) ],
Deb => [ qw($pwd $dpkg_deb $ar $tar $grep $tmp $md5sum $cat $mv) ],
Qftp => [ qw($default_root_directory $permission @FTP
$default_directory $swim_conf) ],
Info => [ qw($parent $base $zcat) ]
);
#############################
# DEFAULT PROGRAM VARIABLES #
#############################
# You can change this to how many lines you would like "swim -qf <>" to
# print out, before asking for -t or --total, it will automatically ask
# though, if there is more than one package and you used the option -i.
# Remember -t can be used with --scripts family members to view the
# title of the script file regardless of this setting, and if -t has to be
# used, the titles will be displayed, which makes sense.
$my_number = 23;
# Just like a shell, you can keep a history of whatever length you want.
$HISTORY = 10;
# For not-installed:
# This part supplies the default value for --arch.
#
# You can determine the default architecture used when -n is
# called or a not-installed database is made. Architectures are always
# being added so check with Debian to find a list. There is alpha, arm,
# hurd (alternative kernel to linux), i386, m68k, powerpc, sparc. Just use
# the arch found after the hyphen in the Contents-(arch) file.
$architecture = "i386";
# For not-installed:
# This part supplies the default value for --dists.
#
# The default distribution can be either stable, unstable, frozen, or
# experimental (rare). These represent the state of development that the
# packages are under. The unstable distribution can have lot's of changes
# within a very short time period, and frozen may or may not be available.
$distribution = "unstable";
#For not-installed:
#This part supplies the default value for --main, --contrib, --non-free,
#and --non-us.
# Distributions are divided into the sections. These sections are called
# distributions in the version 2.4.1.0 packaging manual, because they were at
# one time separate distributions, but this has since changed. You can
# determine which of these sections (main, non-free, contrib or non-US) to
# pull out of the Contents file if you don't want to use --main, --contrib,
# --non-free, and --non-us to selectively pick sections. Basically, whatever
# you pull out should match the Package(s) file(s) you are targetting, this
# program is friendly if you make a mistake, but it's more effecient to pull
# out just what you want. If the same package happens to exist in two
# different sections, main and non-us for example (which is really a
# situation that shouldn't exist, yet it does), you will still be able to
# find this package in the non-us group, but its section and locations will be
# the one which main recognizes assuming that you use the order in the example
# below.
# Setting it up:
# Example: You just want to pull out main and contrib every time you run
# --initndb, --rebuildndb, or --ndb.
# @user_defined_section = qw(main contrib non-US);
# remember "non-US" not "non-us".
#untill non-US is fixed the second is better
#@user_defined_section = qw(main contrib non-free non-US);
@user_defined_section = qw(main contrib non-free);
# Usually, this is
$alt = "debian";
################
# DF LOCATION #
################
# A little philosophy:
# swim was developed for maximum versatility, so whether you are just
# interested in researching, and keeping tabs on the newest packages,
# or maintaining a Debian virtual distribution on a non-Debian real
# distribution, or you are a using swim for distribution development, swim
# provides a way. The default directory (DF - which can also mean
# directory/file) keeps track of Contents and Packages files downloaded
# using --ftp, and gives the files names specific to the distribution and
# architectures they represent. But, you also have the freedom not to use
# the default directory in this case swim will still do the renaming and
# keeping track of the mtime, but you will have to remember where you put
# the files. On the other hand, if you use apt, you won't even have to use
# the DF directory for Packages files because you can get the ones specific
# to your own systems architecture from apt, but if you want to look at
# other architectures you will need to use the DF directory or one of your
# own choice.
# Naming Convention: Contents = Contents-dist.gz
# Packages = Packages-arch-dist-section.gz
$default_directory = '/root/.swim';
# The default root directory is the key to easy management of packages
# downloaded through --ftp and --file, and provides an easy way to put together
# a personalized distribution. Future implementations of swim will provide
# a distribution called personal..Packages and Contents files specific to
# this distribution will automatically be made. This directory can be a
# real ftp site on your computer, or put where ever else you are allowed
# to have directories. dists/distribution/section/architecture/subject will be
# placed above this directory. No matter what, debian must be the final
# directory before dists. Other distributions are placed alongside debian,
# like debian-non-US or personal.
# Feel free to change the permissions. This directory is above your default_
# directory.
$default_root_directory = '/pub/debian';
# Because you may be using a real ftp site, this configuration allows you
# to determine what permissions swim will set for directories it creates
# above the default root directory.
$permission = '0755';
###############
# AR or DPKG? #
###############
# NOTE: users set these next two with the $package_tool variable.
# packaging friends dpkg and dpkg-deb come from the essential and
# required dpkg package. ar from the package binutils can also be used (below).
# This is the archival program used for deb packages, but binutils is just
# a standard non-essential package, and the ar capabilities are built into
# dpkg-deb, and it's better not to assume that the standard packages are
# even established, yet.
$dpkg = ();
$dpkg_deb = ();
# If you don't have the dpkg package on your system then you can use ar
# from the package binutils. This would be a standard, but not an essential
# package in Debian, but this package is also fairly standard amongst all
# distributions, and can even be found in the free djgpp for M$ Oses.
# Since people who have both dpkg and ar may want to try the ar method,
# rather than creating an automatic check, just assign a value to either
# ($dpkg & $dpkg_deb) or just $ar.
#my $ar = '/usr/bin/ar'; # same for RH
$ar = '/usr/bin/ar';
#######
# APT #
#######
# NOTE: users set apt-get and apt-cache with the $apt variable
# If you have apt you are in luck.
$apt_get = ();
$apt_cache = ();
$sources = '/etc/apt/sources.list';
$apt_sources = '/var/state/apt/lists';
#########
# PAGER #
#########
# less is a nice pager, unless you like more! There is an option
# --nopager or -n. Pager is used for --help and swim called without any
# options. more comes from the required package util-linux, whereas
# less comes from a standard package called less. In the future there is
# a possiblity that a large percentage of swim may use an internal pager.
# less, more, or most or...
#$ENV{PAGER} = "/usr/bin/less"; # same RH
$ENV{PAGER} = "less";
$pager = $ENV{PAGER};
#################
# SWIM PROGRAMS #
#################
# This is replaced by the Makefile.
$pre="/usr"; # AUTOREPLACE done by Makefile, do not edit.
# This is the hash making program fastswim.
$fastswim = "$pre/lib/SWIM/bin/fastswim";
# imswim in an alternative to fastswim for --lowmem
$imswim = "$pre/lib/SWIM/bin/imswim";
# This is the low memory program slowswim.
$slowswim = "$pre/lib/SWIM/bin/slowswim";
# This is the dir/file making program longswim.
$longswim = "$pre/lib/SWIM/bin/longswim";
############
# TEMP DIR #
############
# If you want to set an alternative directory for the temporary files
# created when the databases are made, change here. You may want to make
# $tmp a RAM disk. See package loadlin for initrd documentation and an
# explanation for making such a disk. There is also
# /usr/src/kernel-source.version/Documentation. Whether this will speed
# things up is a subject of experimentation.
$tmp = '/tmp';
##################
# MAIN CONFFILES #
##################
# if configuration files are not kept in /etc change this
# and set up the directories by hand.
$swim_conf = '/etc/swim';
#############
# UTILITIES #
#############
# This probably never will have to be changed.
$pwd = `pwd`;
chomp $pwd;
# If the command split is somewhere else besides /usr/bin change this.
# The required package textutils provides this.
#my $splt = '/usr/bin/split'; # same RH
$splt = 'split';
# cat comes from the essential and required package textutils.
#my $cat = '/bin/cat'; # same RH
$cat = 'cat';
# This command also omes from the required and essential package textutils.
#my $sort = '/usr/bin/sort'; # same RH
$sort = 'sort';
# This program uses md5sum from the dpkg package, it can also use md5sum
# from the RH package.
#my $md5sum = '/usr/bin/md5sum'; # same RH
$md5sum = 'md5sum';
# If you want to view compressed files make sure this is correct.
# The required package gzip provides this.
#my $zcat = '/bin/zcat'; # same RH
$zcat = 'zcat';
# tar comes from the essential and required package tar.
#my $tar = '/bin/tar'; # same RH
$tar = 'tar';
# grep comes from the essential and required package grep. This seems
# to require a path.
$grep = '/bin/grep'; # same RH
# gzip comes from the essential and required package gzip.
#my $gzip = "/bin/gzip"; # same RH
$gzip = "gzip";
# mount comes from the essential and required package mount.
#my $mount = '/bin/mount'; # same RH
#my $umount = '/bin/umount'; # same RH
$mount = 'mount';
$umount = 'umount';
# If your file system isn't an ext2 filesystem, you may want to change
# this. mke2fs comes from the essential and required package e2fsprogs.
#my $mke2fs = '/sbin/mke2fs'; # same RH
$mke2fs = 'mke2fs';
# cp and mv from the essential and required package fileutils
#my $copy = '/bin/cp'; # same RH
$copy = 'cp';
$mv = 'mv';
# Your system definitely has gcc if you have ar. gcc is a standard package
# in debian.
$gcc = 'gcc';
######
# FTP #
#######
# Major mode --ftp and --file automates the download of Contents and Packages
# files. Even if you have apt installed, you may still want to download Packages
# from alternative architectures, and the Contents file for your own architecture
# or other architectures. If you want virtual and/or -ld capabilities you need
# the Contents file. You specify a list of ftp or file sites using urls (like
# apt). For your system's architecture specify the type deb, for other
# architectures specify deb(hyphen)architecture (ex: deb-alpha). Regardless of
# whether or not you specify an architecture, deb implies /dist* found under the
# base directory specified by the ftp url, except in the case of experimental,
# and to a degree non-us. minor mode --ftp, and --file will use the sites in this
# configuration as well, on a fifo (first in first out) basis, so choose the
# order of sites based on which are closest, most current, as well as fast.
# IMPORTANT: It is a BIG MISTAKE to use the distributions name (slink,po,etc)
# anywhere in the sources list, or in swim's configuration file..in fact swim
# won't work properly, not to mention the fact that someday your favorite name
# will suddenly disappear. This is because swim thinks in terms of the real
# distribution name (stable,unstable,frozen, experimental). The problem goes
# like this - slink remains slink, but goes from unstable to frozen to stable.
# At first, using the distributions alias may seem appropriate, but the
# purpose of swim is to keep tabs on the dists, and not to ignore changes in
# the states, this also makes managing swim's databases much easier and
# intuitive...more about this later.
# Fun experiments: Swim uses the naming conventions of apt, but leaves the
# Package files compressed in the DF directory. So you can always decompress
# the databases and move them to /var/state/apt/lists. This ofcourse assumes
# that the appropriate changes to the sources.list reflecting these Packages
# (need to be the same architecture as your system) existed before you
# update. (author needs to do this experiment :*)
$ftp1 = "deb ftp://localhost/pub/debian unstable main contrib non-free non-US";
$ftp2 = "deb ftp://localhost/pub/debian unstable main contrib non-free";
$ftp3 = "deb ftp://localhost/pub/debian project/experimental/";
@FTP = ($ftp1,$ftp2,$ftp3);
# These next variables allow some characteristics of the ftp client
# to be altered. See Net::FTP for ways of altering some of these
# variables through the environment.
$firewall = 0;
$port = 0;
$timeout = 120;
$debug = 0;
$passive = 0;
########################################
# STUFF THAT NEVER NEEDS TO BE CHANGED #
########################################
# You will never need to change this unless for some weird reason all the
# files under dpkg are somewhere else (including /info*) , see --dbpath as
# an alternative if you decide to access or make the databases somewhere
# else.
$base = '/var/lib/dpkg';
# --dbpath takes care of this so don't touch.
$parent = '/';
$library = '/var/lib/dpkg';
#############################
# LOAD CUSTOM CONFIGURATION #
#############################
# Here we load in the customized configuration which override the defaults
# Might as well use do, let the world learn Perl ... compare this to apt's
# configuation file with scopes. Swim's sources.list file (/etc/swim/swimz.list),
# will be grabbed at SWIM::Apt and SWIM::Qftp if it exists.
do "$swim_conf/swimrc";
do "$ENV{HOME}/.swim/swimrc";
if ((defined $dpkg && !defined $dpkg_deb) ||
(!defined $dpkg && defined $dpkg_deb)) {
print "swim: need to give both \$dpkg and \$dpkg_deb a value if you want dpkg\n";
exit;
}
if (defined $package_tool) {
if ($package_tool =~ /ar/) {
$ar = $ar;
}
else {
$dpkg = 'dpkg';
$dpkg_deb = 'dpkg-deb';
undef $ar;
}
}
if (defined $apt) {
$apt_get = 'apt-get';
$apt_cache = 'apt-cache';
}
###############################
# MAKE ANY NEEDED DIRECTORIES #
###############################
# make sure all the appropriate directories are made
if (!-d $default_directory) {
if (-e $default_directory) {
print "swim: can not create default directory because a file exists\n";
exit;
}
my @DRD = split(m,/,,$default_directory);
my $placement = "/";
for (1 .. $#DRD) {
$_ == 1 ? ($placement = "/$DRD[$_]")
: ($placement = $placement . "/" . $DRD[$_]);
-d $placement or mkdir("$placement",0755);
}
}
if (!-d "$default_directory$default_root_directory") {
my @DRD = split(m,/,,$default_root_directory);
print "swim: debian must be the final directory before dists\n"
if $DRD[$#DRD] ne "debian";
exit if $DRD[$#DRD] ne "debian";
my $placement = "/";
for (1 .. $#DRD) {
$_ == 1 ? ($placement = "/$DRD[$_]")
: ($placement = $placement . "/" . $DRD[$_]);
unless (-d "$default_directory$placement") {
mkdir("$default_directory$placement",0755)
or die "swim: could not create root default directory\n";
}
}
}
# Makefile will make sure these directories exist, unless for some strange
# reason you have to change them.
if (!-d $library) {
mkdir($library,0755) or die "Couldn't create default directory\n";
}
if (!-d $base) {
mkdir($base,0755) or die "Couldn't create default directory\n";
}
if (!-d $swim_conf) {
mkdir($swim_conf,0666) or die "Couldn't create configuration file directory,
please make the directories which are needed.\n";
}
1;
__END__
=head1 NAME
swimrc - swim configuration file
=head1 DESCRIPTION
B<swimrc> is the configuartion file for swim allowing many default values
to be set so that they do not have to be mentioned on the command line.
Swimrc interacts directly with Perl allowing a wide variety of variables
found in B<SWIW::Conf> to be altered.
=cut
=head1 USAGE
Values for variable can be altered for B<swim> by assigning different
values enclosed in quotes or quoted whitespace (qw()), and ended with a
semi-colon.
$variable = "value";
$variable = "qw(value1 value2 ..)";
=head1 VARIABLES
This is a list of variables with explanations. The default values for
B<swim> are shown.
=head2 OUTPUT VARIABLE
$my_number can be changed to how many lines you would like "swim -qf <>"
to print out, before the program asks for C<-t> or C<--total>. Exception:
If C<-i> is used in the query and there is more than one package then the
total will be presented.
Hint: C<-t> can be used with all the various C<--scripts> family members
to view the title of the script file regardless of this variable setting,
and if C<-t> has to be used, the titles will be displayed, which makes
sense.
B<$my_number = 23;>
=head2 HISTORY
This is a shell-like history kept in relation to searches and the most
recent edit when C<--stdin> is used.
B<$HISTORY = 10;>
=head2 AR or DPKG?
Debian packages are ar archives. If you are using a Debian Distribution
assign "dpkg" to $package_tool, otherwise assign "ar" to $package_tool.
B<$package_tool = "/usr/bin/ar";>
=head2 APT
B<Swim> does not assign a value for apt. To use C<--apt> and C<-xyz>
assign $apt the value "yes".
Example: B<$apt = "yes";>
=head2 PAGER
less is a nice pager, unless you like more! Pager is used for C<--help>
and B<swim> called without any options. There is an option C<--nopager> or
C<-n>. more comes from the required package util-linux, whereas less
comes from a standard package called less. Values: "less", "more", or
"most" or...
B<$ENV{PAGER} = "less";>
=head2 NOT-INSTALLED VARIABLES
Assign values for $architecture and/or $distribution to avoid having to
use C<--arch> and C<--dists> everytime the not-installed databases are
accessed with C<-n> or made or altered.
Architectures are always being added so check with Debian to find a list.
There is I<alpha, arm, hurd-i386 (alternative kernel to linux), i386,
m68k, powerpc, sparc>. Just use the arch found after the hyphen in the
Contents-(arch) file.
B<$architecture = "i386";>
The distribution can be either I<stable, unstable, frozen, or experimental
(rare)>. These represent the state of development that the packages are
under. The unstable distribution can have lot's of changes within a very
short time period, and frozen may or may not be available.
B<$distribution = "unstable";>
Distributions are divided into sections. These sections were called
distributions in the version 2.4.1.0 packaging manual, because they were
at one time separate distributions, but this has since changed.
You can determine which of the sections I<main, non-free, contrib or
non-US> to pull out of the Contents file if you don't want to use
C<--main>, C<--contrib>, C<--non-free>, and C<--non-us> to selectively
pick the sections.
For efficiency, you should choose the sections which you will be pulling
out of the Packages file(s) being targetted.
Rule: Use "non-US" not "non-us".
B<@user_defined_section = qw(main contrib non-free non-US);>
=head2 DF LOCATION
A little philosophy: B<swim> was developed for maximum versatility, so
whether you are just interested in researching, and keeping tabs on the
newest packages, or maintaining a Debian virtual distribution on a
non-Debian distribution, or you are a using B<swim> for distribution
development, B<swim> provides a way.
The next two variables determine the location of the DF (default
directory/file system)
The default directory keeps track of Contents and/or Packages databases
retrieved with --ftp. The Contents and Packages databases and Release
file are give names specific to the distribution and architectures they
represent using the naming convention found in apt's sources directory.
You also have the freedom not to use the default directory, in which case
swim will still do the renaming and keeping track of the mtime, but you
will have to remember where you put the files.
B<$default_directory = '/root/.swim';>
The default root directory (DRD) is the key to easy management of binary
packages, source, dsc, and diff files received from --ftp, and provides an
easy way to put together a personalized distribution. This directory can
be a real ftp site on your computer, or put wherever else you are
allowed to have directories. The DRD is always placed below the value
assigned to $default_directory. According to the previous assignment to
$default_directory, if the DRD is "/pub/a/debian" then the full path
would be "/root/.swim/pub/a/debian".
Example: When a package is downloaded it will be placed in
dists/distribution/section/architecture/subject below the DRD.
Rule: debian must be the final directory before dists, this is because
other distributions are placed alongside debian, like debian-non-US or
personal (specialized distribution).
B<$default_root_directory = '/pub/debian';>
Because you may be using a real ftp site, this variable allows you to
determine what permissions B<swim> will assign for directories it creates
below the DRD.
B<$permission = '0755';>
=head2 TEMPORARY DIRECTORY
If you want to set an alternative directory for the temporary files
created when the databases are made, change here. You may want to make
$tmp a RAM disk. See package loadlin for initrd documentation and an
explanation for making such a disk. There is also documentation in
/usr/src/kernel-source.version/Documentation. Whether this will speed
things up is a subject of experimentation.
B<$tmp = "/tmp";>
=head2 FTP
You can alter the Firewall, Port, Timeout, Debug and Passive
characteristics of the ftp client as defined in Net::FTP(3pm) by providing
arguments to these variables. All variables but $timeout are set to untrue
by default.
$firewall = 0; (FTP firewall machine name)
$port = 0; (defaults to 23)
$timeout = 120; (120 seconds)
$debug = 0; (1 will turn on STDERR)
$passive = 0; (1 will enable)
=head1 OTHER VARIABLES
see SWIM::Conf
=head1 FILES
/etc/swim/swimrc
~/.swim/swimrc
=head1 SEE ALSO
swim(8), Net::FTP(3pm)
=head1 BUGS
Send directly to mttrader@access.mountain.net.
=head1 AUTHOR
Jonathan D. Rosenbaum <mttrader@access.mountain.net>
=head1 COPYRIGHT
Copyright (c) 1999 Jonathan Rosenbaum. All rights reserved. This program
is free software; you can redistribute it and/or modify it under the GPL.
=cut

51
INSTALL Normal file
View File

@ -0,0 +1,51 @@
To install swim, become root and type "make install".
To install extra and important documentation, type "make installdoc".
To remove, type "make remove".
Pod documentation is found in Conf.pm and swim.pod if you want to make
different types of documention using pod translators. There are SGML
documents conforming to the debiandoc DTD for swimrc and swim which can be
converted using tools from the debiandoc-sgml package.
(The modules mentioned below can be located at CPAN at www.perl.com.)
Some distributions may require this module for ftp capabilities.
Net::FTP from libnet-perl
This module provides readline libraries. There are other similiar modules
which also work with Perl's Term::ReadLine(3pm).
Term::ReadLine::Gnu from libterm-readline-gnu-perl or
Term::ReadLine::Perl from libterm-readline-perl-perl
Also read QUICKSTART.text or QUICKSTART.html for additional information.
_________________________________________________________________
Alternative Installation
The modules are put into /usr/lib/perl5/SWIM because this is in Perl's
@INC path, and does not violate Debian's Policy, on the other hand the
modules are rather specific to swim, although they definitely could be
used for other things. To put it in /usr/lib meant either using 'use lib
"/usr/lib"' or pushing the alternative directory into @INC doing a
'BEGIN{}', or setting the Environment variable PERL5LIB. The first method
slowed swim down, the second method caused a bad bug in SWIM::Deb, and the
third method involved trying to make a universe of shells happy, but this
is the best approach for an alternative @INC path.
That's why there is Makefile.alternative. If you already did a 'make
install', now do a 'make remove'. Change the name of Makefile, and change
Makefile.alternative's name to Makefile. You can change PREFIX in this
Makefile to /usr/local if you want to. Follow the same steps as for the
original Makefile, but add one more step, set the Environment vaiable
PERL5LIB to the directory where the modules are. If the PREFIX was not
changed, and you are using a bash shell then 'export PERL5LIB=/usr/lib'.
This alternative Makefile uses the tradition /usr/doc, /usr/man
directories whereas the other Makefile uses /usr/share/doc and
/usr/share/man, this is because of Debian's adherence to the next
generation fsstnd.

76
Makefile Normal file
View File

@ -0,0 +1,76 @@
# Use Makefile.alternative if you want the modules in /usr or /usr/local,
# not in /usr/lib/perl5, see INSTALL.
PREFIX=/usr
all:
clean:
-rm build
-rm *.bak
install:
install -d $(DESTDIR)/var/lib/dpkg
install -d $(DESTDIR)/$(PREFIX)/sbin
cp -a swim $(DESTDIR)/$(PREFIX)/sbin/swim
install -d $(DESTDIR)/$(PREFIX)/lib/perl5/SWIM
cp -f Conf.pm $(DESTDIR)/$(PREFIX)/lib/perl5/SWIM/Conf.pm
cp -fa lib/* $(DESTDIR)/$(PREFIX)/lib/perl5/SWIM
install -d $(DESTDIR)/$(PREFIX)/lib/SWIM
cp -fa bin/* $(DESTDIR)/$(PREFIX)/lib/SWIM
install -d $(DESTDIR)/$(PREFIX)/share/man/man8
cp -f swim.8 $(DESTDIR)/$(PREFIX)/share/man/man8
install -d $(DESTDIR)/$(PREFIX)/share/man/man5
cp -f swimrc.5 $(DESTDIR)/$(PREFIX)/share/man/man5
install -d $(DESTDIR)/usr/share/doc/swim/swim.html
cp -fa swim.html/* $(DESTDIR)/usr/share/doc/swim/swim.html
install -d $(DESTDIR)/usr/share/doc/swim/swimrc.html
cp -fa swimrc.html/* $(DESTDIR)/usr/share/doc/swim/swimrc.html
cp -f QUICKSTART.html $(DESTDIR)/usr/share/doc/swim
cp -f REQUIREMENTS.html $(DESTDIR)/usr/share/doc/swim
cp -f swim_by_example.html $(DESTDIR)/usr/share/doc/swim
install -d $(DESTDIR)/usr/share/doc/swim/examples
cp -fa examples/* $(DESTDIR)/usr/share/doc/swim/examples
install -d $(DESTDIR)/etc/swim
cp -f swimz.list $(DESTDIR)/etc/swim
cp -f swimrc $(DESTDIR)/etc/swim
installdoc:
install -d $(DESTDIR)/$(PREFIX)/share/doc/swim
cp -a QUICKSTART.text $(DESTDIR)/$(PREFIX)/share/doc/swim
cp -a REQUIREMENTS.text $(DESTDIR)/$(PREFIX)/share/doc/swim
cp -a swim_by_example.html $(DESTDIR)/$(PREFIX)/share/doc/swim
cp -a THEMES $(DESTDIR)/$(PREFIX)/share/doc/swim
cp -a TODO $(DESTDIR)/$(PREFIX)/share/doc/swim
cp -a BUGS $(DESTDIR)/$(PREFIX)/share/doc/swim
cp -a TODO $(DESTDIR)/$(PREFIX)/share/doc/swim
cp -a COPYING $(DESTDIR)/$(PREFIX)/share/doc/swim
cp -a contact_and_website $(DESTDIR)/$(PREFIX)/share/doc/swim
cp -a changelog $(DESTDIR)/$(PREFIX)/share/doc/swim
cp -a swim.text $(DESTDIR)/$(PREFIX)/share/doc/swim
cp -a swimrc.text $(DESTDIR)/$(PREFIX)/share/doc/swim
remove:
rm $(PREFIX)/lib/perl5/SWIM/*
rmdir $(PREFIX)/lib/perl5/SWIM
rm $(PREFIX)/sbin/swim
rm /usr/share/doc/swim/swim.html/*
rmdir /usr/share/doc/swim/swim.html
rm /usr/share/doc/swim/swimrc.html/*
rmdir /usr/share/doc/swim/swimrc.html
rm /usr/share/doc/swim/examples/*
rmdir /usr/share/doc/swim/examples
rm /usr/share/doc/swim/*
rmdir /usr/share/doc/swim
rm $(PREFIX)/share/man/man5/swimrc.5
rm $(PREFIX)/share/man/man8/swim.8
rm $(PREFIX)/lib/SWIM/*
rmdir $(PREFIX)/lib/SWIM
debian:
dpkg-buildpackage -tc -rfakeroot
dist: debian localdist stampede rpm
.PHONY: debian

73
Makefile.alternative Normal file
View File

@ -0,0 +1,73 @@
# Set this to wherever you want swim to install. Eg, /usr/local or /usr
PREFIX=/usr
all:
clean:
-rm build
-rm *.bak
install:
install -d $(DESTDIR)/var/lib/dpkg
install -d $(DESTDIR)/$(PREFIX)/sbin
cp -a swim $(DESTDIR)/$(PREFIX)/sbin/swim
install -d $(DESTDIR)/$(PREFIX)/lib/SWIM/bin
perl -pe '$$_="\$$pre=\"$(PREFIX)\";\n" \
if /AUTOREPLACE/' Conf.pm.alternative \
> $(DESTDIR)/$(PREFIX)/lib/SWIM/Conf.pm
chmod 644 $(DESTDIR)/$(PREFIX)/lib/SWIM/Conf.pm
cp -fa lib/* $(DESTDIR)/$(PREFIX)/lib/SWIM
cp -fa bin/* $(DESTDIR)/$(PREFIX)/lib/SWIM/bin
install -d $(DESTDIR)/$(PREFIX)/man/man8
cp -f swim.8 $(DESTDIR)/$(PREFIX)/man/man8
install -d $(DESTDIR)/$(PREFIX)/man/man5
cp -f swimrc.5 $(DESTDIR)/$(PREFIX)/man/man5
install -d $(DESTDIR)/usr/doc/swim/swim.html
cp -fa swim.html/* $(DESTDIR)/usr/doc/swim/swim.html
install -d $(DESTDIR)/usr/doc/swim/swimrc.html
cp -fa swimrc.html/* $(DESTDIR)/usr/doc/swim/swimrc.html
cp -f QUICKSTART.html $(DESTDIR)/usr/doc/swim
cp -f REQUIREMENTS.html $(DESTDIR)/usr/doc/swim
cp -f swim_by_example.html $(DESTDIR)/usr/doc/swim
install -d $(DESTDIR)/usr/doc/swim/examples
cp -fa examples/* $(DESTDIR)/usr/doc/swim/examples
install -d $(DESTDIR)/etc/swim
cp -f swimz.list $(DESTDIR)/etc/swim
cp -f swimrc $(DESTDIR)/etc/swim
installdoc:
install -d $(DESTDIR)/$(PREFIX)/doc/swim
cp -a QUICKSTART.text $(DESTDIR)/$(PREFIX)/doc/swim
cp -a REQUIREMENTS.text $(DESTDIR)/$(PREFIX)/doc/swim
cp -a swim_by_example.html $(DESTDIR)/$(PREFIX)/doc/swim
cp -a THEMES $(DESTDIR)/$(PREFIX)/doc/swim
cp -a TODO $(DESTDIR)/$(PREFIX)/doc/swim
cp -a BUGS $(DESTDIR)/$(PREFIX)/doc/swim
cp -a TODO $(DESTDIR)/$(PREFIX)/doc/swim
cp -a COPYING $(DESTDIR)/$(PREFIX)/doc/swim
cp -a contact_and_website $(DESTDIR)/$(PREFIX)/doc/swim
cp -a changelog $(DESTDIR)/$(PREFIX)/doc/swim
cp -a swim.text $(DESTDIR)/$(PREFIX)/doc/swim
cp -a swimrc.text $(DESTDIR)/$(PREFIX)/doc/swim
remove:
rm -rf $(PREFIX)/lib/SWIM/*
rmdir $(PREFIX)/lib/SWIM
rm $(PREFIX)/sbin/swim
rm /usr/doc/swim/swim.html/*
rmdir /usr/doc/swim/swim.html
rm /usr/doc/swim/swimrc.html/*
rmdir /usr/doc/swim/swimrc.html
rm /usr/doc/swim/examples/*
rmdir /usr/doc/swim/examples
rm /usr/doc/swim/*
rmdir /usr/doc/swim
rm $(PREFIX)/man/man5/swimrc.5
rm $(PREFIX)/man/man8/swim.8
debian:
dpkg-buildpackage -tc -rfakeroot
dist: debian localdist stampede rpm
.PHONY: debian

114
Programming_swim Normal file
View File

@ -0,0 +1,114 @@
Database Structure
note: what's below was written for readability, not to
indicate complex structures, all databases are normal hashes. stripped
implies that the control field was removed, but the data afterwards kept.
Structure of statusindex.deb
1). Initially made in SWIM::DB_Init::database
2). Updated in SWIM::DB::db
3). $sb(packagename) = qw(packagename_version group priority
status(separated with :));
All fields stripped
Structure of nstatusindex-arch-dists.deb
1). Initally made in SWIM::NDB_Init::not_installed
2). Updated in SWIM::NDB::update_packages_ndb
3). $nsb(packagename) = qw(packagename_version group priority);
$nsb{"/."} = qw(packagename_version ...);
All fields stripped
Structure of packages.deb
1). Initally made in SWIM::DB_Init::database
2). Updated in SWIM::DB::db
3). %db = [ @name => (packagename packagename_version ...),
@Tdescriptions => (packagename_version format_info ...),
@conf => (packagename_versionCONF
every_indented_line_after_Conffiles ...),
@REPLACE => (packagename_version(with PRE, DEP, REC, SUG,
CON, PRO, or REP appended)
package_relationship_field (unstripped) ...)
]
Structure of npackages-arch-dists.deb
1). Initially made in SWIM::NDB_Init::not_installed
2). Updated in SWIM::NDB::update_packages_ndb
3). %ndb = [ @name => (packagename packagename_version ...),
@Tdescriptions => (packagename_version format_info ...),
@conf => (empty),
@REPLACE => (packagename_version(with PRE, DEP, REC, SUG,
CON, PRO, REP, MD, and FN appended)
package_relationship_field (unstripped) ...),
@FILENAME => (packagename_versionFN Filename_field(stripped) ...),
@MD5SUM => (packagename_versionMD
package_MD5_checksum(stripped) ...),
@revision => (packagename_versionMD(this comes from the
Filename field) "packagename_versionMD REVISION"
(this time the version comes from the Version
field) ...)
]
The revision field is unusual and occurs in the experimental distribution.
The hash is used by -p so that the version can be figured out. (check
"revision: situation" in SWIM::Deb).
Structure of groupindex.deb
1). Initally made in SWIM::DB_Init::database
2). Updated in SWIM::DB::db
3). $gb(group) = qw(packagenames ......) group stripped from Section:
Structure of ngroupindex-arch-dists.deb
1). Initially made in SWIM::NDB_Init::not_installed
2). Updated in SWIM::NDB::update_packages_ndb
3). $ngb = qw(packagenames ......) group stripped from Section:
Structure of searchindex.deb and dirindex.deb
1). When SWIM::DB_Init::database finishes SWIM::DB_Init::md begins.
This writes @dpackage to transfer.deb, which is processed by either
fastswim (filedir -> big and long) or imswim (which is like longswim,
which produces one large file - filedir.deb), and slowswim (big and
long) into the two files big.debian and long.debian and then the
databases are finished by SWIM::MD::process_md().
2). Rebuilt by SWIM::DB::rebuildflatdb
3). searchindex.deb = /path/filename\n ...... (1 package)
dirindex.deb = /path/dir\n ...... (> 1 package)
Structure of nsearchindex-arch-dists.deb and ndirindex-arch-dists.deb
1). After SWIM::NDB_Init::initndb runs SWIM::NDB_Init::not_installed,
SWIM::NDB_Init::nmd runs longswim which produces
filedir.deb, then initndb runs slowswim producing big.debian and
long.debian. Then the database(s) are finished by
SWIM::MD::prcess_md.
2).
3). nsearchindex-arch-dists.deb = /path/filename\n ...... (1 package)
ndirindex-arch-dists.deb = /path/dir\n ...... (> 1 package)
Note: nsearch* includes elements which pertain to only one
package, this generally implies files, not directories, however
the ni often has more than one package sharing a file, so its
placed into ndir* (this would be rare with an i system).
SWIM::Search::search processes these two files differently,
which is more effecient for the much larger nsearch*, for this
reason you can't merge the two databases together.
Structure of ncontentsindex-arch-dists.deb.
1). A compressed Contents database, no alterations (originally the headers
were removed, but this is a waste of time.) If the FDB (flat database
option if given) SWIM::Library::compress_contents is called from
initndb(), otherwise longswim called from SWIM::NDB_Init::nmd
copies and compresses. The longswim method compresses, but
compress_contents does a cp (not -a). In both cases the header
removal has been depreciated. The important thing is that the utime
remains the same.
2). The new Contents database is copied (utime) and renamed via
compress_contents called from SWIM::NDB.
3). Contents format

206
QUICKSTART.html Normal file
View File

@ -0,0 +1,206 @@
<html>
<head><title>Quickstart</title></head>
<body text="#000000" bgcolor="#FFFFFF" link="#0000EF" vlink="#51188E"
alink="#FF0000">
<br><br><br>
<h1 align=center>QUICKSTART</h1>
<br><br>
<h5>READ THE <A HREF="REQUIREMENTS.html">REQUIREMENTS</A></h5>
Now you can skip the next three steps if you have an installed Debian
distribution and you are in a hurry for a demonstration, but you will miss
out on swim's more awesome capabilities. With that said.....
<p>
<b>FIRST GET SWIMRC PREPARED</b>
<p> Edit the swimrc configution file, you should read <A
HREF="swimrc.html/index.html">swimrc(5)</A>, but I'll ask you some
question right now. You can find swimrc in /etc/swim, and swimrc can be
placed in your home directory in the subdirectory .swim. Entries in the
home directory swimrc override ones in /etc/swim.
<p>
Are you using an installed Debian system? If so, you almost definitely
have dpkg installed. So uncomment this line in /etc/swim/swimrc by
removing the pound sign.
<p>
<code>$package_tool = "/usr/bin/dpkg";</code>
<p>otherwise
<p>
<code>$package_tool = "/usr/bin/ar";</code>
<p>
Do you have the apt package installed? Configure this, or -xyz will not
work.
<p>
<code>$apt = "yes";</code>
<p>
Now you need to decide what architecture you would like to be swim's
default value when you download, build, and query the not-installed
databases.
<p>
What flavor, do you want alpha, arm, hurd-i386, i386, m68k, powerpc,
or sparc? (more coming :*) I decided on .....
<p>
<code>$architecture = "i386";</code>
<p>
What kind of distribution do you want to be your default? stable,
unstable, frozen, or experimental (rare) I like the ever changing ...
<p>
<code>$distribution = "unstable";</code>
<p>
Decide which sections you want? You can have this
<p>
<code>@user_defined_section = qw(main contrib non-free);</code>
<p>
or this.
<p>
<code>@user_defined_section = qw(main);</code>
<p>
or .....
<p>
<b>SECOND GET SWIMZ.LIST PREPARED</b>
<p> Now grab a copy of the <A
HREF="http://www.debian.org/misc/README.mirrors">README.mirrors</A> from
http://www.debian.org/misc/README.mirrors",
you will need this to set-up the configuration file /etc/swim/swimz.list.
<p> If your using apt make sure to read <A
HREF="swim.html/index.html">swim(8)</A> to get the nitty gritty on how you
can synchronize swim along with apt :*} using <A
HREF="swim.html/ch-important.html#s5.6">swimz.list</A>.
<p>
Humm, you found a site which has the distribution you want, and you know
which section you want, and you are happy knowing about packages which can
install on the architecture you computer happens to have.
<p>
So what site is that?
<p>
<code>deb ftp://ftp.swimz.org</code>
<p>
What was the directory you happened to notice in the README.mirrors page?
<p>
<code>deb ftp://ftp.swimz.org/pub/debian</code>
<p>
What distribution did you want? Note: You won't want to use the Release
code name for the distribution, see
<A HREF="swim.html/ch-important.html#s5.6">swimz.list</A>.
<p>
<code>deb ftp://ftp.swimz.org/pub/debian unstable</code>
<p>
What sections did you want?
<p>
<code>deb ftp://ftp.swimz.org/pub/debian unstable main contrib
non-free</code>
<p>
Now put this line in the swimz.list, exactly like written, and ofcourse
use the values you want.
<p>
<b>THIRD GET THE DEBIAN DATABASE WITH FTP</b>
<p>
Just issue this command.
<p>
<kbd>swim --ftp --Contents DF --Packages DF</kbd>
<p>
and wait a little bit.
<p>
<b>FOURTH BUILD THE DATABASES</b>
<p>
This is for a computer system with a Debian distribution installed.
<p>
<kbd>swim --initdb</kbd>
<p>
This next part applies to people who followed all the steps to get here,
and also read the important requirements at the top. This makes the
not-installed databases. Go take a walk, or a swim :*}
<p>
<kbd>swim --initndb --Contents DF DF</kbd>
<p>
When either of these commands are complete they will say "<samp>over and
out</samp>".
<p>
<b>NOW WHAT?</b>
<p> Now the real fun begins. If you happen to have some experience with
rpm you already know some of the options which swim uses, but be prepared
for surpises. <A HREF="swim.html/index.html">swim(8)</A> goes into more detail, the
<A HREF="http://www.rpm.org/maximum-rpm.ps.gz">"<cite>Maximum
RPM</cite>"</A> book by Edward C. Bailey which is freely available may
provide help for swim's <kbd>--query</kbd> option, but you will find that
swim greatly diverges from rpm.
<p> Try something like this, and do not use the <kbd>-n</kbd> unless you
made the not-installed databases, on the other hand, <em>REMEMBER</em> to
use <kbd>-n</kbd> if you do not have an installed Debian system....
<p>
<kbd>swim -n --search swim</kbd>
<p>
now do this..
<p>
<kbd>swim -qnSi</kbd> or <kbd>swim -hn</kbd>
<p>
go to the directory /usr/bin and do
<p>
<kbd>swim -qnf</kbd> <b>.</b>
<p>
you probably will have to do
<p>
<kbd>swim -qnft</kbd> <b>.</b>
<p>
<b>...the fun is just beginning...</b>
<p>
<em>Where are you swimming to today?</em>
</body>
</html>

140
QUICKSTART.text Normal file
View File

@ -0,0 +1,140 @@
READ THE REQUIREMENTS
Now you can skip the next three steps if you have an installed Debian
distribution and you are in a hurry for a demonstration, but you will miss
out on swim's more awesome capabilities. With that said.....
FIRST GET SWIMRC PREPARED
Edit the swimrc configution file, you should read swimrc(5), but I'll ask
you some question right now. You can find swimrc in /etc/swim, and in
your home directory in the subdirectory .swim. Entries in the home
directory swimrc override ones in /etc/swim.
Are you using an installed Debian system? If so, you almost definitely
have dpkg installed. So uncomment this line in /etc/swim/swimrc by
removing the pound sign.
$package_tool = "/usr/bin/dpkg";
otherwise
$package_tool = "/usr/bin/ar";
Do you have the apt package installed? Configure this, or -xyz will not
work.
$apt = "yes";
Now you need to decide what architecture you would like to be swim's
default value when you download, build, and query the not-installed
databases.
What flavor, do you want alpha, arm, hurd-i386, i386, m68k, powerpc,
or sparc? (more coming :*) I decided on .....
$architecture = "i386";
What kind of distribution do you want to be your default? stable,
unstable, frozen, or experimental (rare) I like the ever changing ...
$distribution = "unstable";
Decide which sections you want? You can have this
@user_defined_section = qw(main contrib non-free);
or this.
@user_defined_section = qw(main);
or .....
SECOND GET SWIMZ.LIST PREPARED
Now grab a copy of the README.mirrors from
http://www.debian.org/misc/README.mirrors, you will need this to set-up
the configuration file /etc/swim/swimz.list.
If your using apt make sure to read swim(8) to get the nitty gritty on how
you can synchronize swim along with apt :*} using swimz.list.
Humm, you found a site which has the distribution you want, and you know
which section you want, and you are happy knowing about packages which can
install on the architecture you computer happens to have.
So what site is that?
deb ftp://ftp.swimz.org
What was the directory you happened to notice in the README.mirrors page?
deb ftp://ftp.swimz.org/pub/debian
What distribution did you want? Note: You won't want to use the Release
code name for the distribution, see swimz.list.
deb ftp://ftp.swimz.org/pub/debian unstable
What sections did you want?
deb ftp://ftp.swimz.org/pub/debian unstable main contrib non-free
Now put this line in the swimz.list, exactly like written, and ofcourse
use the values you want.
THIRD GET THE DEBIAN DATABASE WITH FTP
Just issue this command.
swim --ftp --Contents DF --Packages DF
and wait a little bit.
FOURTH BUILD THE DATABASES
This is for a computer system with a Debian distribution installed.
swim --initdb
This next part applies to people who followed all the steps to get here,
and also read the important requirements at the top. This makes the
not-installed databases. Go take a walk, or a swim :*}
swim --initndb --Contents DF DF
When either of these commands are complete they will say "over and out".
NOW WHAT?
Now the real fun begins. If you happen to have some experience with rpm
you already know some of the options which swim uses, but be prepared for
surpises. swim(8) goes into more detail, the "Maximum RPM" book by
Edward C. Bailey which is freely available may provide help for swim's
--query option, but you will find that swim greatly diverges from rpm.
Try something like this, and do not use the -n unless you made the
not-installed databases, on the other hand, REMEMBER to use -n if you
do not have an installed system....
swim -n --search swim
now do this..
swim -qnSi or swim -hn
go to the directory /usr/bin and do
swim -qnf .
you probably will have to do
swim -qnft .
...the fun is just beginning...
Where are you swimming to today?

139
REQUIREMENTS.html Normal file
View File

@ -0,0 +1,139 @@
<html>
<head><title>Requirements</title></head>
<body text="#000000" bgcolor="#FFFFFF" link="#0000EF" vlink="#51188E"
alink="#FF0000">
<br><br><br>
<h2>REQUIRMENTS:</h2>
<p>
Don't get intimidated, this is just to cover all bases, most computer
systems meet the requirements.<p>
<b>PERL</b>: Yes, preferably Perl 5.004.04 or greater.
<p> <b>FTP CAPABILITIES (optional)</b>: You may need to get <A
HREF="ftp://www.perl.com/pub/perl/CPAN/modules/by-category/05_Networking_Devices_IPC/Net/libnet-1.0606.tar.gz">Net::FTP</A>
(Debian libnet-perl package) which depends on Data::Dumper (Debian
data-dumper package). You also need <b>gcc</b> if you do not have a
Debian system so that <em>swim</em> can figure out what architecture your
machine is. You can also find these modules at the <A
HREF="http://www.perl.com">CPAN mirrors</A> or the PACKAGES below.
<p> <b>READLINE CAPABILITIES (optional)</b>: For nice readline
cpabilities get <A
HREF="ftp://www.perl.com/pub/perl/CPAN/modules/by-module/Term/Term-ReadLine-Gnu-1.03.tar.gz">Term::ReadLine::Gnu</A>
or alternatively <A
HREF="ftp://www.perl.com/pub/perl/CPAN/modules/by-module/Term/Term-ReadLine-Perl-0.990
6.tar.gz">Term::ReadLine::Perl</A> which depends on <A
HREF="ftp://www.perl.com/pub/perl/CPAN/modules/by-module/Term/TermReadKey-2.12.tar.gz">Term::ReadKey</A>
. <em>Term::ReadLine::Gnu</em> may be tricky to set-up on non Debian
systems because it depends on <em>ncurses3.4</em> and the <em>GNU Readline
Library version 2.1 or later</em>, but <em>Term::ReadLine::Perl</em> is
much easier to set-up and allows a huge amount of package names to be
present on the command line without a segmentation fault. You could get
swim's ftp capabilities working first, and then just fetch the Debian
ReadLine package(s) and then use swim's --extract option to set the
package(s) up, but, it is sure fun doing a 'make test' when setting up the
ReadLine modules! You can also find these modules at the <A
HREF="http://www.perl.com">CPAN mirrors</A> or the PACKAGES below. <p>
<b>DATABASE CAPABILITIES</b>: DB_File comes standard with Perl. But,
this doesn't mean it is compiled for the newer Berkeley Database
Libraries. DB 1.85 has
known <A
HREF="http://www.sleepycat.com/historic.html">
bugs</A> which effect SWIM. SWIM can work with
1.85, but <kbd>--rebuildflatdb</kbd> and <kbd>--rebuildflatndb</kbd> will
not work properly. You can run a test to find out whether or not you need
to make the change if you have db_dump available on your system (which
db_dump). Enter this:
<P>
<code>perl -e 'use DB_File; tie %testdb,'DB_File',"testdb";';<br>
db_dump testdb</code>
<P>If 'db_dump testdb' produces an error you need to make the change by
installing the newest DB_File. If you have a version of libc6 less than
2.1, first, install a new version ( 2.3.4 or greater) of the <A
HREF="http://www.sleepycat.com">Berkeley DB</A> if you don't already
have it installed. If you get
<A
HREF="ftp://www.perl.com/pub/perl/CPAN/modules/by-module/DB_File/DB_File-1.65.tar.gz">
DB_File</A>
from CPAN you will need to edit
config.in to point to the location of where libdb2 installed db.h, where
libdb2 is installed on your system, and the name of the library. For
Debian this would be:
<P><code>INCLUDE = /usr/include/db2<br>
LIB = /usr/lib<br>
DBNAME = -ldb2</code>
<p><b>PACKAGES</b>: You can get the CPAN modules in some package formats.
Debian 2.1 and Red Hat 5.0 have been tested with these packages:
<p>
<u><em>Debian</em></u><br>
<A
HREF="http://www.debian.org/Packages/unstable/base/libnet-perl.html">libnet-perl</A>
and<br>
<A
HREF="http://www.debian.org/Packages/unstable/base/data-dumper.html">data-dumper</A>
and<br>
<A
HREF="http://www.debian.org/Packages/unstable/interpreters/libterm-readline-gnu-perl.html">libterm-readline-gnu-perl</A>
(plus a lot more) or<br>
<A
HREF="http://www.debian.org/Packages/unstable/interpreters/libterm-readline-perl-perl.html">libterm-readline-perl-perl</A>
and<br>
<A
HREF="http://www.debian.org/Packages/unstable/libs/libterm-readkey-perl.html">libterm-readkey-perl</A><br>
<A HREF="http://www.debian.org/Packages/unstable/libs/libdb2.html">libdb2</A>
(dump_db utility is now part of libc6 2.1)<br>
<p>
<u><em>Red Hat</em></u><br>
<A
HREF="http://filewatcher.org/filename-search/?q=perl-libnet">perl-libnet</A>
and<br>
<A
HREF="http://filewatcher.org/filename-search/?q=perl-Data-Dumper">perl-Data-Dumper</A><br>
<A HREF="http://filewatcher.org/description-search/?q=libdb">db-?</a>
<p>
<b>USER</b>: root. Some of swim's most important functions will not work
properly unless you are running the program as root.
<p><b>HARD DRIVE SPACE</b>: Make sure you have enough hard drive space.
1500
installed packages produces a 10MB fileindex.deb, and the virtual
not-installed filesystem database for the unstable distribution is now
over 40MB. 100MB of free space on your hard drive is probably a good
safety margin, if you run out of hard drive space the program will just
hang or quit.
<p>
<b>MEMORY</b>: Databases made for an installed Debian system require
memory in proportion to the amount of packages actually installed; the
<kbd>--lowmem</kbd> option is an excellent alternative for making the
databases if the computer system is either overloaded or low on memory.
If you get "out of memory" warnings try to free up some memory first then
make the databases. You can also avoid making the virtual filesystem by
not using the <kbd>--Contents</kbd> option or using the FDB argument for
that option. Updating the databases uses very little memory.
<p> <b>OTHER SWIM FUNCTIONS</b>: Most free operating systems have these
packages installed: On a non Debian system, <b>ar</b> from
<em>binutils</em> is used to query Debian binary packages. These next
packages are essential in a free operating system (Linux) -
<em>textutils</em>, <em>fileutils</em>, <em>grep</em>, <em>tar</em>,
<em>gzip</em>, and <em>mount</em>.
<p>
</body>
</html>

90
REQUIREMENTS.text Normal file
View File

@ -0,0 +1,90 @@
REQUIRMENTS:
Don't get intimidated, this is just to cover all bases, most computer
systems meet the requirements.
PERL: Yes, preferably Perl 5.004.04 or greater.
FTP CAPABILITIES: (optional) You may need to get Net::FTP (Debian
libnet-perl package) which depends on Data::Dumper (Debian data-dumper
package). Also check the CPAN mirrors or the PACKAGES below. You also
need gcc if you do not have a Debian system so that swim can figure out
what architecture your machine is. You can also find these modules at the
CPAN mirrors or the PACKAGES below.
READLINE CAPABILITIES: (optional) For nice readline cpabilities get
Term::ReadLine::Gnu or alternatively Term::ReadLine::Perl which depends on
Term::ReadKey. Term::ReadLine::Gnu may be tricky to set-up on non Debian
systems because it depends on ncurses3.4 and the GNU Readline Library
version 2.1 or later, but Term::ReadLine::Perl is much easier to set-up
and allows a huge amount of package names to be present on the command
line without a segmentation fault. You could get swim's ftp capabilities
working first, and then just fetch the Debian ReadLine package(s) and then
use swim's --extract option to set the package(s) up, but, it is sure fun
doing a 'make test' when setting up the ReadLine modules! You can also
find these modules at the CPAN mirrors or the PACKAGES below.
DATABASE CAPABILITIES: DB_File comes standard with Perl. But, this
doesn't mean it is compiled for the newer Berkeley Database Libraries. DB
1.85 has known bugs which effect SWIM. SWIM can work with 1.85, but
--rebuildflatdb and --rebuildflatndb will not work properly. You can run
a test to find out whether or not you need to make the change if you have
db_dump available on your system (which db_dump). Enter this:
perl -e 'use DB_File; tie %testdb,'DB_File',"testdb";';
db_dump testdb
If 'db_dump testdb' produces an error you need to make the change by
installing the newest DB_File. If you have a version of libc6 less than
2.1, first, install a new version (2.3.4 or greater) of the Berkeley DB if
you don't already have it installed. If you get DB_File from CPAN you
will need to edit config.in to point to the location of where libdb2
installed db.h, where libdb2 is installed on your system, and the name of
the library. For Debian this would be:
INCLUDE = /usr/include/db2
LIB = /usr/lib
DBNAME = -ldb2
PACKAGES - You can get the CPAN modules in some package formats. Debian
2.1 and Red Hat 5.0 have been tested with these packages:
Debian -
libnet-perl and
data-dumper and
libterm-readline-gnu-perl (plus a lot more) or
libterm-readline-perl-perl and
libterm-readkey-perl
libdb2
Red Hat -
perl-libnet and
perl-Data-Dumper
db-?
USER: root. Some of swim's most important functions will not work
properly unless you are running the program as root.
HARD DRIVE SPACE: Make sure you have enough hard drive space. 1500
installed packages produces a 10MB fileindex.deb, and the virtual
not-installed filesystem database for the unstable distribution is now
over 40MB. 100MB of free space on your hard drive is probably a good
safety margin, if you run out of hard drive space the program will just
hang or quit.
MEMORY: Databases made for an installed Debian system require memory in
proportion to the amount of packages actually installed; the --lowmem
option is an excellent alternative for making the databases if the
computer system is either overloaded or low on memory. If you get "out of
memory" warnings try to free up some memory first then make the databases.
You can also avoid making the virtual filesystem by not using the
--Contents option or using the FDB argument for that option. Updating the
databases uses very little memory.
OTHER SWIM FUNCTIONS: Most free operating systems have these packages
installed: On a non Debian system, ar from binutils is used to query
Debian binary packages. These next packages are essential in a free
operating system (Linux) - textutils, fileutils, grep, tar, gzip, and
mount.

34
THEMES Normal file
View File

@ -0,0 +1,34 @@
Swim's design gives it the ability to implement features which were once
just fiction.
Most people involved with WM (Window Managers) have heard of themes.
Themes have become very popular. You can design a real cool look for your
WM and then pass it on to other people to recreate what you have. But,
who ever thought that themes could also apply to distributions? The only
requirement to develop a theme from the Debian distributions is to create
a customized Packages database. Apt can take it from there, by simply
clearing the old cache, making a new cache from this Package, and
installing everything. This theme can even be installed along with an
existing installation because apt will figure out what needs to be done.
Themes can easily be made using swim. Here's a list of ideas.
* A module with the capability of taking the output from apt, and creating
a database which would correlate to a successful installation without ever
installing one package. This would essentially be a not-installed
database with one major difference, this database would represent the real
state of a successful installation. This would allow a developer to test
a hypothetical installation, and look at it's structure. Then a Packages
file could be made from this database and tested on a real installation.
Although this module doesn't exist, yet, it could easily be made with a
special designated database interacting with the other functions offered
by swim's existing modules.
* Swim already allows Packages files to be made from *debs placed in the
DF - including creating a place for a personalized distribution (coming).
A person can make there own real personalized distribution in this
manner, and then share their unique Packages file with the rest of the
world, allowing other people to recreate the state of your own
distribution on their machines.

126
TODO Normal file
View File

@ -0,0 +1,126 @@
* Configuration for --dbpath, --root, --main, --contrib, --non-free,
--non-us, --arch, --dists could be automated so that a state could be
established on the command line, without needing to enter any of these
options again, untill a new state was desired, --default would bring
everything back to the default directory /var/lib/dpkg.
* Non-root users could run all functions if permissions were changed,
probably this should be left up to the system administrator.
* Add --todo --bugs to -q.
* Looks like --source and --source_only is kind of deprecated now that apt_0.3.6
is out, and there are Sources.gz in the appropriate places. But, now
there exists three unique ways to get sources, debget which doesn't use
databases, apt which uses databases, and swim which combines the
approaches of both apt and debget, all three ways have their advantages.
Swim isn't dependent on the existence of an up to date Sources.gz.
* --ftp automatically removes packages with changed upstream-revisions..
perhaps move them to a storage location.
* base-files package has changed it's file/dir listing, eventually
SWIM::File can be modified in the future.
* SWIM::Apt needs to be modified so that when it reads the Packages names
in the default directory it will look at the basename to take into
account non-Debian distributions. Non-Debian distributions should
be presented separately when DF is used as an argument. Probably a new
option will be added. This adheres to the swim philosophy of allowing
independent distributions with the exact directory structure of a normal
Debian distribution to exist.
* mention netselect to help people find the best mirror site, and maybe
automatically use netselect on swimz.list to find which sites are up,
and are best to use first, overridding the default sequential order!
* Yes, you can 'cp -a' and 'gzip -d' sources from swim to sources for
apt, then just do a swim --apt --check or vica versa.
* Make sure this doesn't happen for proposed-updates - "swim:
dists/proposed-updates/single/binary-i386/Release does not exist on the
server", and make a note of proposed-updates in the manual, no Contents.
Incoming can be grabbed by doing something like this, "deb url
debian/Incoming" vs experimental "deb url/debian project/experimental/".
Packages are available here, too, no Release or Contents. swim is too
hardwired and this needs to be changed.
* For now, a trade-off will be made in respect to updating the n* virtual
filesystem, even if Contents hasn't been updated, the versions of C,CR
will still be updated with the old Contents, on the other hand if
nfile* was version-less this wouldn't be necessary, then the behavior
mentioned next could be implemented anyways. If Contents are ever
updated on a more consistent basis, this behavior will be changed to
wait for these packages untill the next Contents, but basically this
should be done anyways, it will mean, quick updates during the week, and
one long one when the new Contents becomes available, the lack of
versioning would make this viable. Basically, a database will be kept
for .packagesdiff-arch-dist.deb, nfile* will remain versioned because
this means faster lookups.
* Implement the "on the fly" distribution creation system.
* Add the DF virtual system which will allow --apt2df and --df2apt to
work.
* a search for everything found in -T
* -o DPkg::Options::=--purge once --remove isn't a standard option to dpkg
for "remove", and possible --admindir (like --dbpath) --root (like
--root) and --instdir (where packages should be installed).
* add --force-* at least for --purge and depends.
* an option which would show all packages relationships for a package
being --ftp or -xyrz on the --stdin line
* Complete menuindex() which allows a search of the debian menu system.
* add the pid (personal information database) editing, and data storage.
* Use the MD5 module from libmd5-perl for --md5sum?
* gnupg, pgp, and md5sum checking for source probably using dscverify from
package devscripts, this uses the MD5 module
* Need to add the capability to deal with weird non-standard Filename: .*
situations, both in retrieval, and archiving. In situations like this,
the distribution may not be apparent, but the package could still be
found and placed in a special area, and a special database could store
the information. This database could be transparent, and available for
quering regardless of the distribution default, or command line
specification.
* Add the --file and --http capabilities or at least the capability to
look at Packages from strange directories grabbed by apt using these
methods. Meanwhile, swim's ftp capabilities make slow modems happy, and
allow for precise downloading versus downloading every package related
to -T.
* Add a hash option so that swim can know that po -> unstable, this would
work fine, because swim shows the Release version, but the author is
against implementing this ability.
* Instead of PWD!full_path, allow multiple filenames to be quoted without
pathnames for --extract.
* .., ../, ../../, ../../file-or-dir (not ../../file-or-dir/) ability for
-qf|p works, but more complex ../ is not implemented, yet. ../ will
also follow a symbolic link, this is a feature.
* --search by dirs when in place using -f.
* Add the retro full spectrum of dpkg options, it's nice sometimes to just
do a simple install.
* Gather together all the build children into a giant family including the
teacher and the checker.
* Do the Perl for Non Free OSes thing.
* Remove a large percentage of the bold and underlining from the
documentation.
* Make needed changes and improvements to the Manual - a constant TODO.
* swim faster and faster!

167
bin/fastswim Executable file
View File

@ -0,0 +1,167 @@
#!/usr/bin/perl -w
#use diagnostics;
require 5.004;
use strict;
################################################################################
# Package administration and research tool for Debian #
# Copyright (C) 1999-2000 Jonathan D. Rosenbaum #
# #
# This program is free software; you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation; either version 2 of the License, or #
# (at your option) any later version. #
# #
# This program is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with this program; if not, write to the Free Software #
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.#
################################################################################
# Because it is a better to write to disk, rather than trying to do
# everthing in memory, and then it's good to close the process which
# accomplished this. I am sure there are better ways.
# Anyways if you want to test fastswim do something like this:
# fastswim --transfer /var/lib/dpkg/info /tmp /var/lib/dpkg and create a
# transfer.deb file beforehand in /tmp which has the packagename_version
# one to a line.
my @ppackage;
my %repeaters;
my $thingy;
my $tingy;
my $temp;
my %HL;
my @name;
my %version;
#$| = 1;
#$#name = 2000;
#$#ppackage = 2000;
# This way has been de-pre-c-whatever-ated because it lacks version
# rememberance, and is just kept for testing purposes
if ($#ARGV == -1) {
print "swim: fastswim requires option/arguments, see program for instructions\n";
exit;
chdir("$ARGV[1]");
#consider readdir
@ppackage = <*.list>;
}
# This does the work
elsif ($ARGV[0] eq "--transfer") {
open(TRANSFER, "$ARGV[2]/transfer.deb");
while (<TRANSFER>) {
chomp $_;
if (defined $_) {
my @the = split(/_/, $_);
push(@ppackage, "$the[0].list");
# remember the version.
chomp $the[1];
$version{$the[0]} = $the[1];
}
}
close(TRANSFER);
}
# Make a nice md. I decided on a Hash of Lists, giving all
# files/dirs unique name, and then a list of packages which
# correspond..because this should be faster than a Hash of Hash
# where you'd have to loop through all packages names..find the
# files/dir in all packages names which are the same..I'd assume a HL
# would be a quicker query, even though the Hash would be enormous.
# Possible things: a tree for faster query.
# Put everything into an array..every other is package name
# Better check for packages which don't have /. in their *.list...
# which is rare, but does happen. Sometimes *.list(s) don't have
# all the parent directories, but we won't worry about that.
print " Making the massive hash\n";
$| = 1; my $x = 1;
foreach $thingy (sort @ppackage) {
open(LIST, "$ARGV[1]/$thingy") or die "Humm, strange";
# Because of the version..there are sometimes dots
$thingy =~ m,(.*)\.list,;
my $count = 0;
my @count = <LIST>;
close(LIST);
foreach (@count) {
$x = 1 if $x == 6;
print "|\r" if $x == 1 || $x == 4; print "/\r" if $x == 2;
print "-\r" if $x == 3 || $x == 6; print "\\\r" if $x == 5;
$x++;
chomp $_;
# does /. exist? it should be first.
if ($count == 0) {
if ($_ !~ m,\/\.,) {
my $shifter = $_;
my @redolist = @count;
push(@count,$shifter);
# humm let's rebuild the offending backup list, this
# is important for --db.
unshift(@redolist,"/.");
open(REDOLIST, ">$ARGV[1]/backup/$thingy.bk.bk")
or warn "needed to edit $thingy because it lacked /.,
but could not open up a backup file\n";
my $rd;
foreach $rd (@redolist) {
chomp $rd;
print REDOLIST "$rd\n";
}
close(REDOLIST);
rename
("$ARGV[1]/backup/$thingy.bk.bk","$ARGV[1]/backup/$thingy.bk");
$_ = "/.";
}
}
$count = 1;
$repeaters{$_}++;
if ($repeaters{$_} == 1) {
$temp = 0;
}
else {
$temp = $repeaters{$_} - 1;
}
if (defined $version{$1}) {
$HL{$_}[$temp] = "$1_$version{$1}";
}
}
}
undef @ppackage;
# We will create one file with the 1..and another with >1..
# than split..reverse..and order.accordingly..this makes
# things much faster. Remember clean-up routines for kill.
print " Starting ... writing to $ARGV[2]!\n";
# Create the database
open(BIG, ">$ARGV[2]/big.debian") or die;
open(LONG, ">$ARGV[2]/long.debian") or die;
foreach $thingy (sort keys %HL ) {
$x = 1 if $x == 6;
print "|\r" if $x == 1 || $x == 4; print "/\r" if $x == 2;
print "-\r" if $x == 3 || $x == 6; print "\\\r" if $x == 5;
$x++;
# Humm, will split or grep be faster?
#my $tingy = "@{ $HL{$thingy} }" . " " . @{ $HL{$thingy} };
my $tingy = "@{ $HL{$thingy} }";
if (@{ $HL{$thingy} } > 1 || @{ $HL{$thingy} } eq "") {
print LONG "$thingy -> $tingy\n";
}
elsif (@{ $HL{$thingy} } == 1) {
print BIG "$thingy -> $tingy\n";
}
}
#print "Finished\n";
close(BIG);
close(LONG);
#undef %HL;
print " Cleaning up\n";
__END__

99
bin/imswim Executable file
View File

@ -0,0 +1,99 @@
#!/usr/bin/perl -w
#use diagnostics;
require 5.004;
use strict;
################################################################################
# Package administration and research tool for Debian #
# Copyright (C) 1999-2000 Jonathan D. Rosenbaum #
# #
# This program is free software; you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation; either version 2 of the License, or #
# (at your option) any later version. #
# #
# This program is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with this program; if not, write to the Free Software #
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.#
################################################################################
=pod
This allows computers with a small amount of memory or overloaded system
to succeed in making the databases for SWIM::DB_Init. Instead of using
transfer.deb to grab everything into memory and then creating the
long.debian and big.debian files right out of memory for processing by
SWIM::MD, it works like longswim by creating one large file to the disk
(this can use lots of memory, but can swap easily) then it uses slowswim
to create long.debian and big.debian using a minimal memory method, then
it finishes using SWIM::MD.
To test supply these arguments - info dir, temporary dir "imswim
/var/lib/dpkg/info /tmp" and create a transfer.deb file
beforehand in the temporary dir which has the packagename_version one to a
line.
=cut
if ($#ARGV == -1) {
print "swim: imswim requires arguments, see program for instructions\n";
exit;
}
else {
$| = 1; my $x = 1;
open(FILEDIR, ">$ARGV[1]/filedir.deb")
or warn "could not create filedir.deb\n";
open(TRANSFER, "$ARGV[1]/transfer.deb") or warn "needs transfer.deb";
while (<TRANSFER>) {
chomp;
my @the = split(/_/, $_);
open (LIST, "$ARGV[0]/$the[0].list")
or warn "could not file *list";
chomp;
# better check if /. is missing in any of the *list
my $count = 0;
my @count = <LIST>;
close(LIST);
foreach (@count) {
$x = 1 if $x == 6;
print "|\r" if $x == 1 || $x == 4; print "/\r" if $x == 2;
print "-\r" if $x == 3 || $x == 6; print "\\\r" if $x == 5;
$x++;
chomp $_;
# does /. exist? it should be first.
if ($count == 0) {
if ($_ !~ m,\/\.,) {
my $shifter = $_;
my @redolist = @count;
push(@count,$shifter);
# humm let's rebuild the offending backup list, this
# is important for --db.
unshift(@redolist,"/.");
open(REDOLIST, ">$ARGV[0]/backup/$the[0].list.bk.bk")
or warn "needed to edit $the[0].list because it lacked /.,
but could not open up a backup file\n";
my $rd;
foreach $rd (@redolist) {
chomp $rd;
print REDOLIST "$rd\n";
}
close(REDOLIST);
rename("$ARGV[0]/backup/$the[0].list.bk.bk",
"$ARGV[0]/backup/$the[0].list.bk");
$_ = "/.";
}
}
$count = 1;
print FILEDIR "$_ -> $the[0]_$the[1]\n";
} # foreach @count
} # while TRANSFER
close(TRANSFER);
close(FILEDIR);
} # else

591
bin/longswim Executable file
View File

@ -0,0 +1,591 @@
#!/usr/bin/perl -w
#use diagnostics;
use strict;
use DB_File;
################################################################################
# Package administration and research tool for Debian #
# Copyright (C) 1999-2000 Jonathan D. Rosenbaum #
# #
# This program is free software; you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation; either version 2 of the License, or #
# (at your option) any later version. #
# #
# This program is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with this program; if not, write to the Free Software #
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.#
################################################################################
=pod
This program creates the file filedir.deb using choice() and
comma_choice() (which both use timing() in case Contents is newer than
Packages). It establishes the file based on --main, --contrib, --non-free,
--non-us or the default. This program is quite time consuming and uses
more and more memory as it runs. Afterwared, the output can be processed
by fastswim (high memory approach) or slowswim (low memory approach),
whether either is faster is still subject to experimentation. swim packs
everything into the databases. It also produces the report
.contentsdiff-arch-dists.deb which shows which packages exist in Contents
which don't exist in Packages.
This program takes a large amount of arguments. Look at nmd() in
SWIM::NDB_Init.
=cut
if ($#ARGV == -1) {
print "swim: longswim requires many arguments, see program for instructions\n";
exit;
}
my $Contents;
my $contentsindex;
my ($main,$contrib,$non_free,$non_us);
my $tmp;
my (%watch,%ndb);
my $npackages;
my $gzip;
my $place;
# process @ARGV
$Contents = $ARGV[0]; $contentsindex = $ARGV[1];
$main = $ARGV[2]; $contrib = $ARGV[3];
$non_free = $ARGV[4]; $non_us = $ARGV[5];
$tmp = $ARGV[6];
$npackages = $ARGV[7];
$gzip = $ARGV[8];
$place = $ARGV[9];
my $Contents_mtime = $ARGV[10];
# tie it once not a quarter million times
tie %ndb, 'DB_File', "$npackages" or die "DB_File: $!";
# Let's find the arch and dists
my @archdist = split(m,/,,$contentsindex);
my($arch,$dist) = (split(m,-,,$archdist[$#archdist]))[1,2];
$dist =~ s,\.deb,,;
unlink("$place/.contentsdiff-$arch-$dist.deb")
if -e "$place/.contentsdiff-$arch-$dist.deb";
nmd();
# main processing program
sub nmd {
my %again;
my %all;
$| = 1; my $x = 1;
open(CONTENTS, "$Contents") or die "where is it?\n";
open(FILEDIR,">$tmp/filedir.deb");
open(CONTENTSDB,">$contentsindex");
while (<CONTENTS>) {
print CONTENTSDB $_;
if (/^FILE\s*LOCATION$/) {
while (<CONTENTS>) {
s,^(\./)+,,; # filter for Debians altered dir structure
print CONTENTSDB $_;
$x = 1 if $x == 6;
print "|\r" if $x == 1 || $x == 4; print "/\r" if $x == 2;
print "-\r" if $x == 3 || $x == 6; print "\\\r" if $x == 5;
$x++;
chomp $_;
# find all directories
# split is the way to go.
# If it ends with / its a directory
my($dirfile,$package,@packs,@dirfile,@package,@comma);
######################
# ENDS WITH / #
######################
if (m,.*/\s+\w*,) {
($dirfile,$package) = split(/\s+/,$_,2);
if ($package !~ m,^[a-z0-9-]*/.*$|^[a-z0-9-]*/.*/.*$,) {
my @more_things = split(/\s+/,$package);
$package = $more_things[$#more_things];
(my $backpackage = $package) =~ s,\+,\\+,g;
my @dirfile = split(/\s+$backpackage/,$_);
$dirfile = $dirfile[0];
}
@dirfile = split(/\//,$dirfile); $dirfile =~ s,/$,,;
@comma = split(/,/,$package);
#################
# HAS A COMMA #
#################
if (scalar(@comma) >= 2) {
# humm many packages share this file/dir
my @choice_package;
##########
## MAIN ##
##########
if ($main eq "yes") {
foreach (@comma) {
if (defined $_) {
if ($_ !~ m,^non-free/|^contrib/|^non-us/,) {
push(@choice_package,$_);
}
}
}
@packs = comma_choice(@choice_package);
} # choice in main
############
##NON-FREE##
############
if ($non_free eq "yes") {
foreach (@comma) {
if (m,^non-free/,) {
push(@choice_package,$_);
}
}
@packs = comma_choice(@choice_package);
} # choice non-free
###########
##CONTRIB##
###########
if ($contrib eq "yes") {
foreach (@comma) {
if (m,^contrib/,) {
push(@choice_package,$_);
}
}
@packs = comma_choice(@choice_package);
} # choice contrib
#########
#NON-US##
#########
if ($non_us eq "yes") {
foreach (@comma) {
if (m,^non-us/,) {
push(@choice_package,$_);
}
}
@packs = comma_choice(@choice_package);
} # choice non-us
} # scalar @comma >= 2
# When only one package exists for dir
#############
##############
# NO COMMA #
##############
elsif (scalar(@comma) == 1) {
my $choice_package;
##########
## MAIN ##
##########
if ($main eq "yes") {
# only one package found related to choice section
if (defined $package) {
if ($package !~ m,^non-free/|^contrib/|^non-us/,) {
$choice_package = $package;
@package = split(/\//,$choice_package);
}
}
@packs = choice(@package);
} # end choice main
############
##NON-FREE##
############
if ($non_free eq "yes") {
if (defined $package) {
if ($package =~ m,^non-free/,) {
$choice_package = $package;
@package = split(/\//,$choice_package);
}
}
@packs = choice(@package);
} # end choice main
###########
##CONTRIB##
###########
if ($contrib eq "yes") {
if (defined $package) {
if ($package =~ m,^contrib/,) {
$choice_package = $package;
@package = split(/\//,$choice_package);
}
}
@packs = choice(@package);
} # end choice main
#########
#NON-US##
#########
if ($non_us eq "yes") {
if (defined $package) {
if ($package =~ m,^non-us/,) {
$choice_package = $package;
@package = split(/\//,$choice_package);
}
}
@packs = choice(@package);
} # end choice main
} # @comma = 1
#################
# WRITE TO FILE #
#################
foreach $package (@packs) {
my ($count,$holder);
for ($count = 0; $count <= $#dirfile; $count++) {
if ($count == 0) {
$holder = "/$dirfile[$count]";
my $again = "$dirfile[$count] -> $package";
my $all = "/. -> $package";
$again{$again}++;
$all{$all}++;
if ($all{$all} == 1) {
print FILEDIR "/. -> $package\n";
##repeaters("/.",$package);
}
if ($again{$again} == 1) {
print FILEDIR "/$dirfile[$count] -> $package\n";
##repeaters("/$dirfile[$count]",$package);
}
}
else {
$holder = $holder . "/$dirfile[$count]";
#print "$holder -> $package\n";
#repeaters($holder,$package);
my $again = "$holder -> $package";
$again{$again}++;
if ($again{$again} == 1) {
print FILEDIR "$holder -> $package\n";
##repeaters($holder,$package);
}
}
} # end for
}
} # does end with /
######################
# DOESN'T END WITH / #
######################
# find all files and directories
else {
($dirfile,$package) = split(/\s+/,$_,2);
if ($package !~ m,^[a-z0-9-]*/.*$|^[a-z0-9-]*/.*/.*$,) {
my @more_things = split(/\s+/,$package);
$package = $more_things[$#more_things];
(my $backpackage = $package) =~ s,\+,\\+,g;
# watch this
my @dirfile = split(/\s+$backpackage/,$_);
$dirfile = $dirfile[0];
}
@dirfile = split(/\//,$dirfile);
@comma = split(/,/,$package);
#################
# HAS A COMMA #
#################
if (scalar(@comma) >= 2) {
# humm many packages share this file/dir
my @choice_package;
##########
## MAIN ##
##########
if ($main eq "yes") {
foreach (@comma) {
if (defined $_) {
if ($_ !~ m,^non-free/|^contrib/|^non-us/,) {
push(@choice_package,$_);
}
}
}
@packs = comma_choice(@choice_package);
} # choice in main
############
##NON-FREE##
############
if ($non_free eq "yes") {
foreach (@comma) {
if (m,^non-free/,) {
push(@choice_package,$_);
}
}
@packs = comma_choice(@choice_package);
} # choice non-free
###########
##CONTRIB##
###########
if ($contrib eq "yes") {
foreach (@comma) {
if (m,^contrib/,) {
push(@choice_package,$_);
}
}
@packs = comma_choice(@choice_package);
} # choice contrib
#########
#NON-US##
#########
if ($non_us eq "yes") {
foreach (@comma) {
if (m,^non-us/,) {
push(@choice_package,$_);
}
}
@packs = comma_choice(@choice_package);
} # choice non-us
} # scalar @comma == 2
# When only one package exists for file
#############
##############
# NO COMMA #
##############
elsif (scalar(@comma) == 1) {
my $choice_package;
##########
## MAIN ##
##########
if ($main eq "yes") {
# only one package found related to choice section
if (defined $package) {
if ($package !~ m,^non-free/|^contrib/|^non-us/,) {
$choice_package = $package;
@package = split(/\//,$choice_package);
}
}
@packs = choice(@package);
} # end choice main
############
##NON-FREE##
############
if ($non_free eq "yes") {
if (defined $package) {
if ($package =~ m,^non-free/,) {
$choice_package = $package;
@package = split(/\//,$choice_package);
}
}
@packs = choice(@package);
} # end choice main
###########
##CONTRIB##
###########
if ($contrib eq "yes") {
if (defined $package) {
if ($package =~ m,^contrib/,) {
$choice_package = $package;
@package = split(/\//,$choice_package);
}
}
@packs = choice(@package);
} # end choice main
#########
#NON-US##
#########
if ($non_us eq "yes") {
if (defined $package) {
if ($package =~ m,^non-us/,) {
$choice_package = $package;
@package = split(/\//,$choice_package);
}
}
@packs = choice(@package);
} # end choice main
} # @comma = 1
#################
# WRITE TO FILE #
#################
foreach $package (@packs) {
my ($count,$holder);
for ($count = 0; $count <= $#dirfile; $count++) {
if ($count == 0) {
$holder = "/$dirfile[$count]";
my $again = "$dirfile[$count] -> $package";
my $all = "/. -> $package";
$again{$again}++;
$all{$all}++;
if ($all{$all} == 1) {
print FILEDIR "/. -> $package\n";
}
if ($again{$again} == 1) {
print FILEDIR "/$dirfile[$count] -> $package\n";
}
}
# Here's where things really start to turn ugly.
else {
$holder = $holder . "/$dirfile[$count]";
my $again = "$holder -> $package";
$again{$again}++;
if ($again{$again} == 1) {
print FILEDIR "$holder -> $package\n";
}
}
} # end for
} # @packs - more than one package for this file
} # end else not dir
}
}
}
close(FILEDIR);
close(CONTENTS);
print "Compress contents\n";
system "$gzip", "-9", "$contentsindex";
utime(time,$Contents_mtime,$contentsindex);
print "Cleaning up\n";
# this will add a newline, but better to do a Ctrl-C than to have the
# process hang and respawn itself - something which sometimes happens
kill INT => $$;
print "swim: please press Ctrl-c\n"; # just in case :)
# probably don't need to do this ends the program
#undef %all;
#undef %again;
} # end sub nmd
# this finds the package or none which equal choice section when a
# file/dir is found with one package
sub choice {
my (@package) = @_;
my @packs;
if ($#package == 1) {
my $what = timing($package[1]);
if (defined $what) {
#$package[1] = version($package[1]);
@packs = $what;
}
}
elsif ($#package == 2) {
my $what = timing($package[2]);
if (defined $what) {
#$package[2] = version($package[2]);
@packs = $what;
}
}
return @packs;
} # end sub choice
# this finds the package(s) or none which equal choice section when a
# file/dir is found with more than one package
sub comma_choice {
my (@choice_package) = @_;
my (@package,@packs);
if (@choice_package) {
if ($#choice_package == 0) {
@package = split(/\//,$choice_package[0]);
if ($#package == 1) {
my $what = timing($package[1]);
if (defined $what) {
#$package[1] = version($package[1]);
push(@packs,$what);
}
}
elsif ($#package == 2) {
my $what = timing($package[2]);
if (defined $what) {
#$package[2] = version($package[2]);
push(@packs,$what);
}
}
}
elsif ($#choice_package > 0) {
# Basically, we will keep all conflicting dirs/files
# because often they are related
foreach (@choice_package) {
@package = split(/\//,$_);
if ($#package == 1) {
my $what = timing($package[1]);
if (defined $what) {
push(@packs,$what);
}
}
elsif ($#package == 2) {
my $what = timing($package[2]);
if (defined $what) {
push(@packs,$what);
}
}
}
} # else more than 1 for choice
} # defined choice
return @packs;
} # end sub comma_choice
# this sub produces a report file..in case Packages is older than Contents
# there will be other reports, ofcourse, like if Packages is newer than
# Contents. Uses version();
sub timing {
my ($lookup) = @_;
my $afterlookup = nversion($lookup);
if ($afterlookup eq 1) {
$watch{$lookup}++;
if ($watch{$lookup} == 1) {
open(REPORT,">>$place/.contentsdiff-$arch-$dist.deb")
or die "can't create a file\n";
print REPORT "Found in Contents, not in Packages: $lookup\n";
close(REPORT);
}
return;
}
else {
return $afterlookup;
}
} # end my timing
# checks npackage.deb to find version for package found in Contents
sub nversion {
my ($argument) = @_;
#ndb();
if (defined $argument) {
# We will check for more than two..just in case
if ($argument !~ /_/) {
if (defined $ndb{$argument}) {
$argument = $ndb{$argument};
return $argument;
}
# fixed the space packages
else {
return 1;
}
}
}
#untie %ndb;
} # end sub nversion
sub ndb {
#tie %ndb, 'DB_File', "$npackages" or die "DB_File: $!";
} # end sub ndb

131
bin/slowswim Executable file
View File

@ -0,0 +1,131 @@
#!/usr/bin/perl -w
#use diagnostics;
use strict;
################################################################################
# Package administration and research tool for Debian #
# Copyright (C) 1999-2000 Jonathan D. Rosenbaum #
# #
# This program is free software; you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation; either version 2 of the License, or #
# (at your option) any later version. #
# #
# This program is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with this program; if not, write to the Free Software #
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.#
################################################################################
=pod
This program only takes two argument, a temp directory and the name of the
binary sort..sort. You can test a filedir.deb file.
=cut
if ($#ARGV == -1) {
print "swim: slowswim requires arguments, see program for instructions\n";
exit;
}
my $tmp = $ARGV[0];
my $sort = $ARGV[1];
pre_md();
# This is nmd()'s version of fastswim..also a lowmem method, after making
# long.debian and big.debian, process_md() finishes the job.
sub pre_md {
my %HL;
my $temp;
my %repeaters;
my $fcount = 0;
my @tempholder;
print "Sorting everything\n";
system ("$sort $tmp/filedir.deb > $tmp/sortfiledir.deb");
unlink("$tmp/filedir.deb");
# grab the keys from the sorted file
print "Making the massive hash using lowmem\n";
$| = 1; my $x = 1;
open(FILEDIR, "$tmp/sortfiledir.deb") or die "where is sortfiledir.deb?\n";
while (<FILEDIR>) {
$x = 1 if $x == 6;
print "|\r" if $x == 1 || $x == 4; print "/\r" if $x == 2;
print "-\r" if $x == 3 || $x == 6; print "\\\r" if $x == 5;
$x++;
my ($place, $packname) = split(/ -> /,$_,2);
push(@tempholder,"$place -> $packname");
if ($fcount != 0) {
my($tplace,$tpackname) = split(/ -> /,$tempholder[$fcount - 1],2);
chomp $tpackname;
# As long as they aren't different add to HL because they
# belong to a group.
if ($tplace eq $place) {
#print "$tplace and $place\n";
$repeaters{$tplace}++;
if ($repeaters{$tplace} == 1) {
$temp = 0;
}
else {
$temp = $repeaters{$tplace} - 1;
}
$HL{$tplace}[$temp] = $tpackname;
}
# they new guy is different, but the old guy belongs to the
# previous group or not, so finish adding to %HL and then
# print out, and undef %HL
else {
#print "I AM DIFF $tplace\n";
# finish adding
$repeaters{$tplace}++;
if ($repeaters{$tplace} == 1) {
$temp = 0;
}
else {
$temp = $repeaters{$tplace} - 1;
}
$HL{$tplace}[$temp] = $tpackname;
# print out
open(BIG, ">>$tmp/big.debian") or die;
open(LONG, ">>$tmp/long.debian") or die;
my $thingo;
foreach $thingo (sort keys %HL ) {
my $tingy = "@{ $HL{$thingo} }";
if (@{ $HL{$thingo} } > 1 || @{ $HL{$thingo} } eq "") {
print LONG "$thingo -> $tingy\n";
}
elsif (@{ $HL{$thingo} } == 1) {
print BIG "$thingo -> $tingy\n";
}
}
close(BIG);
close(LONG);
# The whole key for lowmem systems
undef %repeaters;
undef %HL;
undef $tempholder[$fcount - 1];
}
} # if fcount ne 0
$fcount++;
}
# also do this in db() & ndb()
unlink("$tmp/sortfiledir.deb");
} # end sub pre_md

78
changelog Normal file
View File

@ -0,0 +1,78 @@
swim (0.3.6) - October 20 2000
-- Made swim perl-5.6 happy. Thanks to Douglas du Boulay
<ddb@crystal.uwa.edu.au> for pointing this out.
swim (0.3.5) - January 28 2000
-- Fixed a minor bug pertaining to the mtime of Contents which occured
during initial building of the uninstalled filesystem using FDBDF or
DF. This bug arose as a result of a bug fix in 0.3.4.
swim (0.3.4) - January 23 2000
-- Made the changelog and copyright option work properly in relation to
the fsstnd Debian has adopted with backwards compatibility. Fixed a
regexp in Qftp to properly deal with packages which match one another,
but aren't the same. Fixed xyzr to work properly with ps. Fixed share
-d/l output for p option. Added an indication when extraction
succeeds. Now Contents is properly filtered for ndb. Removed extra
output from menu for package option. Added example documentation,
thanks to John Lapeyre for the suggestion. Also, thanks to Joel Soete
for reporting corrupt sources from a faulty upload, and to tucows.com
for adding swim to their archive and awarding swim 5 Penguins.
swim (0.3.3) - January 15 2000
-- Repaired a bug in longswim causing the uninstalled filesystem to be
made with packages which looked like spaces due to a return code error,
which caused some trouble for the virtual directories. ncontents is
now filtered of ./, though it was cool to look at.
swim (0.3.2) - January 05 2000
-- Fixed to properly find documentation in the not-installed new Debian
share directories, perl5 in Depends for the new Debian perl policy, and
year 2000 in help.
swim (0.3.1) - January 04 2000
-- Because of change in Debian's directory structure in Contents, added a
filter so that not-installed database is properly made without repeats.
Fixed a documentation error in QUICKSTART. Made swim@the.netpedia.net
default anonymous login. Minor documentation improvements.
swim (0.3.0) - June 15 1999
-- The cleaned up version of 0.2.9. Rebuild databases if you were using
version 0.2.8 or less.
swim (0.2.9) - May 14 1999
-- This is an interim release until 0.3.0 is released. Major bug fixes,
and some new features, including a history, and updating for
not-installed db. Rebuild databases if you were using an older version.
swim (0.2.8) - Mar 13 1999
-- Fixed a minor bug which was preventing virtual options --xyz and --ftp
from working with searches.
-- Set the $swim_version variable to the right version number, and
automated the release process to avoid problems like the failure to
change this variable in the 0.2.7 release from occurring again.
swim (0.2.7) - Mar 12 1999
-- Fixed a file test in SWIM::Conf which kept the initial directories from
being created on startup, making the program fail. Three names deserve
recognition: John Lapeyre, Jonathan P. Tomer, and Cale Epstein who all
provided their own perspective to the problem, I combined all three
approaches. Shaleh pointed out a packaging error.
swim (0.2.6)
-- First initial public offering around the beginning of March, 1999,
includes the main swim program, four exercise programs to help with
database creation, important swim manuals and twenty-five module
members.
-- swimmers ... take your mark ... go!

7
contact_and_website Normal file
View File

@ -0,0 +1,7 @@
email:
Jonathan D. Rosenbaum <mttrader@access.mountain.net>
http:
the.netpedia.net

20
examples/Cron Executable file
View File

@ -0,0 +1,20 @@
#!/bin/bash
# This is a simple approach. You could have a monthly Cron for stable and
# then update if any changes were observed, a weekly Cron for frozen, and
# a daily Cron for unstable.
# For this example a default of unstable is assumed.
# This downloads only one Contents-arch for the unstable distribution.
# Updates the Packages using apt, and grabs the Contents-arch and Packages
# for the stable distribution if there are any changes.
# Update the sources:
swim --ftp --Contents DF --onec >> /var/log/swim.log 2>&1;
swim --apt --update >> /var/log/swim.log 2>&1;
swim --ftp --dists stable --onec >> /var/log/swim.log 2>&1;
# This will update the database for the default distribution/architecture
# using 'cron' to automatically pick the newest packages.
# Update the databases:
swim --db >> /var/log/swim.log 2>&1;
swim --ndb APT --cron --Contents DF >> /var/log/swim.log 2>&1;

263
lib/Ag.pm Normal file
View File

@ -0,0 +1,263 @@
# Package administration and research tool for Debian
# Copyright (C) 1999-2000 Jonathan D. Rosenbaum
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
package SWIM::Ag;
use strict;
use SWIM::Global qw(:Info $file_now);
use SWIM::DB_Library qw(:Xyz);
use SWIM::Info;
use SWIM::Pn_print;
use SWIM::Deps;
use vars qw(@ISA @EXPORT);
use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(description q_description);
# stuff to query package names, -a, and groups
# -qi <packages name> Anotherwards that big thing of info...also
# -c, -l
sub description {
my ($commands) = @_;
my %commands = %$commands;
if ($commands->{"scripts"} || $commands->{"preinst"} ||
$commands->{"postinst"} || $commands->{"prerm"} ||
$commands->{"postrm"}) {
scripts(\%commands);
}
menu(\%commands) if $commands->{"menu"} || $commands->{"m"};
copyright(\%commands) if $commands->{"copyright"};
changelog(\%commands) if $commands->{"changelog"};
if (!$commands->{"n"}) {
dbi(\%commands);
}
else {
ndb(\%commands);
}
if (defined $argument) {
# We will check for more than two..just in case
if ($argument !~ /_/) {
if (defined $db{$argument}) {
$argument = $db{$argument};
}
}
if ($db{"$argument"}){
my $package = $db{"$argument"};
print $package;
}
else {
print "package $argument is not installed\n";
exit;
}
}
untie %db;
character(\%commands);
shlibs(\%commands) if $commands->{"shlibs"};
if ($commands->{"c"} && !($commands->{"l"} || $commands->{"d"})) {
if (conf(\%commands) ne 0) {
print conf(\%commands) if !$commands->{"md5sum"};
# here for a reason
# if -i because calls from qindexer.
if ($commands->{"i"}) {
require SWIM::File;
SWIM::File->import(qw(file));
file(\%commands)
}
}
}
if (($commands->{"c"} && ($commands->{"l"} || $commands->{"d"})) ||
($commands->{"l"} || $commands->{"d"})) {
if ($commands->{"c"} && conf(\%commands) ne 0) {
print conf(\%commands) if !$commands->{"md5sum"};
}
require SWIM::File;
SWIM::File->import(qw(file));
file(\%commands);
}
if (!($commands->{"z"} || $commands->{"ftp"} ||
$commands->{"remove"} || $commands->{"r"} ||
$commands->{"purge"})) {
if ($commands->{"x"} || $commands->{"ftp"} || $commands->{"source"} ||
$commands->{"source_only"} || $commands->{"remove"} ||
$commands->{"r"} || $commands->{"purge"}) {
require SWIM::Safex;
SWIM::Safex->import(qw(safex));
safex(\%commands);
}
}
} # end sub description
# Access Descriptions, and other stuff for known <packages>.
# This includes -ql(d)c, -qc or plain -q (just the package name and
# version). Anotherwards if -i isn't used this sub is called. And
# -ql is handled by file. Mostly, this was designed for calling a single
# package name on the command line without a known package title except
# when -q is called by itself, but using -T is an exception since this is
# useful.
sub q_description {
my ($commands) = @_;
my %commands = %$commands;
if ($commands->{"scripts"} || $commands->{"preinst"} ||
$commands->{"postinst"} || $commands->{"prerm"} ||
$commands->{"postrm"}) {
scripts(\%commands);
}
menu(\%commands) if $commands->{"menu"} || $commands->{"m"};
copyright(\%commands) if $commands->{"copyright"};
changelog(\%commands) if $commands->{"changelog"};
if (!$commands->{"n"}) {
dbi(\%commands);
}
else {
ndb(\%commands);
}
if (defined $argument) {
if ($argument !~ /_/) {
if (defined $db{$argument}) {
$argument = $db{$argument};
}
if ($commands->{"c"} && $commands->{"d"}) {
require SWIM::File;
SWIM::File->import(qw(file));
print "$argument\n" if $commands->{"g"};
character(\%commands);
shlibs(\%commands) if $commands->{"shlibs"};
if (conf(\%commands) ne 0) {
print conf(\%commands) if !$commands->{"md5sum"};
}
# it's nice to print out -d with -c, so this was added.
file(\%commands);
}
elsif ($commands->{"c"}) {
# this produces annoying spaces
print "$argument\n" if $commands->{"g"} && conf(\%commands) ne 0;
character(\%commands);
shlibs(\%commands) if $commands->{"shlibs"};
if (conf(\%commands) ne 0) {
print conf(\%commands) if !$commands->{"md5sum"};
if ($commands->{"md5sum"}) {
require SWIM::File;
SWIM::File->import(qw(file));
file(\%commands);
}
}
}
elsif ($db{$argument} && !$commands->{"c"}) {
print "$argument\n" if $commands->{"T"} ||
$commands->{"depends"} || $commands->{"pre_depends"} ||
$commands->{"recommends"} || $commands->{"suggests"} ||
$commands->{"conflicts"} || $commands->{"replaces"} ||
$commands->{"provides"};
singular(\%commands);
character(\%commands);
shlibs(\%commands) if $commands->{"shlibs"};
print "\n" if $commands->{"T"} ||
$commands->{"depends"} || $commands->{"pre_depends"} ||
$commands->{"recommends"} || $commands->{"suggests"} ||
$commands->{"conflicts"} || $commands->{"replaces"} ||
$commands->{"provides"};
}
else { print "package $argument is not installed\n"; }
}
elsif ($argument =~ /_/) {
if ($commands->{"c"} && $commands->{"d"}) {
print "$argument\n" if $commands->{"g"};
character(\%commands);
shlibs(\%commands) if $commands->{"shlibs"};
print conf(\%commands) if conf(\%commands) ne 0 && !$commands->{"md5sum"};
require SWIM::File;
SWIM::File->import(qw(file));
file(\%commands);
}
elsif ($commands->{"c"}) {
my $check = conf(\%commands);
print "$argument\n" if $commands->{"g"} && $check ne 0 ||
$commands->{"l"};
character(\%commands);
shlibs(\%commands) if $commands->{"shlibs"};
if (conf(\%commands) ne 0) {
print conf(\%commands) if !$commands->{"md5sum"};
require SWIM::File;
SWIM::File->import(qw(file));
file(\%commands);
}
elsif (conf(\%commands) == 0) {
require SWIM::File;
SWIM::File->import(qw(file));
file(\%commands);
}
}
elsif ($db{$argument} && !$commands->{"c"}) {
# watch this
##print "$argument\n" if $commands->{"g"};
print "$argument\n" if $commands->{"T"} ||
$commands->{"depends"} || $commands->{"pre_depends"} ||
$commands->{"recommends"} || $commands->{"suggests"} ||
$commands->{"conflicts"} || $commands->{"replaces"} ||
$commands->{"provides"};
singular(\%commands);
character(\%commands);
shlibs(\%commands) if $commands->{"shlibs"};
print "\n" if $commands->{"T"} ||
$commands->{"depends"} || $commands->{"pre_depends"} ||
$commands->{"recommends"} || $commands->{"suggests"} ||
$commands->{"conflicts"} || $commands->{"replaces"} ||
$commands->{"provides"};
}
else { print "package $argument is not installed\n"; }
}
}
untie %db;
if (!defined $file_now &&
!($commands->{"z"} || $commands->{"ftp"} ||
$commands->{"remove"} || $commands->{"r"} ||
$commands->{"purge"})) {
if ($commands->{"x"} || $commands->{"ftp"} || $commands->{"source"} ||
$commands->{"source_only"} || $commands->{"remove"} ||
$commands->{"r"} || $commands->{"purge"}) {
require SWIM::Safex;
SWIM::Safex->import(qw(safex));
safex(\%commands);
}
}
} # end sub q_description
1;

1219
lib/Apt.pm Normal file
View File

File diff suppressed because it is too large Load Diff

358
lib/Compare.pm Normal file
View File

@ -0,0 +1,358 @@
# Package administration and research tool for Debian
# Copyright (C) 1999-2000 Jonathan D. Rosenbaum
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
package SWIM::Compare;
use strict;
use SWIM::Conf qw($dpkg);
use SWIM::Library;
use vars qw(@ISA @EXPORT %EXPORT_TAGS);
use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(comparison compare_versions);
# comparison function and checking function (-v) for not-installed databases
=pod
DEVELOPMENTAL
This uses the comparison method mentioned in the packaging manual. It
will look for an epoch *: or the absence, and a revision -* or the
absence. First the epoch is compared, then the upstream-version, than
the debian-revision. The sub will stop and return a value as soon as
a difference is found. A look in the dpkg attic helped out (compare_vnumbers)
here, but lib.pl used separate subs, and doesn't appear to check for
an epoch separately, ofcourse there may have not been an epoch. This
uses the special variable $&, but apparently this isn't as big a waste
of resources in later versions of Perl, but there will be some
experiments and benchmarks for alternatives in the future for this sub.
There some rules built into comparison() to deal with patch to non-patch,
more than one hyphen (-). This involves a little transformation.
You can verify that this sub is working by doing perl -e '$five =\
system "dpkg --compare-versions 10 gt 1.0.17"; print "nop\n" if $five\
== 256; print "yes\n" if $five == 0', take a look at the scripts, too.
Also, use -v (compare_versions()) when using --initndb or --rebuildndb
for a report.
=cut
sub comparison {
# $pversion = version from Packages.gz
# $eversion = version from nstatusindex-arch-dist.deb
my($pversion,$eversion) = @_;
my($epoch, $upstream, $revision);
my($eepoch, $eupstream, $erevision);
my($revisiond,$erevisiond);
my $result;
# If the two versions "eq" one another no reason to go on
if ($pversion ne $eversion) {
# check epoch first, go on if the same
#########
# EPOCH #
#########
if ($pversion =~ /:/ || $eversion =~ /:/) {
if ($pversion =~ /:/) {
($epoch,$upstream) = split(/:/,$pversion,2);
}
else {
$epoch = 0; $upstream = $pversion;
}
if ($eversion =~ /:/) {
($eepoch,$eupstream) = split(/:/,$eversion,2);
}
else {
$eepoch = 0; $eupstream = $eversion;
}
do {
$epoch =~ s/^\d*//; my $epochd = $&;
$eepoch =~ s/^\d*//; my $eepochd = $&;
$result = $epochd <=> $eepochd;
return "<" if $result == -1;
return ">" if $result == 1;
} while (length ($epoch) && length ($eepoch));
#return length ($a) cmp length ($b);
} # end if epoch
else {
$epoch = 0; $upstream = $pversion;
$eepoch = 0; $eupstream = $eversion;
}
# Check the upstream-revision next
#####################
# UPSTREAM-REVISION #
#####################
if ($upstream || $eupstream) {
# we need to run a little test in case hyphens exists more than once
if ($upstream =~ /-/) {
my $hyphen = ($upstream =~ tr/-//);
if ($hyphen > 1) {
$upstream =~ m,(^.*)-(.*$),;
$upstream = $1;
$revision = $2;
}
else {
($upstream,$revision) = split(/-/,$upstream,2);
}
}
else {
# because the absence is considered earlier, and the convention
# is to use -1.
$revision = 0;
}
# we need to run a little test in case hyphens exists more than once
if ($eupstream =~ /-/) {
my $hyphen = ($eupstream =~ tr/-//);
if ($hyphen > 1) {
$eupstream =~ m,(^.*)-(.*$),;
$eupstream = $1;
$erevision = $2;
}
else {
($eupstream,$erevision) = split(/-/,$eupstream,2);
}
}
else {
# because the absence is considered earlier, and the convention
# is to use -1.
$erevision = 0;
}
do {
# letters
$upstream =~ s/^\D*//; my $upstreamd = $&;
$eupstream =~ s/^\D*//; my $eupstreamd = $&;
# hopefully this handles nasty beta situations
if ($upstreamd eq "b" and $eupstreamd eq "." ) {
return "<";
}
elsif ($upstreamd eq "." and $eupstreamd eq "b" ) {
return ">";
}
elsif ($upstreamd eq "beta" and $eupstreamd eq "." ) {
return "<";
}
elsif ($upstreamd eq "." and $eupstreamd eq "beta" ) {
return ">";
}
elsif ($upstreamd eq "." and $eupstreamd eq "-pre-") {
return ">";
}
elsif ($eupstreamd eq "." and $upstreamd eq "-pre-") {
return "<";
}
# solves problems when "." is compared to letters, and also a weird
# case involving a patched version changing to a non-patched version.
if ($upstreamd =~ /\./) {
if ($eupstreamd =~ /\w/) {
if ($eupstreamd =~ /pl/ && $upstreamd !~ /pl/) {
$eupstreamd = "";
}
elsif ($upstreamd !~ /\.\w{2,10}/) {
$eupstreamd = ".";
}
}
elsif ($eupstreamd eq "") {
$eupstreamd = ".";
}
}
# the weird -pre situation
elsif ($upstreamd =~ /-pre/ || $eupstreamd =~ /-pre/) {
$upstreamd = ""; $eupstreamd = "";
}
if ( $eupstreamd =~ /\./) {
if ($upstreamd =~ /\w/) {
if ($upstreamd =~ /pl/ && $eupstreamd !~ /pl/) {
$upstreamd = "";
}
elsif ($upstreamd !~ /\.\w{2,10}/) {
$upstreamd = ".";
}
}
elsif ($upstreamd eq "") {
$upstreamd = ".";
}
}
# the weird -pre situation
elsif ($upstreamd =~ /-pre/ || $eupstreamd =~ /-pre/) {
$upstreamd = ""; $eupstreamd = "";
}
$result = $upstreamd cmp $eupstreamd;
return "<" if $result == -1;
return ">" if $result == 1;
# it's importantant to realize that . & + are being checked for
# above. : and - have already been dealt with. cmp seems to deal with
# these characters with no problems.
# numbers
# found a little problem with <=> when number's eq "",
# but this doesn't effect cmp.
if ($upstream eq "") {
if ($eupstream eq ".") {
$upstream = ".";
}
else {
$upstream = 0;
}
}
if ( $eupstream eq "") {
if ($upstream eq ".") {
$eupstream = ".";
}
else {
$eupstream = 0;
}
}
$upstream =~ s/^\d*//; $upstreamd = $&;
$eupstream =~ s/^\d*//; $eupstreamd = $&;
$result = $upstreamd <=> $eupstreamd;
return "<" if $result == -1;
return ">" if $result == 1;
} while (length ($upstream) || length ($eupstream))
} # end if upstream
else {
$revision = 0;
$erevision = 0;
}
# Finally, check the revision
############
# REVISION #
############
if ($revision || $erevision) {
do {
# letters
$revision =~ s/^\D*//; $revisiond = $&; #$revisiond =~ s/\W/ /g;
$erevision =~ s/^\D*//; $erevisiond = $&; #$erevisiond =~ s/\W/ /g;
# pre in the revision
if ($revisiond eq "." and $erevisiond eq "pre") {
return "r>";
}
elsif ($erevisiond eq "." and $revisiond eq "pre") {
return "r<";
}
$result = $revisiond cmp $erevisiond;
return "r<" if $result == -1;
return "r>" if $result == 1;
# it's importantant to realize that . & + are being checked for
# above. : and - have already been dealt with. cmp seems to deal with
# these characters with no problems.
# numbers
# found a little problem with <=> when number's eq "",
# but this doesn't effect cmp.
if ($revision eq "") {
if ($erevision eq ".") {
$revision = ".";
}
else {
$revision = 0;
}
}
if ( $erevision eq "") {
if ($revision eq ".") {
$erevision = ".";
}
else {
$erevision = 0;
}
}
$revision =~ s/^\d*//; $revisiond = $&;
$erevision =~ s/^\d*//; $erevisiond = $&;
$result = $revisiond <=> $erevisiond;
return "r<" if $result == -1;
return "r>" if $result == 1;
} while (length ($revision) && length ($erevision));
} # end if revision
# still 0? check the remainder..this is just for letters which may have
# been mulled over because they looked like words \w.
if ($result == 0) {
$result = $epoch cmp $eepoch || $upstream cmp $eupstream ||
$revision cmp $erevision;
return "<" if $result == -1;
return ">" if $result == 1;
}
}
} # end sub comparison
# This produces a report to make sure that comparison() is up to par, and
# is called with -v. It uses dpkg's --compare-versions. The advantage of
# not normally running --compare-versions is portability. People using
# other distribution's don't need dpkg installed, and people using weird
# Oses who can't use dpkg can still explore a virtual installation.
sub compare_versions {
# The test result is put in .version_compare
# $result = operand (result from comparison)
# $virtual = version from Packages.gz
# $installed = version from nstatusindex-arch-dist.deb
# $name = packagename
# $commands = options
my ($result, $virtual, $installed, $name, $commands) = @_;
my %commands = %$commands;
my ($cv, $cv_result, $cresult);
my $place = finddb(\%commands);
# usually it will be greater
if (defined $dpkg) {
$cv = system "$dpkg", "--compare-versions", "$virtual", "gt", "$installed";
$cv_result = "no" if $cv == 256;
$cv_result = "yes" if $cv == 0;
#$cresult = "no" if $result =~ m,[r]?<,;
#$cresult = "yes" if $result =~ m,[r]?>,;
$cresult = "no" if $result eq "<" || $result eq "r<";
$cresult = "yes" if $result eq ">" || $result eq "r>";
open(CV,">>$place/.version_compare")
or warn "couldn't create version compare report\n";
if ($cresult eq "yes" && $cv_result eq "no") {
print CV "$name:\ndpkg - $virtual < $installed\nswim - $virtual > $installed\n\n";
}
elsif ($cresult eq "no" && $cv_result eq "yes") {
print CV "$name:\ndpkg - $virtual > $installed\nswim - $virtual < $installed\n\n";
}
else {
return;
}
close(CV);
}
} # end sub compare_versions
1;

672
lib/Conf.pm Normal file
View File

@ -0,0 +1,672 @@
# Package administration and research tool for Debian
# Copyright (C) 1999-2000 Jonathan D. Rosenbaum
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
package SWIM::Conf;
use vars qw(@ISA @EXPORT %EXPORT_TAGS);
use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw($my_number $tmp $architecture $distribution @user_defined_section
$default_directory $default_root_directory $permission $dpkg
$dpkg_deb $ar $gcc $apt_get $apt_cache $sources @FTP $spl $cat
$sort $md5sum $zcat $tar $grep $gzip $fastswim $slowswim $longswim
$mount $umount $mke2fs $copy $pager $base $pwd $parent $library
$splt $mv $imswim $swim_conf $debug $port $timeout
$firewall $passive $apt_sources $HISTORY $alt);
%EXPORT_TAGS = (
Path => [ qw($tmp $parent $base $library) ],
Deb => [ qw($pwd $dpkg_deb $ar $tar $grep $tmp $md5sum $cat $mv) ],
Qftp => [ qw($default_root_directory $permission @FTP
$default_directory $swim_conf) ],
Info => [ qw($parent $base $zcat) ]
);
#############################
# DEFAULT PROGRAM VARIABLES #
#############################
# You can change this to how many lines you would like "swim -qf <>" to
# print out, before asking for -t or --total, it will automatically ask
# though, if there is more than one package and you used the option -i.
# Remember -t can be used with --scripts family members to view the
# title of the script file regardless of this setting, and if -t has to be
# used, the titles will be displayed, which makes sense.
$my_number = 23;
# Just like a shell, you can keep a history of whatever length you want.
$HISTORY = 10;
# For not-installed:
# This part supplies the default value for --arch.
#
# You can determine the default architecture used when -n is
# called or a not-installed database is made. Architectures are always
# being added so check with Debian to find a list. There is alpha, arm,
# hurd (alternative kernel to linux), i386, m68k, powerpc, sparc. Just use
# the arch found after the hyphen in the Contents-(arch) file.
$architecture = "i386";
# For not-installed:
# This part supplies the default value for --dists.
#
# The default distribution can be either stable, unstable, frozen, or
# experimental (rare). These represent the state of development that the
# packages are under. The unstable distribution can have lot's of changes
# within a very short time period, and frozen may or may not be available.
$distribution = "unstable";
#For not-installed:
#This part supplies the default value for --main, --contrib, --non-free,
#and --non-us.
# Distributions are divided into the sections. These sections are called
# distributions in the version 2.4.1.0 packaging manual, because they were at
# one time separate distributions, but this has since changed. You can
# determine which of these sections (main, non-free, contrib or non-US) to
# pull out of the Contents file if you don't want to use --main, --contrib,
# --non-free, and --non-us to selectively pick sections. Basically, whatever
# you pull out should match the Package(s) file(s) you are targetting, this
# program is friendly if you make a mistake, but it's more effecient to pull
# out just what you want. If the same package happens to exist in two
# different sections, main and non-us for example (which is really a
# situation that shouldn't exist, yet it does), you will still be able to
# find this package in the non-us group, but its section and locations will be
# the one which main recognizes assuming that you use the order in the example
# below.
# Setting it up:
# Example: You just want to pull out main and contrib every time you run
# --initndb, --rebuildndb, or --ndb.
# @user_defined_section = qw(main contrib non-US);
# remember "non-US" not "non-us".
# untill non-US is fixed the second is better
#@user_defined_section = qw(main contrib non-free non-US);
@user_defined_section = qw(main contrib non-free);
# Usually, this is
$alt = "debian";
################
# DF LOCATION #
################
# A little philosophy:
# swim was developed for maximum versatility, so whether you are just
# interested in researching, and keeping tabs on the newest packages,
# or maintaining a Debian virtual distribution on a non-Debian real
# distribution, or you are a using swim for distribution development, swim
# provides a way. The default directory (DF - which can also mean
# directory/file) keeps track of Contents and Packages files downloaded
# using --ftp, and gives the files names specific to the distribution and
# architectures they represent. But, you also have the freedom not to use
# the default directory in this case swim will still do the renaming and
# keeping track of the mtime, but you will have to remember where you put
# the files. On the other hand, if you use apt, you won't even have to use
# the DF directory for Packages files because you can get the ones specific
# to your own systems architecture from apt, but if you want to look at
# other architectures you will need to use the DF directory or one of your
# own choice.
# Naming Convention: Contents = Contents-dist.gz
# Packages = Packages-arch-dist-section.gz
$default_directory = '/root/.swim';
# The default root directory is the key to easy management of packages
# downloaded through --ftp and --file, and provides an easy way to put together
# a personalized distribution. Future implementations of swim will provide
# a distribution called personal..Packages and Contents files specific to
# this distribution will automatically be made. This directory can be a
# real ftp site on your computer, or put where ever else you are allowed
# to have directories. dists/distribution/section/architecture/subject will be
# placed above this directory. No matter what, debian must be the final
# directory before dists. Other distributions are placed alongside debian,
# like debian-non-US or personal.
# Feel free to change the permissions. This directory is above your default_
# directory.
$default_root_directory = '/pub/debian';
# Because you may be using a real ftp site, this configuration allows you
# to determine what permissions swim will set for directories it creates
# above the default root directory.
$permission = '0755';
###############
# AR or DPKG? #
###############
# NOTE: users set these next two with the $package_tool variable.
# packaging friends dpkg and dpkg-deb come from the essential and
# required dpkg package. ar from the package binutils can also be used (below).
# This is the archival program used for deb packages, but binutils is just
# a standard non-essential package, and the ar capabilities are built into
# dpkg-deb, and it's better not to assume that the standard packages are
# even established, yet.
$dpkg = ();
$dpkg_deb = ();
# If you don't have the dpkg package on your system then you can use ar
# from the package binutils. This would be a standard, but not an essential
# package in Debian, but this package is also fairly standard amongst all
# distributions, and can even be found in the free djgpp for M$ Oses.
# Since people who have both dpkg and ar may want to try the ar method,
# rather than creating an automatic check, just assign a value to either
# ($dpkg & $dpkg_deb) or just $ar.
#my $ar = '/usr/bin/ar'; # same for RH
$ar = '/usr/bin/ar';
#######
# APT #
#######
# NOTE: users set apt-get and apt-cache with the $apt variable
# If you have apt you are in luck.
$apt_get = ();
$apt_cache = ();
$sources = '/etc/apt/sources.list';
$apt_sources = '/var/state/apt/lists';
#########
# PAGER #
#########
# less is a nice pager, unless you like more! There is an option
# --nopager or -n. Pager is used for --help and swim called without any
# options. more comes from the required package util-linux, whereas
# less comes from a standard package called less. In the future there is
# a possiblity that a large percentage of swim may use an internal pager.
# less, more, or most or...
#$ENV{PAGER} = "/usr/bin/less"; # same RH
$ENV{PAGER} = "less";
$pager = $ENV{PAGER};
#################
# SWIM PROGRAMS #
#################
# This is replaced by the Makefile.
$pre="/usr";
# This is the hash making program fastswim.
$fastswim = "$pre/lib/SWIM/fastswim";
# imswim in an alternative to fastswim for --lowmem
$imswim = "$pre/lib/SWIM/imswim";
# This is the low memory program slowswim.
$slowswim = "$pre/lib/SWIM/slowswim";
# This is the dir/file making program longswim.
$longswim = "$pre/lib/SWIM/longswim";
############
# TEMP DIR #
############
# If you want to set an alternative directory for the temporary files
# created when the databases are made, change here. You may want to make
# $tmp a RAM disk. See package loadlin for initrd documentation and an
# explanation for making such a disk. There is also
# /usr/src/kernel-source.version/Documentation. Whether this will speed
# things up is a subject of experimentation.
$tmp = '/tmp';
##################
# MAIN CONFFILES #
##################
# if configuration files are not kept in /etc change this
# and set up the directories by hand.
$swim_conf = '/etc/swim';
#############
# UTILITIES #
#############
# This probably never will have to be changed.
$pwd = `pwd`;
chomp $pwd;
# If the command split is somewhere else besides /usr/bin change this.
# The required package textutils provides this.
#my $splt = '/usr/bin/split'; # same RH
$splt = 'split';
# cat comes from the essential and required package textutils.
#my $cat = '/bin/cat'; # same RH
$cat = 'cat';
# This command also omes from the required and essential package textutils.
#my $sort = '/usr/bin/sort'; # same RH
$sort = 'sort';
# This program uses md5sum from the dpkg package, it can also use md5sum
# from the RH package.
#my $md5sum = '/usr/bin/md5sum'; # same RH
$md5sum = 'md5sum';
# If you want to view compressed files make sure this is correct.
# The required package gzip provides this.
#my $zcat = '/bin/zcat'; # same RH
$zcat = 'zcat';
# tar comes from the essential and required package tar.
#my $tar = '/bin/tar'; # same RH
$tar = 'tar';
# grep comes from the essential and required package grep. This seems
# to require a path.
$grep = '/bin/grep'; # same RH
# gzip comes from the essential and required package gzip.
#my $gzip = "/bin/gzip"; # same RH
$gzip = "gzip";
# mount comes from the essential and required package mount.
#my $mount = '/bin/mount'; # same RH
#my $umount = '/bin/umount'; # same RH
$mount = 'mount';
$umount = 'umount';
# If your file system isn't an ext2 filesystem, you may want to change
# this. mke2fs comes from the essential and required package e2fsprogs.
#my $mke2fs = '/sbin/mke2fs'; # same RH
$mke2fs = 'mke2fs';
# cp and mv from the essential and required package fileutils
#my $copy = '/bin/cp'; # same RH
$copy = 'cp';
$mv = 'mv';
# Your system definitely has gcc if you have ar. gcc is a standard package
# in debian.
$gcc = 'gcc';
######
# FTP #
#######
# Major mode --ftp and --file automates the download of Contents and Packages
# files. Even if you have apt installed, you may still want to download Packages
# from alternative architectures, and the Contents file for your own architecture
# or other architectures. If you want virtual and/or -ld capabilities you need
# the Contents file. You specify a list of ftp or file sites using urls (like
# apt). For your system's architecture specify the type deb, for other
# architectures specify deb(hyphen)architecture (ex: deb-alpha). Regardless of
# whether or not you specify an architecture, deb implies /dist* found under the
# base directory specified by the ftp url, except in the case of experimental,
# and to a degree non-us. minor mode --ftp, and --file will use the sites in this
# configuration as well, on a fifo (first in first out) basis, so choose the
# order of sites based on which are closest, most current, as well as fast.
# IMPORTANT: It is a BIG MISTAKE to use the distributions name (slink,po,etc)
# anywhere in the sources list, or in swim's configuration file..in fact swim
# won't work properly, not to mention the fact that someday your favorite name
# will suddenly disappear. This is because swim thinks in terms of the real
# distribution name (stable,unstable,frozen, experimental). The problem goes
# like this - slink remains slink, but goes from unstable to frozen to stable.
# At first, using the distributions alias may seem appropriate, but the
# purpose of swim is to keep tabs on the dists, and not to ignore changes in
# the states, this also makes managing swim's databases much easier and
# intuitive...more about this later.
# Fun experiments: Swim uses the naming conventions of apt, but leaves the
# Package files compressed in the DF directory. So you can always decompress
# the databases and move them to /var/state/apt/lists. This ofcourse assumes
# that the appropriate changes to the sources.list reflecting these Packages
# (need to be the same architecture as your system) existed before you
# update. (author needs to do this experiment :*)
$ftp1 = "deb ftp://localhost/pub/debian unstable main contrib non-free non-US";
$ftp2 = "deb ftp://localhost/pub/debian unstable main contrib non-free";
$ftp3 = "deb ftp://localhost/pub/debian project/experimental/";
@FTP = ($ftp1,$ftp2,$ftp3);
# These next variables allow some characteristics of the ftp client
# to be altered. See Net::FTP for ways of altering some of these
# variables through the environment.
$firewall = 0;
$port = 0;
$timeout = 120;
$debug = 0;
$passive = 0;
########################################
# STUFF THAT NEVER NEEDS TO BE CHANGED #
########################################
# You will never need to change this unless for some weird reason all the
# files under dpkg are somewhere else (including /info*) , see --dbpath as
# an alternative if you decide to access or make the databases somewhere
# else.
$base = '/var/lib/dpkg';
# --dbpath takes care of this so don't touch.
$parent = '/';
$library = '/var/lib/dpkg';
#############################
# LOAD CUSTOM CONFIGURATION #
#############################
# Here we load in the customized configuration which override the defaults
# Might as well use do, let the world learn Perl ... compare this to apt's
# configuation file with scopes. Swim's sources.list file (/etc/swim/swimz.list),
# will be grabbed at SWIM::Apt and SWIM::Qftp if it exists.
do "$swim_conf/swimrc";
do "$ENV{HOME}/.swim/swimrc";
if ((defined $dpkg && !defined $dpkg_deb) ||
(!defined $dpkg && defined $dpkg_deb)) {
print "swim: need to give both \$dpkg and \$dpkg_deb a value if you want dpkg\n";
exit;
}
if (defined $package_tool) {
if ($package_tool =~ /ar/) {
$ar = $ar;
}
else {
$dpkg = 'dpkg';
$dpkg_deb = 'dpkg-deb';
undef $ar;
}
}
if (defined $apt) {
$apt_get = 'apt-get';
$apt_cache = 'apt-cache';
}
###############################
# MAKE ANY NEEDED DIRECTORIES #
###############################
# make sure all the appropriate directories are made
if (!-d $default_directory) {
if (-e $default_directory) {
print "swim: can not create default directory because a file exists\n";
exit;
}
my @DRD = split(m,/,,$default_directory);
my $placement = "/";
for (1 .. $#DRD) {
$_ == 1 ? ($placement = "/$DRD[$_]")
: ($placement = $placement . "/" . $DRD[$_]);
-d $placement or mkdir("$placement",0755);
}
}
if (!-d "$default_directory$default_root_directory") {
my @DRD = split(m,/,,$default_root_directory);
print "swim: debian must be the final directory before dists\n"
if $DRD[$#DRD] ne "debian";
exit if $DRD[$#DRD] ne "debian";
my $placement = "/";
for (1 .. $#DRD) {
$_ == 1 ? ($placement = "/$DRD[$_]")
: ($placement = $placement . "/" . $DRD[$_]);
unless (-d "$default_directory$placement") {
mkdir("$default_directory$placement",0755)
or die "swim: could not create root default directory\n";
}
}
}
# Makefile will make sure these directories exist, unless for some strange
# reason you have to change them.
if (!-d $library) {
mkdir($library,0755) or die "Couldn't create default directory\n";
}
if (!-d $base) {
mkdir($base,0755) or die "Couldn't create default directory\n";
}
if (!-d $swim_conf) {
mkdir($swim_conf,0666) or die "Couldn't create configuration file directory,
please make the directories which are needed.\n";
}
1;
__END__
=head1 NAME
swimrc - swim configuration file
=head1 DESCRIPTION
B<swimrc> is the configuartion file for swim allowing many default values
to be set so that they do not have to be mentioned on the command line.
Swimrc interacts directly with Perl allowing a wide variety of variables
found in B<SWIW::Conf> to be altered.
=cut
=head1 USAGE
Values for variable can be altered for B<swim> by assigning different
values enclosed in quotes or quoted whitespace (qw()), and ended with a
semi-colon.
$variable = "value";
$variable = "qw(value1 value2 ..)";
=head1 VARIABLES
This is a list of variables with explanations. The default values for
B<swim> are shown.
=head2 OUTPUT VARIABLE
$my_number can be changed to how many lines you would like "swim -qf <>"
to print out, before the program asks for C<-t> or C<--total>. Exception:
If C<-i> is used in the query and there is more than one package then the
total will be presented.
Hint: C<-t> can be used with all the various C<--scripts> family members
to view the title of the script file regardless of this variable setting,
and if C<-t> has to be used, the titles will be displayed, which makes
sense.
B<$my_number = 23;>
=head2 HISTORY
This is a shell-like history kept in relation to searches and the most
recent edit when C<--stdin> is used.
B<$HISTORY = 10;>
=head2 AR or DPKG?
Debian packages are ar archives. If you are using a Debian Distribution
assign "dpkg" to $package_tool, otherwise assign "ar" to $package_tool.
B<$package_tool = "/usr/bin/ar";>
=head2 APT
B<Swim> does not assign a value for apt. To use C<--apt> and C<-xyz>
assign $apt the value "yes".
Example: B<$apt = "yes";>
=head2 PAGER
less is a nice pager, unless you like more! Pager is used for C<--help>
and B<swim> called without any options. There is an option C<--nopager> or
C<-n>. more comes from the required package util-linux, whereas less
comes from a standard package called less. Values: "less", "more", or
"most" or...
B<$ENV{PAGER} = "less";>
=head2 NOT-INSTALLED VARIABLES
Assign values for $architecture and/or $distribution to avoid having to
use C<--arch> and C<--dists> everytime the not-installed databases are
accessed with C<-n> or made or altered.
Architectures are always being added so check with Debian to find a list.
There is I<alpha, arm, hurd-i386 (alternative kernel to linux), i386,
m68k, powerpc, sparc>. Just use the arch found after the hyphen in the
Contents-(arch) file.
B<$architecture = "i386";>
The distribution can be either I<stable, unstable, frozen, or experimental
(rare)>. These represent the state of development that the packages are
under. The unstable distribution can have lot's of changes within a very
short time period, and frozen may or may not be available.
B<$distribution = "unstable";>
Distributions are divided into sections. These sections were called
distributions in the version 2.4.1.0 packaging manual, because they were
at one time separate distributions, but this has since changed.
You can determine which of the sections I<main, non-free, contrib or
non-US> to pull out of the Contents file if you don't want to use
C<--main>, C<--contrib>, C<--non-free>, and C<--non-us> to selectively
pick the sections.
For efficiency, you should choose the sections which you will be pulling
out of the Packages file(s) being targetted.
Rule: Use "non-US" not "non-us".
B<@user_defined_section = qw(main contrib non-free non-US);>
=head2 DF LOCATION
A little philosophy: B<swim> was developed for maximum versatility, so
whether you are just interested in researching, and keeping tabs on the
newest packages, or maintaining a Debian virtual distribution on a
non-Debian distribution, or you are a using B<swim> for distribution
development, B<swim> provides a way.
The next two variables determine the location of the DF (default
directory/file system)
The default directory keeps track of Contents and/or Packages databases
retrieved with --ftp. The Contents and Packages databases and Release
file are give names specific to the distribution and architectures they
represent using the naming convention found in apt's sources directory.
You also have the freedom not to use the default directory, in which case
swim will still do the renaming and keeping track of the mtime, but you
will have to remember where you put the files.
B<$default_directory = '/root/.swim';>
The default root directory (DRD) is the key to easy management of binary
packages, source, dsc, and diff files received from --ftp, and provides an
easy way to put together a personalized distribution. This directory can
be a real ftp site on your computer, or put wherever else you are
allowed to have directories. The DRD is always placed below the value
assigned to $default_directory. According to the previous assignment to
$default_directory, if the DRD is "/pub/a/debian" then the full path
would be "/root/.swim/pub/a/debian".
Example: When a package is downloaded it will be placed in
dists/distribution/section/architecture/subject below the DRD.
Rule: debian must be the final directory before dists, this is because
other distributions are placed alongside debian, like debian-non-US or
personal (specialized distribution).
B<$default_root_directory = '/pub/debian';>
Because you may be using a real ftp site, this variable allows you to
determine what permissions B<swim> will assign for directories it creates
below the DRD.
B<$permission = '0755';>
=head2 TEMPORARY DIRECTORY
If you want to set an alternative directory for the temporary files
created when the databases are made, change here. You may want to make
$tmp a RAM disk. See package loadlin for initrd documentation and an
explanation for making such a disk. There is also documentation in
/usr/src/kernel-source.version/Documentation. Whether this will speed
things up is a subject of experimentation.
B<$tmp = "/tmp";>
=head2 FTP
You can alter the Firewall, Port, Timeout, Debug and Passive
characteristics of the ftp client as defined in Net::FTP(3pm) by providing
arguments to these variables. All variables but $timeout are set to untrue
by default.
$firewall = 0; (FTP firewall machine name)
$port = 0; (defaults to 23)
$timeout = 120; (120 seconds)
$debug = 0; (1 will turn on STDERR)
$passive = 0; (1 will enable)
=head1 OTHER VARIABLES
see SWIM::Conf
=head1 FILES
/etc/swim/swimrc
~/.swim/swimrc
=head1 SEE ALSO
swim(8), Net::FTP(3pm)
=head1 BUGS
Send directly to mttrader@access.mountain.net.
=head1 AUTHOR
Jonathan D. Rosenbaum <mttrader@access.mountain.net>
=head1 COPYRIGHT
Copyright (c) 1999 Jonathan Rosenbaum. All rights reserved. This program
is free software; you can redistribute it and/or modify it under the GPL.
=cut

947
lib/DB.pm Normal file
View File

@ -0,0 +1,947 @@
# Package administration and research tool for Debian
# Copyright (C) 1999-2000 Jonathan D. Rosenbaum
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
package SWIM::DB;
use strict;
use SWIM::DB_Library qw(:Db);
use SWIM::Format;
use SWIM::Conf qw(:Path);
use SWIM::Global;
use vars qw(@ISA @EXPORT_OK);
use Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(db rebuildflatdb);
# --db --rebuildflatdb db() rebuildflatdb()
# The goal here is to save some time by just updating the database rather
# than rebuilding it. Generally, though, swim -i <package> would be the
# favorable way of doing this, and ultimately may become the primary way of
# setting up the databases after the required packages for this program are
# set-up. This is because --db has to check the status file, whereas -i
# uses statusindex.db, and grabs package information right from the
# package, there are exceptions to this, certain things like the status
# will have to be found from the status file or some other method.
sub db {
# Well, we better check for any changes in the status file, before we
# attempt anything. This is made easy by the version reference hash created
# when --initdb or --rebuilddb is run, and then comparing this to the new
# results when --db is run. Only then will we process, add, and remove
# packages when we know what is gone, and what is new (whether its a
# new package name, or a package with a new version or older version).
# The statusindex.deb could be used for version checking, instead the
# important status field is compared, so if we have situations like
# "deinstall ok config-file" this will be recognized as a CHANGE. The
# update takes place so that the status field remain proper.
my ($commands) = @_;
my %commands = %$commands;
# description stuff
my (@description, @ldescription);
# my @dpackage; # not needed here
# does status exist
my $the_status;
# Keep track of changes to the status file
my $rootsky = "/.";
my @package;
my @name;
my $status;
my @changed_packages;
my @gone;
my (@GONE, @CHANGED, @NEW);
my @before;
my %compare;
# The mys for NEW
my $count = 0;
# a special one to deal with package[1] version change.
my $packv;
my (@essential,$priority,$section,$installed_size,$maintainer,$source);
my (%group, $group);
# Keeps a package->version database
# to save time over using status
my @status;
my ($replaces, $provides, $depends, $pre_depends, $recommends, $suggests,
$conflicts);
my (@conffiles,$line_before,@conf,@complete,@form,@formly);
my $format_deb = "$tmp/format.deb";
dbi(\%commands); ib(\%commands); sb(\%commands);
# Check differences now.
print "checking for new, changed, and removed packages\n";
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
open(DIFFERENCE,"$parent$library/status");
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
open(DIFFERENCE,"$parent$base/status");
}
while (<DIFFERENCE>) {
# Package name
if (/^Package:/i) {
@package = split(/: /,$_);
chomp $package[1];
}
elsif (/^Status:/) {
chomp;
$status = substr($_,8);
# a test
#if ($status eq "purge ok not-installed") {
# if (defined $db{$package[1]}) {
# print "$db{$package[1]}\n";
# }
#}
}
# hold ok not-installed - may want to change this just to
# non-installed.
###########
# VERSION #
###########
elsif (/^Version:/ && $status !~ /not-installed/) {
my $version = $_; chomp $version;
my $ver = m,Version:\s(.*),; my $statusname;
if (defined $sb{$package[1]}) {
$statusname = (split(/\s/,$sb{$package[1]}))[3];
$statusname =~ s/:/ /g;
}
########
# GONE #
########
if (defined $db{$package[1]}) {
push(@gone,"$package[1]_$1");
if ("$package[1]_$1" ne $db{$package[1]}) {
$compare{$package[1]} = "$package[1]_$1";
}
# Version remained the same, but status changed
# even though $statusname may be undefined..this
# routine is only done when it does exist.
######
# CR #
######
elsif ("$package[1]_$1" eq $db{$package[1]} &&
$statusname ne $status) {
push(@changed_packages, "$package[1]");
$compare{$package[1]} = "$package[1]_$1";
}
}
#######
# NEW #
#######
elsif (!defined $db{$package[1]}) {
push(@NEW,$package[1]);
$compare{$package[1]} = "$package[1]_$1";
push(@gone,"$package[1]_$1");
}
}
}
close(DIFFERENCE);
# lets find what existed before, ofcourse mistakes in /. better be
# taken care of beforehand, because this ignores those here. Some time
# may have been saved by using a separate database rather than /., but,
# this keeps things clean.
if ($ib{$rootsky}){
@before = split(/\s/,$ib{$rootsky});
my %tracker;
grep($tracker{$_}++,@gone);
my @goners = grep(!$tracker{$_},@before);
foreach (@goners) {
m,(^.*)_.*$,;
if (!defined $compare{$1}) {
push(@GONE,$1);
}
else {
# these will be process like @GONE for original, and @NEW for
# new
push(@CHANGED,$1);
}
}
}
else {
print "swim: missing important database\n"; exit;
}
foreach (@GONE) {
print "GONE $_\n";
}
foreach (@CHANGED) {
print "CHANGED $_\n";
}
foreach (@changed_packages) {
push(@CHANGED,$_);
print "CHANGED STATUS $_\n";
}
foreach (@NEW) {
print "NEW $_\n";
}
my $new=$#NEW + 1; my $cr=$#changed_packages + 1;
my $ch=($#CHANGED + 1) - $cr; my $gon= $#GONE + 1;
if ($commands->{"check"}) {
print "\n TOTAL\n -----\n";
print "NEW $new\n"; print "GONE $gon\n";
print "CHANGED $ch\n"; print "CHANGED STATUS $cr\n"; exit;
}
print "\n TOTAL\n -----\n";
print "NEW $new\n"; print "GONE $gon\n";
print "CHANGED $ch\n"; print "CHANGED STATUS $cr\n";
@GONE = (@GONE,@CHANGED);
@NEW = (@NEW,@CHANGED);
undef @before; # can use below.
untie %db;
undef %db;
untie %ib;
undef %ib;
# Going to be adding some stuff to nsearchindex.deb and ndirindex.deb
# so better remove any compressed versions if they exist
if (defined @GONE || defined @NEW) {
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
if (-e "$parent$library/searchindex.deb") {
unlink("$parent$library/searchindex.deb.gz");
unlink("$parent$library/dirindex.deb.gz");
}
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
if (-e "$parent$base/searchindex.deb") {
unlink("$parent$base/searchindex.deb.gz");
unlink("$parent$base/dirindex.deb.gz");
}
}
}
# Time for some fun stuff
# There are three states: GONE - all information about this package
# needs to be removed from the databases. NEW - all information about
# this package needs to be put in the databases. CHANGED - a
# combination of the two previous, information could be cross
# referenced and checked for changes, but it's probably no saving of
# time, so first remove information from the same package of a
# different version, then add the information about the package of the
# new version (older or newer)
#############
# #
# GONE #
# #
#############
# GONE. (reverse applies to NEW)
# For package.deb - Delete description
# (packagename_version), packagenameREP, packagenamePRO,
# packagenameDEP, packagenamePRE, packagenameREC,
# packagenameSUG, packagenameCON, packagenameCONF. delete package ->
# version.
#
# for fileindex.deb -
# Find all files and directories associated with the package. Delete
# these files (keys). Find all directories where the file
# exists..delete package name from value, delete whole key if it is the
# only package name.
#
# for groupindex - delete package name (value) from Section
# it belonged to..humm, find section package belongs to in
# statusuindex.deb, and delete whole Section key if only one.
#
# for statusindex.deb -
# delete package -> version group.
#
# for flat files dirindex and searchindex -
# the removal of files and/or directories can be put on hold, and
# done with an option at a later time, since fileindex.deb remembers
# current state, at a later time the old state of the flat files can be
# compared to the new state of fileindex, and these files can be
# rewritten. This is all o.k. because these extra files or directories
# will return undef in search() if the packages don't exist.
ping(\%commands); # uses $ping for package.deb
zing(\%commands); # uses $zing for fileindex.deb
ging(\%commands); # uses $ging for groupindex.deb
sing(\%commands); # uses $sing for statusindex.deb
$| = 1; my $x = 1;
foreach (@GONE) {
print "G|C|CS $x $_.list\r";
$x++;
#first delete keys from package.deb
# If I kept this the name_version would be remembered.
$ping->del($_);
my $orig_argument = $_;
my $packname_version = (split(/\s/,$sb{$orig_argument}))[0];
$packname_version =~ s,\+,\\\+,g;
$argument = "$_";
ver(\%commands);
$ping->del($argument);
my $conf = $argument . "CONF";
$ping->del($conf);
$conf = $argument . "REP";
$ping->del($conf);
$conf = $argument . "PRO";
$ping->del($conf);
$conf = $argument . "DEP";
$ping->del($conf);
$conf = $argument . "PRE";
$ping->del($conf);
$conf = $argument . "REC";
$ping->del($conf);
$conf = $argument . "SUG";
$ping->del($conf);
$conf = $argument . "CON";
$ping->del($conf);
untie $ping;
# next let's go into fileindex.deb and hunt down all directories and
# files associated with this package. It would be kind of nice to use
# package_name.list, but it's probably more realistic not to depend on
# the existence of these file..unless a backup is made. Now if -i is used
# this would be a simple matter, but in this case things are different.
# A database to accomplish this wasn't realistic, so the backup
# files for *.list are in ./info/backup/*.list.bk. We will also have to
# deal with those rare cases that forget /. (smail 2.0v). We should remove
# this file as well as the packagename-conf.md5sums file below.
my $file = "$parent$base/info/backup/$_.list.bk";
my $md5sum_file = "$parent$base/info/$_-conf.md5sums";
open(LIST,"$file");
while (<LIST>) {
chomp;
if (defined $ib{$_}) {
my $status = ($ib{$_} =~ s,$packname_version ,,);
if ($status eq "") {
$status = ($ib{$_} =~ s, $packname_version,,);
if ($status eq "") {
$ib{$_} =~ s,$packname_version,,;
}
}
if ($ib{$_} eq "") {
$zing->del($_);
}
} # if defined
}
close(LIST);
unlink("$file");
#######################
# deinstall situation #
#######################
my $yit = (split(/\s/,$sb{$orig_argument}))[3];
if ($yit eq "deinstall:ok:config-files" ||
$yit eq "purge:ok:config-files") {
if (defined $ib{"/."}) {
my $status = ($ib{"/."} =~ s,$packname_version ,,);
if ($status eq "") {
$status = ($ib{"/."} =~ s, $packname_version,,);
if ($status eq "") {
$ib{"/."} =~ s,$packname_version,,;
}
}
if ($ib{"/."} eq "") {
$zing->del($_);
}
} # if defined
} # deinstall situation
if (-e $md5sum_file) {
unlink("$md5sum_file");
}
# remove from the group, and if only one remove the group.
# Let's first find out which group this monster belongs to.
if (defined $sb{$orig_argument}) {
(my $oa = $orig_argument) =~ s,\+,\\\+,g;
my($section) = (split(/\s/,$sb{$orig_argument}))[1];
if (defined $gb{$section}) {
my $status = ($gb{$section} =~ s,$oa ,,);
if ($status eq "") {
$status = ($gb{$section} =~ s, $oa,,);
if ($status eq "") {
$gb{$section} =~ s,$oa,,;
}
}
if ($gb{$section} eq "") {
$ging->del($section);
}
}
}
# Now ditch the package->version group in statusindex.deb
$sing->del($orig_argument);
untie $sing;
} # end foreach OLD
print "\n" if $#GONE != -1 && $#NEW == -1;
#############
# #
# NEW #
# #
#############
if (-e "$parent$base/status" && -e "$parent$base/info") {
$the_status = "$parent$base/status";
}
else {
print "swim: crucial file(s)/directories are missing in $parent\n";
exit;
}
my %exacts;
my $goon;
print "\n" if $#NEW != -1; $x = 1;
foreach (@NEW) {
$exacts{$_} = "yes";
}
# first let's find the fields to put into packages.deb
# We'll have to go through the status file again, something we
# wouldn't have had to do with swim -i. As it turns out, a good
# percentage of the information can be processed into the database
# while going through status.
open(PRETTY, ">$format_deb");
open(AVAIL, "$the_status");
while (<AVAIL>) {
# here's the difference with database(), we just find the packages
# which belong to the hash %exacts
# Package name
if (/^Package:|^PACKAGE:/) {
@package = split(/: /,$_);
chomp $package[1];
if (defined $exacts{$package[1]}) {
print "N|C|CS $x\r"; $x++;
$goon = "yes";
}
else {
$goon = "no";
undef @package;
next;
}
}
elsif ($goon eq "no") {
next;
}
elsif (/^Status:/) {
$status = $_;
}
elsif (/^Essential/) {
@essential = split(/: /,$_);
}
# missing priority and section will be dealt with below
elsif (/^Priority:/) {
$priority = $_;
}
elsif (/^Section:/) {
$section = $_;
# make the hash for the groupindex.deb
$group = substr($section,9);
chomp $group;
# we will put not-installed in their own group for reference
if ($status !~ /not-installed/) {
if (!defined $gb{$group}) {
$ging->put($group,$package[1]);
}
else {
my $change_group = "$gb{$group} $package[1]";
$ging->del($group);
$ging->put($group,"$change_group");
}
}
}
elsif (/^Installed-Size:/) {
$installed_size = $_;
}
elsif (/^Maintainer:/) {
$maintainer = $_;
}
elsif (/^Source:/) {
$source = $_;
}
# hold ok not-installed - may want to change this just to
# non-installed.
elsif (/^Version:/ && $status !~ /not-installed/) {
my $version = $_;
chomp $version;
###########
# SECTION #
###########
if (defined $section) {
chomp $section;
}
else {
nsb(\%commands);
if (defined $nsb{$package[1]}) {
my ($nvname,$ngname,$npriorname) =
split(/\s/,"$nsb{$package[1]}",3);
$group = $ngname;
}
else {
$group = "unavailable";
}
}
$col1 = "Package: $package[1]";
$col2 = $status;
write PRETTY;
$col1 = $version;
my $ver = m,Version:\s(.*),;
# This creates a name -> version index in package.deb,
# and the statusindex.deb database which will serve to
# determine if the status has changed when --db or -i is
# run.
$packv = "$package[1]_$1";
$ping->put($package[1],$packv);
my ($priory,$statusy);
############
# PRIORITY #
############
if (defined $priority) {
$priory = substr($priority,10);
}
else {
nsb(\%commands);
if (defined $nsb{$package[1]}) {
my ($nvname,$ngname,$npriorname) =
split(/\s/,"$nsb{$package[1]}",3);
$priory = $npriorname;
}
else {
$priory = "unavailable";
}
}
chomp $priory;
$statusy = substr($status,8);
chomp $statusy;
$statusy =~ s/\s/:/g;
my $thimk = "$packv $group $priory $statusy";
$sing->put($package[1],$thimk);
$package[1] = "$packv";
if(defined($essential[1])) {
$col2 = "Essential: $essential[1]";
@essential = ();
}
else {
$col2 = "Essential: no\n";
}
write PRETTY;
######################
# SECTION & PRIORITY #
######################
if (defined $section) {
$col1 = $section;
}
else {
nsb(\%commands);
$package[1] =~ m,(.*)_.*,;
my $packthing = $1;
if (defined $nsb{$packthing}) {
my ($nvname,$ngname,$npriorname) =
split(/\s/,"$nsb{$packthing}",3);
$col1 = "Section: $ngname";
# we can put it in now, no deletion needed
if (!defined $gb{$group}) {
$ging->put($group,$packthing);
}
else {
my $change_group = "$gb{$group} $packthing";
$ging->del($group);
$ging->put($group,"$change_group");
}
}
else {
$col1 = "Section: unavailable";
}
}
if (defined $priority) {
$col2 = $priority;
}
else {
nsb(\%commands);
$package[1] =~ m,(.*)_.*,;
my $packthing = $1;
if (defined $nsb{$packthing}) {
my ($nvname,$ngname,$npriorname) =
split(/\s/,"$nsb{$packthing}",3);
$col2 = "Section: $npriorname";
}
else {
$col2 = "Priority: unavailable\n";
}
}
write PRETTY;
#my $cool = $installed_size . $maintainer;
#print PRETTY $cool;
$col1 = $installed_size;
if (defined $source) {
$col2 = $source;
}
else {
$col2 = "";
}
write PRETTY;
undef $source;
print PRETTY $maintainer
}
# This stuff will be available with seperate query flags or All
elsif (/^Replaces:/) {
$replaces = $_;
if (defined($replaces)) {
$ping->put("$package[1]REP",$replaces);
}
}
elsif (/^Provides:/) {
$provides = $_;
if (defined($provides)) {
$ping->put("$package[1]PRO",$provides);
}
}
elsif (/^Depends:/) {
$depends = $_;
if (defined($depends)) {
$ping->put("$package[1]DEP",$depends);
}
}
elsif (/^Pre-Depends:/) {
$pre_depends = $_;
if (defined($pre_depends)) {
$ping->put("$package[1]PRE",$pre_depends);
}
}
elsif (/^Recommends:/) {
$recommends = $_;
if (defined($recommends)) {
$ping->put("$package[1]REC",$recommends);
}
}
elsif (/^Suggests:/) {
$suggests = $_;
if (defined($suggests)) {
$ping->put("$package[1]SUG",$suggests);
}
}
elsif (/^Conflicts:/) {
$conflicts = $_;
if (defined($conflicts)) {
$ping->put("$package[1]CON",$conflicts);
}
}
# Gather the Configuration Files, Description comes after.
# Available with a single flag.
elsif (/^Conffiles:/) {
my $line = <AVAIL>;
while ($line !~ /^Description:/) {
push(@conffiles,$line);
$line = <AVAIL>;
if ($line =~ /^Description/) {
$line_before = $line;
# put conffiles into one variable
if (defined $package[1]) {
}
my ($c, $cool);
if ($#conffiles != 0) {
for ($c = $#conffiles; $c >= 0; $c--) {
if ($c > 0) {
$cool = $conffiles[$c-1] .= $conffiles[$c];
}
} #end for
}
else {
$cool = $conffiles[0];
}
@conffiles = ();
$ping->put("$package[1]CONF",$cool);
} #if ($line =~ /^Desc
} # while ($line ! /^Desc
} # elsif (/^Conffiles
untie %nsb;
# Only interested in available packages..so this is fine.
# To be combined with first fields.
if (/Description:|^\s\w*|^\s\.\w*/ ||
defined($line_before) =~ /^Description/){
my $many_lines;
if (defined($line_before)) {
push(@ldescription, $line_before);
push(@ldescription, $_);
$line_before = ();
}
else {
$many_lines = $_;
}
if ($_ !~ /^\n$/) {
$count++;
if ($count == 1) {
if (defined $package[1]) {
#chomp $package[1];
#push(@dpackage,$package[1]);
push(@description,$package[1]);
}
}
if (defined($many_lines)) {
push(@ldescription,$many_lines);
}
} # end if ($_ !~ /^\n$/
else {
$count = 0;
# let's put each description into one scalar
my ($c, $cool);
if ($#ldescription != 0) {
for ($c = $#ldescription; $c >= 0; $c--) {
if ($c > 0) {
$cool = $ldescription[$c-1] .= $ldescription[$c];
}
} #end for
} # end if ($#ld
else {
$cool = $ldescription[0];
}
if (defined $cool) {
push(@description,$cool);
}
@ldescription = ();
} # end else
$line_before = ();
}
untie $ping;
untie $ging;
untie $sing;
} # end while (<AVAIL>)
close(PRETTY);
# Let's put together the description with the rest of its fields.
open(FIELDS,"$format_deb");
while (<FIELDS>) {
push(@form,$_);
}
close(FIELDS);
foreach (@form) {
push(@formly,$_);
my ($cool);
$count++;
if ($count == 5) {
my ($c, $cool);
if ($#formly != 0) {
for ($c = $#formly; $c >= 0; $c--) {
if ($c > 0) {
$cool = $formly[$c-1] .= $formly[$c];
}
} #end for
} # end if ($#ld
else {
$cool = $formly[0];
}
push(@complete,$cool);
@formly = ();
$count = 0;
}
}
my $name_version;
foreach (@description) {
if ($count == 1) {
# -i
my $lingo = shift(@complete);
$lingo = $lingo . $_;
#push(@Tdescription, $lingo);
$ping->put($name_version,$lingo);
$lingo = ();
$count = 1;
}
else {
# packagename_version
#push(@Tdescription, $_);
$name_version = $_;
$count = 0;
}
$count++;
untie $ping;
}
undef $ping;
unlink($format_deb);
# Now time to do some file/dir stuff. A backup of *list needs to be
# made, might as well use this. There is a possibility this can be
# used instead of fastswim for initial fileindex.deb.
my $package_name;
if (!-d "$parent$base/info/backup") {
mkdir("$parent$base/info/backup",0666);
}
print "\n" if $#NEW != -1; $x = 1;
foreach $package_name (@NEW) {
open(FILENAME,"$parent$base/info/$package_name.list");
open(CP,">$parent$base/info/backup/$package_name.list.bk");
while (<FILENAME>) {
print CP $_;
}
close(FILENAME);
close(CP);
my $file = "$parent$base/info/backup/$package_name.list.bk";
print "#$x"; print " N|C $package_name.list \r";
$x++;
open(LIST,"$file");
while (<LIST>) {
chomp;
# Better add the new stuff to the flat files first
if (!defined $ib{$_}) {
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
open(SEARCHINDEX,">>$parent$library/searchindex.deb");
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
open(SEARCHINDEX,">>$parent$base/searchindex.deb");
}
if (!-d) {
print SEARCHINDEX "$_\n";
}
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
open(DIRINDEX,">>$parent$library/dirindex.deb");
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
open(DIRINDEX,">>$parent$base/dirindex.deb");
}
if (-d) {
print DIRINDEX "$_\n";
}
} # !defined
# If the directory already exists we can just append
# to the end of the value
if (defined $ib{$_}) {
dbi(\%commands);
my $cvalue = $ib{$_} . " $db{$package_name}";
# put overwrites by default!
$zing->put($_,$cvalue);
} # if defined
else {
dbi(\%commands);
$zing->put($_,$db{$package_name});
}
untie %db;
untie $zing;
}
close(LIST);
close(SEARCHINDEX);
close(DIRINDEX);
my $zit; my ($nit,$yit) = (split(/\s/,$sb{$package_name}))[0,3];
if ($yit eq "deinstall:ok:config-files" ||
$yit eq "purge:ok:config-files") {
($zit = $nit) =~ s,\+,\\\+,;
if ($ib{"/."} !~ m,$zit,) {
$ib{"/."} = $ib{"/."} . " $zit";
}
}
} # end foreach NEW
print "\n" if $#NEW != -1;
} # end sub db
# Generally, it's unecessary to rebuild the flat databases unless major
# changes have occurred to a person's installation, and the database has
# become very repetitive, or a file has changed into a directory. This
# function has also been tried by tieing the flat file to an array, but
# there doesn't seem to be that much of a speed advantage unless ib()
# happens to be in memory, but more experimentation will be tried in the
# future.
sub rebuildflatdb {
my($commands) = @_;
my %commands = %$commands;
ib(\%commands);
print scalar(localtime), "\n";
my $file;
my $dir;
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
!($commands->{"dbpath"} && $commands->{"root"})) {
if (-e "$parent$library/searchindex.deb") {
$dir = "$parent$library/dirindex.deb";
$file = "$parent$library/searchindex.deb";
unlink($file);
unlink("$file.gz") if -e "$file.gz";
unlink($dir);
unlink("$dir.gz") if -e "$dir.gz";
}
else {
print "swim: operation only implemented for installed system\n";
exit;
}
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
if (-e "$parent$base/searchindex.deb") {
$file = "$parent$base/searchindex.deb";
$dir = "$parent$base/dirindex.deb";
unlink($file);
unlink("$file.gz") if -e "$file.gz";
unlink($dir);
unlink("$dir.gz") if -e "$dir.gz";
}
else {
print "swim: operation only implemented for installed system\n";
exit;
}
}
open(DIR,">$dir");
open(FILE,">$file");
# We need to reconstruct long.debian & DEBIAN*, but can't take into account
# weirdisms with the database - NEW packages which aren't NEW.
foreach (keys %ib) {
if (defined $ib{$_}) {
my $filedir = $_;
my $package = $ib{$_};
#$package =~ s/\s/\n/g;
my @the_amount = split(/\s/, $package);
if ($#the_amount > 0) {
print DIR "$filedir\n";
}
elsif ($#the_amount == 0) {
print FILE "$filedir\n";
}
}
}
untie %ib;
print scalar(localtime), "\n";
} # end sub rebuildflatdb
1;

648
lib/DB_Init.pm Normal file
View File

@ -0,0 +1,648 @@
# Package administration and research tool for Debian
# Copyright (C) 1999-2000 Jonathan D. Rosenbaum
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
package SWIM::DB_Init;
use strict;
use SWIM::Conf qw(:Path $fastswim $imswim $slowswim $sort);
#use SWIM::Global;
use SWIM::Format;
use SWIM::MD;
use DB_File;
use vars qw(@ISA @EXPORT);
use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(database);
# database() md() --initdb --rebuilddb
# Time to get serious and make a database
sub database {
my ($commands) = @_;
my %commands = %$commands;
print scalar(localtime), "\n";
#my whatever that is
my @dpackage; # passes name_version to md()
my @Tdescription;
my @description;
my @ldescription;
my @package;
my %db;
my @name;
my $count = 0;
my $the_status;
my $status;
my @essential;
my $priority;
my $section;
my $installed_size;
my $maintainer;
my $source;
my $version;
my $ver;
my %gb;
my %group;
my $group;
# Keeps a package->version database
# to save time over using status
my %sb;
my @status;
my ($replaces, @REPLACE, $provides, $depends, $pre_depends,
$recommends, $suggests, $conflicts);
my @conffiles;
my $line_before;
my @conf;
my @complete;
my @form;
my @formly;
my $format_deb = "$tmp/format.deb";
# Let's decide whether we should even go on. If it is --initdb, and
# the databases already exist, nothing should be touched, but if it is
# --rebuilddb and they exist, then they are removed and remade from
# scratch.
# But first, better clean up any files in $tmp in case of an aborted
# database formation
unlink(<$tmp/DEBIAN*>) if -e "$tmp/DEBIANaa";
unlink("$tmp/transfer.deb") if -e "$tmp/transfer.deb";
unlink("$tmp/big.debian") if -e "$tmp/big.debian";
unlink("$tmp/long.debian") if -e "$tmp/long.debian";
if (-e "$parent$base/status" && -e "$parent$base/info") {
$the_status = "$parent$base/status";
}
else {
print "swim: crucial file(s)/directories are missing in $parent\n";
exit;
}
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
if ($commands->{"initdb"}) {
if (-e "$parent$library/packages.deb" &&
-e "$parent$library/fileindex.deb") {
print "swim: use --rebuilddb\n";
exit;
}
else {
# if a database happens to be missing
if (-e "$parent$library/packages.deb") {
unlink("$parent$library/packages.deb");
}
if (-e "$parent$library/fileindex.deb") {
unlink("$parent$library/fileindex.deb");
}
if (-e "$parent$library/groupindex.deb") {
unlink("$parent$library/groupindex.deb");
}
if (-e "$parent$library/statusindex.deb") {
unlink("$parent$library/statusindex.deb");
}
if (-e "$parent$library/searchindex.deb") {
unlink("$parent$library/searchindex.deb");
}
if (-e "$parent$library/searchindex.deb.gz") {
unlink("$parent$library/searchindex.deb.gz");
}
if (-e "$parent$library/dirindex.deb") {
unlink("$parent$library/dirindex.deb");
}
if (-e "$parent$library/dirindex.deb.gz") {
unlink("$parent$library/dirindex.deb.gz");
}
}
}
# this only works if all databases exist.
elsif ($commands->{"rebuilddb"}) {
if (-e "$parent$library/packages.deb" &&
-e "$parent$library/fileindex.deb") {
unlink("$parent$library/packages.deb");
unlink("$parent$library/fileindex.deb");
unlink("$parent$library/groupindex.deb");
unlink("$parent$library/statusindex.deb");
unlink("$parent$library/searchindex.deb");
unlink("$parent$library/searchindex.deb")
if -e "$parent$library/searchindex.deb";
unlink("$parent$library/dirindex.deb");
unlink("$parent$library/dirindex.deb")
if -e "$parent$library/dirindex.deb.gz";
}
else {
print "swim: use --initdb to create databases\n";
exit;
}
}
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
if ($commands->{"initdb"}) {
if (-e "$parent$base/packages.deb" &&
-e "$parent$base/fileindex.deb") {
print "swim: use --rebuilddb\n";
exit;
}
else {
# if a database happens to be missing
if (-e "$parent$base/packages.deb") {
unlink("$parent$base/packages.deb");
}
if (-e "$parent$base/fileindex.deb") {
unlink("$parent$base/fileindex.deb");
}
if (-e "$parent$base/groupindex.deb") {
unlink("$parent$base/groupindex.deb");
}
if (-e "$parent$library/statusindex.deb") {
unlink("$parent$library/statusindex.deb");
}
if (-e "$parent$library/searchindex.deb") {
unlink("$parent$library/searchindex.deb");
}
if (-e "$parent$library/searchindex.deb.gz") {
unlink("$parent$library/searchindex.deb.gz");
}
if (-e "$parent$library/dirindex.deb") {
unlink("$parent$library/dirindex.deb");
}
if (-e "$parent$library/dirindex.deb.gz") {
unlink("$parent$library/dirindex.deb.gz");
}
}
}
# this only works if all databases exist.
elsif ($commands->{"rebuilddb"}) {
if (-e "$parent$base/packages.deb" &&
-e "$parent$base/fileindex.deb") {
unlink("$parent$base/packages.deb");
unlink("$parent$base/fileindex.deb");
unlink("$parent$base/groupindex.deb");
unlink("$parent$base/statusindex.deb");
unlink("$parent$library/searchindex.deb");
unlink("$parent$library/searchindex.deb")
if -e "$parent$library/searchindex.deb";
unlink("$parent$library/dirindex.deb");
unlink("$parent$library/dirindex.deb")
if -e "$parent$library/dirindex.deb.gz";
}
else {
print "swim: use --initdb to create databases\n";
exit;
}
}
}
# This makes a backup of all the *.list files in ./backup. When
# --initdb/--rebuilddb runs these files should be built or rebuilt,
# but if changes have occured and --db(-i wasn't used) wasn't run
# this won't cause problems because everything is rebuilt, there may
# just be some lingering small files in backup.
# Seems like both approaches are about the same speed.
#use File::Copy;
print "Making backups of *.list\n";
if (!-d "$parent$base/info/backup") {
mkdir("$parent$base/info/backup",0666);
}
opendir(COPY,"$parent$base/info");
foreach (sort grep(/\.list$/, readdir(COPY))) {
#copy ("$parent$base/info/$_","$parent$base/info/backup/$_.bk");
open(FILENAME,"$parent$base/info/$_");
open(CP,">$parent$base/info/backup/$_.bk");
while (<FILENAME>) {
print CP $_;
}
}
closedir(COPY);
print "Description Database is being made\n";
$| = 1; my $x = 0;
open(PRETTY, ">$format_deb");
open(AVAIL, "$the_status");
while (<AVAIL>) {
# Package name
if (/^Package:|^PACKAGE:/) {
@package = split(/: /,$_);
chomp $package[1];
$x = 1 if $x == 6;
print "|\r" if $x == 1 || $x == 4; print "/\r" if $x == 2;
print "-\r" if $x == 3 || $x == 6; print "\\\r" if $x == 5;
$x++;
}
# Some other pertinent fields
# All this stuff can be placed together..since it is generally nice
# to know these things at one glance, in this order.
# Package: Status:
# Version: Essential: (yes or no)
# Section: Priority:
# Installed-Size:
# Maintainer:
# Description:
elsif (/^Status:/) {
$status = $_;
}
elsif (/^Essential/) {
@essential = split(/: /,$_);
}
elsif (/^Priority:/) {
$priority = $_;
}
elsif (/^Section:/) {
$section = $_;
# make the hash for the groupindex.deb
$group = substr($section,9);
chomp $group;
# we will put not-installed in their own group for reference
if ($status !~ /not-installed/) {
if (!defined $group{$group}) {
$group{$group} = $package[1];
}
else {
$group{$group} = "$group{$group} $package[1]";
}
}
}
elsif (/^Installed-Size:/) {
$installed_size = $_;
}
elsif (/^Maintainer:/) {
$maintainer = $_;
}
elsif (/^Source:/) {
$source = $_;
}
# hold ok not-installed - may want to change this just to
# non-installed.
elsif (/^Version:/ && $status !~ /not-installed/) {
$version = $_;
chomp($version, $section);
$col1 = "Package: $package[1]";
$col2 = $status;
write PRETTY;
$col1 = $version;
$ver = m,Version:\s(.*),;
# This creates a name -> version index in package.deb,
# and the statusindex.deb database which will serve to
# determine if the status has changed when --db or -i is
# ran.
push(@name, $package[1]);
push(@status, $package[1]);
$package[1] = "$package[1]_$1";
push(@name, $package[1]);
my $priory = substr($priority,10);
chomp $priory;
my $statusy = substr($status,8);
chomp $statusy;
$statusy =~ s/\s/:/g;
my $thimk = "$package[1] $group $priory $statusy";
push(@status, $thimk);
if(defined($essential[1])) {
$col2 = "Essential: $essential[1]";
@essential = ();
}
else {
$col2 = "Essential: no\n";
}
write PRETTY;
if (defined $section) {
$col1 = $section;
}
else {
$col1 = "Section: unavailable";
}
if (defined $priority) {
$col2 = $priority;
}
else {
$col2 = "Priority: unavailable\n";
}
write PRETTY;
#my $cool = $installed_size . $maintainer;
$col1 = $installed_size;
if (defined $source) {
$col2 = $source;
}
else {
$col2 = "";
}
write PRETTY;
undef $source;
print PRETTY $maintainer
}
# This stuff will be available with seperate query flags or All
elsif (/^Replaces:/) {
$replaces = $_;
if (defined($replaces)) {
push(@REPLACE, "$package[1]REP");
push(@REPLACE, $replaces);
}
}
elsif (/^Provides:/) {
$provides = $_;
if (defined($provides)) {
push(@REPLACE, "$package[1]PRO");
push(@REPLACE, $provides);
}
}
elsif (/^Depends:/) {
$depends = $_;
if (defined($depends)) {
push(@REPLACE, "$package[1]DEP");
push(@REPLACE, $depends);
}
}
elsif (/^Pre-Depends:/) {
$pre_depends = $_;
if (defined($pre_depends)) {
push(@REPLACE, "$package[1]PRE");
push(@REPLACE, $pre_depends);
}
}
elsif (/^Recommends:/) {
$recommends = $_;
if (defined($recommends)) {
push(@REPLACE, "$package[1]REC");
push(@REPLACE, $recommends);
}
}
elsif (/^Suggests:/) {
$suggests = $_;
if (defined($suggests)) {
push(@REPLACE, "$package[1]SUG");
push(@REPLACE, $suggests);
}
}
elsif (/^Conflicts:/) {
$conflicts = $_;
if (defined($conflicts)) {
push(@REPLACE, "$package[1]CON");
push(@REPLACE, $conflicts);
}
}
# Gather the Configuration Files, Description comes after.
# Available with a single flag.
elsif (/^Conffiles:/) {
my $line = <AVAIL>;
while ($line !~ /^Description:/) {
push(@conffiles,$line);
$line = <AVAIL>;
if ($line =~ /^Description/) {
$line_before = $line;
# put conffiles into one variable
if (defined $package[1]) {
#chomp $package[1];
push(@conf,"$package[1]CONF");
}
my ($c, $cool);
if ($#conffiles != 0) {
for ($c = $#conffiles; $c >= 0; $c--) {
if ($c > 0) {
$cool = $conffiles[$c-1] .= $conffiles[$c];
}
} #end for
}
else {
$cool = $conffiles[0];
}
@conffiles = ();
push(@conf,$cool);
} #if ($line =~ /^Desc
} # while ($line ! /^Desc
} # elsif (/^Conffiles
# Only interested in available packages..so this is fine.
# To be combined with first fields.
if (/Description:|^\s\w*|^\s\.\w*/ ||
defined($line_before) =~ /^Description/){
my $many_lines;
if (defined($line_before)) {
push(@ldescription, $line_before);
push(@ldescription, $_);
$line_before = ();
}
else {
$many_lines = $_;
}
if ($_ !~ /^\n$/) {
$count++;
if ($count == 1) {
if (defined $package[1]) {
#chomp $package[1];
push(@dpackage,$package[1]);
push(@description,$package[1]);
}
}
if (defined($many_lines)) {
push(@ldescription,$many_lines);
}
} # end if ($_ !~ /^\n$/
else {
$count = 0;
# let's put each description into one scalar
my ($c, $cool);
if ($#ldescription != 0) {
for ($c = $#ldescription; $c >= 0; $c--) {
if ($c > 0) {
$cool = $ldescription[$c-1] .= $ldescription[$c];
}
} #end for
} # end if ($#ld
else {
$cool = $ldescription[0];
}
if (defined $cool) {
push(@description,$cool);
}
@ldescription = ();
} # end else
$line_before = ();
}
} # end while (<AVAIL>)
close(PRETTY);
# Let's put together the description with the rest of its fields.
open(FIELDS,"$format_deb");
while (<FIELDS>) {
push(@form,$_);
}
close(FIELDS);
foreach (@form) {
push(@formly,$_);
my ($cool);
$count++;
if ($count == 5) {
my ($c, $cool);
if ($#formly != 0) {
for ($c = $#formly; $c >= 0; $c--) {
if ($c > 0) {
$cool = $formly[$c-1] .= $formly[$c];
}
} #end for
} # end if ($#ld
else {
$cool = $formly[0];
}
push(@complete,$cool);
@formly = ();
$count = 0;
}
}
foreach (@description) {
if ($count == 1) {
my $lingo = shift(@complete);
$lingo = $lingo . $_;
push(@Tdescription, $lingo);
$lingo = ();
$count = 1;
}
else {
push(@Tdescription, $_);
$count = 0;
}
$count++;
}
unlink($format_deb);
# We'll keep databases local so that md() doesn't get confused with
# database().
# Put the groups into the groupindex.deb database.
print "Group Database is being made\n";
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
tie %gb, 'DB_File', "$parent$library/groupindex.deb" or die "DB_File: $!";
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
tie %gb, 'DB_File', "$parent$base/groupindex.deb" or die "DB_File: $!";
}
%gb = %group;
untie %gb;
undef %gb;
undef %group;
# Create the important status database.
print "Status Database is being made\n";
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
tie %sb, 'DB_File', "$parent$library/statusindex.deb" or die "DB_File: $!";
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
tie %sb, 'DB_File', "$parent$base/statusindex.deb" or die "DB_File: $!";
}
%sb = @status;
untie %sb;
undef %sb;
undef @status;
# Put everything into the package.deb database.
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
tie %db, 'DB_File', "$parent$library/packages.deb" or die "DB_File: $!";
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
tie %db, 'DB_File', "$parent$base/packages.deb" or die "DB_File: $!";
}
%db = (@name,@Tdescription,@conf,@REPLACE);
untie %db;
undef @Tdescription;
undef @conf;
undef @REPLACE;
undef %db;
# To the total db thing.
if ($commands->{"initdb"} || $commands->{"rebuilddb"}) {
md(\@dpackage,\%commands);
}
} # end sub database
# Basically, this writes @dpackage to transfer.deb, which is processed by
# either fastswim into two files big.debian and long.debian for further
# processing by process_md() or is processed by imswim, then slowswim into
# the two files big.debian and long.debian then finished by process_md()
sub md {
my($dpackage,$commands) = @_; # creates transfer.deb
my %commands = %$commands;
unless (-e "$parent$base/info") {
die 'This program requires the /var/lib/dpkg/info directory set-up by dpkg';
}
# Put all file/dir(*.list)->package_name(s) into an massive array.
# fastswim runs this process separately.
# This enables info files to be used from a different root system
my $argument2 = "$parent$base/info";
# This is just for testing purposes, and serves no real purpose.
if (!defined(@$dpackage)) {
system("$fastswim");
}
# This is what is used.
else {
open(TRANSFER, ">$tmp/transfer.deb");
foreach (@$dpackage) {
print TRANSFER "$_\n";
}
close(TRANSFER);
if (!$commands->{"lowmem"}) {
system $fastswim, "--transfer", $argument2, $tmp;
}
else {
print "Gathering the file(s)/dir(s)\n";
system $imswim, $argument2, $tmp;
system $slowswim, $tmp, $sort;
}
}
undef @$dpackage;
process_md(\%commands);
} # end sub md
1;

497
lib/DB_Library.pm Normal file
View File

@ -0,0 +1,497 @@
# Package administration and research tool for Debian
# Copyright (C) 1999-2000 Jonathan D. Rosenbaum
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
package SWIM::DB_Library;
use strict;
use SWIM::Conf;
use SWIM::Global;
use SWIM::Library;
use DB_File;
use vars qw(@ISA @EXPORT %EXPORT_TAGS);
use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(ib nib dbi ndb sb exist_sb nsb ping zing nzing ging gb
ngb sing ram_on version ver nver nping nzing nging nsing);
%EXPORT_TAGS = (
Search => [ qw(ib dbi nib nsb ndb gb ram_on version ngb) ],
Db => [ qw(sb ib gb nsb ver dbi zing ging ping sing) ],
Md => [ qw(sb ib nsb nzing) ],
Deb => [ qw(sb nsb ndb) ],
NDb => [ qw(ndb nsb ngb nver nping nzing nging nsing
exist_sb sb) ],
Groups => [ qw(gb ngb) ],
Xyz => [ qw(dbi ndb) ]
);
# functions which use DB_File
sub ib {
my ($commands) = @_;
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
if (-e "$parent$library/fileindex.deb") {
tie %ib, 'DB_File', "$parent$library/fileindex.deb" or die "DB_File: $!";
}
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
if (-e "$parent$base/fileindex.deb") {
tie %ib, 'DB_File', "$parent$base/fileindex.deb" or die "DB_File: $!";
}
}
} # end sub ib
sub dbi {
my ($commands) = @_;
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
if (-e "$parent$library/packages.deb" ||
($commands->{"initndb"} || $commands->{"rebuildndb"})) {
tie %db, 'DB_File', "$parent$library/packages.deb" or die "DB_File: $!";
}
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
if (-e "$parent$base/packages.deb" ||
($commands->{"initndb"} || $commands->{"rebuildndb"})) {
tie %db, 'DB_File', "$parent$base/packages.deb" or die "DB_File: $!";
}
}
} # end sub dbi
sub nib {
my ($commands) = @_;
my %commands = %$commands;
my ($arch,$dist) = which_archdist(\%commands);
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
if (!-e "$parent$library/nfileindex$arch$dist.deb") {
return;
}
tie %ib, 'DB_File', "$parent$library/nfileindex$arch$dist.deb" or die "DB_File: $!";
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
if (!-e "$parent$base/nfileindex$arch$dist.deb") {
return;
}
tie %ib, 'DB_File', "$parent$base/nfileindex$arch$dist.deb" or die "DB_File: $!";
}
} # end sub nib
sub ndb {
my ($commands) = @_;
my %commands = %$commands;
my ($arch,$dist) = which_archdist(\%commands);
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
if (-e "$parent$library/npackages$arch$dist.deb" ||
($commands->{"initndb"} || $commands->{"rebuildndb"} ||
$commands->{"ndb"})) {
tie %db, 'DB_File', "$parent$library/npackages$arch$dist.deb"
or die "swim: use pre-existing databases for this option";
}
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
if (-e "$parent$base/npackages$arch$dist.deb" ||
($commands->{"initndb"} || $commands->{"rebuildndb"} ||
$commands->{"ndb"})) {
tie %db, 'DB_File', "$parent$base/npackages$arch$dist.deb"
or die "swim: use pre-existing databases for this option";
}
}
} # end sub ndb
sub sb {
my ($commands) = @_;
my %commands = %$commands;
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
if (-e "$parent$library/statusindex.deb") {
tie %sb, 'DB_File', "$parent$library/statusindex.deb"
or die "DB_File: $!";
}
else {
return;
}
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
if (-e "$parent$base/statusindex.deb") {
tie %sb, 'DB_File', "$parent$base/statusindex.deb"
or die "DB_File: $!";
}
else {
return;
}
}
} # end sub sb
# exist_sb & sb seem to be used primarily in NDB_Init
# This first looks in the immediate directory for statusindex.deb, if it
# isn't found here, it look in the default directory. It then returns
# undef, or initializes the database based on its findings.
sub exist_sb {
my ($commands) = @_;
my %commands = %$commands;
my $yep;
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
if (-e "$parent$library/statusindex.deb") {
$yep = "yes";
}
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
if (-e "$parent$base/statusindex.deb") {
$yep = "yes";
}
}
if (!defined $yep) {
if (-e "$parent$base/statusindex.deb") {
tie %sb, 'DB_File', "$parent$base/statusindex.deb"
or die "DB_File: $!";
return "yes";
}
else {
return;
}
}
elsif (defined $yep) {
sb(\%commands);
return "yes";
}
} # end sub exist_sb
sub nsb {
my ($commands) = @_;
my %commands = %$commands;
my($arch,$dist) = which_archdist(\%commands);
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
if (-e "$parent$library/nstatusindex$arch$dist.deb" ||
($commands->{"initndb"} || $commands->{"rebuildndb"} ||
$commands->{"ndb"})) {
tie %nsb, 'DB_File', "$parent$library/nstatusindex$arch$dist.deb"
or die "swim: use pre-existing databases for this option";
}
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
if (-e "$parent$base/nstatusindex$arch$dist.deb" ||
($commands->{"initndb"} || $commands->{"rebuildndb"} ||
$commands->{"ndb"})) {
tie %nsb, 'DB_File', "$parent$base/nstatusindex$arch$dist.deb" or die
or die "swim: use pre-existing databases for this option";
}
}
} # end sub nsb
sub ping {
my ($commands) = @_;
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
$ping = tie %db, 'DB_File', "$parent$library/packages.deb" or die "DB_File: $!";
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
$ping = tie %db, 'DB_File', "$parent$base/packages.deb" or die "DB_File: $!";
}
}
sub nping {
my ($commands) = @_;
my %commands = %$commands;
my ($arch,$dist) = which_archdist(\%commands);
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
$ping = tie %db, 'DB_File', "$parent$library/npackages$arch$dist.deb"
or die "DB_File: $!";
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
$ping = tie %db, 'DB_File', "$parent$base/npackages$arch$dist.deb"
or die "DB_File: $!";
}
} # end sub nping
sub zing {
my ($commands) = @_;
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
$zing = tie %ib, 'DB_File', "$parent$library/fileindex.deb"
or die "DB_File: $!";
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
$zing = tie %ib, 'DB_File', "$parent$base/fileindex.deb"
or die "DB_File: $!";
}
} # end sub zing
sub nzing {
my ($commands) = @_;
my %commands = %$commands;
my ($arch,$dist) = which_archdist(\%commands);
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
$zing = tie %ib, 'DB_File', "$parent$library/nfileindex$arch$dist.deb"
or die "DB_File: $!";
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
$zing = tie %ib, 'DB_File', "$parent$base/nfileindex$arch$dist.deb"
or die "DB_File: $!";
}
} # end sub nzing
sub ging {
my ($commands) = @_;
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
$ging = tie %gb, 'DB_File', "$parent$library/groupindex.deb" or die "DB_File: $!";
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
$ging = tie %gb, 'DB_File', "$parent$base/groupindex.deb" or die "DB_File: $!";
}
} #end sub ging
sub nging {
my ($commands) = @_;
my %commands = %$commands;
my ($arch,$dist) = which_archdist(\%commands);
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
$ging = tie %gb, 'DB_File',"$parent$library/ngroupindex$arch$dist.deb"
or die "DB_File: $!";
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
$ging = tie %gb, 'DB_File', "$parent$base/ngroupindex$arch$dist.deb"
or die "DB_File: $!";
}
} # end sub nging
sub gb {
my ($commands) = @_;
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
if (-e "$parent$library/groupindex.deb" ||
($commands->{"initndb"} || $commands->{"rebuildndb"})) {
tie %gb, 'DB_File', "$parent$library/groupindex.deb" or die "DB_File: $!";
}
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
if (-e "$parent$base/groupindex.deb" ||
($commands->{"initndb"} || $commands->{"rebuildndb"})) {
tie %gb, 'DB_File', "$parent$base/groupindex.deb" or die "DB_File: $!";
}
}
}
sub ngb {
my ($commands) = @_;
my %commands = %$commands;
my ($arch,$dist) = which_archdist(\%commands);
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
if (-e "$parent$library/ngroupindex$arch$dist.deb" ||
($commands->{"initndb"} || $commands->{"rebuildndb"})) {
tie %gb, 'DB_File', "$parent$library/ngroupindex$arch$dist.deb"
or die "DB_File: $!";
}
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
if (-e "$parent$base/ngroupindex$arch$dist.deb" ||
($commands->{"initndb"} || $commands->{"rebuildndb"})) {
tie %gb, 'DB_File', "$parent$base/ngroupindex$arch$dist.deb"
or die "DB_File: $!";
}
}
}
sub sing {
my ($commands) = @_;
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
$sing = tie %sb, 'DB_File', "$parent$library/statusindex.deb"
or die "DB_File: $!";
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
$sing = tie %sb, 'DB_File', "$parent$base/statusindex.deb" or die "DB_File: $!";
}
} # sub sing
sub nsing {
my ($commands) = @_;
my %commands = %$commands;
my ($arch,$dist) = which_archdist(\%commands);
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
$sing = tie %nsb, 'DB_File', "$parent$library/nstatusindex$arch$dist.deb"
or die "DB_File: $!";
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
$sing = tie %nsb, 'DB_File', "$parent$base/nstatusindex$arch$dist.deb"
or die "DB_File: $!";
}
} # end sub nsing
# This doesn't depend on DB so it can be placed somewhere else if it is used by more
# than SWIM::Search.
# checks to see if ramdisk is on, searchdf() & nfile()-process_nfile()
# (used by file()) uses this
sub ram_on {
my $ramdisk;
# this monster runs for every argument
my $rambo = "$cat /proc/mounts|";
open(RAM, "$rambo");
while (<RAM>) {
if (/ram/) {
my($device,$mount) = split(/\s/,$_,2);
if ($mount =~ /dramdisk/) {
$ramdisk = "yes";
return $ramdisk;
}
}
}
close(RAM);
} # end sub ram_on
# finds package name and version
sub version {
my ($commands) = @_;
my %commands = %$commands;
if (!$commands{"n"}) {
dbi(\%commands);
}
else {
ndb(\%commands);
}
if (defined $argument) {
# We will check for more than two..just in case
if ($argument !~ /_/) {
if (defined $db{$argument}) {
$argument = $db{$argument};
}
}
}
} # end sub version
# returns version but and then is untied
sub ver {
my ($commands) = @_;
my %commands = %$commands;
dbi(\%commands);
if (defined $argument) {
# We will check for more than two..just in case
if ($argument !~ /_/) {
if (defined $db{$argument}) {
$argument = $db{$argument};
}
}
}
untie %db;
} # end sub ver
sub nver {
my ($commands) = @_;
my %commands = %$commands;
ndb(\%commands);
if (defined $argument) {
# We will check for more than two..just in case
if ($argument !~ /_/) {
if (defined $db{$argument}) {
$argument = $db{$argument};
}
}
}
untie %db;
} # end sub nver

1752
lib/Deb.pm Normal file
View File

File diff suppressed because it is too large Load Diff

456
lib/Deps.pm Normal file
View File

@ -0,0 +1,456 @@
# Package administration and research tool for Debian
# Copyright (C) 1999-2000 Jonathan D. Rosenbaum
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
package SWIM::Deps;
use strict;
use SWIM::Global qw(:Info);
use SWIM::DB_Library qw(:Xyz);
use vars qw(@ISA @EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw(character s_character which_character the_character);
# the -T and siblings
# process the database for replaces
sub replaces {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "REP";
if (defined $db{$conf}) {
return $db{$conf};
}
else { return ""; }
}
untie %db;
} # end sub replaces
# process the database for provides
sub provides {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "PRO";
if (defined $db{$conf}) {
return $db{$conf};
}
else { return ""; }
}
untie %db;
} # end sub provides
# process the database for depends
sub depends {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "DEP";
if (defined $db{$conf}) {
return $db{$conf};
}
else { return ""; }
}
untie %db;
} # end sub depends
# process the database for replaces
sub pre_depends {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "PRE";
if (defined $db{$conf}) {
return $db{$conf};
}
else { return ""; }
}
untie %db;
} # end sub pre_depends
# process the database for replaces
sub recommends {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "REC";
if (defined $db{$conf}) {
return $db{$conf};
}
else { return ""; }
}
untie %db;
} # end sub recommends
# process the database for replaces
sub suggests {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "SUG";
if (defined $db{$conf}) {
return $db{$conf};
}
else { return ""; }
}
untie %db;
} # end sub suggests
# process the database for replaces
sub conflicts {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "CON";
if (defined $db{$conf}) {
return $db{$conf};
}
else { return ""; }
}
untie %db;
} # end sub conflicts
#These subroutines are for cases where only packages related to the
# characteristics are printed out.
# process the database for replaces
sub s_replaces {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "REP";
if (defined $db{$conf}) {
return "$argument\n$db{$conf}";
}
else { return ""; }
}
untie %db;
} # end sub s_replaces
# process the database for provides
sub s_provides {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "PRO";
if (defined $db{$conf}) {
return "$argument\n$db{$conf}";
}
else { return ""; }
}
untie %db;
} # end sub s_provides
# process the database for depends
sub s_depends {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "DEP";
if (defined $db{$conf}) {
return "$argument\n$db{$conf}";
}
else { return ""; }
}
untie %db;
} # end sub s_depends
# process the database for replaces
sub s_pre_depends {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "PRE";
if (defined $db{$conf}) {
return "$argument\n$db{$conf}";
}
else { return ""; }
}
untie %db;
} # end sub s_pre_depends
# process the database for replaces
sub s_recommends {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "REC";
if (defined $db{$conf}) {
return "$argument\n$db{$conf}";
}
else { return ""; }
}
untie %db;
} # end sub s_recommends
# process the database for replaces
sub s_suggests {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "SUG";
if (defined $db{$conf}) {
return "$argument\n$db{$conf}";
}
else { return ""; }
}
untie %db;
} # end sub s_suggests
# process the database for replaces
sub s_conflicts {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "CON";
if (defined $db{$conf}) {
return "$argument\n$db{$conf}";
}
else { return ""; }
}
untie %db;
} # end sub s_conflicts
# This figures out which characteristics (Replaces, Provides, etc) the
# options are pointing to. Isn't choosey, prints all packages
sub character {
my ($commands) = @_;
my %commands = %$commands;
# for singular cases
if ($commands->{"g"} && ($commands->{"T"} || $commands->{"pre_depends"} ||
$commands->{"depends"} || $commands->{"recommends"} ||
$commands->{"suggests"} || $commands->{"provides"} ||
$commands->{"replaces"} || $commands->{"conflicts"}) &&
!($commands->{"c"} || $commands->{"d"} || $commands->{"l"} ||
$commands->{"i"})) {
print "$argument\n";
}
# all the characteristics
if (defined $commands->{"T"}) {
print pre_depends(\%commands);
print depends(\%commands);
print recommends(\%commands);
print suggests(\%commands);
print provides(\%commands);
print replaces(\%commands);
print conflicts(\%commands);
}
else {
if (defined $commands->{"pre_depends"}) {
print pre_depends(\%commands);
delete $commands{"pre_depends"} if !($commands->{"S"} || $commands->{"g"});
}
if (defined $commands->{"depends"}) {
print depends(\%commands);
delete $commands{"depends"} if !($commands->{"S"} || $commands->{"g"});
}
if (defined $commands->{"recommends"}) {
print recommends(\%commands);
delete $commands{"recommends"} if !($commands->{"S"} || $commands->{"g"});
}
if (defined $commands->{"suggests"}) {
print suggests(\%commands);
delete $commands{"suggests"} if !($commands->{"S"} || $commands->{"g"});
}
if (defined $commands->{"replaces"}) {
print replaces(\%commands);
delete $commands{"replaces"} if !($commands->{"S"} || $commands->{"g"});
}
if (defined $commands->{"provides"}) {
print provides(\%commands);
delete $commands{"provides"} if !($commands->{"S"} || $commands->{"g"});
}
if (defined $commands->{"conflicts"}) {
print conflicts(\%commands);
delete $commands{"conflicts"} if !($commands->{"S"} || $commands->{"g"});
}
}
} # end sub character
# Prints out the characteristics only for the packages which have them.
sub s_character {
my ($commands) = @_;
my %commands = %$commands;
if ($commands->{"pre_depends"}) {
print s_pre_depends(\%commands);
delete $commands{"pre_depends"};
if (s_pre_depends(\%commands) ne "") {
character(\%commands);
}
# else { s_character(\%commands) }
}
elsif ($commands->{"depends"}) {
print s_depends(\%commands);
delete $commands{"depends"};
if (s_depends(\%commands) ne "") {
character(\%commands);
}
# else { s_character(\%commands) }
}
elsif ($commands->{"recommends"}) {
print s_recommends(\%commands);
delete $commands{"recommends"};
if (s_recommends(\%commands) ne "") {
character(\%commands);
}
# else { s_character(\%commands) }
}
elsif ($commands->{"suggests"}) {
print s_suggests(\%commands);
delete $commands{"suggests"};
if (s_suggests(\%commands) ne "") {
character(\%commands);
}
# else { s_character(\%commands) }
}
elsif ($commands->{"replaces"}) {
print s_replaces(\%commands);
delete $commands{"replaces"};
if (s_replaces(\%commands) ne "") {
character(\%commands);
}
# else { s_character(\%commands) }
}
elsif ($commands->{"provides"}) {
print s_provides(\%commands);
delete $commands{"provides"};
if (s_provides(\%commands) ne "") {
character(\%commands);
}
# else { s_character(\%commands) }
}
elsif ($commands->{"conflicts"}) {
print s_conflicts(\%commands);
delete $commands{"conflicts"};
if (s_conflicts(\%commands) ne "") {
character(\%commands);
}
# else { s_character(\%commands) }
}
# all the characteristics
if ($commands->{"T"}) {
print s_pre_depends(\%commands);
print s_depends(\%commands);
print s_recommends(\%commands);
print s_suggests(\%commands);
print s_provides(\%commands);
print s_replaces(\%commands);
print s_conflicts(\%commands);
}
} # end sub s_character
# helps to determine if character(\%commands) should be used
sub which_character {
my ($commands) = @_;
if ($commands->{"pre_depends"} || $commands->{"depends"} ||
$commands->{"recommends"} || $commands->{"suggests"} ||
$commands->{"replaces"} || $commands->{"provides"} ||
$commands->{"conflicts"}) {
return 1;
}
} # end sub which_character
# This runs a test to see whether or not the characters being asked for
# apply to this package.
sub the_character {
my ($commands) = @_;
my %commands = %$commands;
if (defined $commands->{"pre_depends"}) {
if (pre_depends(\%commands) eq "") {
print "";
}
else { return "ok"; }
}
if (defined $commands->{"depends"}) {
if (depends(\%commands) eq "") {
print "";
}
else { return "ok"; }
}
if (defined $commands->{"recommends"}) {
if (recommends(\%commands) eq "") {
print "";
}
else { return "ok"; }
}
if (defined $commands->{"suggests"}) {
if (suggests(\%commands) eq "") {
print "";
}
else { return "ok"; }
}
if (defined $commands->{"replaces"}) {
if (replaces(\%commands) eq "") {
print "";
}
else { return "ok"; }
}
if (defined $commands->{"provides"}) {
if (provides(\%commands) eq "") {
print "";
}
else { return "ok"; }
}
if (defined $commands->{"conflicts"}) {
if (conflicts(\%commands) eq "") {
print "";
}
else { return "ok"; }
}
} # end sub the_character
1;

110
lib/Dir.pm Normal file
View File

@ -0,0 +1,110 @@
# Package administration and research tool for Debian
# Copyright (C) 1999-2000 Jonathan D. Rosenbaum
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
package SWIM::Dir;
use strict;
use SWIM::Global qw($argument);
use SWIM::Conf qw($pwd);
use vars qw(@ISA @EXPORT @EXPORT_OK);
use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(dir fir);
# dir() fir()
# When --dir is used checks argument (when -f is called) and determines dir
# stuff..is it real or not.
sub dir {
my ($commands) = @_;
if ($commands->{"dir"}) {
if (! -d $argument) {
if (! -e $argument) {
print "$argument is not a directory or file\n";
}
else {
print "$argument is not a directory\n";
}
exit;
}
elsif ($argument =~ m,\/$,) {
if ($argument !~ m,^\/,) {
if ($pwd =~ m,^\/$,) {
$argument =~ m,(.*)\/$,;
$argument = "$pwd$1";
}
else {
$argument =~ m,(.*)\/$,;
$argument = "$pwd/$1";
}
}
else {
$argument =~ m,(.*)\/$,;
$argument = $1;
}
}
elsif ($argument !~ m,\/$|^\/, && $argument =~ m,\/,) {
if ($pwd =~ m,^\/$,) {
$argument = "/$argument";
}
else {
$argument = "$pwd/$argument";
}
}
}
} # end sub dir
# when --dir isn't called...does the same thing as dir.
sub fir {
my ($commands) = @_;
if ($argument =~ m,\/$,) {
# Let's test to see whether it really is a file or directory.
if (! -d $argument) {
print "$argument is not a file\n";
exit;
}
if ($argument !~ m,^\/,) {
if ($pwd =~ m,^\/$,) {
$argument =~ m,(.*)\/$,;
$argument = "$pwd$1";
}
else {
$argument =~ m,(.*)\/$,;
$argument = "$pwd/$1";
}
}
else {
$argument =~ m,(.*)\/$,;
$argument = $1;
}
}
elsif ($argument !~ m,\/$|^\/, && $argument =~ m,\/,) {
if ($pwd =~ m,^\/$,) {
$argument = "/$argument";
}
else {
$argument = "$pwd/$argument";
}
}
} # end sub fir
1;

92
lib/F.pm Normal file
View File

@ -0,0 +1,92 @@
# Package administration and research tool for Debian
# Copyright (C) 1999-2000 Jonathan D. Rosenbaum
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
package SWIM::F;
use Carp;
use strict;
use vars qw(@ISA @EXPORT);
use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(get);
# This is Net::FTP::get with minor modifications. Not all the features
# are used, but are kept, just in case they will be.
sub get
{
my($ftp,$remote,$local,$where) = @_;
my($loc,$len,$buf,$resp,$localfd,$data);
local *FD;
$| = 1;
$localfd = ref($local) ? fileno($local)
: undef;
($local = $remote) =~ s#^.*/##
unless(defined $local);
${*$ftp}{'net_ftp_rest'} = $where
if ($where);
delete ${*$ftp}{'net_ftp_port'};
delete ${*$ftp}{'net_ftp_pasv'};
$data = $ftp->retr($remote) or
return undef;
if(defined $localfd)
{
$loc = $local;
}
else
{
$loc = \*FD;
unless(($where) ? open($loc,">>$local") : open($loc,">$local"))
{
carp "Cannot open Local file $local: $!\n";
$data->abort;
return undef;
}
}
if($ftp->type eq 'I' && !binmode($loc))
{
carp "Cannot binmode Local file $local: $!\n";
$data->abort;
return undef;
}
$buf = ''; my $amt = 0;
#print "\n";
do
{
$len = $data->read($buf,1024);
$amt = $len + $amt;
print "[$amt]\r";
}
while($len > 0 && syswrite($loc,$buf,$len) == $len);
close($loc)
unless defined $localfd;
$data->close(); # implied $ftp->response
return $local;
}

877
lib/File.pm Normal file
View File

@ -0,0 +1,877 @@
# Package administration and research tool for Debian
# Copyright (C) 1999-2000 Jonathan D. Rosenbaum
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
package SWIM::File;
use strict;
use SWIM::Global;
use SWIM::DB_Library qw(:Xyz ram_on nsb);
use SWIM::Library;
use SWIM::Conf qw(:Path $md5sum);
use vars qw(@ISA @EXPORT);
use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(file);
#=pod
#
#This provides the list of files belonging to a package. Although a
#database could be used..it's probably faster, and cheaper on space
#accessing from the /var/lib/dpkg/info* files. And if --md5sum is
#called, the md5sums are shown for the -d ,-l, or -c files they exist for.
#md5sums are checked for, and reported back as OK or FAILED. -l or
#-d(overrides l). -qd(l) md5sum from RH has a slightly different
#output.. filepath/filename: file OK before swim's output..this can be
#altered
#
#=end
sub file {
my ($commands) = @_;
my %commands = %$commands;
my $file;
my $md5;
my @md5;
my $path;
my @path;
my $md5sums;
my $md5sums_conf;
my %md5sums = ();
my $orig_argument;
my $count = 0;
if (!$commands->{"n"}) {
dbi(\%commands);
}
# files/dirs will be found from contents.deb (compressed)
else {
ndb(\%commands);
}
if (defined $argument) {
if ($argument =~ /_/) {
my $check;
if (defined $db{"$argument"}) {
$check = $db{"$argument"};
}
$argument =~ m,(^.*)_(.*$),;
if (defined $check) {
$argument = $1;
}
else {}
}
}
if (defined $argument) {
if (!$commands->{"n"}) {
$file = "$parent$base/info/$argument.list";
if (-e "$parent$base/info/$argument.md5sums") {
$md5sums = "$parent$base/info/$argument.md5sums";
}
if (-e "$parent$base/info/$argument-conf.md5sums" && $commands->{"c"}) {
$md5sums_conf = "$parent$base/info/$argument-conf.md5sums";
}
##################
# MD5SUMS FOR -C #
##################
if ($commands->{"md5sum"} && $commands->{"c"} && !($commands->{"d"} ||
$commands->{"l"})) {
if (!defined $md5sums_conf && $commands->{"c"}) {
$md5sums_conf = make_conf(\%commands);
}
# now we can process $md5sums and $md5sums_conf assuming one or
# both actually exist
if (defined $md5sums_conf) {
chdir("/");
my %path;
open (MD5SUM, "$md5sums_conf");
open (MD5SUMCHECK, "|$md5sum -c 2>$tmp/md5sumcheck");
while (<MD5SUM>) {
if ($_ =~ /newconffile/) {
$path = substr($_, 13);
push(@path,$path);
$md5 = substr($_, 0, 11);
push(@md5,$md5);
chomp $path;
chomp $md5;
$path{"$path"} = $md5;
print MD5SUMCHECK $_;
next;
}
$path = substr($_, 34);
push(@path,$path);
$md5 = substr($_, 0, 32);
push(@md5,$md5);
chomp $path;
chomp $md5;
$path{"$path"} = $md5;
print MD5SUMCHECK $_;
}
close(MD5SUMCHECK);
close(MD5SUM);
#now check with md5sum from the dpkg package
my $check_md5sum;
# won't bother going into this while unless there is a reason
if (defined "$tmp/md5sumcheck" && $md5 ne "newconffile") {
open(MD5SUMFILE, "$tmp/md5sumcheck");
while (<MD5SUMFILE>) {
if ($_ !~ /no files checked/) {
if (/failed/) {
# Humm may be two situations watch or due to coding change
#$check_md5sum = substr($_,39);
$check_md5sum = substr($_,30);
$check_md5sum =~ s/'//;
chomp $check_md5sum;
$md5sums{"$check_md5sum"} = "FAILED";
}
elsif (/can't open/) {
# Humm may be two situations watch or due to coding change
#$check_md5sum = substr($_,28);
$check_md5sum = substr($_,19);
chomp $check_md5sum;
$md5sums{"$check_md5sum"} = "MISSING";
}
}
}
}
close(MD5SUMCHECK);
unlink("$tmp/md5sumcheck");
# This finishes everything
open (LIST,"$md5sums_conf");
while (<LIST>) {
if ($_ =~ /newconffile/) {
$_ = substr($_, 13);
chomp;
}
else {
$_ = substr($_, 34);
chomp;
}
if (defined $path{$_}) {
# humm file_now() not necessary here
if (defined $md5sums{$_}) {
print " /$_ $path{$_} $md5sums{$_}\n";
}
elsif ($path{$_} ne "newconffile") {
print " /$_ $path{$_} OK";
print "\n";
}
<