inetsim-1.2.7/0000755000175000017500000000000013173076432011363 5ustar rgyrgyinetsim-1.2.7/cleanup.sh0000755000175000017500000000213413173076432013351 0ustar rgyrgy#! /bin/sh # remove backup files #for i in `find . -name "*~"`; do rm $i; done # remove reports for i in `find ./report/ -name "report.*.txt"`; do rm -f $i; done # remove logfiles rm -f ./log/main.log rm -f ./log/service.log rm -f ./log/debug.log # remove HTTP postdata for i in `find ./data/http/postdata/ -type f -not -regex ".*\/\.svn\/.*"`; do rm -f $i; done # remove FTP uploads for i in `find ./data/ftp/upload/ -type f -not -regex ".*\/\.svn\/.*"`; do rm -f $i; done # remove TFTP uploads for i in `find ./data/tftp/upload/ -type f -not -regex ".*\/\.svn\/.*"`; do rm -f $i; done # remove service data (from older versions) if [ -f ./data/pop3/pop3.dat ]; then rm -f ./data/pop3/pop3.dat rm -f ./data/pop3/session.dat rm -f ./data/pop3/session.lck fi if [ -f ./data/tftp/uploads.dat ]; then rm -f ./data/tftp/uploads.dat rm -f ./data/tftp/uploads.idx fi # remove service data rm -f ./data/smtp/smtp.mbox rm -f ./data/smtp/smtps.mbox rm -f ./data/pop3/pop3.data ./data/pop3/pop3.lock ./data/pop3/pop3.session rm -f ./data/pop3/pop3s.data ./data/pop3/pop3s.lock ./data/pop3/pop3s.session # inetsim-1.2.7/doc/0000755000175000017500000000000013173076432012130 5ustar rgyrgyinetsim-1.2.7/doc/inetsim.de.pod0000644000175000017500000000723413173076432014701 0ustar rgyrgy=pod =head1 NAME B - Programm zur Simulation von Internet-Diensten =head1 UEBERSICHT B [B<--config> >] [B<--version>] [B<--data-dir> >] [B<--log-dir> >] [B<--report-dir> >] [B<--bind-address> >] [B<--max-childs> >] [B<--user> >] [B<--faketime-init-delta> >] [B<--faketime-auto-delay> >] [B<--faketime-auto-incr> >] [B<--session> >] [B<--pidfile> >] =head1 BESCHREIBUNG B simuliert gaengige Internet-Dienste wie I, I, I oder I. =head1 OPTIONEN =over 4 =item B<--config> > Angabe einer alternativen Konfigurationsdatei. Standard ist conf/inetsim.conf im aktuellen Verzeichnis. =item B<--version> Ausgabe der Versionsinformation. =item B<--data-dir> > Angabe eines alternativen Datenverzeichnisses. Standard ist data/ im aktuellen Verzeichnis. =item B<--log-dir> > Angabe eines alternativen Logverzeichnisses. Standard ist log/ im aktuellen Verzeichnis. =item B<--report-dir> > Angabe eines alternativen Reportverzeichnisses. Standard ist report/ im aktuellen Verzeichnis. =item B<--bind-address> > Angabe der IP-Adresse, unter welcher die Dienste lauschen sollen. =item B<--max-childs> > Angabe der maximalen Anzahl der gestarteten Kindprozesse (Anzahl paralleler Verbindungen) fuer jeden Dienst. Standard ist 10. =item B<--user> > Angabe eines alternativen Benutzers, unter welchem die Dienste laufen sollen. Standard ist nobody. =item B<--faketime-init-delta> > Angabe der anfaenglichen Zeitdifferenz in Sekunden (positiv oder negativ) - relativ zum aktuellen Datum bzw. zur aktuellen Uhrzeit. Diese wird anstelle des Wertes aus der Konfigurationsdatei verwendet. Hinweis: Die Zeitdifferenz wird von allen Diensten beruecksichtigt. Standard ist 0 (aktuelles Datum/aktuelle Uhrzeit). =item B<--faketime-auto-delay> > Angabe der Zeitverzoegerung in Sekunden, nach welcher die Zeitdifferenz regelmaessig entsprechend dem bei B<--faketime-auto-incr> eingestellten Wert erhoeht oder verringert wird. Ein Wert von '0' schaltet diese Funktion ab. Standard ist 0 (ausgeschaltet). =item B<--faketime-auto-incr> > Angabe der Schrittweite in Sekunden, um welche die Zeit in regelmaessigen Abstaenden erhoeht oder verringert wird. Diese Option ist nur wirksam, wenn bei B<--faketime-auto-delay> die Zeitverzoegerung eingeschaltet ist (nicht auf '0' gesetzt). Standard ist 3600. =item B<--session> > Angabe eines alternativen Sitzungsnamens. Standard ist die Prozess-ID des Hauptprogramms. =item B<--pidfile> > Angabe einer alternativen PID-Datei. Standard ist /var/run/inetsim.pid. =back =head1 BEISPIELE Simulation mit Sitzungsnamen 'simtest5' starten # inetsim --session simtest5 Simulation mit Zeitsprung von einem Tag in die Zukunft nach jeweils 60 Sekunden starten # inetsim --faketime-auto-delay 60 --faketime-auto-incr 86400 dito, jedoch mit Zeitsprung in die Vergangenheit # inetsim --faketime-auto-delay 60 --faketime-auto-incr -86400 =head1 BENOETIGT Perl 5, Getopt::Long, Net::Server, Net::DNS, IO::Handle, IO::Socket, IO::Select, IPC::Shareable, Digest::SHA, File::Copy, MIME::Base64, IPTables::IPv4::IPQueue (optional) =head1 AUTOREN S ESE, S ESE =cut inetsim-1.2.7/doc/inetsim.conf.de.pod0000644000175000017500000002341513173076432015624 0ustar rgyrgy=pod =head1 NAME inetsim.conf - Konfigurationsdatei fuer INetSim =head1 BESCHREIBUNG I ist die Konfigurationsdatei fuer B(1). Das Format von I ist simpel: eine Option pro Zeile, wobei Leerzeilen und Zeilen, die mit # beginnen, ignoriert werden. =head1 GLOBALE OPTIONEN =over 4 =item I Startet den Dienst DIENST. =item I Angabe der IP-Adresse, auf welcher die Dienste lauschen sollen. =item I Angabe des Benutzers, unter welchem die Dienste laufen sollen. =item I Angabe der maximalen Anzahl der gestarteten Kindprozesse (Anzahl paralleler Verbindungen) fuer jeden Dienst. =item I Angabe der Zeit in Sekunden, nach welcher inaktive Verbindungen geschlossen werden. =item I<[Dienstname]_bind_port PORT> Angabe des Ports fuer den angegebenen Dienst. =item I Erstelle einen Report mit einer Zusammenfassung der Verbindungen der Sitzung beim Beenden von INetSim. =item I Erstelle Reports in der angegebenen Sprache. =back =head1 FAKETIME OPTIONEN =over 4 =item I Angabe der anfaenglichen Zeitdifferenz in Sekunden (positiv oder negativ) relativ zum aktuellen Datum bzw. zur aktuellen Uhrzeit. Die Zeitdifferenz wird von allen Diensten beruecksichtigt. Ist dieser Wert auf '0' gesetzt, wird das aktuelle Datum bzw. die aktuelle Uhrzeit verwendet. =item I Angabe der Zeitverzoegerung in Sekunden, nach welcher die Zeitdifferenz regelmaessig entsprechend dem bei B eingestellten Wert erhoeht oder verringert wird. Ein Wert von '0' schaltet diese Funktion ab. =item I Angabe der Schrittweite in Sekunden, um welche die Zeit in regelmaessigen Abstaenden erhoeht oder verringert wird. Diese Option ist nur wirksam, wenn bei B die Zeitverzoegerung eingeschaltet ist (nicht auf '0' gesetzt). =back =head1 ZUSAETZLICHE DNS OPTIONEN =over 4 =item I IP-Adresse, die als Standard in DNS-Antworten zurueckgegeben wird. =item I Hostname, der als Standard in DNS-Antworten zurueckgegeben wird. =item I Domainname, der als Standard in DNS-Antworten zurueckgegeben wird. =item I Abbilden statischer Eintraege fuer DNS. =item I Versionsangabe, die zurueckgegeben wird. =back =head1 ZUSAETZLICHE HTTP(S) OPTIONEN =over 4 =item I Version, welche in HTTP-Antworten ausgegeben wird. =item I Schaltet fuer HTTP den Fake-Modus ein oder aus. =item I Angabe der Datei und des MIME-Typs, welche basierend auf der Dateierweiterung in der HTTP-Anfrage zurueckgegeben werden. =item I Angabe der Standarddatei und des Standard-MIME-Typs, welche zurueckgegeben werden, wenn zur Dateierweiterung der HTTP-Anfrage kein passender Eintrag mit B definiert ist. =item I Angabe der Datei und des MIME-Typs, welche basierend auf dem zugehoerigen Pfad in der HTTP-Anfrage zurueckgegeben werden. =back =head1 ZUSAETZLICHE SMTP(S) OPTIONEN =over 4 =item I Angabe des Bannertextes, der in der SMTP-Grussmeldung benutzt wird. =item I Angabe des FQDN-Hostnamens fuer SMTP. =item I Angabe, ob der Client HELO/EHLO vor allen anderen Kommandos senden muss. =item I Schaltet die Unterstuetzung fuer 'Erweitertes SMTP' (ESMTP) ein oder aus. =item I SMTP 'service extensions', welche dem Client angeboten werden. =item I Biete nur Authentifizierungsmechanismen an, die eine Rueckwandlung der vom Client gesendeten Authentifizierungsinformationen in einen Benutzernamen und ein Passwort im Klartext ermoeglichen. =item I Zwinge den Client zur Authentifizierung. =back =head1 ZUSAETZLICHE POP3(S) OPTIONEN =over 4 =item I Angabe des Bannertextes, der in der POP3-Grussmeldung benutzt wird. =item I Angabe des Hostnamens, der in der POP3-Grussmeldung benutzt wird. =item I Maximale Anzahl der E-Mails, die aus den zur Verfuegung stehenden mbox-Dateien fuer die dynamische Erzeugung der POP3-Mailbox verwendet werden. =item I Neueinlesen der zur Verfuegung stehenden mbox-Dateien, wenn der POP3-Dienst waehrend der angegebenen Anzahl an Sekunden nicht benutzt wurde. =item I Neuerzeugung der POP3-Mailbox, wenn der POP3-Dienst waehrend der angegebenen Anzahl an Sekunden nicht benutzt wurde. =item I Biete nur Authentifizierungsmechanismen an, die eine Rueckwandlung der vom Client gesendeten Authentifizierungsinformationen in einen Benutzernamen und ein Passwort im Klartext ermoeglichen. =item I Schaltet die Unterstuetzung von APOP ein oder aus. =item I Schaltet die Unterstuetzung von POP3 'capabilities' ein oder aus. =item I> POP3 'capabilities', die dem Client angeboten werden. =back =head1 ZUSAETZLICHE FTP(S) OPTIONEN =over 4 =item I Angabe des Bannertextes, der in der FTP-Grussmeldung benutzt wird. =item I Versionsangabe, die in Antworten auf das STAT-Kommando zurueckgegeben wird. =item I Erlaube das rekursive Loeschen von Verzeichnissen, auch wenn diese nicht leer sind. =back =head1 ADDITIONAL TFTP OPTIONS =over 4 =item I Erlaube das Ueberschreiben vorhandener Dateien. =item I Schaltet die Unterstuetzung von TFTP-Optionen ein oder aus. =item I TFTP-Optionen, die dem Client angeboten werden. =back =head1 ZUSAETZLICHE NTP OPTIONEN =over 4 =item I Angabe der IP-Adresse, welche in NTP-Antworten zurueckgegeben wird. =item I Schaltet strenge Tests fuer Client-Pakete ein oder aus. =back =head1 ZUSAETZLICHE IRC OPTIONEN =over 4 =item I Angabe des FQDN-Hostnamens fuer IRC. =item I Versionsangabe, die zurueckgegeben wird. =back =head1 ZUSAETZLICHE DUMMY OPTIONEN =over 4 =item I Bannertext, welcher an den Client gesendet wird, wenn dieser nach B Sekunden seit Aufbau der Verbindung noch keine Daten gesendet hat. Bei Angabe eines Leerstrings ("") wird nur CRLF gesendet. Diese Option ist nur wirksam, wenn B nicht auf den Wert '0' gesetzt ist. =item I Wurden innerhalb dieser Anzahl von Sekunden nach Aufbau einer neuen Verbindung noch keine Daten vom Client empfangen, wird der Bannertext B gesendet. Ein Wert von '0' schaltet diese Funktion ab. =back =head1 REDIRECT OPTIONEN =over 4 =item I Schaltet die Umleitung von Verbindungen ein oder aus. =item I Ist diese Option gesetzt, werden Verbindungen auf ungenutzte Ports zum Dummy-Dienst umgeleitet. =item I Angabe der IP-Adresse, welche als Quell-IP benutzt werden soll, wenn B Pakete wie ein Router in externe Netze weiterleitet. Die Angabe ist nur wirksam, wenn mittels B Regeln fuer die Umleitung von Paketen definiert sind. =item I Statische Regeln fuer die Umleitung von Verbindungen. =item I Aendert das Time-To-Live-Feld in ausgehenden IP-Paketen auf einen zufaelligen Wert. =item I Verbindungen zu auf diesen Port werden nicht umgeleitet. =item I Ist diese Option gesetzt, werden BOOTP (DHCP) Broadcasts nicht umgeleitet (UDP-Pakete von der Quell-Adresse 0.0.0.0, Port 68 an die Ziel-Adresse 255.255.255.255, Port 67 und umgekehrt). =item I Ist diese Option gesetzt, werden NetBIOS Broadcasts nicht umgeleitet (UDP-Pakete mit Quell- und Ziel-Port 137/138 und Ziel-Adresse x.x.x.255 im lokalen Netz). =item I Ist diese Option auf 'ms' gesetzt, werden ICMP-Timestamp-Anfragen mit der Anzahl von Millisekunden seit Mitternacht UTC entsprechend der Faketime beantwortet. Ist diese Option auf 'sec' gesetzt, werden ICMP-Timestamp-Anfragen mit der Anzahl von Sekunden seit der 'Epoche' beantwortet. Dabei wird das hoechstwertige Bit des Zeitstempels gesetzt, um einen Nicht-Standard-Wert zu signalisieren. Ist diese Option auf 'no' gesetzt, werden ICMP-Timestamp-Anfragen nicht veraendert. =back =head1 SSL OPTIONEN =over 4 =item I<[Dienstname]_ssl_keyfile DATEINAME> Name der PEM-Datei, welche den privaten SSL-Schluessel enthaelt. Der Schluessel darf nicht mit einem Passwort geschuetzt sein! =item I<[Dienstname]_ssl_certfile DATEINAME> Name der Datei, welche das SSL-Zertifikat enthaelt. =item I<[Dienstname]_ssl_dhfile DATEINAME> Name der PEM-Datei mit Diffie-Hellman-Parametern. =back =head1 SIEHE AUCH =over 4 B(1) =back =head1 AUTOREN S ESE, S ESE =cut inetsim-1.2.7/doc/inetsim.en.pod0000644000175000017500000000642713173076432014716 0ustar rgyrgy=pod =head1 NAME B - INetSim is a suite for simulating common internet services =head1 SYNOPSIS B [B<--config> >] [B<--version>] [B<--data-dir> >] [B<--log-dir> >] [B<--report-dir> >] [B<--bind-address> >] [B<--max-childs> >] [B<--user> >] [B<--faketime-init-delta> >] [B<--faketime-auto-delay> >] [B<--faketime-auto-incr> >] [B<--session> >] [B<--pidfile> >] =head1 DESCRIPTION B simulates common internet services like I, I, I or I. =head1 OPTIONS =over 4 =item B<--config> > The configuration file to use, default is conf/inetsim.conf in the current directory. =item B<--version> Output version information. =item B<--data-dir> > The data directory to use, default is data/ in the current directory. =item B<--log-dir> > The log directory to use, default is log/ in the current directory. =item B<--report-dir> > The report directory to use, default is report/ in the current directory. =item B<--bind-address> > The IP address to bind services to. =item B<--max-childs> > The maximum number of child processes (number of parallel connections) for each service. Default is 10. =item B<--user> > User to run services. Default is 'nobody'. =item B<--faketime-init-delta> > Initial number of seconds (positive or negative) relative to current date/time for fake time used by all services. This overrides the option 'faketime-init-delta' in the configuration file. Default is 0 (use current date/time). =item B<--faketime-auto-delay> > Number of seconds to wait before incrementing or decrementing fake time by amount of seconds specified with B. Setting to '0' disables this option. This overrides the option 'faketime-auto-delay' in the configuration file. Default is 0 (disabled). =item B<--faketime-auto-incr> > Number of seconds by which fake time is incremented or decremented at regular intervals specified by B. This option only takes effect if B is enabled (not set to '0'). This overrides the option 'faketime-auto-incr' in the configuration file. Default is 3600. =item B<--session> > Session name to use, default is the PID of the parent process. =item B<--pidfile> > The pid file to use, default is /var/run/inetsim.pid. =back =head1 EXAMPLES Start the simulation with session name 'simtest5' # inetsim --session simtest5 Start the simulation with a one-day-jump to the future after 60 seconds # inetsim --faketime-auto-delay 60 --faketime-auto-incr 86400 dito, but with jump to the past # inetsim --faketime-auto-delay 60 --faketime-auto-incr -86400 =head1 REQUIRES Perl 5, Getopt::Long, Net::Server, Net::DNS, IO::Handle, IO::Socket, IO::Select, IPC::Shareable, Digest::SHA, File::Copy, MIME::Base64, IPTables::IPv4::IPQueue (optional) =head1 AUTHOR S ESE, S ESE =cut inetsim-1.2.7/doc/inetsim.conf.en.pod0000644000175000017500000002037713173076432015642 0ustar rgyrgy=pod =head1 NAME inetsim.conf - Configuration file for INetSim =head1 DESCRIPTION I is the configuration file for B(1). The format of I is simple: one option per line, with blank lines and lines starting with # ignored. =head1 GLOBAL OPTIONS =over 4 =item I Start service SERVICE. =item I The IP address to bind services to. =item I User to run services. =item I Maximum number of child processes (number of parallel connections) for each service. =item I Timeout in seconds after which a connection is closed by the service. =item I<[servicename]_bind_port PORT> PORT number to bind service to. =item I Create report with a summary of connections for the session on shutdown. =item I Set language for reports. =back =head1 FAKETIME OPTIONS =over 4 =item I Initial number of seconds (positive or negative) relative to current date/time for fake time used by all services. If set to '0', current date/time is used. =item I Number of seconds to wait before incrementing/decrementing fake time by amount of seconds specified with B. Setting to '0' disables this option. =item I Number of seconds by which fake time is incremented/decremented at regular intervals specified by B. This option only takes effect if B is enabled (not set to '0'). =back =head1 ADDITIONAL DNS OPTIONS =over 4 =item I Default IP address to return in DNS replies. =item I Default hostname to return in DNS replies. =item I Default domainname to return in DNS replies. =item I Static mapping for DNS. =item I Version string to return. =back =head1 ADDITIONAL HTTP(S) OPTIONS =over 4 =item I Version string to return in HTTP(S) replies. =item I Turn HTTP(S) fake mode on or off. =item I The fake files returned in fake mode based on the file extension in the HTTP(S) request. =item I The default fake file and MIME type returned in fake mode if the file extension in the HTTP(S) request does not match any of the extensions defined with B. =item I The fake files returned in fake mode based on the path in the HTTP(S) request. =back =head1 ADDITIONAL SMTP(S) OPTIONS =over 4 =item I The banner string used in SMTP greeting message. =item I The FQDN hostname used for SMTP. =item I Client has to send HELO/EHLO before any other command. =item I Turn support for 'Extended SMTP' (ESMTP) on or off. =item I SMTP service extensions offered to client. =item I Only offer authentication mechanisms which allow reversing the authentication information sent by a client to clear text username/password. =item I Force the client to authenticate. =back =head1 ADDITIONAL POP3(S) OPTIONS =over 4 =item I The banner string used in POP3 greeting message. =item I The hostname used in POP3 greeting message. =item I Maximum number of e-mails to select from supplied mbox files for creation of random POP3 mailbox. =item I Re-read supplied mbox files if POP3 service was inactive for seconds. =item I Rebuild random POP3 mailbox if POP3 service was inactive for seconds. =item I Only offer authentication mechanisms which allow reversing the authentication information sent by a client to clear text username/password. =item I Turn APOP on or off. =item I Turn support for pop3 capabilities on or off. =item I POP3 capabilities offered to client. =back =head1 ADDITIONAL FTP(S) OPTIONS =over 4 =item I The banner string used in FTP greeting message. =item I Version string to return in replies to the STAT command. =item I Allow recursive deletion of directories, even if they are not empty. =back =head1 ADDITIONAL TFTP OPTIONS =over 4 =item I Allow overwriting of existing files. =item I Turn support for tftp options on or off. =item I TFTP options offered to client. =back =head1 ADDITIONAL NTP OPTIONS =over 4 =item I The IP address to return in NTP replies. =item I Turn strict checks for client packets on or off. =back =head1 ADDITIONAL IRC OPTIONS =over 4 =item I The FQDN hostname used for IRC. =item I Version string to return. =back =head1 ADDITIONAL DUMMY OPTIONS =over 4 =item I Banner string sent to client if no data has been received for B seconds since the client has established the connection. If set to an empty string (""), only CRLF will be sent. This option only takes effect if B is not set to '0'. =item I Number of seconds to wait for client sending any data after establishing a new connection. If no data has been received within this amount of time, B will be sent to the client. Setting to '0' disables sending of a banner string. =back =head1 REDIRECT OPTIONS =over 4 =item I Turn connection redirection on or off. =item I Redirect connection attempts to unbound ports to dummy service. =item I IP address used as source address if B acts as a router for redirecting packets to external networks. This option only takes effect if static rules for redirecting packets to external networks are defined (see B). =item I Static mappings for connection redirection. =item I Change the time-to-live header field to a random value in outgoing IP packets. =item I Connections to on this port are not redirected. =item I If set to 'yes', BOOTP (DHCP) broadcasts will not be redirected (UDP packets with source address 0.0.0.0, port 68 and destination address 255.255.255.255, port 67 or vice versa). =item I If set to 'yes', NetBIOS broadcasts will not be redirected (UDP packets with source/destination port 137/138 and destination address x.x.x.255 on the local network). =item I If set to 'ms', ICMP Timestamp requests will be answered with number of milliseconds since midnight UTC according to faketime. If set to 'sec', ICMP Timestamp requests will be answered with number of seconds since epoch (high order bit of the timestamp will be set to indicate non-standard value). Setting to 'no' disables manipulation of ICMP Timestamp requests. =back =head1 SSL OPTIONS =over 4 =item I<[servicename]_ssl_keyfile FILENAME> Name of the SSL private key PEM file. The key MUST NOT be encrypted! =item I<[servicename]_ssl_certfile FILENAME> Name of the SSL certificate file. =item I<[servicename]_ssl_dhfile FILENAME> Name of the Diffie-Hellman parameter PEM file. =back =head1 SEE ALSO =over 4 B(1) =back =head1 AUTHOR S ESE, S ESE =cut inetsim-1.2.7/LIESMICH0000644000175000017500000002761413173076432012515 0ustar rgyrgy---------------------------------------------------------------------- This 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 software 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 software. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ---------------------------------------------------------------------- 1. BESCHREIBUNG --------------- INetSim ist ein Programm zur Simulation von Internet-Diensten in einer Laborumgebung, z.B. zur Analyse des Netzwerkverhaltens unbekannter Schadprogramme. 1.1 Implementierte Dienst-Module Derzeit sind Module zur Simulation folgender Dienste im INetSim-Paket enthalten: - HTTP/HTTPS - "Real-Modus": Liefert existierende Dateien aus einem Webroot-Verzeichnis. - "Fake-Modus": Liefert konfigurierte Fake-Dateien basierend auf der Dateiendung in der HTTP-Anfrage (z.B. .html oder .exe) oder statischen Pfaden, Anfragen an checkip.dyndns.org werden mit der IP-Adresse des Clients beantwortet - unterstuetzt die Methoden GET, HEAD, POST und OPTIONS mit HTTP/1.0 und HTTP/1.1 - SMTP/SMTPS - empfangene E-Mails werden im mbox-Format gespeichert - unterstuetzt ESMTP und die flexible Konfiguration von "Service Extensions" - unterstuetzt die Authentifizierungsmethoden PLAIN, LOGIN, ANONYMOUS, CRAM-MD5 und CRAM-SHA1, beliebige Authentifizierungsdaten werden akzeptiert und im Klartext protokolliert - POP3/POP3S - dynamische Erzeugung zufaelliger Postfachinhalte aus mbox-Dateien - unterstuetzt die Authentifizierungsmethoden PLAIN, LOGIN und CRAM-MD5, beliebige Authentifizierungsdaten werden akzeptiert und im Klartext protokolliert - DNS - Vorwaerts- und Rueckwaertsaufloesung mit Standardeinstellungen und konfigurierbaren statischen Zuordnungen - FTP/FTPS - Download und Upload - erzeugt ein virtuelles Dateisystem basierend auf einem existierenden ftproot-Verzeichnis und ermoeglicht damit das Erstellen und Loeschen beliebiger Dateien - TFTP - Download und Upload - IRC - Basiskommandos - NTP - Ident - Finger - Syslog - "Small servers": - Daytime, - Time, - Echo, - Chargen, - Discard und - Quotd - Dummy Die Portnummer, auf der ein Dienst lauscht, kann fuer jeden Dienst unabhaengig konfiguriert werden. 1.2 Faketime INetSim kann in einem "Faketime"-Modus gestartet werden, um das Laufzeitverhalten von Schadprogrammen zu analysieren, die NTP oder Time/Daytime verwenden, um bestimmte Aktionen in Abhaengigkeit des aktuellen Datums und der Uhrzeit zu starten. Im "Faketime"-Modus antworten alle Dienste, die Informationen zum Datum und zur Uhrzeit liefern (z.B. NTP oder HTTP) mit einem gefaelschten Zeitstempel, welcher auf einem konfigurierbaren Delta zur aktuellen Systemzeit basiert. Optional kann dieses Delta automatisch in festgelegten Intervallen erhoeht bzw. verringert werden. 1.3 Umleitung von Verbindungen Zusaetzlich zur Umleitung von Verbindungen mittels gefaelschter DNS-Antworten ermoeglicht INetSim die IP-basierte Umleitung beliebiger Verbindungen (tcp, udp und icmp). Diese Funktion ist nur verfuegbar, wenn INetSim auf Linux-Plattformen mit Kernel-Unterstuetzung fuer "packet queueing" (Kernel-Option CONFIG_NETFILTER_NETLINK_QUEUE) eingesetzt wird. Diese Funktion unterstuetzt statische Regeln zur Umleitung von Verbindungen basierend auf Ziel-IP-Adresse, Portnummer und/oder Protokoll. Damit kann INetSim auch als NAT-Router zur Umleitung von Paketen an andere Systeme agieren. Optional kann der TTL-Wert von IP-Paketen, welche von verschiedenen "virtuellen" Verbindungszielen an die Clients gesendet werden, variiert werden, um den Datenverkehr authentischer aussehen zu lassen. Die Linux-Kernel-Versionen 3.5.0 und spaeter enthalten das Modul ip_queue nicht mehr, so dass diese Funktion nur unter aelteren Kernel-Versionen zur Verfuegung steht. 1.4 Dummy-Dienst Der Dummy-Dienst protokolliert lediglich alle Daten, die er von einem Client empfaengt. Dieses Modul ist nuetzlich in Verbindung mit der Umleitung von Verbindungen, um alle Daten mitzuschneiden, die von einem Client an Ports gesendet werden, die nicht an ein anderes Dienst-Modul gebunden sind. Optional kann ein konfigurierbarer Bannertext gesendet werden, wenn nach einer vorgegebenen Zeit seit dem Aufbau der Verbindung noch keine Daten vom Client empfangen wurden. Dies koennte z.B. bei der Analyse eines Schadprogramms nuetzlich sein, welches einen POP3- oder SMTP-Server auf einem ungewoehnlichen Port erwartet. 1.5 Protokollierung und Berichte Alle eingehenden Anfragen an die simulierten Dienste und die dazugehoerigen ausgehenden Antworten werden detailliert protokolliert. Nach Beenden einer INetSim-Sitzung wird optional ein zusaetzlicher Bericht (Report) fuer diese Sitzung mit einer Zusammenfassung der Verbindungen aus den Logdaten erzeugt. 2. VERFUEGBARKEIT ----------------- Die jeweils aktuelle Version von INetSim ist erhaeltlich unter 3. VORRAUSSETZUNGEN ------------------- - ein POSIX-kompatibles und System-V-IPC-faehiges Betriebssystem (z.B. Linux) - Perl in Version 5.006 oder neuer - Perl-Bibliothek Net::Server (available from http://search.cpan.org/~rhandom/Net-Server/) - Perl-Bibliothek Net::DNS (erhaeltlich unter http://search.cpan.org/~olaf/Net-DNS/) - Perl-Bibliothek IPC::Shareable (erhaeltlich unter http://search.cpan.org/~bsugars/IPC-Shareable/) - Perl-Bibliothek Digest::SHA (erhaeltlich unter http://search.cpan.org/~mshelor/Digest-SHA/) - Perl-Bibliothek IO::Socket::SSL (erhaeltlich unter http://search.cpan.org/~sullr/IO-Socket-SSL/) - zusaetzlich, zur Benutzung von IP-basierten Verbindungsumleitungen (nur auf Linux-Plattformen mit Kernel-Unterstuetzung fuer "packet queueing" verfuegbar): Perl-Bibliothek Perlipq (erhaeltlich unter http://search.cpan.org/~jmorris/perlipq/) Die aktuelle Version von INetSim wurde unter Debian GNU/Linux 7 (wheezy) und 8 (jessie) entwickelt und getestet. Es wurde berichtet, dass INetSim ebenfalls problemlos unter verschiedenen Versionen von Ubuntu, Gentoo Linux, FreeBSD und OpenBSD laeuft. Wenn INetSim bei Dir erfolgreich auf einem anderen System laeuft oder wenn Du Probleme hast, INetSim unter Systemen laufen zu lassen, die die oben genannten Voraussetzungen erfuellen, gib uns bitte einen Hinweis an . 4. INSTALLATION --------------- Lade Dir die aktuelle Version von INetSim von folgender Adresse herunter: . Stelle sicher, dass Perl und alle oben aufgefuehrten zusaetzlich benoetigten Module installiert sind. INetSim startet alle Dienste mit den Privilegien des Benutzers, welcher in der Konfigurationsdatei angegeben ist (standardmaessig 'nobody'). Vergewissere Dich, dass dieser Benutzer auf Deinem System existiert. INetSim fuehrt alle Dienste mit Privilegien der Gruppe 'inetsim' aus, daher muss eine Gruppe mit diesem Namen auf dem System eingerichtet werden. Unter Linux kann diese Gruppe z.B. als root mit dem Befehl 'groupadd inetsim' eingerichtet werden. Entpacke das heruntergeladene Archiv in ein Verzeichnis Deiner Wahl (z.B. /opt/inetsim). Wechsele in das Hauptverzeichnis des entpackten Archivs und fuehre das Skript 'setup.sh' als root aus. Dieses setzt einige benoetigte Rechte fuer Dateien und Verzeichnisse von INetSim. 5. KONFIGURATION ---------------- Fuer die Dokumentation der Konfiguration von INetSim lies bitte die Manual-Seite von 'inetsim.conf' im Unterverzeichnis 'man/de/man5' und die Kommentare in der Beispiel-Konfigurationsdatei 'conf/inetsim.conf', welche im Paket enthalten ist. 6. BENUTZUNG ------------ Um INetSim zu starten, wechsele in das Hauptverzeichnis des entpackten Archivs und fuehre das Startskript 'inetsim' als root aus. Fuer die Dokumentation der moeglichen Kommandozeilenoptionen des Startskripts lies bitte die Manual-Seite 'inetsim' im Unterverzeichnis 'man/de/man1'. INetSim benoetigt root-Rechte, um Sockets an Ports kleiner als 1024 zu binden. Nach dem Binden der Sockets werden die root-Rechte wie unter Punkt 'Installation' beschrieben geaendert. Derzeit kann das Startskript von INetSim nur mit root-Rechten ausgefuehrt werden - auch wenn keine Ports kleiner als 1024 zur Benutzung konfiguriert sind. Dies aendert sich moeglichweise in zukuenftigen Versionen. !! WICHTIGER HINWEIS fuer Benutzer von OpenBSD/FreeBSD: !! Der Standardwert fuer die maximale Anzahl von Semaphore-Identifikatoren unter OpenBSD/FreeBSD ist 10. INetSim benoetigt jedoch einige Semaphore- Identifikatoren mehr. Daher muss der entsprechende sysctl-Wert (kern.seminfo.semmni unter OpenBSD, kern.ipc.semmni unter FreeBSD) erhoeht werden. Ein Wert von 20 sollte ausreichend sein. Andernfalls bricht INetSim beim Start mit einer Fehlermeldung wie dieser ab: "Could not create semaphore set: No space left on device". 7. UEBER DIE AUTOREN -------------------- INetSim wurde entwickelt von Matthias Eckert und Thomas Hungenberg. Wir beide arbeiten im Bereich IT-Sicherheit und Teil unserer taeglichen Arbeit ist die Analyse von unbekannten Schadprogrammen. 8. UEBER DAS PROJEKT -------------------- Um in unserer Laborumgebung eine schnelle Laufzeitanalyse des Netzwerkverhaltens von Schadprogrammen zu ermoeglichen, brauchten wir ein Programm, das die Internet-Dienste simuliert, die haeufig von Schadprogrammen genutzt werden. Anfangs nutzten wir eine kleine Sammlung von selbst geschriebenen Perl-Skripten zusammen mit speziell konfigurierten Implementierungen von Server-Diensten wie Apache, Postfix, dnsmasq und ntpd, aber damit waren wir auf Dauer nicht zufrieden, da es eine Menge Einschraenkungen bei der Kombination der Programme gab (z.B. Probleme bei der Korrelation von Log-Daten). In Gespraechen mit anderen Sicherheitsfachleuten merkten wir, dass auch dort im Analyse-Bereich noch ein komfortables Programm zur Simulation verschiedener Internet-Dienste mit diversen Log- sowie zentralisierten Kontroll-Funktionen benoetigt wird. Also beschlossen wir, das Projekt 'INetSim' zu starten, um genau so etwas zu entwickeln. Da uns im Buero keine ausreichende Zeit dafuer zur Verfuegung stand, haben wir die Software in unserer Freizeit geschrieben. Wir beide benutzten Perl zwar bereits seit einigen Jahren, allerdings nur fuer kleine Skripte, zum Beispiel fuer die Auswertung von Logdaten. Das Projekt INetSim war eine willkommene Herausforderung, mehr praktische Erfahrung in der Perl-Programmierung zu bekommen und uns tiefgehend mit den verschiedenen Dienst-Spezifikationen (RFCs) zu befassen. Wir denken, dass INetSim vielen Leuten, die im Bereich IT-Sicherheit oder Netzwerkanalyse arbeiten, nuetzlich sein kann, so dass wir uns entschlossen haben haben, es der Gemeinschaft als freie Software - lizenziert unter der GNU General Public License (GPL) - zur Verfuegung zu stellen. Wir freuen uns ueber jegliche Rueckmeldung zum Einsatz von INetSim. Bitte sende Dein Feedback an . Bitte beachte: Da dies unser erstes groesseres Software-Projekt ist, welches wir in Perl geschrieben haben, ist der Code sicherlich verbesserungswuerdig. In der Zwischenzeit haben wir eine Menge mehr ueber die Benutzung von Referenzen, Paketen und Objekt-orientierte Programmierung in Perl gelernt, so dass der Code unseres naechsten Projekts deutlich besser sein wird. ;-) 9. COPYRIGHT ------------ Copyright (c) 2007-2016 Thomas Hungenberg & Matthias Eckert This software is licensed under the GNU General Public License (GPL). For more information read the file COPYING which should be included with this distribution. ---------------------------------------------------------------------- inetsim-1.2.7/man/0000755000175000017500000000000013173076432012136 5ustar rgyrgyinetsim-1.2.7/man/de/0000755000175000017500000000000013173076432012526 5ustar rgyrgyinetsim-1.2.7/man/de/man5/0000755000175000017500000000000013173076432013366 5ustar rgyrgyinetsim-1.2.7/man/de/man5/inetsim.conf.50000644000175000017500000004176413173076432016064 0ustar rgyrgy.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.28) .\" .\" Standard preamble: .\" ======================================================================== .de Sp \" Vertical space (when we can't use .PP) .if t .sp .5v .if n .sp .. .de Vb \" Begin verbatim text .ft CW .nf .ne \\$1 .. .de Ve \" End verbatim text .ft R .fi .. .\" Set up some character translations and predefined strings. \*(-- will .\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left .\" double quote, and \*(R" will give a right double quote. \*(C+ will .\" give a nicer C++. Capital omega is used to do unbreakable dashes and .\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, .\" nothing in troff, for use with C<>. .tr \(*W- .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' .ie n \{\ . ds -- \(*W- . ds PI pi . if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch . if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch . ds L" "" . ds R" "" . ds C` "" . ds C' "" 'br\} .el\{\ . ds -- \|\(em\| . ds PI \(*p . ds L" `` . ds R" '' . ds C` . ds C' 'br\} .\" .\" Escape single quotes in literal strings from groff's Unicode transform. .ie \n(.g .ds Aq \(aq .el .ds Aq ' .\" .\" If the F register is turned on, we'll generate index entries on stderr for .\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index .\" entries marked with X<> in POD. Of course, you'll have to process the .\" output yourself in some meaningful fashion. .\" .\" Avoid warning from groff about undefined register 'F'. .de IX .. .nr rF 0 .if \n(.g .if rF .nr rF 1 .if (\n(rF:(\n(.g==0)) \{ . if \nF \{ . de IX . tm Index:\\$1\t\\n%\t"\\$2" .. . if !\nF==2 \{ . nr % 0 . nr F 2 . \} . \} .\} .rr rF .\" .\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). .\" Fear. Run. Save yourself. No user-serviceable parts. . \" fudge factors for nroff and troff .if n \{\ . ds #H 0 . ds #V .8m . ds #F .3m . ds #[ \f1 . ds #] \fP .\} .if t \{\ . ds #H ((1u-(\\\\n(.fu%2u))*.13m) . ds #V .6m . ds #F 0 . ds #[ \& . ds #] \& .\} . \" simple accents for nroff and troff .if n \{\ . ds ' \& . ds ` \& . ds ^ \& . ds , \& . ds ~ ~ . ds / .\} .if t \{\ . ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" . ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' . ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' . ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' . ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' . ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' .\} . \" troff and (daisy-wheel) nroff accents .ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' .ds 8 \h'\*(#H'\(*b\h'-\*(#H' .ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] .ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' .ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' .ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] .ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] .ds ae a\h'-(\w'a'u*4/10)'e .ds Ae A\h'-(\w'A'u*4/10)'E . \" corrections for vroff .if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' .if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' . \" for low resolution devices (crt and lpr) .if \n(.H>23 .if \n(.V>19 \ \{\ . ds : e . ds 8 ss . ds o a . ds d- d\h'-1'\(ga . ds D- D\h'-1'\(hy . ds th \o'bp' . ds Th \o'LP' . ds ae ae . ds Ae AE .\} .rm #[ #] #H #V #F C .\" ======================================================================== .\" .IX Title "inetsim.conf 5" .TH inetsim.conf 5 "2017-10-22" "perl v5.20.2" " " .\" For nroff, turn off justification. Always turn off hyphenation; it makes .\" way too many mistakes in technical documents. .if n .ad l .nh .SH "NAME" inetsim.conf \- Konfigurationsdatei fuer INetSim .SH "BESCHREIBUNG" .IX Header "BESCHREIBUNG" \&\fIinetsim.conf\fR ist die Konfigurationsdatei fuer \fBinetsim\fR(1). .PP Das Format von \fIinetsim.conf\fR ist simpel: eine Option pro Zeile, wobei Leerzeilen und Zeilen, die mit # beginnen, ignoriert werden. .SH "GLOBALE OPTIONEN" .IX Header "GLOBALE OPTIONEN" .IP "\fIstart_service \s-1DIENST\s0\fR" 4 .IX Item "start_service DIENST" Startet den Dienst \s-1DIENST.\s0 .IP "\fIservice_bind_address IP-ADRESSE\fR" 4 .IX Item "service_bind_address IP-ADRESSE" Angabe der IP-Adresse, auf welcher die Dienste lauschen sollen. .IP "\fIservice_run_as_user \s-1BENUTZER\s0\fR" 4 .IX Item "service_run_as_user BENUTZER" Angabe des Benutzers, unter welchem die Dienste laufen sollen. .IP "\fIservice_max_childs \s-1ANZAHL\s0\fR" 4 .IX Item "service_max_childs ANZAHL" Angabe der maximalen Anzahl der gestarteten Kindprozesse (Anzahl paralleler Verbindungen) fuer jeden Dienst. .IP "\fIservice_timeout \s-1SEKUNDEN\s0\fR" 4 .IX Item "service_timeout SEKUNDEN" Angabe der Zeit in Sekunden, nach welcher inaktive Verbindungen geschlossen werden. .IP "\fI[Dienstname]_bind_port \s-1PORT\s0\fR" 4 .IX Item "[Dienstname]_bind_port PORT" Angabe des Ports fuer den angegebenen Dienst. .IP "\fIcreate_reports [YES|NO]\fR" 4 .IX Item "create_reports [YES|NO]" Erstelle einen Report mit einer Zusammenfassung der Verbindungen der Sitzung beim Beenden von INetSim. .IP "\fIreport_language \s-1SPRACHKUERZEL\s0\fR" 4 .IX Item "report_language SPRACHKUERZEL" Erstelle Reports in der angegebenen Sprache. .SH "FAKETIME OPTIONEN" .IX Header "FAKETIME OPTIONEN" .IP "\fIfaketime_init_delta \s-1SEKUNDEN\s0\fR" 4 .IX Item "faketime_init_delta SEKUNDEN" Angabe der anfaenglichen Zeitdifferenz in Sekunden (positiv oder negativ) relativ zum aktuellen Datum bzw. zur aktuellen Uhrzeit. Die Zeitdifferenz wird von allen Diensten beruecksichtigt. Ist dieser Wert auf '0' gesetzt, wird das aktuelle Datum bzw. die aktuelle Uhrzeit verwendet. .IP "\fIfaketime_auto_delay \s-1SEKUNDEN\s0\fR" 4 .IX Item "faketime_auto_delay SEKUNDEN" Angabe der Zeitverzoegerung in Sekunden, nach welcher die Zeitdifferenz regelmaessig entsprechend dem bei \fBfaketime_auto_increment\fR eingestellten Wert erhoeht oder verringert wird. Ein Wert von '0' schaltet diese Funktion ab. .IP "\fIfaketime_auto_increment \s-1SEKUNDEN\s0\fR" 4 .IX Item "faketime_auto_increment SEKUNDEN" Angabe der Schrittweite in Sekunden, um welche die Zeit in regelmaessigen Abstaenden erhoeht oder verringert wird. Diese Option ist nur wirksam, wenn bei \fBfaketime_auto_delay\fR die Zeitverzoegerung eingeschaltet ist (nicht auf '0' gesetzt). .SH "ZUSAETZLICHE DNS OPTIONEN" .IX Header "ZUSAETZLICHE DNS OPTIONEN" .IP "\fIdns_default_ip IP-ADRESSE\fR" 4 .IX Item "dns_default_ip IP-ADRESSE" IP-Adresse, die als Standard in DNS-Antworten zurueckgegeben wird. .IP "\fIdns_default_hostname \s-1HOSTNAME\s0\fR" 4 .IX Item "dns_default_hostname HOSTNAME" Hostname, der als Standard in DNS-Antworten zurueckgegeben wird. .IP "\fIdns_default_domainname \s-1DOMAINNAME\s0\fR" 4 .IX Item "dns_default_domainname DOMAINNAME" Domainname, der als Standard in DNS-Antworten zurueckgegeben wird. .IP "\fIdns_static \s-1FQDN_HOSTNAME\s0 IP-ADRESSE\fR" 4 .IX Item "dns_static FQDN_HOSTNAME IP-ADRESSE" Abbilden statischer Eintraege fuer \s-1DNS.\s0 .IP "\fIdns_version \s-1STRING\s0\fR" 4 .IX Item "dns_version STRING" Versionsangabe, die zurueckgegeben wird. .SH "ZUSAETZLICHE HTTP(S) OPTIONEN" .IX Header "ZUSAETZLICHE HTTP(S) OPTIONEN" .IP "\fIhttp(s)_version \s-1STRING\s0\fR" 4 .IX Item "http(s)_version STRING" Version, welche in HTTP-Antworten ausgegeben wird. .IP "\fIhttp(s)_fakemode [YES|NO]\fR" 4 .IX Item "http(s)_fakemode [YES|NO]" Schaltet fuer \s-1HTTP\s0 den Fake-Modus ein oder aus. .IP "\fIhttp(s)_fakefile \s-1ERWEITERUNG DATEINAME MIMETYP\s0\fR" 4 .IX Item "http(s)_fakefile ERWEITERUNG DATEINAME MIMETYP" Angabe der Datei und des MIME-Typs, welche basierend auf der Dateierweiterung in der HTTP-Anfrage zurueckgegeben werden. .IP "\fIhttp(s)_default_fakefile \s-1DATEINAME MIMETYP\s0\fR" 4 .IX Item "http(s)_default_fakefile DATEINAME MIMETYP" Angabe der Standarddatei und des Standard-MIME-Typs, welche zurueckgegeben werden, wenn zur Dateierweiterung der HTTP-Anfrage kein passender Eintrag mit \fBhttp_fakefile\fR definiert ist. .IP "\fIhttp(s)_static_fakefile \s-1PFAD DATEINAME MIMETYP\s0\fR" 4 .IX Item "http(s)_static_fakefile PFAD DATEINAME MIMETYP" Angabe der Datei und des MIME-Typs, welche basierend auf dem zugehoerigen Pfad in der HTTP-Anfrage zurueckgegeben werden. .SH "ZUSAETZLICHE SMTP(S) OPTIONEN" .IX Header "ZUSAETZLICHE SMTP(S) OPTIONEN" .IP "\fIsmtp(s)_banner \s-1STRING\s0\fR" 4 .IX Item "smtp(s)_banner STRING" Angabe des Bannertextes, der in der SMTP-Grussmeldung benutzt wird. .IP "\fIsmtp(s)_fqdn_hostname \s-1FQDN_HOSTNAME\s0\fR" 4 .IX Item "smtp(s)_fqdn_hostname FQDN_HOSTNAME" Angabe des FQDN-Hostnamens fuer \s-1SMTP.\s0 .IP "\fIsmtp(s)_helo_required [YES|NO]\fR" 4 .IX Item "smtp(s)_helo_required [YES|NO]" Angabe, ob der Client \s-1HELO/EHLO\s0 vor allen anderen Kommandos senden muss. .IP "\fIsmtp(s)_extended_smtp\fR" 4 .IX Item "smtp(s)_extended_smtp" Schaltet die Unterstuetzung fuer 'Erweitertes \s-1SMTP\s0' (\s-1ESMTP\s0) ein oder aus. .IP "\fIsmtp(s)_service_extension \s-1ERWEITERUNG\s0 [\s-1PARAMETER\s0]\fR" 4 .IX Item "smtp(s)_service_extension ERWEITERUNG [PARAMETER]" \&\s-1SMTP \s0'service extensions', welche dem Client angeboten werden. .IP "\fIsmtp(s)_auth_reversibleonly [YES|NO]\fR" 4 .IX Item "smtp(s)_auth_reversibleonly [YES|NO]" Biete nur Authentifizierungsmechanismen an, die eine Rueckwandlung der vom Client gesendeten Authentifizierungsinformationen in einen Benutzernamen und ein Passwort im Klartext ermoeglichen. .IP "\fIsmtp(s)_auth_required [YES|NO]\fR" 4 .IX Item "smtp(s)_auth_required [YES|NO]" Zwinge den Client zur Authentifizierung. .SH "ZUSAETZLICHE POP3(S) OPTIONEN" .IX Header "ZUSAETZLICHE POP3(S) OPTIONEN" .IP "\fIpop3(s)_banner \s-1STRING\s0\fR" 4 .IX Item "pop3(s)_banner STRING" Angabe des Bannertextes, der in der POP3\-Grussmeldung benutzt wird. .IP "\fIpop3(s)_hostname \s-1HOSTNAME\s0\fR" 4 .IX Item "pop3(s)_hostname HOSTNAME" Angabe des Hostnamens, der in der POP3\-Grussmeldung benutzt wird. .IP "\fIpop3(s)_mbox_maxmails \s-1ANZAHL\s0\fR" 4 .IX Item "pop3(s)_mbox_maxmails ANZAHL" Maximale Anzahl der E\-Mails, die aus den zur Verfuegung stehenden mbox-Dateien fuer die dynamische Erzeugung der POP3\-Mailbox verwendet werden. .IP "\fIpop3(s)_mbox_reread \s-1ANZAHL\s0\fR" 4 .IX Item "pop3(s)_mbox_reread ANZAHL" Neueinlesen der zur Verfuegung stehenden mbox-Dateien, wenn der POP3\-Dienst waehrend der angegebenen Anzahl an Sekunden nicht benutzt wurde. .IP "\fIpop3(s)_mbox_rebuild \s-1ANZAHL\s0\fR" 4 .IX Item "pop3(s)_mbox_rebuild ANZAHL" Neuerzeugung der POP3\-Mailbox, wenn der POP3\-Dienst waehrend der angegebenen Anzahl an Sekunden nicht benutzt wurde. .IP "\fIpop3(s)_auth_reversibleonly [YES|NO]\fR" 4 .IX Item "pop3(s)_auth_reversibleonly [YES|NO]" Biete nur Authentifizierungsmechanismen an, die eine Rueckwandlung der vom Client gesendeten Authentifizierungsinformationen in einen Benutzernamen und ein Passwort im Klartext ermoeglichen. .IP "\fIpop3(s)_enable_apop [YES|NO]\fR" 4 .IX Item "pop3(s)_enable_apop [YES|NO]" Schaltet die Unterstuetzung von \s-1APOP\s0 ein oder aus. .IP "\fIpop3(s)_enable_capabilities [YES|NO]\fR" 4 .IX Item "pop3(s)_enable_capabilities [YES|NO]" Schaltet die Unterstuetzung von \s-1POP3 \s0'capabilities' ein oder aus. .IP "\fIpop3(s)_capability \s-1CAPABILITY\s0 [\s-1PARAMETER\s0]\fR>" 4 .IX Item "pop3(s)_capability CAPABILITY [PARAMETER]>" \&\s-1POP3 \s0'capabilities', die dem Client angeboten werden. .SH "ZUSAETZLICHE FTP(S) OPTIONEN" .IX Header "ZUSAETZLICHE FTP(S) OPTIONEN" .IP "\fIftp(s)_banner \s-1STRING\s0\fR" 4 .IX Item "ftp(s)_banner STRING" Angabe des Bannertextes, der in der FTP-Grussmeldung benutzt wird. .IP "\fIftp(s)_version \s-1STRING\s0\fR" 4 .IX Item "ftp(s)_version STRING" Versionsangabe, die in Antworten auf das STAT-Kommando zurueckgegeben wird. .IP "\fIftp(s)_recursive_delete [YES|NO]\fR" 4 .IX Item "ftp(s)_recursive_delete [YES|NO]" Erlaube das rekursive Loeschen von Verzeichnissen, auch wenn diese nicht leer sind. .SH "ADDITIONAL TFTP OPTIONS" .IX Header "ADDITIONAL TFTP OPTIONS" .IP "\fItftp_allow_overwrite [YES|NO]\fR" 4 .IX Item "tftp_allow_overwrite [YES|NO]" Erlaube das Ueberschreiben vorhandener Dateien. .IP "\fItftp_enable_options [YES|NO]\fR" 4 .IX Item "tftp_enable_options [YES|NO]" Schaltet die Unterstuetzung von TFTP-Optionen ein oder aus. .IP "\fItftp_option \s-1OPTION PARAMETER\s0\fR" 4 .IX Item "tftp_option OPTION PARAMETER" TFTP-Optionen, die dem Client angeboten werden. .SH "ZUSAETZLICHE NTP OPTIONEN" .IX Header "ZUSAETZLICHE NTP OPTIONEN" .IP "\fIntp_server_ip IP-ADRESSE\fR" 4 .IX Item "ntp_server_ip IP-ADRESSE" Angabe der IP-Adresse, welche in NTP-Antworten zurueckgegeben wird. .IP "\fIntp_strict_checks [YES|NO]\fR" 4 .IX Item "ntp_strict_checks [YES|NO]" Schaltet strenge Tests fuer Client-Pakete ein oder aus. .SH "ZUSAETZLICHE IRC OPTIONEN" .IX Header "ZUSAETZLICHE IRC OPTIONEN" .IP "\fIirc_fqdn_hostname \s-1FQDN_HOSTNAME\s0\fR" 4 .IX Item "irc_fqdn_hostname FQDN_HOSTNAME" Angabe des FQDN-Hostnamens fuer \s-1IRC.\s0 .IP "\fIirc_version \s-1STRING\s0\fR" 4 .IX Item "irc_version STRING" Versionsangabe, die zurueckgegeben wird. .SH "ZUSAETZLICHE DUMMY OPTIONEN" .IX Header "ZUSAETZLICHE DUMMY OPTIONEN" .IP "\fIdummy_banner \s-1STRING\s0\fR" 4 .IX Item "dummy_banner STRING" Bannertext, welcher an den Client gesendet wird, wenn dieser nach \fBdummy_banner_wait\fR Sekunden seit Aufbau der Verbindung noch keine Daten gesendet hat. Bei Angabe eines Leerstrings ("") wird nur \s-1CRLF\s0 gesendet. Diese Option ist nur wirksam, wenn \&\fBdummy_banner_wait\fR nicht auf den Wert '0' gesetzt ist. .IP "\fIdummy_banner_wait \s-1ANZAHL\s0\fR" 4 .IX Item "dummy_banner_wait ANZAHL" Wurden innerhalb dieser Anzahl von Sekunden nach Aufbau einer neuen Verbindung noch keine Daten vom Client empfangen, wird der Bannertext \fBdummy_banner\fR gesendet. Ein Wert von '0' schaltet diese Funktion ab. .SH "REDIRECT OPTIONEN" .IX Header "REDIRECT OPTIONEN" .IP "\fIredirect_enabled [YES|NO]\fR" 4 .IX Item "redirect_enabled [YES|NO]" Schaltet die Umleitung von Verbindungen ein oder aus. .IP "\fIredirect_unknown_services [YES|NO]\fR" 4 .IX Item "redirect_unknown_services [YES|NO]" Ist diese Option gesetzt, werden Verbindungen auf ungenutzte Ports zum Dummy-Dienst umgeleitet. .IP "\fIredirect_external_address IP-ADRESSE\fR" 4 .IX Item "redirect_external_address IP-ADRESSE" Angabe der IP-Adresse, welche als Quell-IP benutzt werden soll, wenn \&\fBINetSim\fR Pakete wie ein Router in externe Netze weiterleitet. Die Angabe ist nur wirksam, wenn mittels \fBredirect_static_rule\fR Regeln fuer die Umleitung von Paketen definiert sind. .IP "\fIredirect_static_rule \s-1PROTOKOLL IP\-ADRESSE:PORT IP\-ADRESSE:PORT\s0\fR" 4 .IX Item "redirect_static_rule PROTOKOLL IP-ADRESSE:PORT IP-ADRESSE:PORT" Statische Regeln fuer die Umleitung von Verbindungen. .IP "\fIredirect_change_ttl [YES|NO]\fR" 4 .IX Item "redirect_change_ttl [YES|NO]" Aendert das Time-To-Live-Feld in ausgehenden IP-Paketen auf einen zufaelligen Wert. .IP "\fIredirect_exclude_port \s-1PROTOKOLL:PORT\s0\fR" 4 .IX Item "redirect_exclude_port PROTOKOLL:PORT" Verbindungen zu auf diesen Port werden nicht umgeleitet. .IP "\fIredirect_ignore_bootp [YES|NO]\fR" 4 .IX Item "redirect_ignore_bootp [YES|NO]" Ist diese Option gesetzt, werden \s-1BOOTP \s0(\s-1DHCP\s0) Broadcasts nicht umgeleitet (UDP-Pakete von der Quell-Adresse 0.0.0.0, Port 68 an die Ziel-Adresse 255.255.255.255, Port 67 und umgekehrt). .IP "\fIredirect_ignore_netbios [YES|NO]\fR" 4 .IX Item "redirect_ignore_netbios [YES|NO]" Ist diese Option gesetzt, werden NetBIOS Broadcasts nicht umgeleitet (UDP-Pakete mit Quell\- und Ziel-Port 137/138 und Ziel-Adresse x.x.x.255 im lokalen Netz). .IP "\fIredirect_icmp_timestamp [MS|SEC|NO]\fR" 4 .IX Item "redirect_icmp_timestamp [MS|SEC|NO]" Ist diese Option auf 'ms' gesetzt, werden ICMP-Timestamp-Anfragen mit der Anzahl von Millisekunden seit Mitternacht \s-1UTC\s0 entsprechend der Faketime beantwortet. Ist diese Option auf 'sec' gesetzt, werden ICMP-Timestamp-Anfragen mit der Anzahl von Sekunden seit der 'Epoche' beantwortet. Dabei wird das hoechstwertige Bit des Zeitstempels gesetzt, um einen Nicht-Standard-Wert zu signalisieren. Ist diese Option auf 'no' gesetzt, werden ICMP-Timestamp-Anfragen nicht veraendert. .SH "SSL OPTIONEN" .IX Header "SSL OPTIONEN" .IP "\fI[Dienstname]_ssl_keyfile \s-1DATEINAME\s0\fR" 4 .IX Item "[Dienstname]_ssl_keyfile DATEINAME" Name der PEM-Datei, welche den privaten SSL-Schluessel enthaelt. Der Schluessel darf nicht mit einem Passwort geschuetzt sein! .IP "\fI[Dienstname]_ssl_certfile \s-1DATEINAME\s0\fR" 4 .IX Item "[Dienstname]_ssl_certfile DATEINAME" Name der Datei, welche das SSL-Zertifikat enthaelt. .IP "\fI[Dienstname]_ssl_dhfile \s-1DATEINAME\s0\fR" 4 .IX Item "[Dienstname]_ssl_dhfile DATEINAME" Name der PEM-Datei mit Diffie-Hellman-Parametern. .SH "SIEHE AUCH" .IX Header "SIEHE AUCH" .RS 4 \&\fBinetsim\fR(1) .RE .SH "AUTOREN" .IX Header "AUTOREN" Matthias\ Eckert , Thomas\ Hungenberg inetsim-1.2.7/man/de/man1/0000755000175000017500000000000013173076432013362 5ustar rgyrgyinetsim-1.2.7/man/de/man1/inetsim.10000644000175000017500000002077213173076432015124 0ustar rgyrgy.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.28) .\" .\" Standard preamble: .\" ======================================================================== .de Sp \" Vertical space (when we can't use .PP) .if t .sp .5v .if n .sp .. .de Vb \" Begin verbatim text .ft CW .nf .ne \\$1 .. .de Ve \" End verbatim text .ft R .fi .. .\" Set up some character translations and predefined strings. \*(-- will .\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left .\" double quote, and \*(R" will give a right double quote. \*(C+ will .\" give a nicer C++. Capital omega is used to do unbreakable dashes and .\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, .\" nothing in troff, for use with C<>. .tr \(*W- .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' .ie n \{\ . ds -- \(*W- . ds PI pi . if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch . if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch . ds L" "" . ds R" "" . ds C` "" . ds C' "" 'br\} .el\{\ . ds -- \|\(em\| . ds PI \(*p . ds L" `` . ds R" '' . ds C` . ds C' 'br\} .\" .\" Escape single quotes in literal strings from groff's Unicode transform. .ie \n(.g .ds Aq \(aq .el .ds Aq ' .\" .\" If the F register is turned on, we'll generate index entries on stderr for .\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index .\" entries marked with X<> in POD. Of course, you'll have to process the .\" output yourself in some meaningful fashion. .\" .\" Avoid warning from groff about undefined register 'F'. .de IX .. .nr rF 0 .if \n(.g .if rF .nr rF 1 .if (\n(rF:(\n(.g==0)) \{ . if \nF \{ . de IX . tm Index:\\$1\t\\n%\t"\\$2" .. . if !\nF==2 \{ . nr % 0 . nr F 2 . \} . \} .\} .rr rF .\" .\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). .\" Fear. Run. Save yourself. No user-serviceable parts. . \" fudge factors for nroff and troff .if n \{\ . ds #H 0 . ds #V .8m . ds #F .3m . ds #[ \f1 . ds #] \fP .\} .if t \{\ . ds #H ((1u-(\\\\n(.fu%2u))*.13m) . ds #V .6m . ds #F 0 . ds #[ \& . ds #] \& .\} . \" simple accents for nroff and troff .if n \{\ . ds ' \& . ds ` \& . ds ^ \& . ds , \& . ds ~ ~ . ds / .\} .if t \{\ . ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" . ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' . ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' . ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' . ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' . ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' .\} . \" troff and (daisy-wheel) nroff accents .ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' .ds 8 \h'\*(#H'\(*b\h'-\*(#H' .ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] .ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' .ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' .ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] .ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] .ds ae a\h'-(\w'a'u*4/10)'e .ds Ae A\h'-(\w'A'u*4/10)'E . \" corrections for vroff .if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' .if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' . \" for low resolution devices (crt and lpr) .if \n(.H>23 .if \n(.V>19 \ \{\ . ds : e . ds 8 ss . ds o a . ds d- d\h'-1'\(ga . ds D- D\h'-1'\(hy . ds th \o'bp' . ds Th \o'LP' . ds ae ae . ds Ae AE .\} .rm #[ #] #H #V #F C .\" ======================================================================== .\" .IX Title "inetsim 1" .TH inetsim 1 "2017-10-22" "perl v5.20.2" " " .\" For nroff, turn off justification. Always turn off hyphenation; it makes .\" way too many mistakes in technical documents. .if n .ad l .nh .SH "NAME" inetsim \- Programm zur Simulation von Internet\-Diensten .SH "UEBERSICHT" .IX Header "UEBERSICHT" \&\fBinetsim\fR [\fB\-\-config\fR <\fIKonfigurationsdatei\fR>] [\fB\-\-version\fR] [\fB\-\-data\-dir\fR <\fIDatenverzeichnis\fR>] [\fB\-\-log\-dir\fR <\fILogverzeichnis\fR>] [\fB\-\-report\-dir\fR <\fIReportverzeichnis\fR>] [\fB\-\-bind\-address\fR <\fIIP-Adresse\fR>] [\fB\-\-max\-childs\fR <\fImaximale Anzahl der Kindprozesse\fR>] [\fB\-\-user\fR <\fIBenutzername\fR>] [\fB\-\-faketime\-init\-delta\fR <\fIanfaengliche Zeitdifferenz\fR>] [\fB\-\-faketime\-auto\-delay\fR <\fIZeitverzoegerung\fR>] [\fB\-\-faketime\-auto\-incr\fR <\fISchrittweite\fR>] [\fB\-\-session\fR <\fIName der Sitzung\fR>] [\fB\-\-pidfile\fR <\fIPID-Datei\fR>] .SH "BESCHREIBUNG" .IX Header "BESCHREIBUNG" \&\fBINetSim\fR simuliert gaengige Internet-Dienste wie \&\fI\s-1DNS\s0\fR, \fI\s-1HTTP\s0\fR, \fI\s-1SMTP\s0\fR oder \fI\s-1POP3\s0\fR. .SH "OPTIONEN" .IX Header "OPTIONEN" .IP "\fB\-\-config\fR <\fIKonfigurationsdatei\fR>" 4 .IX Item "--config " Angabe einer alternativen Konfigurationsdatei. Standard ist conf/inetsim.conf im aktuellen Verzeichnis. .IP "\fB\-\-version\fR" 4 .IX Item "--version" Ausgabe der Versionsinformation. .IP "\fB\-\-data\-dir\fR <\fIDatenverzeichnis\fR>" 4 .IX Item "--data-dir " Angabe eines alternativen Datenverzeichnisses. Standard ist data/ im aktuellen Verzeichnis. .IP "\fB\-\-log\-dir\fR <\fILogverzeichnis\fR>" 4 .IX Item "--log-dir " Angabe eines alternativen Logverzeichnisses. Standard ist log/ im aktuellen Verzeichnis. .IP "\fB\-\-report\-dir\fR <\fIReportverzeichnis\fR>" 4 .IX Item "--report-dir " Angabe eines alternativen Reportverzeichnisses. Standard ist report/ im aktuellen Verzeichnis. .IP "\fB\-\-bind\-address\fR <\fIIP-Adresse\fR>" 4 .IX Item "--bind-address " Angabe der IP-Adresse, unter welcher die Dienste lauschen sollen. .IP "\fB\-\-max\-childs\fR <\fImaximale Anzahl der Kindprozesse\fR>" 4 .IX Item "--max-childs " Angabe der maximalen Anzahl der gestarteten Kindprozesse (Anzahl paralleler Verbindungen) fuer jeden Dienst. Standard ist 10. .IP "\fB\-\-user\fR <\fIBenutzername\fR>" 4 .IX Item "--user " Angabe eines alternativen Benutzers, unter welchem die Dienste laufen sollen. Standard ist nobody. .IP "\fB\-\-faketime\-init\-delta\fR <\fIanfaengliche Zeitdifferenz\fR>" 4 .IX Item "--faketime-init-delta " Angabe der anfaenglichen Zeitdifferenz in Sekunden (positiv oder negativ) \- relativ zum aktuellen Datum bzw. zur aktuellen Uhrzeit. Diese wird anstelle des Wertes aus der Konfigurationsdatei verwendet. Hinweis: Die Zeitdifferenz wird von allen Diensten beruecksichtigt. Standard ist 0 (aktuelles Datum/aktuelle Uhrzeit). .IP "\fB\-\-faketime\-auto\-delay\fR <\fIZeitverzoegerung\fR>" 4 .IX Item "--faketime-auto-delay " Angabe der Zeitverzoegerung in Sekunden, nach welcher die Zeitdifferenz regelmaessig entsprechend dem bei \fB\-\-faketime\-auto\-incr\fR eingestellten Wert erhoeht oder verringert wird. Ein Wert von '0' schaltet diese Funktion ab. Standard ist 0 (ausgeschaltet). .IP "\fB\-\-faketime\-auto\-incr\fR <\fISchrittweite\fR>" 4 .IX Item "--faketime-auto-incr " Angabe der Schrittweite in Sekunden, um welche die Zeit in regelmaessigen Abstaenden erhoeht oder verringert wird. Diese Option ist nur wirksam, wenn bei \fB\-\-faketime\-auto\-delay\fR die Zeitverzoegerung eingeschaltet ist (nicht auf '0' gesetzt). Standard ist 3600. .IP "\fB\-\-session\fR <\fIName der Sitzung\fR>" 4 .IX Item "--session " Angabe eines alternativen Sitzungsnamens. Standard ist die Prozess-ID des Hauptprogramms. .IP "\fB\-\-pidfile\fR <\fIPID-Datei\fR>" 4 .IX Item "--pidfile " Angabe einer alternativen PID-Datei. Standard ist /var/run/inetsim.pid. .SH "BEISPIELE" .IX Header "BEISPIELE" Simulation mit Sitzungsnamen 'simtest5' starten .PP .Vb 1 \& # inetsim \-\-session simtest5 .Ve .PP Simulation mit Zeitsprung von einem Tag in die Zukunft nach jeweils 60 Sekunden starten .PP .Vb 1 \& # inetsim \-\-faketime\-auto\-delay 60 \-\-faketime\-auto\-incr 86400 .Ve .PP dito, jedoch mit Zeitsprung in die Vergangenheit .PP .Vb 1 \& # inetsim \-\-faketime\-auto\-delay 60 \-\-faketime\-auto\-incr \-86400 .Ve .SH "BENOETIGT" .IX Header "BENOETIGT" Perl 5, Getopt::Long, Net::Server, Net::DNS, IO::Handle, IO::Socket, IO::Select, IPC::Shareable, Digest::SHA, File::Copy, MIME::Base64, IPTables::IPv4::IPQueue (optional) .SH "AUTOREN" .IX Header "AUTOREN" Matthias\ Eckert , Thomas\ Hungenberg inetsim-1.2.7/man/man5/0000755000175000017500000000000013173076432012776 5ustar rgyrgyinetsim-1.2.7/man/man5/inetsim.conf.50000644000175000017500000003726113173076432015471 0ustar rgyrgy.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.28) .\" .\" Standard preamble: .\" ======================================================================== .de Sp \" Vertical space (when we can't use .PP) .if t .sp .5v .if n .sp .. .de Vb \" Begin verbatim text .ft CW .nf .ne \\$1 .. .de Ve \" End verbatim text .ft R .fi .. .\" Set up some character translations and predefined strings. \*(-- will .\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left .\" double quote, and \*(R" will give a right double quote. \*(C+ will .\" give a nicer C++. Capital omega is used to do unbreakable dashes and .\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, .\" nothing in troff, for use with C<>. .tr \(*W- .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' .ie n \{\ . ds -- \(*W- . ds PI pi . if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch . if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch . ds L" "" . ds R" "" . ds C` "" . ds C' "" 'br\} .el\{\ . ds -- \|\(em\| . ds PI \(*p . ds L" `` . ds R" '' . ds C` . ds C' 'br\} .\" .\" Escape single quotes in literal strings from groff's Unicode transform. .ie \n(.g .ds Aq \(aq .el .ds Aq ' .\" .\" If the F register is turned on, we'll generate index entries on stderr for .\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index .\" entries marked with X<> in POD. Of course, you'll have to process the .\" output yourself in some meaningful fashion. .\" .\" Avoid warning from groff about undefined register 'F'. .de IX .. .nr rF 0 .if \n(.g .if rF .nr rF 1 .if (\n(rF:(\n(.g==0)) \{ . if \nF \{ . de IX . tm Index:\\$1\t\\n%\t"\\$2" .. . if !\nF==2 \{ . nr % 0 . nr F 2 . \} . \} .\} .rr rF .\" .\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). .\" Fear. Run. Save yourself. No user-serviceable parts. . \" fudge factors for nroff and troff .if n \{\ . ds #H 0 . ds #V .8m . ds #F .3m . ds #[ \f1 . ds #] \fP .\} .if t \{\ . ds #H ((1u-(\\\\n(.fu%2u))*.13m) . ds #V .6m . ds #F 0 . ds #[ \& . ds #] \& .\} . \" simple accents for nroff and troff .if n \{\ . ds ' \& . ds ` \& . ds ^ \& . ds , \& . ds ~ ~ . ds / .\} .if t \{\ . ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" . ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' . ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' . ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' . ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' . ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' .\} . \" troff and (daisy-wheel) nroff accents .ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' .ds 8 \h'\*(#H'\(*b\h'-\*(#H' .ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] .ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' .ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' .ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] .ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] .ds ae a\h'-(\w'a'u*4/10)'e .ds Ae A\h'-(\w'A'u*4/10)'E . \" corrections for vroff .if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' .if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' . \" for low resolution devices (crt and lpr) .if \n(.H>23 .if \n(.V>19 \ \{\ . ds : e . ds 8 ss . ds o a . ds d- d\h'-1'\(ga . ds D- D\h'-1'\(hy . ds th \o'bp' . ds Th \o'LP' . ds ae ae . ds Ae AE .\} .rm #[ #] #H #V #F C .\" ======================================================================== .\" .IX Title "inetsim.conf 5" .TH inetsim.conf 5 "2017-10-22" "perl v5.20.2" " " .\" For nroff, turn off justification. Always turn off hyphenation; it makes .\" way too many mistakes in technical documents. .if n .ad l .nh .SH "NAME" inetsim.conf \- Configuration file for INetSim .SH "DESCRIPTION" .IX Header "DESCRIPTION" \&\fIinetsim.conf\fR is the configuration file for \fBinetsim\fR(1). .PP The format of \fIinetsim.conf\fR is simple: one option per line, with blank lines and lines starting with # ignored. .SH "GLOBAL OPTIONS" .IX Header "GLOBAL OPTIONS" .IP "\fIstart_service \s-1SERVICE\s0\fR" 4 .IX Item "start_service SERVICE" Start service \s-1SERVICE.\s0 .IP "\fIservice_bind_address \s-1ADDRESS\s0\fR" 4 .IX Item "service_bind_address ADDRESS" The \s-1IP\s0 address to bind services to. .IP "\fIservice_run_as_user \s-1USER\s0\fR" 4 .IX Item "service_run_as_user USER" User to run services. .IP "\fIservice_max_childs \s-1NUMBER\s0\fR" 4 .IX Item "service_max_childs NUMBER" Maximum number of child processes (number of parallel connections) for each service. .IP "\fIservice_timeout \s-1SECONDS\s0\fR" 4 .IX Item "service_timeout SECONDS" Timeout in seconds after which a connection is closed by the service. .IP "\fI[servicename]_bind_port \s-1PORT\s0\fR" 4 .IX Item "[servicename]_bind_port PORT" \&\s-1PORT\s0 number to bind service to. .IP "\fIcreate_reports [YES|NO]\fR" 4 .IX Item "create_reports [YES|NO]" Create report with a summary of connections for the session on shutdown. .IP "\fIreport_language \s-1LANGUAGE\s0\fR" 4 .IX Item "report_language LANGUAGE" Set language for reports. .SH "FAKETIME OPTIONS" .IX Header "FAKETIME OPTIONS" .IP "\fIfaketime_init_delta \s-1SECONDS\s0\fR" 4 .IX Item "faketime_init_delta SECONDS" Initial number of seconds (positive or negative) relative to current date/time for fake time used by all services. If set to '0', current date/time is used. .IP "\fIfaketime_auto_delay \s-1SECONDS\s0\fR" 4 .IX Item "faketime_auto_delay SECONDS" Number of seconds to wait before incrementing/decrementing fake time by amount of seconds specified with \fBfaketime_auto_increment\fR. Setting to '0' disables this option. .IP "\fIfaketime_auto_increment \s-1SECONDS\s0\fR" 4 .IX Item "faketime_auto_increment SECONDS" Number of seconds by which fake time is incremented/decremented at regular intervals specified by \fBfaketime_auto_delay\fR. This option only takes effect if \fBfaketime_auto_delay\fR is enabled (not set to '0'). .SH "ADDITIONAL DNS OPTIONS" .IX Header "ADDITIONAL DNS OPTIONS" .IP "\fIdns_default_ip IP-ADDRESS\fR" 4 .IX Item "dns_default_ip IP-ADDRESS" Default \s-1IP\s0 address to return in \s-1DNS\s0 replies. .IP "\fIdns_default_hostname \s-1HOSTNAME\s0\fR" 4 .IX Item "dns_default_hostname HOSTNAME" Default hostname to return in \s-1DNS\s0 replies. .IP "\fIdns_default_domainname \s-1DOMAINNAME\s0\fR" 4 .IX Item "dns_default_domainname DOMAINNAME" Default domainname to return in \s-1DNS\s0 replies. .IP "\fIdns_static \s-1FQDN_HOSTNAME\s0 IP-ADDRESS\fR" 4 .IX Item "dns_static FQDN_HOSTNAME IP-ADDRESS" Static mapping for \s-1DNS.\s0 .IP "\fIdns_version \s-1STRING\s0\fR" 4 .IX Item "dns_version STRING" Version string to return. .SH "ADDITIONAL HTTP(S) OPTIONS" .IX Header "ADDITIONAL HTTP(S) OPTIONS" .IP "\fIhttp(s)_version\fR" 4 .IX Item "http(s)_version" Version string to return in \s-1HTTP\s0(S) replies. .IP "\fIhttp(s)_fakemode [YES|NO]\fR" 4 .IX Item "http(s)_fakemode [YES|NO]" Turn \s-1HTTP\s0(S) fake mode on or off. .IP "\fIhttp(s)_fakefile \s-1EXTENSION FILENAME MIMETYPE\s0\fR" 4 .IX Item "http(s)_fakefile EXTENSION FILENAME MIMETYPE" The fake files returned in fake mode based on the file extension in the \s-1HTTP\s0(S) request. .IP "\fIhttp(s)_default_fakefile \s-1FILENAME MIMETYPE\s0\fR" 4 .IX Item "http(s)_default_fakefile FILENAME MIMETYPE" The default fake file and \s-1MIME\s0 type returned in fake mode if the file extension in the \&\s-1HTTP\s0(S) request does not match any of the extensions defined with \fBhttp(s)_fakefile\fR. .IP "\fIhttp(s)_static_fakefile \s-1PATH FILENAME MIMETYPE\s0\fR" 4 .IX Item "http(s)_static_fakefile PATH FILENAME MIMETYPE" The fake files returned in fake mode based on the path in the \s-1HTTP\s0(S) request. .SH "ADDITIONAL SMTP(S) OPTIONS" .IX Header "ADDITIONAL SMTP(S) OPTIONS" .IP "\fIsmtp(s)_banner \s-1STRING\s0\fR" 4 .IX Item "smtp(s)_banner STRING" The banner string used in \s-1SMTP\s0 greeting message. .IP "\fIsmtp(s)_fqdn_hostname \s-1FQDN_HOST\s0\fR" 4 .IX Item "smtp(s)_fqdn_hostname FQDN_HOST" The \s-1FQDN\s0 hostname used for \s-1SMTP.\s0 .IP "\fIsmtp(s)_helo_required [YES|NO]\fR" 4 .IX Item "smtp(s)_helo_required [YES|NO]" Client has to send \s-1HELO/EHLO\s0 before any other command. .IP "\fIsmtp(s)_extended_smtp\fR" 4 .IX Item "smtp(s)_extended_smtp" Turn support for 'Extended \s-1SMTP\s0' (\s-1ESMTP\s0) on or off. .IP "\fIsmtp(s)_service_extension \s-1EXTENSION\s0 [\s-1PARAMETER\s0(S)]\fR" 4 .IX Item "smtp(s)_service_extension EXTENSION [PARAMETER(S)]" \&\s-1SMTP\s0 service extensions offered to client. .IP "\fIsmtp(s)_auth_reversibleonly [YES|NO]\fR" 4 .IX Item "smtp(s)_auth_reversibleonly [YES|NO]" Only offer authentication mechanisms which allow reversing the authentication information sent by a client to clear text username/password. .IP "\fIsmtp(s)_auth_required [YES|NO]\fR" 4 .IX Item "smtp(s)_auth_required [YES|NO]" Force the client to authenticate. .SH "ADDITIONAL POP3(S) OPTIONS" .IX Header "ADDITIONAL POP3(S) OPTIONS" .IP "\fIpop3(s)_banner \s-1STRING\s0\fR" 4 .IX Item "pop3(s)_banner STRING" The banner string used in \s-1POP3\s0 greeting message. .IP "\fIpop3(s)_hostname \s-1HOST\s0\fR" 4 .IX Item "pop3(s)_hostname HOST" The hostname used in \s-1POP3\s0 greeting message. .IP "\fIpop3(s)_mbox_maxmails \s-1NUMBER\s0\fR" 4 .IX Item "pop3(s)_mbox_maxmails NUMBER" Maximum number of e\-mails to select from supplied mbox files for creation of random \s-1POP3\s0 mailbox. .IP "\fIpop3(s)_mbox_reread \s-1NUMBER\s0\fR" 4 .IX Item "pop3(s)_mbox_reread NUMBER" Re-read supplied mbox files if \s-1POP3\s0 service was inactive for <\s-1NUMBER\s0> seconds. .IP "\fIpop3(s)_mbox_rebuild \s-1NUMBER\s0\fR" 4 .IX Item "pop3(s)_mbox_rebuild NUMBER" Rebuild random \s-1POP3\s0 mailbox if \s-1POP3\s0 service was inactive for <\s-1NUMBER\s0> seconds. .IP "\fIpop3(s)_auth_reversibleonly [YES|NO]\fR" 4 .IX Item "pop3(s)_auth_reversibleonly [YES|NO]" Only offer authentication mechanisms which allow reversing the authentication information sent by a client to clear text username/password. .IP "\fIpop3(s)_enable_apop [YES|NO]\fR" 4 .IX Item "pop3(s)_enable_apop [YES|NO]" Turn \s-1APOP\s0 on or off. .IP "\fIpop3(s)_enable_capabilities [YES|NO]\fR" 4 .IX Item "pop3(s)_enable_capabilities [YES|NO]" Turn support for pop3 capabilities on or off. .IP "\fIpop3(s)_capability \s-1CAPABILITY\s0 [\s-1PARAMETER\s0(S)]\fR" 4 .IX Item "pop3(s)_capability CAPABILITY [PARAMETER(S)]" \&\s-1POP3\s0 capabilities offered to client. .SH "ADDITIONAL FTP(S) OPTIONS" .IX Header "ADDITIONAL FTP(S) OPTIONS" .IP "\fIftp(s)_banner \s-1STRING\s0\fR" 4 .IX Item "ftp(s)_banner STRING" The banner string used in \s-1FTP\s0 greeting message. .IP "\fIftp(s)_version \s-1STRING\s0\fR" 4 .IX Item "ftp(s)_version STRING" Version string to return in replies to the \s-1STAT\s0 command. .IP "\fIftp(s)_recursive_delete [YES|NO]\fR" 4 .IX Item "ftp(s)_recursive_delete [YES|NO]" Allow recursive deletion of directories, even if they are not empty. .SH "ADDITIONAL TFTP OPTIONS" .IX Header "ADDITIONAL TFTP OPTIONS" .IP "\fItftp_allow_overwrite [YES|NO]\fR" 4 .IX Item "tftp_allow_overwrite [YES|NO]" Allow overwriting of existing files. .IP "\fItftp_enable_options [YES|NO]\fR" 4 .IX Item "tftp_enable_options [YES|NO]" Turn support for tftp options on or off. .IP "\fItftp_option \s-1OPTION PARAMETER\s0(S)\fR" 4 .IX Item "tftp_option OPTION PARAMETER(S)" \&\s-1TFTP\s0 options offered to client. .SH "ADDITIONAL NTP OPTIONS" .IX Header "ADDITIONAL NTP OPTIONS" .IP "\fIntp_server_ip IP-ADDRESS\fR" 4 .IX Item "ntp_server_ip IP-ADDRESS" The \s-1IP\s0 address to return in \s-1NTP\s0 replies. .IP "\fIntp_strict_checks [YES|NO]\fR" 4 .IX Item "ntp_strict_checks [YES|NO]" Turn strict checks for client packets on or off. .SH "ADDITIONAL IRC OPTIONS" .IX Header "ADDITIONAL IRC OPTIONS" .IP "\fIirc_fqdn_hostname \s-1FQDN_HOST\s0\fR" 4 .IX Item "irc_fqdn_hostname FQDN_HOST" The \s-1FQDN\s0 hostname used for \s-1IRC.\s0 .IP "\fIirc_version \s-1STRING\s0\fR" 4 .IX Item "irc_version STRING" Version string to return. .SH "ADDITIONAL DUMMY OPTIONS" .IX Header "ADDITIONAL DUMMY OPTIONS" .IP "\fIdummy_banner \s-1STRING\s0\fR" 4 .IX Item "dummy_banner STRING" Banner string sent to client if no data has been received for \&\fBdummy_banner_wait\fR seconds since the client has established the connection. If set to an empty string (""), only \s-1CRLF\s0 will be sent. This option only takes effect if \fBdummy_banner_wait\fR is not set to '0'. .IP "\fIdummy_banner_wait \s-1NUMBER\s0\fR" 4 .IX Item "dummy_banner_wait NUMBER" Number of seconds to wait for client sending any data after establishing a new connection. If no data has been received within this amount of time, \fBdummy_banner\fR will be sent to the client. Setting to '0' disables sending of a banner string. .SH "REDIRECT OPTIONS" .IX Header "REDIRECT OPTIONS" .IP "\fIredirect_enabled [YES|NO]\fR" 4 .IX Item "redirect_enabled [YES|NO]" Turn connection redirection on or off. .IP "\fIredirect_unknown_services [YES|NO]\fR" 4 .IX Item "redirect_unknown_services [YES|NO]" Redirect connection attempts to unbound ports to dummy service. .IP "\fIredirect_external_address IP-ADDRESS\fR" 4 .IX Item "redirect_external_address IP-ADDRESS" \&\s-1IP\s0 address used as source address if \fBINetSim\fR acts as a router for redirecting packets to external networks. This option only takes effect if static rules for redirecting packets to external networks are defined (see \fBredirect_static_rule\fR). .IP "\fIredirect_static_rule \s-1PROTOCOL IP\-ADDRESS:PORT IP\-ADDRESS:PORT\s0\fR" 4 .IX Item "redirect_static_rule PROTOCOL IP-ADDRESS:PORT IP-ADDRESS:PORT" Static mappings for connection redirection. .IP "\fIredirect_change_ttl [YES|NO]\fR" 4 .IX Item "redirect_change_ttl [YES|NO]" Change the time-to-live header field to a random value in outgoing \s-1IP\s0 packets. .IP "\fIredirect_exclude_port \s-1PROTOCOL:PORT\s0\fR" 4 .IX Item "redirect_exclude_port PROTOCOL:PORT" Connections to on this port are not redirected. .IP "\fIredirect_ignore_bootp [YES|NO]\fR" 4 .IX Item "redirect_ignore_bootp [YES|NO]" If set to 'yes', \s-1BOOTP \s0(\s-1DHCP\s0) broadcasts will not be redirected (\s-1UDP\s0 packets with source address 0.0.0.0, port 68 and destination address 255.255.255.255, port 67 or vice versa). .IP "\fIredirect_ignore_netbios [YES|NO]\fR" 4 .IX Item "redirect_ignore_netbios [YES|NO]" If set to 'yes', NetBIOS broadcasts will not be redirected (\s-1UDP\s0 packets with source/destination port 137/138 and destination address x.x.x.255 on the local network). .IP "\fIredirect_icmp_timestamp [MS|SEC|NO]\fR" 4 .IX Item "redirect_icmp_timestamp [MS|SEC|NO]" If set to 'ms', \s-1ICMP\s0 Timestamp requests will be answered with number of milliseconds since midnight \s-1UTC\s0 according to faketime. If set to 'sec', \s-1ICMP\s0 Timestamp requests will be answered with number of seconds since epoch (high order bit of the timestamp will be set to indicate non-standard value). Setting to 'no' disables manipulation of \s-1ICMP\s0 Timestamp requests. .SH "SSL OPTIONS" .IX Header "SSL OPTIONS" .IP "\fI[servicename]_ssl_keyfile \s-1FILENAME\s0\fR" 4 .IX Item "[servicename]_ssl_keyfile FILENAME" Name of the \s-1SSL\s0 private key \s-1PEM\s0 file. The key \s-1MUST NOT\s0 be encrypted! .IP "\fI[servicename]_ssl_certfile \s-1FILENAME\s0\fR" 4 .IX Item "[servicename]_ssl_certfile FILENAME" Name of the \s-1SSL\s0 certificate file. .IP "\fI[servicename]_ssl_dhfile \s-1FILENAME\s0\fR" 4 .IX Item "[servicename]_ssl_dhfile FILENAME" Name of the Diffie-Hellman parameter \s-1PEM\s0 file. .SH "SEE ALSO" .IX Header "SEE ALSO" .RS 4 \&\fBinetsim\fR(1) .RE .SH "AUTHOR" .IX Header "AUTHOR" Matthias\ Eckert , Thomas\ Hungenberg inetsim-1.2.7/man/man1/0000755000175000017500000000000013173076432012772 5ustar rgyrgyinetsim-1.2.7/man/man1/inetsim.10000644000175000017500000002013413173076432014524 0ustar rgyrgy.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.28) .\" .\" Standard preamble: .\" ======================================================================== .de Sp \" Vertical space (when we can't use .PP) .if t .sp .5v .if n .sp .. .de Vb \" Begin verbatim text .ft CW .nf .ne \\$1 .. .de Ve \" End verbatim text .ft R .fi .. .\" Set up some character translations and predefined strings. \*(-- will .\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left .\" double quote, and \*(R" will give a right double quote. \*(C+ will .\" give a nicer C++. Capital omega is used to do unbreakable dashes and .\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, .\" nothing in troff, for use with C<>. .tr \(*W- .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' .ie n \{\ . ds -- \(*W- . ds PI pi . if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch . if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch . ds L" "" . ds R" "" . ds C` "" . ds C' "" 'br\} .el\{\ . ds -- \|\(em\| . ds PI \(*p . ds L" `` . ds R" '' . ds C` . ds C' 'br\} .\" .\" Escape single quotes in literal strings from groff's Unicode transform. .ie \n(.g .ds Aq \(aq .el .ds Aq ' .\" .\" If the F register is turned on, we'll generate index entries on stderr for .\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index .\" entries marked with X<> in POD. Of course, you'll have to process the .\" output yourself in some meaningful fashion. .\" .\" Avoid warning from groff about undefined register 'F'. .de IX .. .nr rF 0 .if \n(.g .if rF .nr rF 1 .if (\n(rF:(\n(.g==0)) \{ . if \nF \{ . de IX . tm Index:\\$1\t\\n%\t"\\$2" .. . if !\nF==2 \{ . nr % 0 . nr F 2 . \} . \} .\} .rr rF .\" .\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). .\" Fear. Run. Save yourself. No user-serviceable parts. . \" fudge factors for nroff and troff .if n \{\ . ds #H 0 . ds #V .8m . ds #F .3m . ds #[ \f1 . ds #] \fP .\} .if t \{\ . ds #H ((1u-(\\\\n(.fu%2u))*.13m) . ds #V .6m . ds #F 0 . ds #[ \& . ds #] \& .\} . \" simple accents for nroff and troff .if n \{\ . ds ' \& . ds ` \& . ds ^ \& . ds , \& . ds ~ ~ . ds / .\} .if t \{\ . ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" . ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' . ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' . ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' . ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' . ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' .\} . \" troff and (daisy-wheel) nroff accents .ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' .ds 8 \h'\*(#H'\(*b\h'-\*(#H' .ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] .ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' .ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' .ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] .ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] .ds ae a\h'-(\w'a'u*4/10)'e .ds Ae A\h'-(\w'A'u*4/10)'E . \" corrections for vroff .if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' .if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' . \" for low resolution devices (crt and lpr) .if \n(.H>23 .if \n(.V>19 \ \{\ . ds : e . ds 8 ss . ds o a . ds d- d\h'-1'\(ga . ds D- D\h'-1'\(hy . ds th \o'bp' . ds Th \o'LP' . ds ae ae . ds Ae AE .\} .rm #[ #] #H #V #F C .\" ======================================================================== .\" .IX Title "inetsim 1" .TH inetsim 1 "2017-10-22" "perl v5.20.2" " " .\" For nroff, turn off justification. Always turn off hyphenation; it makes .\" way too many mistakes in technical documents. .if n .ad l .nh .SH "NAME" inetsim \- INetSim is a suite for simulating common internet services .SH "SYNOPSIS" .IX Header "SYNOPSIS" \&\fBinetsim\fR [\fB\-\-config\fR <\fIconfiguration file\fR>] [\fB\-\-version\fR] [\fB\-\-data\-dir\fR <\fIdata directory\fR>] [\fB\-\-log\-dir\fR <\fIlog directory\fR>] [\fB\-\-report\-dir\fR <\fIreport directory\fR>] [\fB\-\-bind\-address\fR <\fIip address\fR>] [\fB\-\-max\-childs\fR <\fImaximum child processes\fR>] [\fB\-\-user\fR <\fIuser name\fR>] [\fB\-\-faketime\-init\-delta\fR <\fIinitial time delta\fR>] [\fB\-\-faketime\-auto\-delay\fR <\fIdelay time\fR>] [\fB\-\-faketime\-auto\-incr\fR <\fIstepwidth\fR>] [\fB\-\-session\fR <\fIsession name\fR>] [\fB\-\-pidfile\fR <\fIpid file\fR>] .SH "DESCRIPTION" .IX Header "DESCRIPTION" \&\fBINetSim\fR simulates common internet services like \&\fI\s-1DNS\s0\fR, \fI\s-1HTTP\s0\fR, \fI\s-1SMTP\s0\fR or \fI\s-1POP3\s0\fR. .SH "OPTIONS" .IX Header "OPTIONS" .IP "\fB\-\-config\fR <\fIconfiguration file\fR>" 4 .IX Item "--config " The configuration file to use, default is conf/inetsim.conf in the current directory. .IP "\fB\-\-version\fR" 4 .IX Item "--version" Output version information. .IP "\fB\-\-data\-dir\fR <\fIdata directory\fR>" 4 .IX Item "--data-dir " The data directory to use, default is data/ in the current directory. .IP "\fB\-\-log\-dir\fR <\fIlog directory\fR>" 4 .IX Item "--log-dir " The log directory to use, default is log/ in the current directory. .IP "\fB\-\-report\-dir\fR <\fIreport directory\fR>" 4 .IX Item "--report-dir " The report directory to use, default is report/ in the current directory. .IP "\fB\-\-bind\-address\fR <\fI\s-1IP\s0 address\fR>" 4 .IX Item "--bind-address " The \s-1IP\s0 address to bind services to. .IP "\fB\-\-max\-childs\fR <\fImaximum child processes\fR>" 4 .IX Item "--max-childs " The maximum number of child processes (number of parallel connections) for each service. Default is 10. .IP "\fB\-\-user\fR <\fIusername\fR>" 4 .IX Item "--user " User to run services. Default is 'nobody'. .IP "\fB\-\-faketime\-init\-delta\fR <\fIinitial time delta\fR>" 4 .IX Item "--faketime-init-delta " Initial number of seconds (positive or negative) relative to current date/time for fake time used by all services. This overrides the option 'faketime\-init\-delta' in the configuration file. Default is 0 (use current date/time). .IP "\fB\-\-faketime\-auto\-delay\fR <\fIdelay time\fR>" 4 .IX Item "--faketime-auto-delay " Number of seconds to wait before incrementing or decrementing fake time by amount of seconds specified with \fBfaketime-auto-incr\fR. Setting to '0' disables this option. This overrides the option \&'faketime\-auto\-delay' in the configuration file. Default is 0 (disabled). .IP "\fB\-\-faketime\-auto\-incr\fR <\fIstepwidth\fR>" 4 .IX Item "--faketime-auto-incr " Number of seconds by which fake time is incremented or decremented at regular intervals specified by \fBfaketime_auto_delay\fR. This option only takes effect if \fBfaketime-auto-delay\fR is enabled (not set to '0'). This overrides the option 'faketime\-auto\-incr' in the configuration file. Default is 3600. .IP "\fB\-\-session\fR <\fIsession name\fR>" 4 .IX Item "--session " Session name to use, default is the \s-1PID\s0 of the parent process. .IP "\fB\-\-pidfile\fR <\fIpid file\fR>" 4 .IX Item "--pidfile " The pid file to use, default is /var/run/inetsim.pid. .SH "EXAMPLES" .IX Header "EXAMPLES" Start the simulation with session name 'simtest5' .PP .Vb 1 \& # inetsim \-\-session simtest5 .Ve .PP Start the simulation with a one-day-jump to the future after 60 seconds .PP .Vb 1 \& # inetsim \-\-faketime\-auto\-delay 60 \-\-faketime\-auto\-incr 86400 .Ve .PP dito, but with jump to the past .PP .Vb 1 \& # inetsim \-\-faketime\-auto\-delay 60 \-\-faketime\-auto\-incr \-86400 .Ve .SH "REQUIRES" .IX Header "REQUIRES" Perl 5, Getopt::Long, Net::Server, Net::DNS, IO::Handle, IO::Socket, IO::Select, IPC::Shareable, Digest::SHA, File::Copy, MIME::Base64, IPTables::IPv4::IPQueue (optional) .SH "AUTHOR" .IX Header "AUTHOR" Matthias\ Eckert , Thomas\ Hungenberg inetsim-1.2.7/COPYING0000644000175000017500000004307613173076432012430 0ustar rgyrgy GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, Cambridge, MA 02139, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. 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 Appendix: 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. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19yy name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 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. inetsim-1.2.7/DISCLAIMER0000644000175000017500000000232413173076432012723 0ustar rgyrgy NO WARRANTY BECAUSE THE SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "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 SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 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 SOFTWARE 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 SOFTWARE (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 SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. inetsim-1.2.7/CHANGES0000644000175000017500000001056113173076432012361 0ustar rgyrgy1.2.7 (2017-10-22) ------------------ - DNS: Fixed 'DNS_BindPort is tainted' problem with newer Perl versions 1.2.6 (2016-08-29) ------------------ - DNS: Bugfixes, input validation - Fix init script for use with systemd 1.2.5 (2014-05-24) ------------------ - Fixed incompatibility issue with newer versions of IO::Socket::SSL - Fixed incompatibility issue with some NTP clients - Set HTTP(S) POST data directory correctly if '--data-dir' command line option is used 1.2.4 (2013-08-15) ------------------ - Fixed broken report module 1.2.3 (2012-10-01) ------------------ - Changed Debian package dependency from Digest::SHA1 to Digest::SHA - Changed process name format 1.2.2 (2010-11-24) ------------------ - DNS: - added check for broken version 0.65 of Net::DNS - HTTP: - added support for static fakefiles - some bugfixes with HTTPS fakemode 1.2.1 (2010-07-09) ------------------ - POP3: fixed a small typo that caused the module to be practically unusable 1.2 (2010-04-25) ---------------- - new service module: IRC - basic command set - SMTP: - added SSL support (smtps) - added support for service extension STARTTLS - added support for enforced authentication - POP3: - added SSL support (pop3s) - added support for capabilities STLS, TOP, IMPLEMENTATION, LOGIN-DELAY, EXPIRE, RESP-CODES and AUTH-RESP-CODE - HTTP: - added SSL support (https) - FTP: - added SSL support (ftps) - TFTP: - added support for TFTP options 'blksize', 'timeout' and 'tsize' - added virtual file system - Redirect: - added support for ICMP - some minor bugfixes 1.1.1 (2009-09-09) ------------------ - FTP: always re-read content of static ftp root directory on startup - SMTP: set 'Return-Path' to '<>' for MAILER-DAEMON messages, replaced header 'Delivered-To' with 'Envelope-To' - POP3: fixed logging of non-printable characters - some minor bugfixes 1.1 (2008-10-12) ---------------- - new service module: FTP - new service module: Syslog - added support for HTTP methods POST and OPTIONS - added support for port numbers in HTTP 'Host' header and absoluteURI - changed SMTP HELO/EHLO response - added support for SMTP service extensions ENHANCEDSTATUSCODES, SEND, SAML, SOML, TURN, ETRN, ATRN, MTRK, BINARYMIME, CHUNKING, DELIVERBY, SUBMITTER, CHECKPOINT, NO-SOLICITING, FUTURERELEASE - added configuration options 'dummy_banner' and 'dummy_banner_wait' - added configuration options 'redirect_ignore_bootp' and 'redirect_ignore_netbios' - added configuration options 'create_reports' and 'report_language' - changed format of service logfile to include service child process id - changed default value for 'service_timeout' to 120 seconds - install script 'set_permissions.sh' renamed to 'setup.sh' 1.0 (2008-07-07) ---------------- - changed default setting for configuration option 'redirect_enabled' to 'no' 1.0rc4 (2008-06-29) ------------------- - Perl library Net::Server is no longer included with the INetSim distribution - added 'dummy' service module (just logs all received data) - added 'redirect' feature: - uses Linux kernel IP_QUEUE, so only available on Linux platforms - allows for IP-based connection redirection (tcp/udp) - supports static rules for redirection based on target IP address, port and/or protocol - can act as a NAT router for redirection of packets to other hosts - optionally varies the TTL value of IP packets sent to the clients from different "virtual" connection targets to make traffic look more authentic - DNS.pm: added handling of AAAA queries (returns empty answer with status 'NOERROR') - SMTP.pm: add 'Received:' headers to messages - HTTP.pm: improved Request-URI parsing, now supports absolute URIs - NTP.pm: added configuration option for less strict checks - added timeout handling for all service modules - removed 'bind_address' configuration options for individual services - some minor bugfixes 1.0rc3 (2007-12-12) ------------------- - added 'finger' service module - added configuration option for SMTP and POP3 to select if only reversible or all supported authentication mechanisms are offered - added support for SMTP extensions DSN, ETRN, EXPN, HELP and VERP 1.0rc2 (2007-10-21) ------------------- - added TFTP service module - added POP3 configuration options pop3_mbox_maxmails, pop3_mbox_reread and pop3_mbox_rebuild - added sample SPAM mbox file for POP3 1.0rc1 (2007-10-17) ------------------- - first public release inetsim-1.2.7/log/0000755000175000017500000000000013173076432012144 5ustar rgyrgyinetsim-1.2.7/README0000644000175000017500000002463413173076432012254 0ustar rgyrgy---------------------------------------------------------------------- This 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 software 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 software. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ---------------------------------------------------------------------- 1. DESCRIPTION -------------- INetSim is a software suite for simulating common internet services in a lab environment, e.g. for analyzing the network behaviour of unknown malware samples. 1.1 Implemented service modules Currently, modules for the simulation of the following services are included with the INetSim distribution: - HTTP/HTTPS - "real-mode": Delivers existing files from a webroot directory. - "fake-mode": Delivers configured fake files based on the file extension in the HTTP request (e.g. .html or .exe) or static paths, Requests for checkip.dyndns.org are answered with client's IP address - supports HTTP methods GET, HEAD, POST and OPTIONS with HTTP/1.0 and HTTP/1.1 - SMTP/SMTPS - received e-mails are stored in mbox format - supports ESMTP and flexible configuration of service extensions - supports authentication methods PLAIN, LOGIN, ANONYMOUS, CRAM-MD5 and CRAM-SHA1 - arbitrary authentication data is accepted and logged in plain text - POP3/POP3S - dynamic creation of mailbox content from supplied mbox files - supports authentication methods PLAIN, LOGIN and CRAM-MD5 - arbitrary authentication data is accepted and logged in plain text - DNS - forward and reverse lookup with default and static configuration - FTP/FTPS - download and upload - builds a virtual filesystem based on an existing ftproot directory which allows for creation and deletion of arbitrary files - TFTP - download and upload - IRC - basic command set - NTP - Ident - Finger - Syslog - "Small servers": - Daytime, - Time, - Echo, - Chargen, - Discard and - Quotd - Dummy The listening port number can be configured for each service. 1.2 Faketime INetSim can be run in 'faketime' mode to analyze the runtime behaviour of malware which use NTP or Time/Daytime to start specific actions based on the current date and time. In 'faketime' mode, all services using date/time information (e.g. NTP or HTTP) respond with a fake timestamp which is based on a configured delta to current system time. Optionally, this delta can automatically be incremented or decremented by a configured value at specific intervals. 1.3 Connection redirection In addition to connection redirection via fake DNS responses, INetSim allows for IP-based redirection of arbitrary connections (TCP, UDP and ICMP). This feature is only available when running INetSim on Linux platforms with Kernel support for packet queueing (Kernel compile time option CONFIG_NETFILTER_NETLINK_QUEUE). This feature supports static rules for connection redirection based on target IP address, port and/or protocol. INetSim can also act as a NAT router for redirection of packets to other hosts. Optionally, the TTL value of IP packets sent to the clients from different "virtual" connection targets can be varied to make traffic look more authentic. Important note: Linux kernel versions 3.5.0 and later no longer include the ip_queue module, so INetSim's redirect feature only works with earlier kernel versions. 1.4 Dummy service The Dummy service simply logs all data received from the client. This module is most useful when used along with connection redirection to capture all traffic sent from the client to ports not bound to any other service module. Optionally, a configurable banner string can be sent if no data has been received for a given amount of time after the client established the connection. This might be useful e.g. while analyzing a malware which expects a POP3 or SMTP server on an unusual port. 1.5 Logging and reports All incoming requests to the simulated services and the corresponding outgoing replies are logged in detail. When stopping an INetSim session, optionally an additional report for that session with a summary of the connections is created from the logfile. 2. AVAILABILITY --------------- You can get the latest version of INetSim from . 3. PREREQUISITES ---------------- - POSIX compatible and System V IPC capable operating system (e.g. Linux) - Perl version 5.006 or more recent - Perl library Net::Server (available from http://search.cpan.org/~rhandom/Net-Server/) - Perl library Net::DNS (available from http://search.cpan.org/~olaf/Net-DNS/) - Perl library IPC::Shareable (available from http://search.cpan.org/~bsugars/IPC-Shareable/) - Perl library Digest::SHA (available from http://search.cpan.org/~mshelor/Digest-SHA/) - Perl library IO::Socket::SSL (available from http://search.cpan.org/~sullr/IO-Socket-SSL/) - additionally, for IP-based connection redirection (only supported on Linux platforms with Kernel support for packet queueing): Perl library Perlipq (available from http://search.cpan.org/~jmorris/perlipq/) The current version of INetSim has been developed and tested on Debian GNU/Linux 7 (wheezy) and 8 (jessie). It has been reported to also run smoothly on different versions of Ubuntu, Gentoo Linux, FreeBSD and OpenBSD. If you successfully run INetSim on any other platform, or if you experience problems running INetSim on platforms which meet the above mentioned requirements, please drop us a note at . 4. INSTALLATION --------------- Get the latest version of INetSim from . Make sure you have installed Perl and all required modules listed above. INetSim runs all services with privileges of the user specified in the configuration file (default: 'nobody'), so make sure this user exists on your system. INetSim runs all services with privileges of group 'inetsim', so you need to add a group with that name to your system. On a Linux system, this can be done by executing the command 'groupadd inetsim' as root. Unpack the downloaded tarball to a directory of your choice (e.g. /opt/inetsim). Change into the top-level directory of the unpacked tarball and run the script 'setup.sh' as root. This will set some required permissions on files and directories of INetSim. 5. CONFIGURATION ---------------- For a documentation of the configuration directives of INetSim, please refer to the manpage 'inetsim.conf' in subdirectory 'man/man5' and the comments in the sample configuration file 'conf/inetsim.conf' included with the INetSim distribution. 6. USAGE -------- To start INetSim, change into the top-level directory of the unpacked tarball and run the startup script 'inetsim' as root. For a documentation of the available command line options for the startup script, please refer to the manpage 'inetsim' included with the INetSim distribution in subdirectory 'man/man1'. INetSim requires root privileges to bind sockets to ports below 1024. After binding the sockets, root privileges are dropped as described in section 'Installation'. Currently, the INetSim startup script can only be run with root privileges, even if no ports below 1024 are configured to be used. This might change in future releases. !! IMPORTANT NOTE for users of OpenBSD/FreeBSD: !! The default maximum number of semaphore identifiers on OpenBSD/FreeBSD is 10. INetSim needs some more semaphore identifiers to run. So you have to raise the corresponding sysctl value (kern.seminfo.semmni on OpenBSD, kern.ipc.semmni on FreeBSD). A value of 20 should work. Otherwise INetSim will crash with an error message like "Could not create semaphore set: No space left on device" on startup. 7. ABOUT THE AUTHORS --------------------- INetSim is developed by Thomas Hungenberg and Matthias Eckert. We both work in the field of IT security and part of our daily work is the analysis of unknown malware samples. 8. ABOUT THE PROJECT --------------------- To perform a quick run-time analysis of the network behaviour of unknown malware samples, we were in need of a tool to simulate internet services which are commonly used by malware in our laboratory environment. We started off with a bunch of home-grown Perl scripts together with specially configured server service implementations like Apache, Postfix, dnsmasq and ntpd, but we were not happy with this because of a lot of disadvantages resulting from the combination of many programs (e.g. problems with correlation of log data). While talking to other security analysts, we noticed that there is definitely a need for a comfortable single suite to simulate different internet services with common logging and centralized control functions. So we decided to start the project 'INetSim' to develop such a suite. Due to lack of time at the office, the programming was done in our spare time. We both have been using Perl for many years but mostly for small scripts, e.g. for the analysis of logfiles. The project INetSim was a welcome opportunity to gain more practical experience in programming Perl and to deal with the specifications (RFCs) for several services in depth. We think INetSim might be useful for other security researchers as well and therefore decided to release it to the community as free software licensed under the GNU General Public License (GPL). Any feedback on your experiences with INetSim is appreciated. Please send your comments to . NOTE: As this is our first larger software project written in Perl, please do not be too harsh when you review the code. By now, we learned a lot more about using references, packages and object-oriented programming in Perl, so the design and code will be much better in our next project. ;-) 9. COPYRIGHT ------------ Copyright (c) 2007-2016 Thomas Hungenberg & Matthias Eckert This software is licensed under the GNU General Public License (GPL). For more information read the file COPYING which should be included with this distribution. ---------------------------------------------------------------------- inetsim-1.2.7/lib/0000755000175000017500000000000013173076432012131 5ustar rgyrgyinetsim-1.2.7/lib/INetSim.pm0000644000175000017500000004042513173076432014004 0ustar rgyrgy# -*- perl -*- # # INetSim - An internet simulation framework # # (c)2007-2017 Matthias Eckert, Thomas Hungenberg # # Version 1.2.7 (2017-10-22) # # For history/changelog see bottom of this file. # ############################################################# package INetSim; use strict; use warnings; use POSIX; # modules to use use INetSim::CommandLine; use INetSim::Config; use INetSim::Log; use INetSim::FakeTime; use INetSim::Chargen::TCP; use INetSim::Chargen::UDP; use INetSim::Daytime::TCP; use INetSim::Daytime::UDP; use INetSim::Discard::TCP; use INetSim::Discard::UDP; use INetSim::Echo::TCP; use INetSim::Echo::UDP; use INetSim::Quotd::TCP; use INetSim::Quotd::UDP; use INetSim::Time::TCP; use INetSim::Time::UDP; use INetSim::HTTP; use INetSim::Ident; use INetSim::NTP; use INetSim::SMTP; use INetSim::POP3; use INetSim::DNS; use INetSim::TFTP; use INetSim::Report; use INetSim::Finger; use INetSim::Dummy::TCP; use INetSim::Dummy::UDP; use INetSim::FTP; use INetSim::Syslog; use INetSim::IRC; my $VERSION = "INetSim 1.2.7 (2017-10-22)"; ############################################################# # Local variables my $PPID = $$; # Parent PID my @childs = (); # Child PIDs ############################################################# # Child process handling # sub fork_services { my @services_to_start = &INetSim::Config::getServicesToStart(); foreach (@services_to_start) { my $pid = fork(); if ($pid) { # we are the parent process push(@childs, $pid); } elsif ($pid == 0){ # we are the child process if(/^dns$/) { &INetSim::DNS::dns; } elsif(/^smtp$/) { INetSim::SMTP->run; } elsif(/^smtps$/) { INetSim::SMTP->new({ SSL => 1 })->run; } elsif(/^pop3$/) { INetSim::POP3->run; } elsif(/^pop3s$/) { INetSim::POP3->new({ SSL => 1 })->run; } elsif(/^http$/) { INetSim::HTTP->run; } elsif(/^https$/) { INetSim::HTTP->new({ SSL => 1 })->run; } elsif(/^ntp$/) { INetSim::NTP->run; } elsif(/^time_tcp$/) { INetSim::Time::TCP->run; } elsif(/^time_udp$/) { INetSim::Time::UDP->run; } elsif(/^daytime_tcp$/) { INetSim::Daytime::TCP->run; } elsif(/^daytime_udp$/) { INetSim::Daytime::UDP->run; } elsif(/^ident$/) { INetSim::Ident->run; } elsif(/^echo_tcp$/) { INetSim::Echo::TCP->run; } elsif(/^echo_udp$/) { INetSim::Echo::UDP->run; } elsif(/^discard_tcp$/) { INetSim::Discard::TCP->run; } elsif(/^discard_udp$/) { INetSim::Discard::UDP->run; } elsif(/^chargen_tcp$/) { INetSim::Chargen::TCP->run; } elsif(/^chargen_udp$/) { INetSim::Chargen::UDP->run; } elsif(/^quotd_tcp$/) { INetSim::Quotd::TCP->run; } elsif(/^quotd_udp$/) { INetSim::Quotd::UDP->run; } elsif(/^tftp$/) { INetSim::TFTP->run; } elsif(/^finger$/) { INetSim::Finger->run; } elsif(/^dummy_tcp$/) { INetSim::Dummy::TCP->run; } elsif(/^dummy_udp$/) { INetSim::Dummy::UDP->run; } elsif(/^ftp$/) { INetSim::FTP->run; } elsif(/^ftps$/) { INetSim::FTP->new({ SSL => 1 })->run; } elsif(/^syslog$/) { INetSim::Syslog->run; } elsif(/^irc$/) { INetSim::IRC->run; } elsif(/^ircs$/) { INetSim::IRC->run( SSL => 1 ); } } else { &error_exit ("Could not fork: $!", 1); } } sleep 1; } sub handle_pid { my $cmd = shift; my $pidfile = &INetSim::CommandLine::getCommandLineOption("pidfile"); $pidfile =~ /(.*)/; # evil untaint $pidfile = $1; if ($cmd eq "create") { if (-f $pidfile) { print STDOUT "PIDfile '$pidfile' exists - INetSim already running?\n"; exit 1; } else { if (! open (PIDFILE, "> $pidfile")) { print STDOUT "Unable to open PIDfile for writing: $!\n"; exit 1; } print PIDFILE $PPID; close PIDFILE; } } elsif ($cmd eq "remove") { if (-f $pidfile) { unlink $pidfile; } else { print STDOUT "Hmm, PIDfile '$pidfile' not found (but, who cares?)\n"; } } } sub auto_faketime { if (&INetSim::Config::getConfigParameter("Faketime_AutoDelay") > 0) { my $pid = fork(); if ($pid) { # we are the parent process push(@childs, $pid); } elsif ($pid == 0){ # we are the child process &INetSim::FakeTime::auto_faketime(); } } } sub redirect_packets { if (&INetSim::Config::getConfigParameter("Redirect_Enabled")) { # check for linux if ($^O !~ /linux/i) { &INetSim::Log::MainLog("failed! Error: Sorry, the Redirect module does not support this operating system!", "redirect"); return 0; } # check for Perlipq library eval { eval "use IPTables::IPv4::IPQueue; 1" or die; }; if ($@) { &INetSim::Log::MainLog("failed! Error: Sorry, this module requires the Perlipq library (IPTables::IPv4::IPQueue)!", "redirect"); return 0; } # check for redirect module eval { eval "use INetSim::Redirect; 1" or die; }; if ($@) { &INetSim::Log::MainLog("failed! Error: $@", "redirect"); return 0; } my $pid = fork(); if ($pid) { # we are the parent process push(@childs, $pid); } elsif ($pid == 0){ # we are the child process &INetSim::Redirect::run(); } } } sub rest_in_peace { my $count = @childs; my $i; for ($i = 0; $i < $count; $i++) { waitpid(-1,&WNOHANG); if (! (kill (0, $childs[$i]))) { splice (@childs, $i, 1); $count = @childs; $i--; } } } sub wait_pids { wait(); foreach (@childs){ waitpid($_, 0); } } sub kill_pids { foreach (@childs){ kill("TERM", $_); waitpid($_, 0); } } sub error_exit { my $msg = shift; if (! defined $msg) { $msg = "Unknown error"; } my $exitcode = shift; if (! defined $exitcode) { $exitcode = 1; } elsif (($exitcode !~ /^[\d]{1,3}$/) || (int($exitcode) < 0) || (int($exitcode > 255))) { print STDOUT "Illegal exit code!\n"; $exitcode = 1; } print STDOUT "Error: $msg.\n"; &kill_pids; &wait_pids; &handle_pid("remove"); exit 1; } ############################################################# # Main # sub main { # Parse commandline options &INetSim::CommandLine::parse_options(); # Check command line option 'help' if (&INetSim::CommandLine::getCommandLineOption("help")) { print STDOUT << "EOF"; $VERSION by Matthias Eckert & Thomas Hungenberg Usage: $0 [options] Available options: --help Print this help message. --version Show version information. --config= Configuration file to use. --log-dir= Directory logfiles are written to. --data-dir= Directory containing service data. --report-dir= Directory reports are written to. --bind-address= Default IP address to bind services to. Overrides configuration option 'default_bind_address'. --max-childs= Default maximum number of child processes per service. Overrides configuration option 'default_max_childs'. --user= Default user to run services. Overrides configuration option 'default_run_as_user'. --faketime-init-delta= Initial faketime delta (seconds). Overrides configuration option 'faketime_init_delta'. --faketime-auto-delay= Delay for auto incrementing faketime (seconds). Overrides configuration option 'faketime_auto_delay'. --faketime-auto-incr= Delta for auto incrementing faketime (seconds). Overrides configuration option 'faketime_auto_increment'. --session= Session id to use. Defaults to main process id. --pidfile= Pid file to use. Defaults to '/var/run/inetsim.pid'. EOF ; exit 0; } elsif (&INetSim::CommandLine::getCommandLineOption("version")) { print STDOUT "$VERSION by Matthias Eckert & Thomas Hungenberg\n"; exit 0; } # Check if we are running with root privileges (EUID 0) if ( $> != 0 ) { print STDOUT "Sorry, this program must be started as root!\n"; exit 1; } # Check if group "inetsim" exists on system my $gid = getgrnam("inetsim"); if (! defined $gid) { print STDOUT "No such group 'inetsim' configured on this system!\n"; print STDOUT "Please create group and start again. See documentation for more information.\n"; exit 1; } print STDOUT "$VERSION by Matthias Eckert & Thomas Hungenberg\n"; # create pidfile &handle_pid("create"); # Parse configuration file &INetSim::Config::parse_config; # Check if there are services to start configured, else exit if (! scalar(&INetSim::Config::getServicesToStart())) { &INetSim::Log::MainLog("No services to start configured. Exiting."); &handle_pid("remove"); exit 0; } # ignore some signal handlers during startup local $SIG{'INT'} = 'IGNORE'; local $SIG{'HUP'} = 'IGNORE'; local $SIG{'TERM'} = 'IGNORE'; &INetSim::Log::MainLog("=== INetSim main process started (PID $PPID) ==="); &INetSim::Log::MainLog("Session ID: " . &INetSim::Config::getConfigParameter("SessionID")); &INetSim::Log::MainLog("Listening on: " . &INetSim::Config::getConfigParameter("Default_BindAddress")); &INetSim::Log::MainLog("Real Date/Time: " . strftime "%Y-%m-%d %H:%M:%S", localtime); &INetSim::Log::MainLog("Fake Date/Time: " . (strftime "%Y-%m-%d %H:%M:%S", localtime(&INetSim::FakeTime::get_faketime())). " (Delta: " . &INetSim::Config::getConfigParameter("Faketime_Delta") . " seconds)"); &INetSim::Log::MainLog(" Forking services..."); &fork_services(); &auto_faketime(); &redirect_packets(); if ($$ == $PPID) { $0 = 'inetsim_main'; sleep 2; # reap zombies ;-) &rest_in_peace; &INetSim::Log::MainLog(" done."); &INetSim::Log::MainLog("Simulation running."); # catch up some signalhandlers for the parent process local $SIG{'INT'} = sub {&kill_pids;}; local $SIG{'HUP'} = sub {&kill_pids;}; local $SIG{'TERM'} = sub {&kill_pids;}; &wait_pids; &INetSim::Log::MainLog("Simulation stopped."); # create report if (&INetSim::Config::getConfigParameter("Create_Reports")) { &INetSim::Report::GenReport; } &INetSim::Log::MainLog("=== INetSim main process stopped (PID $PPID) ==="); &INetSim::Log::MainLog("."); } # delete pidfile &handle_pid("remove"); exit 0; } 1; ############################################################# # # History: # # Version 1.2.4 (2013-08-14) th # - changed date/time output format # # Version 1.2beta5 (2010-04-15) me # - added 'Default_BindAddress' to startup screen # # Version 1.2beta4 (2009-12-15) th # # Version 1.2beta3 (2009-09-23) me [branch] # - added service IRC/IRCs # # Version 1.1.1 (2009-09-09) th # - 1.1.1 release # # Version 1.2beta2 (2009-09-04) me [branch] # - services POP3, HTTP and FTP prepared for using SSL too # # Version 1.2beta1 (2009-09-03) me [branch] # - added service SMTPS # - added commandline option '--version' to help output # # Version 1.1 (2008-10-12) me # - 1.1 release # # Version 1.1pre4 (2008-09-08) me # - added service syslog # # Version 1.1pre3 (2008-08-24) me # - changed FTP module name # # Version 1.1pre2 (2008-08-20) me # - added service FTP # # Version 1.1pre1 (2008-08-09) th # - added configuration option 'Create_Reports' # # Version 1.0 (2008-07-06) th # - 1.0 release # # Version 1.0rc4 (2008-06-26) th # - 1.0 rc4 release # # Version 1.0rc4pre9 (2008-03-20) me # - fixed checks in function redirect_packets() # # Version 1.0rc4pre8 (2008-03-19) me # - changed handling for OS check and added an error message # - removed check for use of 'INetSim::Redirect' (see line below) # - added check for use of 'IPTables::IPv4::IPQueue' instead of # the redirect module and added an error message # - added function rest_in_peace() to get possible zombies # # Version 1.0rc4pre7 (2008-03-17) me # - added &INetSim::Config::getConfigParameter("Redirect_Enabled") in # function redirect_packets() # # Version 1.0rc4pre6 (2008-03-15) me # - added check for use of 'INetSim::Redirect', because it's # system dependent # - added check for operating system in function redirect_packets() # # Version 1.0rc4pre5 (2008-03-07) me # - added service "redirect" # # Version 1.0rc4pre4 (2008-03-06) me # - added service "dummy" # # Version 1.0rc4pre3 (2008-03-05) me # - moved checks for uid '0' and group 'inetsim' below commandline # parser, because '--help' should always be possible # # Version 1.0rc4pre2 (2008-02-17) me # - replaced variable 'pidfile' with # &INetSim::CommandLine::getCommandLineOption("pidfile"); # - unused old code in function 'handle_pid' removed # # Version 1.0rc4pre1 (2007-12-31) th # - change process names # # Version 1.0rc3 (2007-12-12) me # - new public release # # Version 1.0rc3pre1 (2007-11-07) me # - added service finger # # Version 1.0rc2 (2007-10-21) th # - new public release # # Version 1.0rc1 (2007-10-17) th # - first public release # # Version 0.41 (2007-05-31) th # - added/removed some comments # # Version 0.40 (2007-05-23) th # - added 'sleep 1' to main process to wait for all services started # # Version 0.39 (2007-04-30) th # - check if group 'inetsim' exists on system # - use getServicesToStart() instead of accessing module # variables in Config.pm # # Version 0.38 (2007-04-29) th # - added module CommandLine.pm # - added check for command line option 'help' # - added global variable 'VERSION' # # Version 0.37 (2007-04-25) th # - replaced &INetSim::FakeTime::get_faketime_delta() with # &INetSim::Config::getConfigParameter("faketime_delta") # # Version 0.36 (2007-04-22) th # - added function error_exit() # - renamed parameter options in handle_pid() to "create" and "remove" # # Version 0.35 (2007-04-21) me # - added GenReport() # # Version 0.34 (2007-04-20) me # - added check for uid 0 # # Version 0.33 (2007-04-20) me # - added function for pidfile handling # # Version 0.32 (2007-04-20) me # - added logging of $INetSim::Config::SessionID # - re-added a dot at the end of main log # (this makes the log easier to read) # # Version 0.31 (2007-04-10) th # - renamed fork_servers() to fork_services() # - added auto_faketime() # # Version 0.30 (2007-04-09) th # - added module FakeTime # # Version 0.30 (2007-04-05) th # - changed module name 'dns.pm' to 'DNS.pm' # # Version 0.29 (2007-03-30) me # - added service tftp # # Version 0.28 (2007-03-27) th # - moved CONFIGFILENAME, MAINLOGFILENAME and # SUBLOGFILENAME to INetSim::Config # - moved logging functions to INetSim::Log # # Version 0.27 (2007-03-26) th # - changed daytime_tcp to use INetSim::GenericServer # - changed daytime_udp to use INetSim::GenericServer # - changed time_tcp to use INetSim::GenericServer # - changed time_udp to use INetSim::GenericServer # - changed quotd_tcp to use INetSim::GenericServer # - changed quotd_udp to use INetSim::GenericServer # - changed discard_tcp to use INetSim::GenericServer # - changed discard_udp to use INetSim::GenericServer # - changed smtp to use INetSim::GenericServer # - changed pop3 to use INetSim::GenericServer # # Version 0.26 (2007-03-24) th # - changed chargen_tcp to use INetSim::GenericServer # - changed chargen_udp to use INetSim::GenericServer # - changed http to use INetSim::GenericServer # # Version 0.25 (2007-03-23) th # - changed echo_tcp to use INetSim::GenericServer # - changed echo_udp to use INetSim::GenericServer # # Version 0.24 (2007-03-19) th # - added service http # # Version 0.23 (2007-03-19) me # - added service ident # - added service echo # - added service discard # - added service chargen # - added service discard # # Version 0.22 (2007-03-16) th # - added configuration option @INetSim::Config::ServicesToStart # - changed BASEDIR to "." # # Version 0.21 (2007-03-15) me # - ignore signals during startup # # Version 0.2 (2007-03-15) th # - added configuration module # - rewrote fork_servers() # - changed logfile location # # Version 0.1 (2007-03-12) me # ############################################################# inetsim-1.2.7/lib/INetSim/0000755000175000017500000000000013173076432013441 5ustar rgyrgyinetsim-1.2.7/lib/INetSim/DNS.pm0000644000175000017500000003541313173076432014431 0ustar rgyrgy# -*- perl -*- # # INetSim::DNS - A fake DNS server # # RFC 1035 (and many others) - Domain Name System # # (c)2007-2017 Matthias Eckert, Thomas Hungenberg # # Version 0.6 (2017-04-19) # # For history/changelog see bottom of this file. # ############################################################# package INetSim::DNS; use strict; use warnings; use Net::DNS; use Net::DNS::Nameserver; sub dns{ # check for broken version 0.65 of Net::DNS if ($Net::DNS::VERSION eq "0.65") { &INetSim::Log::MainLog("failed! (The installed version 0.65 of Perl library Net::DNS is broken. Please upgrade to version 0.66 or later.)", &INetSim::Config::getConfigParameter("DNS_ServiceName")); exit 1; } my $CPID = $$; my $localaddr = (defined &INetSim::Config::getConfigParameter("DNS_BindAddress") ? &INetSim::Config::getConfigParameter("DNS_BindAddress") : &INetSim::Config::getConfigParameter("Default_BindAddress")); $localaddr =~ /^(.*)$/; # fool taint check $localaddr = $1; my $bindport = &INetSim::Config::getConfigParameter("DNS_BindPort"); $bindport =~ /^(.*)$/; # fool taint check $bindport = $1; local $SIG{'INT'} = 'IGNORE'; local $SIG{'TERM'} = sub {&INetSim::Log::MainLog("stopped (PID $CPID)", &INetSim::Config::getConfigParameter("DNS_ServiceName")); exit 0;}; my $server = Net::DNS::Nameserver->new(LocalAddr => $localaddr, LocalPort => $bindport, ReplyHandler => \&dns_reply_handler, Verbose => '0'); if(! $server) { &INetSim::Log::MainLog("failed!", &INetSim::Config::getConfigParameter("DNS_ServiceName")); exit 1; } # drop root privileges my $runasuser = (defined &INetSim::Config::getConfigParameter("DNS_RunAsUser") ? &INetSim::Config::getConfigParameter("DNS_RunAsUser") : &INetSim::Config::getConfigParameter("Default_RunAsUser")); my $runasgroup = (defined &INetSim::Config::getConfigParameter("DNS_RunAsGroup") ? &INetSim::Config::getConfigParameter("DNS_RunAsGroup") : &INetSim::Config::getConfigParameter("Default_RunAsGroup")); my $uid = getpwnam($runasuser); my $gid = getgrnam($runasgroup); POSIX::setgid($gid); my $newgid = POSIX::getgid(); if ($newgid != $gid) { &INetSim::Log::MainLog("failed! (Cannot switch group)", &INetSim::Config::getConfigParameter("DNS_ServiceName")); exit 0; } POSIX::setuid($uid); if ($< != $uid || $> != $uid) { $< = $> = $uid; # try again - reportedly needed by some Perl 5.8.0 Linux systems if ($< != $uid) { &INetSim::Log::MainLog("failed! (Cannot switch user)", &INetSim::Config::getConfigParameter("DNS_ServiceName")); exit 0; } } $0 = 'inetsim_' . &INetSim::Config::getConfigParameter("DNS_ServiceName"); &INetSim::Log::MainLog("started (PID $CPID)", &INetSim::Config::getConfigParameter("DNS_ServiceName")); $server->main_loop; &INetSim::Log::MainLog("stopped (PID $CPID)", &INetSim::Config::getConfigParameter("DNS_ServiceName")); exit 0; } sub dns_reply_handler { # STILL NEEDS WORK !!! my ($queryname, $queryclass, $querytype, $rhost, $query) = @_; my (@ans, @auth, @add) = (); my @logans = (); my $resultcode = "REFUSED"; my $ttl = 3600; my $SOA_serial = 20150801; my $SOA_refresh = 1000; my $SOA_retry = 800; my $SOA_expire = 7200; my $SOA_minimum = 3600; my $stat_success = 0; my $serviceName = &INetSim::Config::getConfigParameter("DNS_ServiceName"); my $localaddress = &INetSim::Config::getConfigParameter("Default_BindAddress"); &INetSim::Log::SubLog("[$rhost] connect", $serviceName, $$); if (! defined ($queryname) || ! defined ($queryclass) || ! defined ($querytype) || ! defined ($rhost)) { $resultcode = "SERVFAIL"; } elsif (($queryclass ne "IN") && ($queryclass ne "CH")) { $resultcode = "REFUSED"; } elsif (length($queryname) > 255) { $resultcode = "FORMERR"; } elsif ($querytype eq "A") { my $rdata; if ($queryname =~ /^wpad$/i || $queryname =~ /^wpad\..*/i) { $rdata = $localaddress; push @ans, Net::DNS::RR->new("$queryname $ttl $queryclass A $rdata"); push (@logans, "$queryname $ttl $queryclass A $rdata"); $resultcode = "NOERROR"; } else { if ($queryname =~ /^[0-9a-zA-Z-.]{1,255}$/) { $rdata = &getIP($queryname); push @ans, Net::DNS::RR->new("$queryname $ttl $queryclass A $rdata"); push (@logans, "$queryname $ttl $queryclass A $rdata"); $resultcode = "NOERROR"; } else { # invalid queryname $resultcode = "NXDOMAIN"; } } } elsif ($querytype eq "SOA") { if ($queryname =~ /^[0-9a-zA-Z-.]{1,255}$/) { # Answer section push @ans, Net::DNS::RR->new("$queryname $ttl $queryclass SOA ns1.$queryname hostmaster.$queryname $SOA_serial $SOA_refresh $SOA_retry $SOA_expire $SOA_minimum"); push @logans, "$queryname $ttl $queryclass SOA ns1.$queryname hostmaster.$queryname $SOA_serial $SOA_refresh $SOA_retry $SOA_expire $SOA_minimum"; # NS in Authority section push @auth, Net::DNS::RR->new("$queryname $ttl $queryclass NS ns1.$queryname"); push @auth, Net::DNS::RR->new("$queryname $ttl $queryclass NS ns2.$queryname"); push @logans, "$queryname $ttl $queryclass NS ns1.$queryname"; push @logans, "$queryname $ttl $queryclass NS ns2.$queryname"; # IPs for NS NS in Additional section my $ns1ip = getIP("ns1.$queryname"); my $ns2ip = getIP("ns2.$queryname"); push @add, Net::DNS::RR->new("ns1.$queryname $ttl $queryclass A $ns1ip"); push @add, Net::DNS::RR->new("ns2.$queryname $ttl $queryclass A $ns2ip"); push @logans, "ns1.$queryname $ttl $queryclass A $ns1ip"; push @logans, "ns2.$queryname $ttl $queryclass A $ns2ip"; $resultcode = "NOERROR"; } else { # invalid queryname $resultcode = "NXDOMAIN"; } } elsif ($querytype eq "PTR") { if ($queryname =~ /^[0-9a-zA-Z-.]{1,255}$/) { my $rdata = &getHost($queryname); push @ans, Net::DNS::RR->new("$queryname $ttl $queryclass PTR $rdata"); push @logans, "$queryname $ttl $queryclass $querytype $rdata"; $resultcode = "NOERROR"; } else { # invalid queryname $resultcode = "NXDOMAIN"; } } elsif ($querytype eq "TXT") { my $rdata; # http://www.ietf.org/rfc/rfc4892.txt # http://www.ietf.org/proceedings/54/I-D/draft-ietf-dnsop-serverid-00.txt if ($queryclass eq "CH" && ($queryname =~ /^(version|hostname)\.bind/i || $queryname =~ /^(id|version)\.server/i)) { $rdata = &INetSim::Config::getConfigParameter("DNS_Version"); } elsif ($queryname =~ /^[0-9a-zA-Z-.]{1,255}$/) { $rdata = "this is a txt record"; push @ans, Net::DNS::RR->new("$queryname $ttl $queryclass TXT \"$rdata\""); push @logans, "$queryname $ttl $queryclass $querytype \"$rdata\""; $resultcode = "NOERROR"; } else { # invalid queryname $resultcode = "NXDOMAIN"; } } elsif ($querytype eq "MX") { if ($queryname =~ /^[0-9a-zA-Z-.]{1,255}$/) { push @ans, Net::DNS::RR->new("$queryname $ttl $queryclass MX 10 mx1.$queryname"); push @ans, Net::DNS::RR->new("$queryname $ttl $queryclass MX 20 mx2.$queryname"); push (@logans, "$queryname $ttl $queryclass MX 10 mx1.$queryname"); push (@logans, "$queryname $ttl $queryclass MX 20 mx2.$queryname"); # IP-Adressen fr MX in Additional Section my $mx1ip = getIP("mx1.$queryname"); my $mx2ip = getIP("mx2.$queryname"); push @add, Net::DNS::RR->new("mx1.$queryname $ttl $queryclass A $mx1ip"); push @add, Net::DNS::RR->new("mx2.$queryname $ttl $queryclass A $mx2ip"); push (@logans, "mx1.$queryname $ttl $queryclass A $mx1ip"); push (@logans, "mx2.$queryname $ttl $queryclass A $mx2ip"); $resultcode = "NOERROR"; } else { # invalid queryname $resultcode = "NXDOMAIN"; } } elsif ($querytype eq "NS") { if ($queryname =~ /^[0-9a-zA-Z-.]{1,255}$/) { push @ans, Net::DNS::RR->new("$queryname $ttl $queryclass NS ns1.$queryname"); push @ans, Net::DNS::RR->new("$queryname $ttl $queryclass NS ns2.$queryname"); push (@logans, "$queryname $ttl $queryclass NS ns1.$queryname"); push (@logans, "$queryname $ttl $queryclass NS ns2.$queryname"); # IPs for NS in Additional Section my $ns1ip = getIP("ns1.$queryname"); my $ns2ip = getIP("ns2.$queryname"); push @add, Net::DNS::RR->new("ns1.$queryname $ttl $queryclass A $ns1ip"); push @add, Net::DNS::RR->new("ns2.$queryname $ttl $queryclass A $ns2ip"); push @logans, "ns1.$queryname $ttl $queryclass A $ns1ip"; push @logans, "ns2.$queryname $ttl $queryclass A $ns2ip"; $resultcode = "NOERROR"; } else { # invalid queryname $resultcode = "NXDOMAIN"; } } elsif ($querytype eq "ANY") { if ($queryname =~ /^[0-9a-zA-Z-.]{1,255}$/) { # SOA push @ans, Net::DNS::RR->new("$queryname $ttl $queryclass SOA ns1.$queryname hostmaster.$queryname $SOA_serial $SOA_refresh $SOA_retry $SOA_expire $SOA_minimum"); push @logans, "$queryname $ttl $queryclass SOA ns1.$queryname hostmaster.$queryname $SOA_serial $SOA_refresh $SOA_retry $SOA_expire $SOA_minimum"; # NS push @ans, Net::DNS::RR->new("$queryname $ttl $queryclass NS ns1.$queryname"); push @ans, Net::DNS::RR->new("$queryname $ttl $queryclass NS ns2.$queryname"); push (@logans, "$queryname $ttl $queryclass NS ns1.$queryname"); push (@logans, "$queryname $ttl $queryclass NS ns2.$queryname"); # MX push @ans, Net::DNS::RR->new("$queryname $ttl $queryclass MX 10 mx1.$queryname"); push @ans, Net::DNS::RR->new("$queryname $ttl $queryclass MX 20 mx2.$queryname"); push (@logans, "$queryname $ttl $queryclass $querytype 10 mx1.$queryname"); push (@logans, "$queryname $ttl $queryclass $querytype 20 mx2.$queryname"); # A my $rdata = &getIP($queryname); push @ans, Net::DNS::RR->new("$queryname $ttl $queryclass A $rdata"); push (@logans, "$queryname $ttl $queryclass A $rdata"); # IPs for NS and MX my $ns1ip = getIP("ns1.$queryname"); my $ns2ip = getIP("ns2.$queryname"); push @add, Net::DNS::RR->new("ns1.$queryname $ttl $queryclass A $ns1ip"); push @add, Net::DNS::RR->new("ns2.$queryname $ttl $queryclass A $ns2ip"); push @logans, "ns1.$queryname $ttl $queryclass A $ns1ip"; push @logans, "ns2.$queryname $ttl $queryclass A $ns2ip"; my $mx1ip = getIP("mx1.$queryname"); my $mx2ip = getIP("mx2.$queryname"); push @add, Net::DNS::RR->new("mx1.$queryname $ttl $queryclass A $mx1ip"); push @add, Net::DNS::RR->new("mx2.$queryname $ttl $queryclass A $mx2ip"); push (@logans, "mx1.$queryname $ttl $queryclass A $mx1ip"); push (@logans, "mx2.$queryname $ttl $queryclass A $mx2ip"); $resultcode = "NOERROR"; } else { # invalid queryname $resultcode = "NXDOMAIN"; } } elsif ($querytype eq "CNAME") { if ($queryname =~ /^[0-9a-zA-Z-.]{1,255}$/) { # some host push @ans, Net::DNS::RR->new("$queryname $ttl $queryclass CNAME host.$queryname"); push (@logans, "$queryname $ttl $queryclass CNAME host.$queryname"); $resultcode = "NOERROR"; } else { # invalid queryname $resultcode = "NXDOMAIN"; } } elsif ($querytype eq "AXFR") { $resultcode = "REFUSED"; } elsif ($querytype eq "AAAA") { $resultcode = "NOERROR"; } else { # $resultcode = "NXDOMAIN"; $resultcode = "NOTIMP"; } &INetSim::Log::SubLog("[$rhost] recv: Query Type ".$querytype.", Class ".$queryclass.", Name ".$queryname, $serviceName, $$); if ($resultcode ne "NXDOMAIN" && $resultcode ne "REFUSED" && $resultcode ne "NOTIMP" && $resultcode ne "SERVFAIL") { foreach my $msg (@logans){ &INetSim::Log::SubLog("[$rhost] send: ".$msg, $serviceName, $$); } $stat_success = 1; } else { &INetSim::Log::SubLog("[$rhost] Error: $resultcode", $serviceName, $$); } &INetSim::Log::SubLog("[$rhost] disconnect", $serviceName, $$); &INetSim::Log::SubLog("[$rhost] stat: $stat_success qtype=$querytype qclass=$queryclass qname=$queryname", $serviceName, $$); return ($resultcode, \@ans, \@auth, \@add, {aa => 1}); } sub getIP { my $hostname = lc(shift); my %static_host_to_ip = &INetSim::Config::getConfigHash("DNS_StaticHostToIP"); if (defined $static_host_to_ip{$hostname}) { return $static_host_to_ip{$hostname}; } else { return &INetSim::Config::getConfigParameter("DNS_Default_IP"); } } sub getHost { my $ip = lc(shift); my %static_ip_to_host = &INetSim::Config::getConfigHash("DNS_StaticIPToHost"); if (defined $static_ip_to_host{$ip}) { return $static_ip_to_host{$ip}; } else { return &INetSim::Config::getConfigParameter("DNS_Default_Hostname") . "." . &INetSim::Config::getConfigParameter("DNS_Default_Domainname"); } } 1; ############################################################# # # History: # # Version 0.6 (2017-04-19) th # - Fool taint check # # Version 0.5 (2016-08-09) th # - bugfixes, input validation # # Version 0.46 (2010-09-18) th # - check for broken version 0.65 of Net::DNS # # Version 0.45 (2009-09-25) me # - changed answer to server version queries and set query class to CH # # Version 0.44 (2009-09-24) me # - added new config parameter 'DNS_Version' # # Version 0.43 (2008-08-27) me # - added logging of process id # # Version 0.42 (2008-08-20) me # - added handling of queries for hosts called 'wpad' (look at # http://tools.ietf.org/html/draft-cooper-webi-wpad-00 for details) # # Version 0.41 (2008-06-26) me # - added checks for uninitialized variables # - changed answer to unknown query types to 'NOTIMP' (not implemented) # - added logging of result code if an error occurs # # Version 0.40 (2008-06-12) me # - changed handling of AAAA queries (according to RFC 4074) # # Version 0.39 (2008-06-12) me # - added handling of AAAA queries (returns NOTIMP) # # Version 0.38 (2007-12-31) th # - change process name # # Version 0.37 (2007-05-15) th # - switch user and group # # Version 0.36 (2007-04-27) th # - use getConfigParameter, getConfigHash # # Version 0.35 (2007-04-24) th # - replaced die() call if creating server fails # # Version 0.34 (2007-04-21) me # - added logging of status for use with &INetSim::Report::GenReport() # # Version 0.33 (2007-04-05) th # - made bind address configurable # # Version 0.32 (2007-04-02) th # - added handling of SOA queries # - moved additional information in responses from 'answer' # to 'additional' section # - added resolving of configured static addresses and names # # Version 0.31 (2007-03-27) th # - added configuration options # $INetSim::Config::DNS_ServiceName # $INetSim::Config::DNS_BindPort # # Version 0.3 (2007-03-17) th # - added configuration options # $INetSim::Config::DNS_Default_IP # $INetSim::Config::DNS_Default_Hostname # $INetSim::Config::DNS_Default_Domainname # # Version 0.2b (2007-03-15) me # ############################################################# inetsim-1.2.7/lib/INetSim/IRC.pm0000644000175000017500000006106513173076432014424 0ustar rgyrgy# -*- perl -*- # # INetSim::IRC - A fake IRC server # # RFC 1459 - Internet Relay Chat Protocol # # (c)2009-2010 Matthias Eckert, Thomas Hungenberg # # Version 0.10 (2010-04-19) # # For history/changelog see bottom of this file. # ############################################################# package INetSim::IRC; use strict; use warnings; use POSIX; use IO::Socket; use IO::Select; my %CONN; my %NICK; my %USER; my %HOST; my %CHAN; sub loop { my $self = shift; my $socket = $self->{server}->{socket}; my $select = $self->{server}->{select}; my $client; while (1) { my @can_read = $select->can_read(0.01); $self->{number_of_clients} = int($select->count()); foreach $client (@can_read) { if ($client == $socket) { $self->_accept; next; } $self->{server}->{client} = $client; $self->process_request; } my @can_write = $select->can_write(0.01); $self->{number_of_clients} = int($select->count()); foreach $client (@can_write) { $self->{server}->{client} = $client; #$self->check_timeout(); } } } sub send_initial_response { my $self = shift; my $client = $self->{server}->{client}; my $now = &INetSim::FakeTime::get_faketime(); $CONN{$client}->{connected} = $now; $CONN{$client}->{last_send} = $now; $CONN{$client}->{host} = $client->peerhost; $CONN{$client}->{port} = $client->peerport; $self->send_("NOTICE AUTH :*** Welcome to $self->{hostname}"); $self->send_("NOTICE AUTH :*** Looking up your hostname"); $self->send_("NOTICE AUTH :*** Checking Ident"); $self->send_("NOTICE AUTH :*** No ident response"); $self->send_("NOTICE AUTH :*** Found your hostname"); } sub _accept { my $self = shift; # accept the new connection my $client = $self->{server}->{socket}->accept; (defined $client) or return 0; ($client->connected) or return 0; $self->{server}->{client} = $client; # add the new handle to IO::Select $self->{server}->{select}->add($client); if ($self->{server}->{select}->exists($client)) { $self->slog_("connect"); $self->send_initial_response(); return 1; } else { $self->slog_("connect"); if ($self->{number_of_clients} >= $self->{maxchilds}) { $self->send_("ERROR :Closing Link: " . $client->peerhost . " (Maximum number of connections ($self->{maxchilds}) exceeded)"); } else { $self->send_("ERROR :Closing Link: " . $client->peerhost . " (Internal server error)"); } $self->slog_("disconnect"); $client->close; return 0; } } sub register_connection { my $self = shift; my $client = $self->{server}->{client}; my $rhost = $client->peerhost; my $rport = $client->peerport; $CONN{$client} = { connected => 0, host => undef, port => undef, ssl => undef, last_recv => 0, last_send => undef, last_ping_send => 0, last_pong_recv => 0, retries => 2, registered => 0, pass => undef, user => undef, nick => undef, realname => undef, channels => undef, modes => undef }; } sub process_request { my $self = shift; my $client = $self->{server}->{client}; my $rhost = $client->peerhost; my $rport = $client->peerport; # my $registered = $CONN{$client}->{registered}; # my $user = $CONN{$client}->{user}; # my $nick = $CONN{$client}->{nick}; my $line = <$client>; if (!defined $line) { $self->QUIT; return; } $line =~ s/[\r\n]+$//; ($line) or return; $self->slog_("recv: $line"); # update timestamp $CONN{$client}->{last_recv} = &INetSim::FakeTime::get_faketime(); # process request below... my ($user, $nick, $host, $command, $params) = $self->split_messageparts($line); (defined $command && $command) or return; # if ($command =~ /^PASS$/i) { $self->PASS($user, $nick, $host, $params); } elsif ($command =~ /^NICK$/i) { $self->NICK($user, $nick, $host, $params); } elsif ($command =~ /^USER$/i) { $self->USER($user, $nick, $host, $params); } # elsif ($command =~ /^SERVER$/i) { # $self->SERVER($user, $nick, $host, $params); # } # elsif ($command =~ /^OPER$/i) { # $self->OPER($user, $nick, $host, $params); # } elsif ($command =~ /^QUIT$/i) { $self->QUIT($user, $nick, $host, $params); } # elsif ($command =~ /^SQUIT$/i) { # $self->SQUIT($user, $nick, $host, $params); # } elsif ($command =~ /^JOIN$/i) { $self->JOIN($user, $nick, $host, $params); } elsif ($command =~ /^PART$/i) { $self->PART($user, $nick, $host, $params); } elsif ($command =~ /^MODE$/i) { $self->MODE($user, $nick, $host, $params); } # elsif ($command =~ /^TOPIC$/i) { # $self->TOPIC($user, $nick, $host, $params); # } # elsif ($command =~ /^NAMES$/i) { # $self->NAMES($user, $nick, $host, $params); # } # elsif ($command =~ /^LIST$/i) { # $self->LIST($user, $nick, $host, $params); # } # elsif ($command =~ /^INVITE$/i) { # $self->INVITE($user, $nick, $host, $params); # } # elsif ($command =~ /^KICK$/i) { # $self->KICK($user, $nick, $host, $params); # } # elsif ($command =~ /^VERSION$/i) { # $self->VERSION($user, $nick, $host, $params); # } # elsif ($command =~ /^STATS$/i) { # $self->STATS($user, $nick, $host, $params); # } # elsif ($command =~ /^LINKS$/i) { # $self->LINKS($user, $nick, $host, $params); # } # elsif ($command =~ /^TIME$/i) { # $self->TIME($user, $nick, $host, $params); # } # elsif ($command =~ /^CONNECT$/i) { # $self->CONNECT($user, $nick, $host, $params); # } # elsif ($command =~ /^TRACE$/i) { # $self->TRACE($user, $nick, $host, $params); # } # elsif ($command =~ /^ADMIN$/i) { # $self->ADMIN($user, $nick, $host, $params); # } # elsif ($command =~ /^INFO$/i) { # $self->INFO($user, $nick, $host, $params); # } elsif ($command =~ /^PRIVMSG$/i) { # $self->PRIVMSG($user, $nick, $host, $params); if ($CONN{$client}->{registered}) { $self->broadcast(":" . $CONN{$client}->{nick} . "!" . $CONN{$client}->{user} . "\@" . $CONN{$client}->{host} . " PRIVMSG $params"); #print STDERR ":" . $CONN{$client}->{nick} . "!" . $CONN{$client}->{user} . "\@" . $CONN{$client}->{host} . " PRIVMSG $params\n"; } } # elsif ($command =~ /^NOTICE$/i) { # $self->NOTICE($user, $nick, $host, $params); # } # elsif ($command =~ /^WHO$/i) { # $self->WHO($user, $nick, $host, $params); # } # elsif ($command =~ /^WHOIS$/i) { # $self->WHOIS($user, $nick, $host, $params); # } # elsif ($command =~ /^WHOWAS$/i) { # $self->WHOWAS($user, $nick, $host, $params); # } # elsif ($command =~ /^KILL$/i) { # $self->KILL($user, $nick, $host, $params); # } elsif ($command =~ /^PING$/i) { $self->PING($user, $nick, $host, $params); } elsif ($command =~ /^PONG$/i) { $self->PONG($user, $nick, $host, $params); } # elsif ($command =~ /^ERROR$/i) { # $self->ERROR($user, $nick, $host, $params); # } # OPTIONALS # elsif ($command =~ /^AWAY$/i) { # $self->AWAY($user, $nick, $host, $params); # } # elsif ($command =~ /^REHASH$/i) { # $self->REHASH($user, $nick, $host, $params); # } # elsif ($command =~ /^RESTART$/i) { # $self->RESTART($user, $nick, $host, $params); # } # elsif ($command =~ /^SUMMON$/i) { # $self->SUMMON($user, $nick, $host, $params); # } # elsif ($command =~ /^USERS$/i) { # $self->USERS($user, $nick, $host, $params); # } # elsif ($command =~ /^WALLOPS$/i) { # $self->WALLOPS($user, $nick, $host, $params); # } # elsif ($command =~ /^USERHOST$/i) { # $self->USERHOST($user, $nick, $host, $params); # } # elsif ($command =~ /^ISON$/i) { # $self->ISON($user, $nick, $host, $params); # } # else { # # nick!user@host # if ($CONN{$client}->{registered}) { # $self->broadcast(":$nick!$user\@$host PRIVMSG #CHAN :$line"); # } # } } sub split_messageparts { my ($self, $raw) = @_; my $client = $self->{server}->{client}; my $prefix; my ($user, $nick, $host, $command, $params); my $dummy; (defined $raw && $raw) or return undef; $raw =~ s/[^\x20-\x7E\r\n\t]//g; $raw =~ s/^[\s\t]+//; if ($raw =~ /^:/) { ($prefix, $command, $params) = split (/[\s\t]+/, $raw, 3); if (defined $prefix && $prefix) { ($nick, $dummy) = split (/[\!]+/, $prefix, 2); if (defined $dummy && $dummy) { ($user, $host) = split (/[\@]+/, $dummy, 2); } } } elsif ($raw =~ /^(PASS|NICK|USER|SERVER|OPER|QUIT|SQUIT|JOIN|PART|MODE|TOPIC|NAMES|LIST|INVITE|KICK|VERSION|STATS|LINKS|TIME|CONNECT|TRACE|ADMIN|INFO|PRIVMSG|NOTICE|WHO|WHOIS|WHOWAS|KILL|PING|PONG|ERROR|AWAY|REHASH|RESTART|SUMMON|USERS|WALLOPS|USERHOST|ISON)[\s\t]+.*$/i) { ($command, $params) = split (/[\s\t]+/, $raw, 2); } if (! defined $user || ! $user) { if (defined $CONN{$client}->{user}) { $user = $CONN{$client}->{user}; } else { $user = ""; } } if (! defined $nick || ! $nick) { if (defined $CONN{$client}->{nick}) { $nick = $CONN{$client}->{nick}; } else { $nick = ""; } } if (! defined $host || ! $host) { if (defined $CONN{$client}->{host}) { $host = $CONN{$client}->{host}; } else { $host = ""; } } #print STDERR "raw: $raw\n"; #print STDERR "user: $user, nick: $nick, host: $host, command: $command, params: $params\n"; return ($user, $nick, $host, $command, $params); } sub PASS { my ($self, $user, $nick, $host, $params) = @_; my $client = $self->{server}->{client}; if (! defined $params || ! $params) { if ($CONN{$client}->{registered}) { $self->send_(":$self->{hostname} 461 $CONN{$client}->{nick} PASS :Not enough parameters"); } else { $self->send_(":$self->{hostname} 461 unknown PASS :Not enough parameters"); } return; } if ($CONN{$client}->{registered}) { $self->send_(":$self->{hostname} 462 $CONN{$client}->{nick} :You may not reregister"); return; } $CONN{$client}->{pass} = $params; } sub NICK { my ($self, $user, $nick, $host, $params) = @_; my $client = $self->{server}->{client}; my ($oldnick, $newnick, $hopcount); if (! defined $params || ! $params) { if ($CONN{$client}->{registered}) { $self->send_(":$self->{hostname} 431 $CONN{$client}->{nick} :No nickname given"); } else { $self->send_(":$self->{hostname} 431 unknown :No nickname given"); } return; } $params =~ s/[\s\t]+$//; ($newnick, $hopcount) = split (/[\s\t]+/, $params, 2); if (defined $NICK{$newnick}) { if ($CONN{$client}->{registered}) { $self->send_(":$self->{hostname} 433 $CONN{$client}->{nick} :Nickname is already in use"); } else { $self->send_(":$self->{hostname} 436 unknown :Nickname collision KILL"); } return; } $NICK{$newnick} = 1; if ($CONN{$client}->{registered}) { $oldnick = $CONN{$client}->{nick}; delete $NICK{$oldnick}; } $CONN{$client}->{nick} = $newnick; (defined $hopcount && $hopcount) and $CONN{$client}->{hopcount} = $hopcount; if (! $CONN{$client}->{registered}) { if ($CONN{$client}->{nick} && $CONN{$client}->{user}) { $self->register; } $self->send_("PING :$self->{hostname}"); } else { $self->send_(":$oldnick!$CONN{$client}->{user}\@$CONN{$client}->{host} NICK :$newnick"); $self->broadcast(":$oldnick!$CONN{$client}->{user}\@$CONN{$client}->{host} NICK :$newnick"); # $self->broadcast("NOTICE $self->{hostname} #CHAN :$oldnick is now known as $newnick"); } } sub USER { my ($self, $user, $nick, $host, $params) = @_; my $client = $self->{server}->{client}; my ($realname, $server); if (! defined $params || ! $params) { $self->send_(":$self->{hostname} 461 unknown USER :Not enough parameters"); return; } ($user, $host, $server, $realname) = split(/[\s\t]+/, $params, 4); if (! defined $realname || ! $realname) { $self->send_(":$self->{hostname} 461 unknown USER :Not enough parameters"); return; } if ($CONN{$client}->{registered}) { $self->send_(":$self->{hostname} 462 $CONN{$client}->{nick} :You may not reregister"); return; } $realname =~ s/^://; $CONN{$client}->{user} = $user; $CONN{$client}->{realname} = $realname; if ($CONN{$client}->{nick} && $CONN{$client}->{user}) { $self->register; } } sub QUIT { my ($self, $user, $nick, $host, $params) = @_; my $client = $self->{server}->{client}; if ($CONN{$client}->{registered}) { $self->broadcast("NOTICE $self->{hostname} :User Disconnected: $CONN{$client}->{user}"); } $self->_close; } sub PONG { my ($self, $user, $nick, $host, $params) = @_; my $client = $self->{server}->{client}; if (! $CONN{$client}->{registered}) { $self->send_(":$self->{hostname} 451 unknown * PONG :You have not registered"); return; } if (! defined $params || ! $params) { $self->send_(":$self->{hostname} 461 $CONN{$client}->{nick} PONG :Not enough parameters"); return; } $CONN{$client}->{last_pong} = &INetSim::FakeTime::get_faketime(); } sub PING { my ($self, $user, $nick, $host, $params) = @_; my $client = $self->{server}->{client}; if (! $CONN{$client}->{registered}) { $self->send_(":$self->{hostname} 451 unknown * PING :You have not registered"); return; } if (! defined $params || ! $params) { $self->send_(":$self->{hostname} 461 $CONN{$client}->{nick} PING :Not enough parameters"); return; } $params =~ s/^://; $self->send_("PONG $params"); } sub JOIN { my ($self, $user, $nick, $host, $params) = @_; my $client = $self->{server}->{client}; if (! $CONN{$client}->{registered}) { $self->send_(":$self->{hostname} 451 unknown * JOIN :You have not registered"); return; } if (! defined $params || ! $params) { $self->send_(":$self->{hostname} 461 $CONN{$client}->{nick} JOIN :Not enough parameters"); return; } # $self->broadcast("NOTICE $self->{hostname} :User has joined: $CONN{$client}->{user}"); $self->broadcast(":$CONN{$client}->{nick}!$CONN{$client}->{user}\@$CONN{$client}->{host} JOIN :$params"); $self->send_(":$CONN{$client}->{nick}!$CONN{$client}->{user}\@$CONN{$client}->{host} JOIN :$params"); $params =~ s/^#//; $CONN{$client}->{channels} .= "$params,"; } sub PART { my ($self, $user, $nick, $host, $params) = @_; my $client = $self->{server}->{client}; if (! $CONN{$client}->{registered}) { $self->send_(":$self->{hostname} 451 unknown * PART :You have not registered"); return; } if (! defined $params || ! $params) { $self->send_(":$self->{hostname} 461 $CONN{$client}->{nick} PART :Not enough parameters"); return; } # $self->broadcast("NOTICE $self->{hostname} #CHAN :User has left: $CONN{$client}->{user}"); $self->broadcast(":$CONN{$client}->{nick}!$CONN{$client}->{user}\@$CONN{$client}->{host} PART :$params"); $self->send_(":$CONN{$client}->{nick}!$CONN{$client}->{user}\@$CONN{$client}->{host} PART :$params"); } sub MODE { my ($self, $user, $nick, $host, $params) = @_; my $client = $self->{server}->{client}; if (! $CONN{$client}->{registered}) { $self->send_(":$self->{hostname} 451 unknown * MODE :You have not registered"); return; } if (! defined $params || ! $params) { $self->send_(":$self->{hostname} 461 $CONN{$client}->{nick} MODE :Not enough parameters"); return; } $self->send_(":$CONN{$client}->{nick}!$CONN{$client}->{user}\@$CONN{$client}->{host} MODE :$params"); } sub register { my ($self, $sock, $msg) = @_; my $client = $self->{server}->{client}; $CONN{$client}->{registered} = 1; # the server sends replies 001 to 004 to a user upon successful registration $self->send_(":$self->{hostname} 001 $CONN{$client}->{nick} :Welcome to the Internet Relay Network $CONN{$client}->{nick}"); $self->send_(":$self->{hostname} 002 $CONN{$client}->{nick} :Your host is $self->{hostname}, running $self->{version}"); $self->send_(":$self->{hostname} 003 $CONN{$client}->{nick} :This server was created Oct 04 2009 at 02:47:07"); $self->send_(":$self->{hostname} 004 $CONN{$client}->{nick} :$self->{hostname} $self->{version}"); # tell the others about the new client $self->broadcast("NOTICE $self->{hostname} :User Connected: $CONN{$client}->{user}"); } sub broadcast { my ($self, $msg) = @_; my $sclient = $self->{server}->{client}; my $select = $self->{server}->{select}; (defined $msg && $msg) or return; my @can_write = $select->can_write(0.01); foreach my $receiver (@can_write) { next if ($receiver == $sclient); next if (! $CONN{$receiver}->{registered}); next if (! $self->{server}->{select}->exists($receiver)); $self->send_("$msg", $receiver); } } sub slog_ { my ($self, $msg, $sock) = @_; (defined $sock && $sock) or $sock = $self->{server}->{client}; my $rhost = $sock->peerhost; my $rport = $sock->peerport; (defined $msg) or return; $msg =~ s/[\r\n]*//; &INetSim::Log::SubLog("[$rhost:$rport] $msg", $self->{servicename}, $$); } sub dlog_ { my ($self, $msg, $sock) = @_; (defined $sock && $sock) or $sock = $self->{server}->{client}; my $rhost = $sock->peerhost; my $rport = $sock->peerport; (defined $msg) or return; $msg =~ s/[\r\n]*//; &INetSim::Log::DebugLog("[$rhost:$rport] $msg", $self->{servicename}, $$); } sub send_ { my ($self, $msg, $sock) = @_; (defined $sock && $sock) or $sock = $self->{server}->{client}; (defined $msg) or return; $msg =~ s/[\r\n]*//; print $sock "$msg\r\n"; $self->slog_("send: $msg", $sock); $CONN{$sock}->{last_send} = &INetSim::FakeTime::get_faketime(); } sub new { my $class = shift || die "Missing class"; my $args = @_ == 1 ? shift : {@_}; my $self = bless {server => { %$args }}, $class; return $self; } sub configure_hook { my $self = shift; $self->{server}->{host} = &INetSim::Config::getConfigParameter("Default_BindAddress"); # bind to address $self->{server}->{port} = &INetSim::Config::getConfigParameter("IRC_BindPort"); $self->{server}->{proto} = 'tcp'; # TCP protocol $self->{server}->{type} = SOCK_STREAM; $self->{server}->{user} = &INetSim::Config::getConfigParameter("Default_RunAsUser"); # user to run as $self->{server}->{group} = &INetSim::Config::getConfigParameter("Default_RunAsGroup"); # group to run as $self->{servicename} = &INetSim::Config::getConfigParameter("IRC_ServiceName"); $self->{maxchilds} = &INetSim::Config::getConfigParameter("Default_MaxChilds"); $self->{timeout} = &INetSim::Config::getConfigParameter("Default_TimeOut"); $self->{hostname} = &INetSim::Config::getConfigParameter("IRC_FQDN_Hostname"); $self->{version} = &INetSim::Config::getConfigParameter("IRC_Version"); } sub pre_loop_hook { my $self = shift; $0 = 'inetsim_' . $self->{servicename}; &INetSim::Log::MainLog("started (PID $$)", $self->{servicename}); } sub pre_server_close_hook { my $self = shift; &INetSim::Log::MainLog("stopped (PID $$)", $self->{servicename}); } sub fatal_hook { my ($self, $msg) = @_; if (defined $msg) { $msg =~ s/[\r\n]*//; &INetSim::Log::MainLog("failed! $!", $self->{servicename}); } else { &INetSim::Log::MainLog("failed!", $self->{servicename}); } exit 1; } sub server_close { my $self = shift; $self->{server}->{socket}->close(); exit 0; } sub bind { my $self = shift; # evil untaint $self->{server}->{host} =~ /(.*)/; $self->{server}->{host} = $1; # bind to socket $self->{server}->{socket} = new IO::Socket::INET( Listen => 1, LocalAddr => $self->{server}->{host}, LocalPort => $self->{server}->{port}, Proto => $self->{server}->{proto}, Type => $self->{server}->{type}, ReuseAddr => 1 ); (defined $self->{server}->{socket}) or $self->fatal_hook("$!"); # add socket to select $self->{server}->{select} = new IO::Select($self->{server}->{socket}); (defined $self->{server}->{select}) or $self->fatal_hook("$!"); # drop root privileges my $uid = getpwnam($self->{server}->{user}); my $gid = getgrnam($self->{server}->{group}); # group POSIX::setgid($gid); my $newgid = POSIX::getgid(); if ($newgid != $gid) { &INetSim::Log::MainLog("failed! (Cannot switch group)", $self->{servicename}); $self->server_close; } # user POSIX::setuid($uid); if ($< != $uid || $> != $uid) { $< = $> = $uid; # try again - reportedly needed by some Perl 5.8.0 Linux systems if ($< != $uid) { &INetSim::Log::MainLog("failed! (Cannot switch user)", $self->{servicename}); $self->server_close; } } # ignore SIG_INT, SIG_PIPE and SIG_QUIT $SIG{'INT'} = $SIG{'PIPE'} = $SIG{'QUIT'} = 'IGNORE'; # only "listen" for SIG_TERM from parent process $SIG{'TERM'} = sub { $self->pre_server_close_hook; $self->server_close; }; } sub run { my $self = ref($_[0]) ? shift() : shift->new; # configure this service $self->configure_hook; # open the socket and drop privilegies (set user/group) $self->bind; # just for compatibility with net::server $self->pre_loop_hook; # standard loop for: _accept->process_request->_close $self->loop; # just for compatibility with net::server $self->pre_server_close_hook; # shutdown socket and exit $self->server_close; } sub _close { my $self = shift; my $client = $self->{server}->{client}; my $rhost = $client->peerhost; my $rport = $client->peerport; &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$); if ($self->{server}->{select}->exists($client)) { $self->{server}->{select}->remove($client); } $client->close; delete $CONN{$client}; } sub error_exit { my ($self, $sock, $msg) = @_; my $rhost = $sock->peerhost; my $rport = $sock->peerport; if (! defined $msg) { $msg = "Unknown error"; } &INetSim::Log::MainLog("$msg. Closing connection.", $self->{servicename}); &INetSim::Log::SubLog("[$rhost:$rport] error: $msg. Closing connection.", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$); exit 1; } 1; ############################################################# # # History: # # Version 0.10 (2010-04-19) me # - use configuration variables for version and hostname # instead of static values # # Version 0.9 (2010-04-15) th/me # - removed replacing of non-printable characters before logging # as it is already implemented in log module # # Version 0.8 (2009-12-18) me # - do not log 'service stop' twice # # Version 0.7 (2009-12-05) me # - fixed a bug in server reply for nick name change # # Version 0.6 (2009-10-14) me # - added function to split message parts # - added support for nick name change # # Version 0.5 (2009-10-04) me # - some small fixes # # Version 0.4 (2009-10-03) me # - THIS PROTOCOL IS A DAMNED CRAP ! :-( # - first very simple implementations for PASS, NICK, USER, JOIN, # PART, MODE, PING, PONG and PRIVMSG # # Version 0.3 (2009-10-01) me # - played with IO::Select (try and error) # - changed initial server greeting # - added function _accept() # # Version 0.2 (2009-09-30) me # - enhanced in a similar manner like Net::Server # # Version 0.1 (2009-09-23) me # - initial version # ############################################################# inetsim-1.2.7/lib/INetSim/Echo/0000755000175000017500000000000013173076432014317 5ustar rgyrgyinetsim-1.2.7/lib/INetSim/Echo/TCP.pm0000644000175000017500000001146213173076432015307 0ustar rgyrgy# -*- perl -*- # # INetSim::Echo::TCP - A fake TCP echo server # # RFC 862 - Echo Protocol # # (c)2007-2010 Matthias Eckert, Thomas Hungenberg # # Version 0.50 (2010-04-12) # # For history/changelog see bottom of this file. # ############################################################# package INetSim::Echo::TCP; use strict; use warnings; use base qw(INetSim::Echo); sub configure_hook { my $self = shift; $self->{server}->{host} = &INetSim::Config::getConfigParameter("Default_BindAddress"); # bind to address $self->{server}->{port} = &INetSim::Config::getConfigParameter("Echo_TCP_BindPort"); # bind to port $self->{server}->{proto} = 'tcp'; # TCP protocol $self->{server}->{user} = &INetSim::Config::getConfigParameter("Default_RunAsUser"); # user to run as $self->{server}->{group} = &INetSim::Config::getConfigParameter("Default_RunAsGroup"); # group to run as $self->{server}->{setsid} = 0; # do not daemonize $self->{server}->{no_client_stdout} = 1; # do not attach client to STDOUT $self->{server}->{log_level} = 0; # do not log anything $self->{servicename} = &INetSim::Config::getConfigParameter("Echo_TCP_ServiceName"); $self->{max_childs} = &INetSim::Config::getConfigParameter("Default_MaxChilds"); $self->{timeout} = &INetSim::Config::getConfigParameter("Default_TimeOut"); } sub pre_loop_hook { my $self = shift; $0 = "inetsim_$self->{servicename}"; &INetSim::Log::MainLog("started (PID $$)", $self->{servicename}); } sub pre_server_close_hook { my $self = shift; &INetSim::Log::MainLog("stopped (PID $$)", $self->{servicename}); } sub fatal_hook { my $self = shift; &INetSim::Log::MainLog("failed!", $self->{servicename}); exit 0; } sub process_request { my $self = shift; my $client = $self->{server}->{client}; my $rhost = $self->{server}->{peeraddr}; my $rport = $self->{server}->{peerport}; my $stat_success = 0; &INetSim::Log::SubLog("[$rhost:$rport] connect", $self->{servicename}, $$); if ($self->{server}->{numchilds} >= $self->{max_childs}) { print $client "Maximum number of connections ($self->{max_childs}) exceeded.\n"; &INetSim::Log::SubLog("[$rhost:$rport] Connection refused - maximum number of connections ($self->{max_childs}) exceeded.", $self->{servicename}, $$); } else { eval { local $SIG{'ALRM'} = sub { die "TIMEOUT" }; alarm($self->{timeout}); while (my $line = <$client>) { print $client $line; $line =~ s/^[\r\n]+//g; $line =~ s/[\r\n]+$//g; if ($line ne "") { &INetSim::Log::SubLog("[$rhost:$rport] recv: $line", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] send: $line", $self->{servicename}, $$); $stat_success = 1; } alarm($self->{timeout}); } alarm(0); }; } if ($@ =~ /TIMEOUT/) { &INetSim::Log::SubLog("[$rhost:$rport] disconnect (timeout)", $self->{servicename}, $$); } else { &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$); } &INetSim::Log::SubLog("[$rhost:$rport] stat: $stat_success", $self->{servicename}, $$); } 1; ############################################################# # # History: # # Version 0.50 (2010-04-12) me # - undo changes from version 0.45 because it's already implemented # in the log module # # Version 0.49 (2009-10-28) me # - improved some code parts # # Version 0.48 (2008-08-27) me # - added logging of process id # # Version 0.47 (2008-03-19) me # - added timeout after inactivity of n seconds, using new # config parameter Default_TimeOut # # Version 0.46 (2007-12-31) th # - change process name # # Version 0.45 (2007-05-08) th # - replace non-printable characters with "." before logging # # Version 0.44 (2007-04-26) th # - use getConfigParameter # # Version 0.43 (2007-04-21) me # - added logging of status for use with &INetSim::Report::GenReport() # # Version 0.42 (2007-04-05) th # - changed check for MaxChilds, BindAddress, RunAsUser and # RunAsGroup # # Version 0.41 (2007-03-26) th # - added logging of refused connections # # Version 0.4 (2007-03-23) th # - split TCP and UDP servers to separate modules # - rewrote module to use INetSim::GenericServer # # Version 0.3 (2007-03-20) th # - changed echo_tcp for use with generic tcp_server # # Version 0.2 (2007-03-19) th # - rewrote echo_tcp to serve multiple connections # - added logging of remote port # # Version 0.1 (2007-03-18) me # ############################################################# inetsim-1.2.7/lib/INetSim/Echo/UDP.pm0000644000175000017500000001047613173076432015315 0ustar rgyrgy# -*- perl -*- # # INetSim::Echo::UDP - A fake UDP echo server # # RFC 862 - Echo Protocol # # (c)2007-2010 Matthias Eckert, Thomas Hungenberg # # Version 0.49 (2010-04-12) # # For history/changelog see bottom of this file. # ############################################################# package INetSim::Echo::UDP; use strict; use warnings; use base qw(INetSim::Echo); sub configure_hook { my $self = shift; $self->{server}->{host} = &INetSim::Config::getConfigParameter("Default_BindAddress"); # bind to address $self->{server}->{port} = &INetSim::Config::getConfigParameter("Echo_UDP_BindPort"); # bind to port $self->{server}->{proto} = 'udp'; # UDP protocol $self->{server}->{user} = &INetSim::Config::getConfigParameter("Default_RunAsUser"); # user to run as $self->{server}->{group} = &INetSim::Config::getConfigParameter("Default_RunAsGroup"); # group to run as $self->{server}->{setsid} = 0; # do not daemonize $self->{server}->{no_client_stdout} = 1; # do not attach client to STDOUT $self->{server}->{log_level} = 0; # do not log anything # $self->{server}->{udp_recv_len} = 1024; # default is 4096 $self->{servicename} = &INetSim::Config::getConfigParameter("Echo_UDP_ServiceName"); $self->{max_childs} = &INetSim::Config::getConfigParameter("Default_MaxChilds"); } sub pre_loop_hook { my $self = shift; $0 = "inetsim_$self->{servicename}"; &INetSim::Log::MainLog("started (PID $$)", $self->{servicename}); } sub pre_server_close_hook { my $self = shift; &INetSim::Log::MainLog("stopped (PID $$)", $self->{servicename}); } sub fatal_hook { my $self = shift; &INetSim::Log::MainLog("failed!", $self->{servicename}); exit 0; } sub process_request { my $self = shift; my $client = $self->{server}->{client}; my $rhost = $self->{server}->{peeraddr}; my $rport = $self->{server}->{peerport}; my $stat_success = 0; &INetSim::Log::SubLog("[$rhost:$rport] connect", $self->{servicename}, $$); if ($self->{server}->{numchilds} >= $self->{max_childs}) { print $client "Maximum number of connections ($self->{max_childs}) exceeded.\n"; &INetSim::Log::SubLog("[$rhost:$rport] Connection refused - maximum number of connections ($self->{max_childs}) exceeded.", $self->{servicename}, $$); } else { my $recvmsg = $self->{server}->{udp_data}; $client->send($recvmsg, 0); $recvmsg =~ s/^[\r\n]+//g; $recvmsg =~ s/[\r\n]+$//g; if ($recvmsg ne "") { &INetSim::Log::SubLog("[$rhost:$rport] recv: " . $recvmsg, $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] send: " . $recvmsg, $self->{servicename}, $$); $stat_success = 1; } } &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] stat: $stat_success", $self->{servicename}, $$); } 1; ############################################################# # # History: # # Version 0.49 (2010-04-12) me # - undo changes from version 0.45 because it's already implemented # in the log module # # Version 0.48 (2009-10-28) me # - improved some code parts # # Version 0.47 (2008-08-27) me # - added logging of process id # # Version 0.46 (2007-12-31) th # - change process name # # Version 0.45 (2007-05-08) th # - replace non-printable characters with "." before logging # # Version 0.44 (2007-04-26) th # - use getConfigParameter # # Version 0.43 (2007-04-21) me # - added logging of status for use with &INetSim::Report::GenReport() # # Version 0.42 (2007-04-05) th # - changed check for MaxChilds, BindAddress, RunAsUser and # RunAsGroup # # Version 0.41 (2007-03-26) th # - added logging of refused connections # # Version 0.4 (2007-03-23) th # - split TCP and UDP servers to separate modules # - rewrote module to use INetSim::GenericServer # # Version 0.3 (2007-03-20) th # - changed echo_tcp for use with generic tcp_server # # Version 0.2 (2007-03-19) th # - rewrote echo_tcp to serve multiple connections # - added logging of remote port # # Version 0.1 (2007-03-18) me # ############################################################# inetsim-1.2.7/lib/INetSim/POP3.pm0000644000175000017500000017076713173076432014542 0ustar rgyrgy# -*- perl -*- # # INetSim::POP3 - A fake POP3 server # # RFC 1939 - Post Office Protocol - Version 3 # # (c)2007-2014 Matthias Eckert, Thomas Hungenberg # # Version 0.106 (2014-05-23) # # For history/changelog see bottom of this file. # ############################################################# package INetSim::POP3; use strict; use warnings; use base qw(INetSim::GenericServer); use Digest::SHA; use MIME::Base64; #use Fcntl ':mode'; my $SSL = 0; eval { require IO::Socket::SSL; }; if (! $@) { $SSL = 1; }; # http://www.iana.org/assignments/pop3-extension-mechanism my %CAPA_AVAIL = ( "TOP" => 1, # RFC 1939, 2449 "USER" => 1, # RFC 1939, 2449 "SASL" => 2, # RFC 2449, 1734, 5034, 2195 ... (http://www.iana.org/assignments/sasl-mechanisms) "RESP-CODES" => 1, # RFC 2449 "LOGIN-DELAY" => 2, # RFC 2449 "PIPELINING" => 0, # RFC 2449 "EXPIRE" => 2, # RFC 2449 "UIDL" => 1, # RFC 1939, 2449 "IMPLEMENTATION" => 2, # RFC 2449 "AUTH-RESP-CODE" => 1, # RFC 3206 "STLS" => 1 # RFC 2595 ); # status: 10 of 11 # # Note: APOP is not listed as capability here (see RFC 2449 section 6.0 for more details) my %POP3_CAPA; my @MBOX; my %status; sub configure_hook { my $self = shift; my ($dev, $inode, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks, $grpname) = undef; $self->{server}->{host} = &INetSim::Config::getConfigParameter("Default_BindAddress"); # bind to address $self->{server}->{proto} = 'tcp'; # TCP protocol $self->{server}->{user} = &INetSim::Config::getConfigParameter("Default_RunAsUser"); # user to run as $self->{server}->{group} = &INetSim::Config::getConfigParameter("Default_RunAsGroup"); # group to run as $self->{server}->{setsid} = 0; # do not daemonize $self->{server}->{no_client_stdout} = 1; # do not attach client to STDOUT $self->{server}->{log_level} = 0; # do not log anything # cert directory $self->{cert_dir} = &INetSim::Config::getConfigParameter("CertDir"); if (defined $self->{server}->{'SSL'} && $self->{server}->{'SSL'}) { $self->{servicename} = &INetSim::Config::getConfigParameter("POP3S_ServiceName"); if (! $SSL) { &INetSim::Log::MainLog("failed! Library IO::Socket::SSL not installed", $self->{servicename}); exit 1; } $self->{ssl_key} = $self->{cert_dir} . (defined &INetSim::Config::getConfigParameter("POP3S_KeyFileName") ? &INetSim::Config::getConfigParameter("POP3S_KeyFileName") : &INetSim::Config::getConfigParameter("Default_KeyFileName")); $self->{ssl_crt} = $self->{cert_dir} . (defined &INetSim::Config::getConfigParameter("POP3S_CrtFileName") ? &INetSim::Config::getConfigParameter("POP3S_CrtFileName") : &INetSim::Config::getConfigParameter("Default_CrtFileName")); $self->{ssl_dh} = (defined &INetSim::Config::getConfigParameter("POP3S_DHFileName") ? &INetSim::Config::getConfigParameter("POP3S_DHFileName") : &INetSim::Config::getConfigParameter("Default_DHFileName")); if (! -f $self->{ssl_key} || ! -r $self->{ssl_key} || ! -f $self->{ssl_crt} || ! -r $self->{ssl_crt} || ! -s $self->{ssl_key} || ! -s $self->{ssl_crt}) { &INetSim::Log::MainLog("failed! Unable to read SSL certificate files", $self->{servicename}); exit 1; } $self->{ssl_enabled} = 1; $self->{server}->{port} = &INetSim::Config::getConfigParameter("POP3S_BindPort"); # bind to port $self->{mboxdirname} = &INetSim::Config::getConfigParameter("POP3S_MBOXDirName"); $self->{datfile} = $self->{mboxdirname} . "/pop3s.data"; $self->{sessionlockfile} = $self->{mboxdirname} . "/pop3s.lock"; $self->{sessiondatfile} = $self->{mboxdirname} . "/pop3s.session"; $self->{version} = &INetSim::Config::getConfigParameter("POP3S_Version"); $self->{banner} = &INetSim::Config::getConfigParameter("POP3S_Banner"); $self->{hostname} = &INetSim::Config::getConfigParameter("POP3S_Hostname"); $self->{enable_apop} = &INetSim::Config::getConfigParameter("POP3S_EnableAPOP"); $self->{capabilities} = &INetSim::Config::getConfigParameter("POP3S_EnableCapabilities"); $self->{auth_reversible_only} = &INetSim::Config::getConfigParameter("POP3S_AuthReversibleOnly"); $self->{mbox_reread} = &INetSim::Config::getConfigParameter("POP3S_MBOXReRead"); $self->{mbox_rebuild} = &INetSim::Config::getConfigParameter("POP3S_MBOXReBuild"); $self->{mbox_maxmails} = &INetSim::Config::getConfigParameter("POP3S_MBOXMaxMails"); } else { $self->{servicename} = &INetSim::Config::getConfigParameter("POP3_ServiceName"); $self->{ssl_enabled} = 0; $self->{server}->{port} = &INetSim::Config::getConfigParameter("POP3_BindPort"); # bind to port $self->{mboxdirname} = &INetSim::Config::getConfigParameter("POP3_MBOXDirName"); $self->{datfile} = $self->{mboxdirname} . "/pop3.data"; $self->{sessionlockfile} = $self->{mboxdirname} . "/pop3.lock"; $self->{sessiondatfile} = $self->{mboxdirname} . "/pop3.session"; $self->{version} = &INetSim::Config::getConfigParameter("POP3_Version"); $self->{banner} = &INetSim::Config::getConfigParameter("POP3_Banner"); $self->{hostname} = &INetSim::Config::getConfigParameter("POP3_Hostname"); $self->{enable_apop} = &INetSim::Config::getConfigParameter("POP3_EnableAPOP"); $self->{capabilities} = &INetSim::Config::getConfigParameter("POP3_EnableCapabilities"); $self->{auth_reversible_only} = &INetSim::Config::getConfigParameter("POP3_AuthReversibleOnly"); $self->{mbox_reread} = &INetSim::Config::getConfigParameter("POP3_MBOXReRead"); $self->{mbox_rebuild} = &INetSim::Config::getConfigParameter("POP3_MBOXReBuild"); $self->{mbox_maxmails} = &INetSim::Config::getConfigParameter("POP3_MBOXMaxMails"); $self->{ssl_key} = $self->{cert_dir} . (defined &INetSim::Config::getConfigParameter("POP3_KeyFileName") ? &INetSim::Config::getConfigParameter("POP3_KeyFileName") : &INetSim::Config::getConfigParameter("Default_KeyFileName")); $self->{ssl_crt} = $self->{cert_dir} . (defined &INetSim::Config::getConfigParameter("POP3_CrtFileName") ? &INetSim::Config::getConfigParameter("POP3_CrtFileName") : &INetSim::Config::getConfigParameter("Default_CrtFileName")); $self->{ssl_dh} = (defined &INetSim::Config::getConfigParameter("POP3_DHFileName") ? &INetSim::Config::getConfigParameter("POP3_DHFileName") : &INetSim::Config::getConfigParameter("Default_DHFileName")); } # warn about missing dh file and disable if (defined $self->{ssl_dh} && $self->{ssl_dh}) { $self->{ssl_dh} = $self->{cert_dir} . $self->{ssl_dh}; if (! -f $self->{ssl_dh} || ! -r $self->{ssl_dh}) { &INetSim::Log::MainLog("Warning: Unable to read Diffie-Hellman parameter file '$self->{ssl_dh}'", $self->{servicename}); $self->{ssl_dh} = undef; } } # disable apop, if 'auth_reversible_only' is enabled if ($self->{auth_reversible_only} && $self->{enable_apop}) { $self->{enable_apop} = 0; } $self->{maxchilds} = &INetSim::Config::getConfigParameter("Default_MaxChilds"); $self->{timeout} = &INetSim::Config::getConfigParameter("Default_TimeOut"); $self->{mboxdirname} =~ /^(.*)$/; # evil untaint! $self->{mboxdirname} = $1; $self->{datfile} =~ /^(.*)$/; # evil untaint! $self->{datfile} = $1; $self->{sessionlockfile} =~ /^(.*)$/; # evil untaint! $self->{sessionlockfile} = $1; $self->{sessiondatfile} =~ /^(.*)$/; # evil untaint! $self->{sessiondatfile} = $1; $MBOX[0] = ""; if (! open (DAT, ">> $self->{datfile}")) { &INetSim::Log::MainLog("Warning: Unable to open POP3 main data file file '$self->{datfile}': $!", $self->{servicename}); } else { close DAT; chmod 0660, $self->{datfile}; $gid = getgrnam("inetsim"); if (! defined $gid) { &INetSim::Log::MainLog("Warning: Unable to get GID for group 'inetsim'", $self->{servicename}); } chown -1, $gid, $self->{datfile}; ($dev, $inode, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat $self->{datfile}; $grpname = getgrgid $gid; # check for group owner 'inetsim' if ($grpname ne "inetsim") { &INetSim::Log::MainLog("Warning: Group owner of POP3 main datafile '$self->{datfile}' is not 'inetsim' but '$grpname'", $self->{servicename}); } # check for group r/w permissions if ((($mode & 0060) >> 3) != 6) { &INetSim::Log::MainLog("Warning: No group r/w permissions on POP3 main datafile '$self->{datfile}'", $self->{servicename}); } } if (! open (LCK, ">> $self->{sessionlockfile}")) { &INetSim::Log::MainLog("Warning: Unable to open POP3 lockfile file file '$self->{sessionlockfile}': $!", $self->{servicename}); } else { close LCK; chmod 0660, $self->{sessionlockfile}; $gid = getgrnam("inetsim"); if (! defined $gid) { &INetSim::Log::MainLog("Warning: Unable to get GID for group 'inetsim'", $self->{servicename}); } chown -1, $gid, $self->{sessionlockfile}; ($dev, $inode, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat $self->{sessionlockfile}; $grpname = getgrgid $gid; # check for group owner 'inetsim' if ($grpname ne "inetsim") { &INetSim::Log::MainLog("Warning: Group owner of POP3 lockfile '$self->{sessionlockfile}' is not 'inetsim' but '$grpname'", $self->{servicename}); } # check for group r/w permissions if ((($mode & 0060) >> 3) != 6) { &INetSim::Log::MainLog("Warning: No group r/w permissions on POP3 lockfile '$self->{sessionlockfile}'", $self->{servicename}); } } if (! open (SDAT, ">> $self->{sessiondatfile}")) { &INetSim::Log::MainLog("Warning: Unable to open POP3 session data file file '$self->{sessiondatfile}': $!", $self->{servicename}); } else { close SDAT; chmod 0660, $self->{sessiondatfile}; $gid = getgrnam("inetsim"); if (! defined $gid) { &INetSim::Log::MainLog("Warning: Unable to get GID for group 'inetsim'", $self->{servicename}); } chown -1, $gid, $self->{sessiondatfile}; ($dev, $inode, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat $self->{sessiondatfile}; $grpname = getgrgid $gid; # check for group owner 'inetsim' if ($grpname ne "inetsim") { &INetSim::Log::MainLog("Warning: Group owner of POP3 session datafile '$self->{sessiondatfile}' is not 'inetsim' but '$grpname'", $self->{servicename}); } # check for group r/w permissions if ((($mode & 0060) >> 3) != 6) { &INetSim::Log::MainLog("Warning: No group r/w permissions on POP3 session datafile '$self->{sessiondatfile}'", $self->{servicename}); } } # register configured (and available) capabilities $self->register_capabilities; } sub pre_loop_hook { my $self = shift; $0 = 'inetsim_' . $self->{servicename}; &INetSim::Log::MainLog("started (PID $$)", $self->{servicename}); } sub pre_server_close_hook { my $self = shift; $self->session_lock("unlock"); &INetSim::Log::MainLog("stopped (PID $$)", $self->{servicename}); } sub fatal_hook { my $self = shift; &INetSim::Log::MainLog("failed!", $self->{servicename}); exit 0; } sub process_request { my $self = shift; my $client = $self->{server}->{client}; my $line; $status{success} = 0; $status{auth_type} = ""; $status{credentials} = ""; $status{retrieved} = 0; $status{deleted} = 0; $status{tls_used} = 0; $status{tls_cipher} = ""; if ($self->{ssl_enabled} && ! $self->upgrade_to_ssl()) { $self->slog_("connect"); $self->slog_("info: Error setting up SSL: $self->{last_ssl_error}"); $self->slog_("disconnect"); } elsif ($self->{server}->{numchilds} >= $self->{maxchilds}) { $self->slog_("connect"); $self->send_("-ERR", "Maximum number of connections ($self->{maxchilds}) exceeded."); $self->slog_("disconnect"); } else { $self->slog_("connect"); ### Server Greeting if ($self->{enable_apop}) { $self->send_("+OK", "$self->{banner} <$$." . &INetSim::FakeTime::get_faketime() . "\@$self->{hostname}>"); } else { $self->send_("+OK", "$self->{banner}"); } # set variables/flags $self->{last_login} = 0; $self->{lock_error} = 0; $self->{state} = "auth"; # srand(time() ^($$ + ($$ <<15))); eval { local $SIG{'ALRM'} = sub { die "TIMEOUT" }; alarm($self->{timeout}); while ($line = <$client>){ ### 1. Waiting for Authorisation - The RFC calls this the Authentication State. Valid commands: USER PASS APOP QUIT ### 2. After 1, switching to Transaction State. Valid commands: STAT LIST RETR DELE NOOP RSET UIDL QUIT $line =~ s/^[\r\n\s\t]+//g; $line =~ s/[\r\n\s\t]+$//g; alarm($self->{timeout}); $self->slog_("recv: $line"); ### Auth via USER/PASS if ($line =~ /^USER(|([\s]+)(.*))$/i && defined $POP3_CAPA{USER}) { $self->USER($3); } elsif ($line =~ /^PASS(|([\s]+)(.*))$/i && defined $POP3_CAPA{USER}) { $self->PASS($3); if ($self->{close_connection}) { last; } } ### Auth via APOP elsif ($line =~ /^APOP(|([\s]+)(.*))$/i && $self->{enable_apop}) { $self->APOP($3); if ($self->{close_connection}) { last; } } elsif ($line =~ /^QUIT(|([\s]+)(.*))$/i) { $self->QUIT($3); if ($self->{close_connection}) { last; } } elsif ($line =~ /^STAT(|([\s]+)(.*))$/i) { $self->STAT($3); } elsif ($line =~ /^LIST(|([\s]+)(.*))$/i) { $self->LIST($3); } elsif ($line =~ /^RETR(|([\s]+)(.*))$/i) { $self->RETR($3); } elsif ($line =~ /^DELE(|([\s]+)(.*))$/i) { $self->DELE($3); } elsif ($line =~ /^NOOP(|([\s]+)(.*))$/i) { $self->NOOP($3); } elsif ($line =~ /^RSET(|([\s]+)(.*))$/i) { $self->RSET($3); } elsif ($line =~ /^TOP(|([\s]+)(.*))$/i && defined $POP3_CAPA{TOP}) { $self->TOP($3); } elsif ($line =~ /^UIDL(|([\s]+)(.*))$/i && defined $POP3_CAPA{UIDL}) { $self->UIDL($3); } elsif ($line =~ /^CAPA(|([\s]+)(.*))$/i && $self->{capabilities}) { $self->CAPA($3); } elsif ($line =~ /^AUTH(|([\s]+)(.*))$/i && defined $POP3_CAPA{SASL}) { $self->AUTH($3); if ($self->{close_connection}) { last; } } elsif ($line =~ /^STLS(|([\s]+)(.*))$/i && defined $POP3_CAPA{STLS}) { $self->STLS($3); if ($self->{close_connection}) { last; } } else { $self->send_("-ERR", "Unknown command."); } alarm($self->{timeout}); } alarm(0); }; if ($@ =~ /TIMEOUT/) { $self->send_("-ERR", "timeout exceeded"); $self->slog_("disconnect (timeout)"); } else { $self->slog_("disconnect"); } if (! $self->{lock_error} && $self->session_lock()){ $self->session_lock("unlock"); } } if ($status{success}) { $self->slog_("stat: $status{success} retrieved=$status{retrieved} deleted=$status{deleted} auth=$status{auth_type} creds=$status{credentials} tls=$status{tls_used} cipher=$status{tls_cipher}"); } else { $self->slog_("stat: $status{success}"); } } sub slog_ { my ($self, $msg) = @_; my $rhost = $self->{server}->{peeraddr}; my $rport = $self->{server}->{peerport}; if (defined ($msg)) { $msg =~ s/[\r\n]*//; &INetSim::Log::SubLog("[$rhost:$rport] $msg", $self->{servicename}, $$); } } sub dlog_ { my ($self, $msg) = @_; my $rhost = $self->{server}->{peeraddr}; my $rport = $self->{server}->{peerport}; if (defined ($msg)) { $msg =~ s/[\r\n]*//; &INetSim::Log::DebugLog("[$rhost:$rport] $msg", $self->{servicename}, $$); } } sub send_ { my ($self, $code, $msg, $ecode) = @_; # status code [+OK/-ERR] (required) ; message (required) ; extended status code (optional [RFC 2449, 3206]) my $client = $self->{server}->{client}; if (defined ($code) && defined ($msg)) { alarm($self->{timeout}); $msg =~ s/[\r\n]*//; if ($code =~ /^(\+OK|\-ERR)$/) { if ($self->{capabilities} && $code =~ /^\-ERR$/ && defined $POP3_CAPA{"RESP-CODES"} && defined $ecode && $ecode ne "") { if ($ecode =~ /^IN\-USE$/) { print $client "$code [$ecode] $msg\r\n"; $self->slog_("send: $code [$ecode] $msg"); } elsif (defined $POP3_CAPA{"LOGIN-DELAY"} && $ecode =~ /^LOGIN\-DELAY$/) { print $client "$code [$ecode] $msg\r\n"; $self->slog_("send: $code [$ecode] $msg"); } elsif (defined $POP3_CAPA{"AUTH-RESP-CODE"} && $ecode =~ /^(SYS\/TEMP|SYS\/PERM|AUTH)$/) { print $client "$code [$ecode] $msg\r\n"; $self->slog_("send: $code [$ecode] $msg"); } else { print $client "$code $msg\r\n"; $self->slog_("send: $code $msg"); } } else { print $client "$code $msg\r\n"; $self->slog_("send: $code $msg"); } } else { print $client "$msg\r\n"; $self->slog_("send: $msg"); } alarm($self->{timeout}); } } sub get_credentials { my ($self, $mech, $enc) = @_; my ($user, $pass, $other) = ""; my $dec; (defined $mech && $mech) or return 0; (defined $enc && $enc) or return 0; # decode base64, but not for APOP or USER/PASS if ($mech ne "apop" && $mech ne "user" && $mech ne "pass") { $enc =~ s/([^\x2B-\x7A])//g; $enc =~ s/([\x2C-\x2E])//g; $enc =~ s/([\x3A-\x3C])//g; $enc =~ s/([\x3E-\x40])//g; $enc =~ s/([\x5B-\x60])//g; $dec = b64_dec($enc); (defined $dec && $dec) or return 0; $dec =~ s/[\r\n]*$//; $dec =~ s/[\s\t]{2,}/\ /g; $dec =~ s/^[\s\t]+//; ($dec) or return 0; } # USER/PASS: RFC 1939 if ($mech eq "user" || $mech eq "pass") { $enc =~ s/[\r\n]*$//; $enc =~ s/[\s\t]{2,}/\ /g; $enc =~ s/^[\s\t]+//; $enc =~ s/[\s\t]+$//; # replace non-printable characters with "." $enc =~ s/([^\x20-\x7e])/\./g; if ($mech eq "user") { $user = $enc; $pass = ""; (defined $user && $user) or return 0; (length($user) <= 1024) or return 0; } elsif ($mech eq "pass") { $user = ""; $pass = $enc; (defined $pass && $pass) or return 0; (length($pass) <= 1024) or return 0; } $dec = $enc; } # APOP: RFC 1939 if ($mech eq "apop") { $enc =~ s/[\r\n]*$//; $enc =~ s/[\s\t]{2,}/\ /g; $enc =~ s/^[\s\t]+//; $enc =~ s/[\s\t]+$//; # replace non-printable characters with "." $enc =~ s/([^\x20-\x7e])/\./g; ($user, $pass) = split(/\s+/, $enc, 2); # check user/digest (defined $user && $user && defined $pass && $pass) or return 0; $user =~ s/\s+$//; $pass =~ s/^\s+//; $pass =~ s/\s+$//; # check maximum length (length($user) <= 1024) or return 0; # check for valid md5 ($pass =~ /^[[:xdigit:]]{32}$/) or return 0; $dec = $enc; } # ANONYMOUS: RFC 4505 [2245] elsif ($mech eq "anonymous") { $dec =~ s/[\s\t]+$//; # check maximum length (length($dec) <= 1024) or return 0; # replace non-printable characters with "." $dec =~ s/([^\x20-\x7e])/\./g; $user = $dec; $pass = ""; } # PLAIN: RFC 4616 [2595] elsif ($mech eq "plain") { # check maximum length (length($dec) <= 1024) or return 0; ($other, $user, $pass) = split(/\x00/, $dec, 3); (defined $user && $user && defined $pass && $pass) or return 0; $other = "" if (! defined $other); $dec =~ s/[\x00]+/\ /g; $dec =~ s/^\s+//g; $other =~ s/^\s+//; $user =~ s/^\s+//; $user =~ s/\s+$//; $pass =~ s/^\s+//; # replace non-printable characters with "." $dec =~ s/([^\x20-\x7e])/\./g; $other =~ s/([^\x20-\x7e])/\./g; $user =~ s/([^\x20-\x7e])/\./g; $pass =~ s/([^\x20-\x7e])/\./g; } # LOGIN: http://tools.ietf.org/html/draft-murchison-sasl-login-00 # check the username for login mechanism elsif ($mech eq "login_user") { $dec =~ s/[\s\t]+$//; # check maximum length (length($dec) < 64) or return 0; # replace non-printable characters with "." $dec =~ s/([^\x20-\x7e])/\./g; $user = $dec; } # check the password for login mechanism elsif ($mech eq "login_pass") { # check maximum length (length($dec) <= 1024) or return 0; # replace non-printable characters with "." $dec =~ s/([^\x20-\x7e])/\./g; $pass = $dec; } # CRAM-MD5/SHA1: RFC 2195 elsif ($mech eq "cram-md5" || $mech eq "cram-sha1") { $dec =~ s/\s+$//; # replace non-printable characters with "." $dec =~ s/([^\x20-\x7e])/\./g; ($user, $pass) = split(/\s+/, $dec, 2); (defined $user && $user && defined $pass && $pass) or return 0; $user =~ s/\s+$//; $pass =~ s/^\s+//; $pass =~ s/\s+$//; # check maximum length (length($user) <= 1024) or return 0; # check for valid md5 if ($mech eq "cram-md5" && $pass !~ /^[[:xdigit:]]{32}$/) { return 0; } # check for valid sha1 if ($mech eq "cram-sha1" && $pass !~ /^[[:xdigit:]]{40}$/) { return 0; } } return ($dec, $user, $pass, $other); } sub AUTH { my ($self, $args) = @_; my $client = $self->{server}->{client}; my @methods = split(/[\s\t]+/, $POP3_CAPA{SASL}); my ($encoded, $decoded); my ($user, $pass, $other, $dummy); if ($self->{state} ne "auth") { $self->send_("-ERR", "Command not available in TRANSACTION state."); return; } if (! defined $args || $args eq "" || $args =~ /^[\s\t]+\z/) { $self->send_("+OK", "List of supported authentication methods follows"); foreach (@methods) { $self->send_("", "$_"); } $self->send_("", "."); return; } my ($mechanism, $string, $more) = split(/[\s\t]+/, $args, 3); if (defined $more && $more && $more !~ /^[\s\t]+\z/) { $self->send_("-ERR", "Too many arguments for the auth command."); return; } if (! defined $mechanism || ! $mechanism) { $self->send_("-ERR", "Too few arguments for the auth command."); return; } if ($mechanism !~ /^(ANONYMOUS|PLAIN|LOGIN|CRAM-MD5|CRAM-SHA1)$/i) { $self->send_("-ERR", "Unknown authentication method"); return; } $mechanism = lc($mechanism); # test for allowed methods my $found = 0; foreach (@methods) { if ($mechanism eq lc($_)) { $found = 1; last; } } if (! $found) { $self->send_("-ERR", "Unknown authentication method"); return; } ### ANONYMOUS or PLAIN if ($mechanism eq "anonymous" || $mechanism eq "plain") { if (! defined $string || $string eq "") { $self->send_("", "+ Go on"); alarm($self->{timeout}); chomp($string = <$client>); alarm($self->{timeout}); $string =~ s/\r$//g; $string =~ s/[\r\n]+//g; # replace non-printable characters with "." $string =~ s/([^\x20-\x7e])/\./g; $self->slog_("recv: $string"); } if (! defined $string || $string eq "") { $self->send_("-ERR", "Authentication failed.", "AUTH"); return; } if ($string =~ /^\*/) { $self->send_("-ERR", "Authentication cancelled"); return; } ($decoded, $user, $pass, $other) = $self->get_credentials($mechanism, $string); if (! defined $decoded || ! $decoded) { $self->send_("-ERR", "Authentication failed.", "AUTH"); return; } $self->slog_("info: $string --> $decoded"); } ### LOGIN elsif ($mechanism eq "login") { if (defined $string && $string eq "") { $self->send_("-ERR", "Authentication failed.", "AUTH"); return; } # ask for username $self->send_("", "+ VXNlcm5hbWU6"); $self->slog_("info: VXNlcm5hbWU6 --> Username:"); alarm($self->{timeout}); chomp($string = <$client>); alarm($self->{timeout}); $string =~ s/\r$//g; $string =~ s/[\r\n]+//g; # replace non-printable characters with "." $string =~ s/([^\x20-\x7e])/\./g; $self->slog_("recv: $string"); if (! defined $string || $string eq "") { $self->send_("-ERR", "Authentication failed.", "AUTH"); return; } if ($string =~ /^\*/) { $self->send_("-ERR", "Authentication cancelled"); return; } ($decoded, $user, $dummy, $other) = $self->get_credentials("login_user", $string); if (! defined $decoded || ! $decoded) { $self->send_("-ERR", "Authentication failed.", "AUTH"); return; } $self->slog_("info: $string --> $decoded"); # ask for password $self->send_("", "+ UGFzc3dvcmQ6"); $self->slog_("info: UGFzc3dvcmQ6 --> Password:"); alarm($self->{timeout}); chomp($string = <$client>); alarm($self->{timeout}); $string =~ s/\r$//g; $string =~ s/[\r\n]+//g; # replace non-printable characters with "." $string =~ s/([^\x20-\x7e])/\./g; $self->slog_("recv: $string"); if (! defined $string || $string eq "") { $self->send_("-ERR", "Authentication failed.", "AUTH"); return; } if ($string =~ /^\*/) { $self->send_("-ERR", "Authentication cancelled"); return; } ($decoded, $dummy, $pass, $other) = $self->get_credentials("login_pass", $string); if (! defined $decoded || ! $decoded) { $self->send_("-ERR", "Authentication failed.", "AUTH"); return; } $self->slog_("info: $string --> $decoded"); } ### CRAM-MD5 or CRAM-SHA1 elsif ($mechanism eq "cram-md5" || $mechanism eq "cram-sha1") { if (defined $string && $string eq "") { $self->send_("-ERR", "Authentication failed.", "AUTH"); return; } my $greeting = "<$$." . &INetSim::FakeTime::get_faketime() . '@' . "$self->{hostname}>"; $encoded = encode_base64($greeting); $encoded =~ s/[\r\n]+$//; $self->send_("", "+ $encoded"); $self->slog_("info: $encoded --> $greeting"); alarm($self->{timeout}); chomp($string = <$client>); alarm($self->{timeout}); $string =~ s/\r$//g; $string =~ s/[\r\n]+//g; # replace non-printable characters with "." $string =~ s/([^\x20-\x7e])/\./g; $self->slog_("recv: $string"); if (! defined $string || $string eq "") { $self->send_("-ERR", "Authentication failed.", "AUTH"); return; } if ($string =~ /^\*/) { $self->send_("-ERR", "Authentication cancelled"); return; } ($decoded, $user, $pass, $other) = $self->get_credentials($mechanism, $string); if (! defined $decoded || ! $decoded) { $self->send_("-ERR", "Authentication failed.", "AUTH"); return; } $self->slog_("info: $string --> $decoded"); } ### Authentication successful... if (! $self->session_lock("lock")) { $self->send_("-ERR", "maildrop already locked.", "IN-USE"); $self->{lock_error} = 1; $self->{close_connection} = 1; return; } if ($self->login_delay()) { $self->send_("-ERR", "minimum time between mail checks violation", "LOGIN-DELAY"); $self->{close_connection} = 1; return; } $status{success} = 1; $status{auth_type} = "sasl/$mechanism"; $status{credentials} = "$user:$pass"; $self->{state} = "trans"; $self->mbox_reread(); $self->mbox_rebuild(); $self->session_read(); $self->spoolinfo(); } sub USER { my ($self, $args) = @_; my ($user, $pass, $other, $dummy); if ($self->{state} ne "auth") { $self->send_("-ERR", "Command not available in TRANSACTION state."); return; } if (! defined $args || ! $args || $args =~ /^[\s\t]+\z/) { $self->send_("-ERR", "Too few arguments for the user command."); return; } ($dummy, $user, $pass, $other) = $self->get_credentials("user", $args); if (! defined $dummy || ! $dummy) { $self->send_("-ERR", "Wrong username."); return; } if (length($user) < 2) { $self->send_("-ERR", "No such user.", "SYS/TEMP"); return; } if (length($user) > 508) { $self->send_("-ERR", "Username too long.", "SYS/PERM"); return; } $status{auth_type} = "user/pass"; $self->{state} = "auth"; $self->{username} = $user; $self->send_("+OK", "Please give password."); } sub PASS { my ($self, $args) = @_; my ($user, $pass, $other, $dummy); if ($self->{state} ne "auth") { $self->send_("-ERR", "Command not available in TRANSACTION state."); return; } if (! defined $self->{username} || ! $self->{username}) { $self->send_("-ERR", "Please give username first."); return; } if (! defined $args || ! $args || $args =~ /^[\s\t]+\z/) { $self->send_("-ERR", "Too few arguments for the pass command."); return; } ($dummy, $user, $pass, $other) = $self->get_credentials("pass", $args); if (! defined $dummy || ! $dummy) { $self->send_("-ERR", "Authentication failed.", "AUTH"); return; } if (length($pass) < 2) { $self->send_("-ERR", "Wrong password.", "AUTH"); return; } if (length($pass) > 508) { $self->send_("-ERR", "Password too long", "SYS/PERM"); return; } if (! $self->session_lock("lock")) { $self->send_("-ERR", "maildrop already locked.", "IN-USE"); $self->{lock_error} = 1; $self->{close_connection} = 1; return; } if ($self->login_delay()) { $self->send_("-ERR", "minimum time between mail checks violation", "LOGIN-DELAY"); $self->{close_connection} = 1; return; } $status{success} = 1; $status{auth_type} = "user/pass"; $status{credentials} = "$self->{username}:$pass"; $self->{state} = "trans"; $self->mbox_reread(); $self->mbox_rebuild(); $self->session_read(); $self->spoolinfo(); } sub APOP { my ($self, $args) = @_; my ($user, $digest, $other, $dummy); if ($self->{state} ne "auth") { $self->send_("-ERR", "Command not available in TRANSACTION state."); return; } if (! defined $args || $args eq "" || $args =~ /^[\s\t]+\z/) { $self->send_("-ERR", "Too few arguments for the apop command."); return; } ($dummy, $user, $digest, $other) = $self->get_credentials("apop", $args); if (! defined $dummy || ! $dummy) { $self->send_("-ERR", "Authentication failed.", "AUTH"); return; } if (length($user) < 2) { $self->send_("-ERR", "No such user.", "SYS/TEMP"); return; } if (length($user) > 476) { $self->send_("-ERR", "Username too long.", "SYS/PERM"); return; } if (! $self->session_lock("lock")) { $self->send_("-ERR", "Maildrop already locked.", "IN-USE"); $self->{lock_error} = 1; $self->{close_connection} = 1; return; } if ($self->login_delay()) { $self->send_("-ERR", "minimum time between mail checks violation", "LOGIN-DELAY"); $self->{close_connection} = 1; return; } $status{success} = 1; $status{auth_type} = "apop"; $status{credentials} = "$user:$digest"; $self->{state} = "trans"; $self->mbox_reread(); $self->mbox_rebuild(); $self->session_read(); $self->spoolinfo(); } sub QUIT { my ($self, $args) = @_; if (defined $args && $args && $args !~ /^[\s\t]+\z/) { $self->send_("-ERR", "Too many arguments for the quit command."); return; } if ($self->{state} eq "trans") { $self->{state} = "update"; $self->session_update(); $self->session_lock("unlock"); } $self->{state} = "auth"; $self->{close_connection} = 1; $self->send_("+OK", "Bye."); } sub CAPA { my ($self, $args) = @_; if (defined $args && $args && $args !~ /^[\s\t]+\z/) { $self->send_("-ERR", "Too many arguments for the capa command."); return; } # do multiline output $self->send_("+OK", "Capability list follows"); foreach (keys %POP3_CAPA) { if ($POP3_CAPA{$_} ne "") { $self->send_("", "$_ $POP3_CAPA{$_}"); } else { $self->send_("", "$_"); } } $self->send_("", "."); } sub STAT { my ($self, $args) = @_; if ($self->{state} ne "trans") { $self->send_("-ERR", "Unknown command."); return; } if (defined $args && $args && $args !~ /^[\s\t]+\z/) { $self->send_("-ERR", "Too many arguments for the stat command."); return; } $self->spoolinfo("STAT"); } sub LIST { my ($self, $args) = @_; my $client = $self->{server}->{client}; if ($self->{state} ne "trans") { $self->send_("-ERR", "Unknown command."); return; } if (defined $args && $args) { $args =~ s/^[\s\t]+//; $args =~ s/[\s\t]+\z//; if (! $args || $args !~ /^\d+\z/) { $self->send_("-ERR", "Invalid message number."); return; } my ($flag, $hash, $uid, $size, $header, $body) = $self->read_mail($args); if (defined $flag && $flag) { $self->send_("+OK", "$args $size"); } else { $self->send_("-ERR", "No such message or message deleted."); return; } } else { $self->spoolinfo("LIST"); } } sub RETR { my ($self, $args) = @_; my $client = $self->{server}->{client}; if ($self->{state} ne "trans") { $self->send_("-ERR", "Unknown command."); return; } if (! defined $args || ! $args) { $self->send_("-ERR", "Too few arguments for the retr command."); return; } $args =~ s/^[\s\t]+//; $args =~ s/[\s\t]+\z//; if (! $args || $args !~ /^\d+\z/) { $self->send_("-ERR", "Invalid message number."); return; } my ($flag, $hash, $uid, $size, $header, $body) = $self->read_mail($args); if (defined $flag && $flag) { $self->send_("+OK", "Message follows ($size octets)"); print $client "$header\r\n$body"; $self->slog_("send: <(MESSAGE)>"); print $client "\r\n.\r\n"; $self->slog_("send: ."); $status{retrieved}++; } else { $self->send_("-ERR", "No such message or message deleted."); } } sub DELE { my ($self, $args) = @_; if ($self->{state} ne "trans") { $self->send_("-ERR", "Unknown command."); return; } if (! defined $args || ! $args) { $self->send_("-ERR", "Too few arguments for the dele command."); return; } $args =~ s/^[\s\t]+//; $args =~ s/[\s\t]+\z//; if (! $args || $args !~ /^\d+\z/) { $self->send_("-ERR", "Invalid message number."); return; } if ($self->mark_mail($args)) { $self->send_("+OK", "Message deleted"); $status{deleted}++; } else { $self->send_("-ERR", "No such message"); } } sub TOP { my ($self, $args) = @_; my $client = $self->{server}->{client}; if ($self->{state} ne "trans") { $self->send_("-ERR", "Unknown command."); return; } if (! defined $args || $args eq "" || $args =~ /^[\s\t]+\z/) { $self->send_("-ERR", "Too few arguments for the top command."); return; } my ($number, $lines, $more) = split(/[\s\t]+/, $args, 3); if (defined $more && $more && $more !~ /^[\s\t]+\z/) { $self->send_("-ERR", "Too many arguments for the top command."); return; } if (! $number || $number !~ /^\d+\z/) { $self->send_("-ERR", "Invalid message number."); return; } if (! defined $lines || $lines !~ /^\d+\z/) { $self->send_("-ERR", "Invalid number of lines."); return; } my ($flag, $hash, $uid, $size, $header, $body) = $self->read_mail($number); if (defined $flag && $flag) { my @out = split (/\r\n/, $body); $self->send_("+OK", "top of message follows"); print $client "$header\r\n"; $self->slog_("send: <(MESSAGEPART)>"); if ($lines) { my $i = 0; foreach (@out) { print $client $out[$i]; $i++; last if ($i >= $lines); print $client "\r\n"; } } print $client "\r\n.\r\n"; $self->slog_("send: ."); } else { $self->send_("-ERR", "No such message or message deleted."); } } sub UIDL { my ($self, $args) = @_; my $client = $self->{server}->{client}; if ($self->{state} ne "trans") { $self->send_("-ERR", "Unknown command."); return; } if (defined $args && $args) { $args =~ s/^[\s\t]+//; $args =~ s/[\s\t]+\z//; if (! $args || $args !~ /^\d+\z/) { $self->send_("-ERR", "Invalid message number."); return; } my ($flag, $hash, $uid, $size, $header, $body) = $self->read_mail($args); if (defined $flag && $flag) { $self->send_("+OK", "$args $uid"); } else { $self->send_("-ERR", "No such message or message deleted."); return; } } else { $self->spoolinfo("UIDL"); } } sub NOOP { my ($self, $args) = @_; if ($self->{state} ne "trans") { $self->send_("-ERR", "Unknown command."); return; } if (defined $args && $args && $args !~ /^[\s\t]+\z/) { $self->send_("-ERR", "Too many arguments for the noop command."); return; } $self->send_("+OK", ""); } sub RSET { my ($self, $args) = @_; if ($self->{state} ne "trans") { $self->send_("-ERR", "Unknown command."); return; } if (defined $args && $args && $args !~ /^[\s\t]+\z/) { $self->send_("-ERR", "Too many arguments for the rset command."); return; } $self->spoolinfo(); } sub STLS { my ($self, $args) = @_; if (defined $args && $args && $args !~ /^[\s\t]+\z/) { $self->send_("-ERR", "Too many arguments for the stls command."); return; } if ($self->{using_tls}) { $self->send_("-ERR", "Command not permitted when TLS active"); return; } if ($self->{state} ne "auth") { $self->send_("-ERR", "Command not available in TRANSACTION state."); return; } $self->send_("+OK", "Begin TLS negotiation"); if ($self->upgrade_to_ssl()) { # deleting STLS extension (rfc 2595, section 4) delete $POP3_CAPA{"STLS"}; # set tls flag $self->{using_tls} = 1; $status{tls_used} = 1; # log success $self->slog_("info: Connection successfully upgraded to SSL"); } else { $self->slog_("info: Upgrade to SSL failed: $self->{last_ssl_error}"); $self->{close_connection} = 1; } } sub login_delay { my $self = shift; my $now = &INetSim::FakeTime::get_faketime(); $self->last_login(); if ($self->{capabilities} && defined $POP3_CAPA{"LOGIN-DELAY"} && $POP3_CAPA{"LOGIN-DELAY"} =~ /^(\d+)(\sUSER)?$/) { my $diff = &timediff($now, $self->{last_login}); if ($1 && $diff <= $1) { return 1; } } $self->{last_login} = $now; return 0; } sub spoolinfo { my ($self, $args) = @_; my $client = $self->{server}->{client}; my $count_all = 0; my $size_all = 0; my $i; my @uid; my @lst; for ($i = 1; $i < scalar @MBOX; $i++) { my ($flag, $hash, $uid, $size, $header, $body) = $self->read_mail($i); if (defined $flag && $flag) { $count_all++; $size_all += $size; push (@uid, "$i $uid"); push (@lst, "$i $size"); } } if (! defined $args || ! $args) { $self->send_("+OK", "$count_all message(s) ($size_all octets)."); return; } # extra stuff required by other commands if ($args eq "UIDL") { $self->send_("+OK", "UID listing follows"); foreach (@uid) { print $client "$_\r\n"; } $self->slog_("send: <(MESSAGEUIDS)>"); $self->send_("", "."); } elsif ($args eq "LIST") { $self->send_("+OK", "$count_all message(s) ($size_all octets)."); foreach (@lst) { print $client "$_\r\n"; } $self->slog_("send: <(MESSAGELIST)>"); $self->send_("", "."); } elsif ($args eq "STAT") { $self->send_("+OK", "$count_all $size_all"); } } sub add_mail { my ($self, $msg) = @_; my ($flag, $hash, $uid, $size, $header, $body); (defined $msg && $msg) or return 0; # remove mbox 'From ' $msg =~ s/^From .*?[\r\n]+//; # convert LF to CR/LF $msg =~ s/\r\n/\n/g; $msg =~ s/\n/\r\n/g; # quote 'CR+LF+.+CR+LF' $msg =~ s/\r\n\.\r\n/\r\n\.\.\r\n/g; # split header & body $msg =~ s/(\r\n){2,}/\|/; ($header, $body) = split(/\|/, $msg, 2); $header =~ s/[\r\n]+$//; $header =~ s/^[\r\n]+//; $body =~ s/[\r\n]+$//; $body =~ s/^[\r\n]+//; $header .= "\r\n"; $body .= "\r\n"; # get message length $size = int(length($header . $body) + 2); # hash the first 1024 bytes my $sha1 = Digest::SHA->new; $sha1->add(substr($msg, 0, 1024)); $hash = lc($sha1->hexdigest); # use 16 chars from hash as message uid $uid = substr($hash, 0, 16); # set flag (0 = deleted, 1 = available) $flag = 1; # add infos and the message to the array push (@MBOX, "$flag|$hash|$uid|$size|$header|$body"); return 1; } sub read_mail { my ($self, $number) = @_; my ($flag, $hash, $uid, $size, $header, $body); (defined $number && $number) or return 0; (defined $MBOX[$number]) or return 0; ($flag, $hash, $uid, $size, $header, $body) = split(/\|/, $MBOX[$number], 6); return ($flag, $hash, $uid, $size, $header, $body); } sub mark_mail { my ($self, $number) = @_; (defined $number && $number) or return 0; (defined $MBOX[$number]) or return 0; ($MBOX[$number] =~ /^1/) or return 0; $MBOX[$number] =~ s/^1(.*)$/0$1/m; return 1; } sub unmark_mail { my ($self, $number) = @_; (defined $number && $number) or return 0; (defined $MBOX[$number]) or return 0; ($MBOX[$number] =~ /^0/) or return 0; $MBOX[$number] =~ s/^0(.*)$/1$1/m; return 1; } sub mbox_reread { my $self = shift; my $mboxdirname = $self->{mboxdirname}; my $now = &INetSim::FakeTime::get_faketime(); my $last = $self->last_filechange($self->{datfile}); my $diff = &timediff($now, $last); if ($diff && $diff > $self->{mbox_reread}) { my @files; chomp(@files = <${mboxdirname}/*.mbox>); if (@files) { if (! open (DAT, ">$self->{datfile}")) { $self->dlog_("Could not open data file: $!"); return 0; } print DAT "CreationTime: $now\n"; my $file; foreach $file (@files) { if (! open (MBX, "$file")) { $self->dlog_("Could not open mbox file: $!"); next; } while () { s/\r\n/\n/g; print DAT $_; } print DAT "\n"; close MBX; } close DAT; } return 1; } return 0; } sub mbox_rebuild { my $self = shift; my $now = &INetSim::FakeTime::get_faketime(); my $last = $self->last_filechange($self->{sessiondatfile}); my $diff = &timediff($now, $last); my $max_mails = int(rand($self->{mbox_maxmails})); if ($diff && $diff > $self->{mbox_rebuild}) { if (! open (SES, ">$self->{sessiondatfile}")) { $self->dlog_("Could not open sessiondata file: $!"); return 0; } print SES "CreationTime: $now\n"; print SES "LastLogin: $self->{last_login}\n"; if (! open (DAT, "$self->{datfile}")) { $self->dlog_("Could not open data file: $!"); close SES; return 0; } my $msg; my $count = 0; my $line; my $last = ""; while ($line = ) { $line =~ s/\r\n/\n/g; next if ($line =~ /^CreationTime: (\d+)?$/); if ($line =~ /^From /) { if (defined $msg && $msg && $msg =~ /^From / && int(rand(100)) % 2 && $count < $max_mails) { print SES "$msg\n"; $count++; $last = ""; } $msg = undef; } $msg .= $line; last if ($count >= $max_mails); $last = $line; } close DAT; close SES; return 1; } return 0; } sub session_read { my $self = shift; my $count = 0; my $line; my $last = ""; my $msg; if (! open (SES, "$self->{sessiondatfile}")) { $self->dlog_("Could not open session data file: $!"); return 0; } while ($line = ) { next if ($line =~ /^CreationTime: (\d+)?$/); next if ($line =~ /^LastLogin: (\d+)?$/); if (defined $msg && $msg && $line =~ /^From / && $last =~ /^$/) { $self->add_mail($msg); $count++; $msg = undef; } $msg .= $line; } if (defined $msg && $msg && $msg =~ /^From /) { $self->add_mail($msg); $count++; } } sub session_update { my $self = shift; my $now = &INetSim::FakeTime::get_faketime(); if (! open (SES, ">$self->{sessiondatfile}")) { $self->dlog_("Could not open session data file: $!"); return 0; } print SES "CreationTime: $now\n"; print SES "LastLogin: $self->{last_login}\n"; my $i; for ($i = 1; $i < scalar @MBOX; $i++) { my ($flag, $hash, $uid, $size, $header, $body) = $self->read_mail($i); if (defined $flag && $flag) { print SES "From unknown\n"; print SES "$header\n$body\n\n"; } } close SES; } sub session_lock { my $self = shift; my $cmd = shift || "status"; my $lock = 0; if (open(LCK, "<$self->{sessionlockfile}")) { $lock = ; close LCK; } else { $self->dlog_("Could not open lock file: $!"); return 0; } if ($cmd eq "lock") { # already locked return 0 if ($lock); $lock = &INetSim::FakeTime::get_faketime(); if (open(LCK, ">$self->{sessionlockfile}")) { print LCK $lock; close LCK; return $lock; } else { $self->dlog_("Could not open lock file: $!"); return 0; } } elsif ($cmd eq "unlock") { # not locked return 0 if (! $lock); $lock = 0; if (open(LCK, ">$self->{sessionlockfile}")) { print LCK $lock; close LCK; return $lock; } else { $self->dlog_("Could not open lock file: $!"); return 0; } } else { return $lock; } } sub timediff { my ($time1, $time2) = @_; my $diff = 0; if (defined $time1 && defined $time2) { if ($time1 > $time2) { $diff = $time1 - $time2; } elsif ($time2 > $time1) { $diff = $time2 - $time1; } else { $diff = 0; } } return $diff; } sub last_filechange { my ($self, $file) = @_; (defined $file && $file && -f $file) or return 0; if (! open (FILE, "$file")) { $self->dlog_("Could not open file '$file': $!"); return 0; } my $ts = ; close FILE; if (defined $ts && $ts && $ts =~ /^CreationTime:\s(\d+)$/) { (defined $1 && $1) and return $1; } return 1; } sub last_login { my $self = shift; if (! open (SES, "$self->{sessiondatfile}")) { $self->dlog_("Could not open session data file: $!"); return 0; } my $dummy = ; my $last = ; close SES; if (defined $last && $last && $last =~ /^LastLogin:\s(\d+)$/) { $self->{last_login} = $1; } else { $self->{last_login} = 0; } return 1; } sub b64_dec { my $string = shift; my $length; my $out; (defined $string && $string) or return 0; (length($string) % 4 == 0) or return 0; ($string =~ /^[A-Za-z0-9\+\/]+([\=]{0,2})$/) or return 0; return decode_base64($string); } sub register_capabilities { my $self = shift; my %conf_capa; if ($self->{capabilities}) { if ($self->{ssl_enabled}) { %conf_capa = &INetSim::Config::getConfigHash("POP3S_Capabilities"); } else { %conf_capa = &INetSim::Config::getConfigHash("POP3_Capabilities"); } foreach (keys %conf_capa) { if (defined ($CAPA_AVAIL{$_}) && $CAPA_AVAIL{$_}) { if (! defined ($POP3_CAPA{$_})) { # for compatibility with old option 'pop3_auth_reversibleonly' if ($_ eq "SASL" && $self->{auth_reversible_only}) { $conf_capa{$_} =~ s/CRAM-(MD5|SHA1)([\s]+)?//g; # do not register without any mechanism next if ($conf_capa{$_} !~ /[A-Za-z0-9]+/); } $conf_capa{$_} =~ s/[\s]+$//; # parameters are allowed if ($CAPA_AVAIL{$_} == 2) { $POP3_CAPA{$_} = $conf_capa{$_}; } # parameters are not allowed else { $POP3_CAPA{$_} = ""; } } } } # resolve possible dependencies below... # # disable SASL, if no mechanisms are set if (defined $POP3_CAPA{SASL} && $POP3_CAPA{SASL} eq "") { delete $POP3_CAPA{SASL}; } # disable STLS, if SSL library not found or certfile/keyfile not found/not readable/empty if (! $SSL || ! -f $self->{ssl_key} || ! -r $self->{ssl_key} || ! -f $self->{ssl_crt} || ! -r $self->{ssl_crt} || ! -s $self->{ssl_key} || ! -s $self->{ssl_crt}) { delete $POP3_CAPA{STLS}; } # warn about missing dh file and disable if (defined $self->{ssl_dh} && (! -f $self->{ssl_dh} || ! -r $self->{ssl_dh} || ! -s $self->{ssl_dh})) { &INetSim::Log::MainLog("Warning: Unable to read Diffie-Hellman parameter file '$self->{ssl_dh}'", $self->{servicename}); $self->{ssl_dh} = undef; } # disable STLS, if already using SSL if ($self->{ssl_enabled}) { delete $POP3_CAPA{STLS}; } # check LOGIN-DELAY if (defined $POP3_CAPA{"LOGIN-DELAY"} && $POP3_CAPA{"LOGIN-DELAY"} !~ /^\d+(\sUSER)?$/) { delete $POP3_CAPA{"LOGIN-DELAY"}; } # check EXPIRE if (defined $POP3_CAPA{EXPIRE} && $POP3_CAPA{EXPIRE} !~ /^(\d+|NEVER|\d+\sUSER)$/) { delete $POP3_CAPA{EXPIRE}; } # check IMPLEMENTATION if (defined $POP3_CAPA{IMPLEMENTATION} && $POP3_CAPA{IMPLEMENTATION} eq "") { $POP3_CAPA{IMPLEMENTATION} = $self->{version}; } } # if USER and SASL capabilities and the APOP command are disabled, enable the weakest authentication mechanism (USER/PASS) if (! defined $POP3_CAPA{USER} && ! defined $POP3_CAPA{SASL} && ! $self->{enable_apop}) { $POP3_CAPA{USER} = ""; } } sub upgrade_to_ssl { my $self = shift; my %ssl_params = ( SSL_version => "SSLv23", SSL_cipher_list => "ALL", SSL_server => 1, SSL_use_cert => 1, SSL_key_file => $self->{ssl_key}, SSL_cert_file => $self->{ssl_crt} ); $self->{last_ssl_error} = ""; if (defined $self->{ssl_dh} && $self->{ssl_dh}) { $ssl_params{'SSL_dh_file'} = $self->{ssl_dh}; } my $result = IO::Socket::SSL::socket_to_SSL( $self->{server}->{client}, %ssl_params ); if (defined $result) { $status{tls_cipher} = lc($result->get_cipher()); return 1; } else { $self->{last_ssl_error} = IO::Socket::SSL::errstr(); return 0; } } sub error_exit { my ($self, $msg) = @_; my $rhost = $self->{server}->{peeraddr}; my $rport = $self->{server}->{peerport}; if (! defined $msg) { $msg = "Unknown error"; } &INetSim::Log::MainLog("$msg. Closing connection.", $self->{servicename}); &INetSim::Log::SubLog("[$rhost:$rport] error: $msg. Closing connection.", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$); exit 1; } 1; ############################################################# # # History: # # Version 0.106 (2014-05-23) th # - changed SSL_version to "SSLv23" # # Version 0.105 (2010-06-16) me # - fixed a small typo - THX to Stephan N. # # Version 0.104 (2010-04-12) me # - do not filter non-printable characters because it's already # implemented in the log module # # Version 0.103 (2009-12-19) me # - added new configuration variable 'CertDir' # # Version 0.102 (2009-10-09) me # - added generic function spoolinfo() to get some informations # about the messages in one step # - added generic decoder/parser function get_credentials() and # fixed some bugs in the authentication part - i believe, it # should be bullet-proof now :-) # - fixed small typos # # Version 0.101 (2009-10-06) me # - fixed small typo in function AUTH # - added new optional config paramter 'POP3[S]_DHFileName' # - changed function upgrade_to_ssl() to work with Diffie-Hellman # parameters and added 'ALL' available ciphers to the SSL # options (except 'eNULL') # - added information about TLS and SSL cipher to the status line # # Version 0.100 (2009-09-25) me # - added check for SSL library and cert files # - added new config parameter 'POP3[S]_Version' # # Version 0.99 (2009-09-24) me # - fixed small typo # # Version 0.98 (2009-09-23) me # - changed logging for TOP command # - added regular POP3 error response for session timeout # # Version 0.97 (2009-09-22) me # - enhanced support for LOGIN-DELAY, RESP-CODES and AUTH-RESP-CODE # - added more checks to register_capabilities() # - fixed some bugs in mbox_rebuild() # # Version 0.96 (2009-09-10) me # - added function register_capabilities() # - changed handling of mbox files # - changed handling of session data # - substituted message for maximum connections with an regular POP3 # error response # - added quoting for '.' in mail body # - added support for TOP (RFC 2449) # - added support for STLS (RFC 2595) # # Version 0.95 (2009-09-07) me # - complete rewrite (oo-style) # - added generic function send_() # - changed regular expression for commands # - added new ConfigParameter 'POP3[S]_EnableAPOP' # - changed server greeting, because it depends on APOP support # (for details see RFC 2449, section 6.0) # - added support for IMPLEMENTATION (RFC 1939, 2449) # - added support for LOGIN-DELAY and EXPIRE (RFC 2449) # - added support for RESP-CODES and AUTH-RESP-CODE (RFC 2449, 3206) # - added support for authentication mechanisms ANONYMOUS and CRAM-SHA1 # # Version 0.94 (2009-09-04) me # - prepared for complete rewrite ;-) # - added hash for available capabilities # - added support for SSL (pop3s) # - added generic functions slog_(), dlog_() and upgrade_to_ssl() # - some bugfixes with variables # - removed a bunch of unnecessary variables # # Version 0.93 (2009-08-27) me # - replace non-printable characters with "." # # Version 0.92 (2008-08-27) me # - added logging of process id # # Version 0.91 (2008-06-26) me # - fixed problem with uninitialized variables # # Version 0.90 (2008-03-25) me # - changed timeout handling # # Version 0.89 (2008-03-19) me # - added timeout after inactivity of n seconds, using new # config parameter Default_TimeOut # # Version 0.88 (2007-12-31) th # - change process name # # Version 0.87 (2007-12-09) me # - changed authentication mechanism support for use with new # ConfigParameter "POP3_AuthReversibleOnly" # # Version 0.86 (2007-10-21) th # - added "/" to beginning of filenames in POP3_MBOXDirName # # Version 0.85 (2007-10-20) me # - added new ConfigParameter "POP3_MBOXMaxMails" # - added new ConfigParameter "POP3_MBOXReRead" # - added new ConfigParameter "POP3_MBOXReBuild" # - fixed a bug with rebuilding timeout # # Version 0.84 (2007-09-16) me # - added CAPA command (RFC 2449) # - added support for SASL (RFC 2222/4422 + 1734) # - added SASL mechanisms PLAIN, LOGIN and CRAM-MD5 # - changed status details about authentication # # Version 0.83 (2007-09-03) me # - creating pop3.dat, session.dat and session.lck if they doesn't exist # # Version 0.82 (2007-05-26) me # - added checks if mbox file is available and writeable # # Version 0.81 (2007-05-01) me # - fixed a bug with incorrect mailcounts after delete # - added extra header "INetSim-ID" (to speed up size calculations etc.) # - added timeout value for &merge_avail_mbox_files # - added timeout value for rewrite of session-mbox # - added value for maximum mailcount # - changed logging of uidl and list command to prevent logfile-DoS # - fixed a bug with no mails after datafile cleanup # - ToDo: * timeout for new merge of mbox files should be added to config # * timeout for rebuild of session mbox should be added to config # * maximum mailcount should be added to config # * deleted-flag should be removed from extra header # # Version 0.80 (2007-04-29) me # - rewrote module for use without IPC::Shareable # - added new ConfigParameter "POP3_MBOXDirName" # - added function to generate unique mail-ids (sha1) # - added function to merge available mbox files # - added function for random selection of mails from merged mbox # # Version 0.76 (2007-04-26) th # - use getConfigParameter # # Version 0.75 (2007-04-26) me # - fixed a ugly bug in &spoolupdate with remaining messages after delete # # Version 0.74 (2007-04-25) th # - use single global shareable hash instead of multiple variables/arrays # # Version 0.73 (2007-04-24) me # - changed failed message and exit() if mbox is not available # to warning message only - no exit # # Version 0.72 (2007-04-21) th # - changed check if mbox file is available # # Version 0.71 (2007-04-21) me # - added logging of status for use with &INetSim::Report::GenReport() # # Version 0.70 (2007-04-19) me # - fixed logging for UIDL command # # Version 0.69 (2007-04-19) me # - fixed incorrect LIST, STAT and UIDL commands (new bug # because of the previous handling-fixes in 0.68) # - fixed possible unlock without authentication # - fixed possible maildrop change without authentication # - global array handling changed # # Version 0.68 (2007-04-18) me # - locking mechanism added # - fixed incorrect handling of DELE, RSET, RETR and QUIT # commands (according to RFC "Update-State") # # Version 0.67 (2007-04-10) th # - get fake time via &INetSim::FakeTime::get_faketime() # instead of accessing $INetSim::Config::FakeTimeDelta # - fixed double 'disconnect' message # # Version 0.66 (2007-04-05) th # - changed check for MaxChilds, BindAddress, RunAsUser and # RunAsGroup # # Version 0.65 (2007-03-27) th # - use IPC::Shareable to share POP3 spool info # # Version 0.6 (2007-03-26) th # - rewrote module to use INetSim::GenericServer # # Version 0.51 (2007-03-18) th # - added configuration options # $INetSim::Config::POP3_Banner # $INetSim::Config::POP3_Hostname # # Version 0.5 (2007-03-16) me # ############################################################# inetsim-1.2.7/lib/INetSim/Log.pm0000644000175000017500000002050113173076432014516 0ustar rgyrgy# -*- perl -*- # # INetSim::Log - INetSim logging # # (c)2007-2013 Matthias Eckert, Thomas Hungenberg # # Version 0.37 (2013-08-15) # # For history/changelog see bottom of this file. # ############################################################# package INetSim::Log; use strict; use warnings; use Fcntl ':mode'; my $mainlogfilename; my $sublogfilename; my $debuglogfilename; my $DEBUG = 0; my $SID = undef; sub init { my $dummy = &INetSim::Config::getConfigParameter("MainLogfileName"); $dummy =~ /^(.*)$/; # evil untaint! $mainlogfilename = $1; $dummy = &INetSim::Config::getConfigParameter("SubLogfileName"); $dummy =~ /^(.*)$/; # evil untaint! $sublogfilename = $1; $dummy = &INetSim::Config::getConfigParameter("DebugLogfileName"); $dummy =~ /^(.*)$/; # evil untaint! $debuglogfilename = $1; # check if MainLogfile exists if (! -f $mainlogfilename) { # if not, create it print STDOUT "Main logfile '$mainlogfilename' does not exist. Trying to create it...\n"; if (open (MLOG, ">$mainlogfilename")) { print STDOUT "Main logfile '$mainlogfilename' successfully created.\n"; close MLOG; chmod 0660, $mainlogfilename; my $gid = getgrnam("inetsim"); if (! defined $gid) { &INetSim::error_exit("Unable to get GID for group 'inetsim'"); } chown -1, $gid, $mainlogfilename; } else { &INetSim::error_exit("Unable to create main logfile '$mainlogfilename': $!"); } } else { # check ownership and permissions my ($dev, $inode, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat $mainlogfilename; my $grpname = getgrgid $gid; # check for group owner 'inetsim' if ($grpname ne "inetsim") { &INetSim::error_exit("Group owner of main logfile '$mainlogfilename' is not 'inetsim' but '$grpname'"); } # check for group r/w permissions if ((($mode & 0060) >> 3) != 6) { &INetSim::error_exit("No group r/w permissions on main logfile '$mainlogfilename'"); } } # check if SubLogfile exists if (! -f $sublogfilename) { # if not, create it print STDOUT "Sub logfile '$sublogfilename' does not exist. Trying to create it...\n"; if (open (MLOG, ">$sublogfilename")) { print STDOUT "Sub logfile '$sublogfilename' successfully created.\n"; close MLOG; chmod 0660, $sublogfilename; my $gid = getgrnam("inetsim"); if (! defined $gid) { &INetSim::error_exit("Unable to get GID for group 'inetsim'"); } chown -1, $gid, $sublogfilename; } else { &INetSim::error_exit("Unable to create sub logfile '$sublogfilename': $!"); } } else { # check ownership and permissions my ($dev, $inode, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat $sublogfilename; my $grpname = getgrgid $gid; # check for group owner 'inetsim' if ($grpname ne "inetsim") { &INetSim::error_exit("Group owner of sub logfile '$sublogfilename' is not 'inetsim' but '$grpname'"); } # check for group r/w permissions if ((($mode & 0060) >> 3) != 6) { &INetSim::error_exit("No group r/w permissions on sub logfile '$sublogfilename'"); } } # check if DebugLogfile exists if (! -f $debuglogfilename) { # if not, create it print STDOUT "Debug logfile '$debuglogfilename' does not exist. Trying to create it...\n"; if (open (MLOG, ">$debuglogfilename")) { print STDOUT "Debug logfile '$debuglogfilename' successfully created.\n"; close MLOG; chmod 0660, $debuglogfilename; my $gid = getgrnam("inetsim"); if (! defined $gid) { &INetSim::error_exit("Unable to get GID for group 'inetsim'"); } chown -1, $gid, $debuglogfilename; } else { &INetSim::error_exit("Unable to create debug logfile '$debuglogfilename': $!"); } } else { # check ownership and permissions my ($dev, $inode, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat $debuglogfilename; my $grpname = getgrgid $gid; # check for group owner 'inetsim' if ($grpname ne "inetsim") { &INetSim::error_exit("Group owner of debug logfile '$debuglogfilename' is not 'inetsim' but '$grpname'"); } # check for group r/w permissions if ((($mode & 0060) >> 3) != 6) { &INetSim::error_exit("No group r/w permissions on debug logfile '$debuglogfilename'"); } } $DEBUG = &INetSim::Config::getConfigParameter("Debug"); } sub MainLog{ my $msg = shift || return 0; my $service = shift || "main"; $msg =~ s/[\r\n]*$//g; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydat,$isdst) = localtime(); my $date = sprintf "%4d-%02d-%02d %02d:%02d:%02d", $year+1900,$mon+1,$mday,$hour,$min,$sec; if (! open (MLOG, ">>$mainlogfilename")) { &INetSim::error_exit("Unable to open main logfile '$mainlogfilename': $!"); } select MLOG; $| = 1; if ($service ne "main") { print MLOG "[$date] * $service $msg\n"; $msg =~ s/failed\!/\033\[31\;1mfailed\!\033\[0m/; print STDOUT " * $service - $msg\n"; } else { print MLOG "[$date] $msg\n"; $msg =~ s/failed\!/\033\[31\;1mfailed\!\033\[0m/; print STDOUT "$msg\n"; } close MLOG; } sub SubLog{ my ($msg, $service, $cpid) = @_; ($msg && $service && $cpid) or return; $msg =~ s/[\r\n]*$//g; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydat,$isdst) = localtime(&INetSim::FakeTime::get_faketime()); my $fakedate = sprintf "%4d-%02d-%02d %02d:%02d:%02d", $year+1900,$mon+1,$mday,$hour,$min,$sec; if (! open (SLOG, ">>$sublogfilename")) { &INetSim::error_exit("Unable to open sub logfile '$sublogfilename': $!"); } select SLOG; $| = 1; # replace non-printable characters with "." $msg =~ s/([^\x20-\x7e])/\./g; (!$SID) && ($SID = &INetSim::Config::getConfigParameter("SessionID")); print SLOG "[$fakedate] [$SID] [$service $cpid] $msg\n"; close SLOG; } sub DebugLog{ ($DEBUG) or return; my ($msg, $service, $cpid) = @_; ($msg && $service && $cpid) or return; $msg =~ s/[\r\n]*$//g; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydat,$isdst) = localtime(&INetSim::FakeTime::get_faketime()); my $fakedate = sprintf "%4d-%02d-%02d %02d:%02d:%02d", $year+1900,$mon+1,$mday,$hour,$min,$sec; if (! open (DLOG, ">>$debuglogfilename")) { &INetSim::error_exit("Unable to open debug logfile '$debuglogfilename': $!"); } select DLOG; $| = 1; # replace non-printable characters with "." $msg =~ s/([^\x20-\x7e])/\./g; (!$SID) && ($SID = &INetSim::Config::getConfigParameter("SessionID")); print DLOG "[$fakedate] [$SID] [$service $cpid] $msg\n"; close DLOG; } 1; ############################################################# # # History: # # Version 0.37 (2013-08-15) th # - use correct session ID in service.log # # Version 0.36 (2009-10-30) me # - replace non-printable characters with "." # # Version 0.35 (2009-10-29) me # - small optimisations - mostly in functions SubLog() and DebugLog() # # Version 0.34 (2008-09-01) me # - changed column of process id in functions SubLog() and DebugLog() # # Version 0.33 (2008-08-27) me # - added logging of process id in functions SubLog() and DebugLog() # # Version 0.32 (2007-05-02) th # - merged versions 0.30b and 0.31 # # Version 0.31 (2007-04-30) th # - check group owner and permissions of logfiles # # Version 0.30b (2007-04-28) me # - added function DebugLog # # Version 0.30 (2007-04-29) th # - added init function # - check if logfiles exist, otherwise create them # # Version 0.29 (2007-04-27) th # - use getConfigParameter # # Version 0.28 (2007-04-24) th # - fixed deep recursion if logfiles cannot be opened # # Version 0.27 (2007-04-22) th # - separate $service and $msg by "-" in SubLog # # Version 0.26 (2007-04-20) me # - added logging of $INetSim::Config::SessionID in SubLog # # Version 0.25 (2007-04-19) me # - eye-catcher for "failed!" messages added # # Version 0.24 (2007-04-13) th # - removed logging of real date/time in SubLog # # Version 0.23 (2007-04-10) th # - get fake time via &INetSim::FakeTime::get_faketime() # instead of accessing $INetSim::Config::FakeTimeDelta # # Version 0.22 (2007-04-09) th # - added logging of faketime in SubLog # # Version 0.21 (2007-04-06) th # - added blanks in sublog output # # Version 0.2 (2007-03-27) th # - moved logging functions from main program to this module # ############################################################# inetsim-1.2.7/lib/INetSim/Discard.pm0000644000175000017500000000071713173076432015355 0ustar rgyrgy# -*- perl -*- # # INetSim::Discard - Base package for Discard::TCP and Discard::UDP # # (c)2007-2008 Thomas Hungenberg, Matthias Eckert # # Version 0.1 (2007-03-26) # ############################################################# # # History: # # Version 0.1 (2007-03-26) th # ############################################################# package INetSim::Discard; use strict; use warnings; use base qw(INetSim::GenericServer); # no shared functions 1; # inetsim-1.2.7/lib/INetSim/Config.pm0000644000175000017500000027444113173076432015220 0ustar rgyrgy# -*- perl -*- # # INetSim::Config - INetSim configuration file parser # # (c)2007-2013 Thomas Hungenberg, Matthias Eckert # # Version 0.105 (2013-11-02) # # For history/changelog see bottom of this file. # ############################################################# package INetSim::Config; use strict; use warnings; use Cwd; use IPC::Shareable; ############################################################# # Global / Default variables my @SERVICES = qw/smtp pop3 http ftp ntp dns ident daytime_tcp daytime_udp time_tcp time_udp echo_tcp echo_udp discard_tcp discard_udp chargen_tcp chargen_udp quotd_tcp quotd_udp tftp autofaketime finger dummy_tcp dummy_udp syslog irc/; my @SSLSERVICES = qw/smtps pop3s https ftps/; my @ServicesToStart = (); my @usedPorts = (); # check for SSL support eval { require IO::Socket::SSL; }; my $SSL = (! $@) ? 1 : 0; # set BaseDir to current working directory my $currentdir = cwd(); $currentdir =~ /^(.*)$/; # evil untaint! my $logdir = $currentdir . "/log/"; my $datadir = $currentdir . "/data/"; my $reportdir = $currentdir . "/report/"; ############################################################# # Configuration Options my %ConfigOptions; my %shareopts = ( create => 1, exclusive => 0, mode => 0666, destroy => 1 ); tie %ConfigOptions, 'IPC::Shareable', "CNFG", { %shareopts } or die "unable to tie"; %ConfigOptions = ( SessionID => $$, LogDir => $logdir, MainLogfileName => $logdir . "main.log", SubLogfileName => $logdir . "service.log", DebugLogfileName => $logdir . "debug.log", ConfigFileName => $currentdir . "/conf/inetsim.conf", DataDir => $datadir, CertDir => $datadir . "certs/", ReportDir => $reportdir, Debug => 0, Faketime_Delta => 0, Faketime_AutoDelay => 0, Faketime_AutoIncrement => 3600, Faketime_Max => 2147483647, Default_BindAddress => "127.0.0.1", Default_MaxChilds => 10, Default_RunAsUser => 'nobody', Default_RunAsGroup => 'inetsim', Default_TimeOut => 120, Default_KeyFileName => "default_key.pem", Default_CrtFileName => "default_cert.pem", Default_DHFileName => undef, Create_Reports => 1, ReportLanguage => "en", Chargen_TCP_BindAddress => undef, Chargen_TCP_BindPort => 19, Chargen_TCP_MaxChilds => undef, Chargen_TCP_RunAsUser => undef, Chargen_TCP_RunAsGroup => undef, Chargen_TCP_ServiceName => undef, Chargen_UDP_BindAddress => undef, Chargen_UDP_BindPort => 19, Chargen_UDP_MaxChilds => undef, Chargen_UDP_RunAsUser => undef, Chargen_UDP_RunAsGroup => undef, Chargen_UDP_ServiceName => undef, Daytime_TCP_BindAddress => undef, Daytime_TCP_BindPort => 13, Daytime_TCP_MaxChilds => undef, Daytime_TCP_RunAsUser => undef, Daytime_TCP_RunAsGroup => undef, Daytime_TCP_ServiceName => undef, Daytime_UDP_BindAddress => undef, Daytime_UDP_BindPort => 13, Daytime_UDP_MaxChilds => undef, Daytime_UDP_RunAsUser => undef, Daytime_UDP_RunAsGroup => undef, Daytime_UDP_ServiceName => undef, Discard_TCP_BindAddress => undef, Discard_TCP_BindPort => 9, Discard_TCP_MaxChilds => undef, Discard_TCP_RunAsUser => undef, Discard_TCP_RunAsGroup => undef, Discard_TCP_ServiceName => undef, Discard_UDP_BindAddress => undef, Discard_UDP_BindPort => 9, Discard_UDP_MaxChilds => undef, Discard_UDP_RunAsUser => undef, Discard_UDP_RunAsGroup => undef, Discard_UDP_ServiceName => undef, DNS_BindAddress => undef, DNS_BindPort => 53, DNS_RunAsUser => undef, DNS_RunAsGroup => undef, DNS_MaxChilds => undef, DNS_Default_IP => "127.0.0.1", DNS_Default_Hostname => "www", DNS_Default_Domainname => "inetsim.org", DNS_Version => "INetSim DNS Server", DNS_StaticHostToIP => {}, DNS_StaticIPToHost => {}, DNS_ServiceName => undef, Echo_TCP_BindAddress => undef, Echo_TCP_BindPort => 7, Echo_TCP_MaxChilds => undef, Echo_TCP_RunAsUser => undef, Echo_TCP_RunAsGroup => undef, Echo_TCP_ServiceName => undef, Echo_UDP_BindAddress => undef, Echo_UDP_BindPort => 7, Echo_UDP_MaxChilds => undef, Echo_UDP_RunAsUser => undef, Echo_UDP_RunAsGroup => undef, Echo_UDP_ServiceName => undef, HTTP_BindAddress => undef, HTTP_BindPort => 80, HTTP_MaxChilds => undef, HTTP_RunAsUser => undef, HTTP_RunAsGroup => undef, HTTP_DocumentRoot => $datadir . "http/wwwroot", HTTP_MIMETypesFileName => $datadir . "http/mime.types", HTTP_Version => "INetSim HTTP Server", HTTP_FakeMode => 1, HTTP_FakeFileDir => $datadir . "http/fakefiles", HTTP_FakeFileExtToName => {}, HTTP_FakeFileExtToMIMEType => {}, HTTP_Default_FakeFileName => undef, HTTP_Default_FakeFileMIMEType => undef, HTTP_Static_FakeFilePathToName => {}, HTTP_Static_FakeFilePathToMIMEType => {}, HTTP_POSTDataDir => $datadir . "http/postdata", HTTP_KeyFileName => undef, # options added, because upgrade is possible (see RFC 2817) HTTP_CrtFileName => undef, HTTP_DHFileName => undef, HTTP_ServiceName => undef, HTTPS_BindAddress => undef, HTTPS_BindPort => 443, HTTPS_MaxChilds => undef, HTTPS_RunAsUser => undef, HTTPS_RunAsGroup => undef, HTTPS_DocumentRoot => $datadir . "http/wwwroot", HTTPS_MIMETypesFileName => $datadir . "http/mime.types", HTTPS_Version => "INetSim HTTPs Server", HTTPS_FakeMode => 1, HTTPS_FakeFileDir => $datadir . "http/fakefiles", HTTPS_FakeFileExtToName => {}, HTTPS_FakeFileExtToMIMEType => {}, HTTPS_Default_FakeFileName => undef, HTTPS_Default_FakeFileMIMEType => undef, HTTPS_Static_FakeFilePathToName => {}, HTTPS_Static_FakeFilePathToMIMEType => {}, HTTPS_POSTDataDir => $datadir . "http/postdata", HTTPS_KeyFileName => undef, HTTPS_CrtFileName => undef, HTTPS_DHFileName => undef, HTTPS_ServiceName => undef, Ident_BindAddress => undef, Ident_BindPort => 113, Ident_MaxChilds => undef, Ident_RunAsUser => undef, Ident_RunAsGroup => undef, Ident_ServiceName => undef, NTP_BindAddress => undef, NTP_BindPort => 123, NTP_MaxChilds => undef, NTP_RunAsUser => undef, NTP_RunAsGroup => undef, NTP_StrictChecks => 1, NTP_Server_IP => "127.0.0.1", NTP_ServiceName => undef, POP3_BindAddress => undef, POP3_BindPort => 110, POP3_MaxChilds => undef, POP3_RunAsUser => undef, POP3_RunAsGroup => undef, POP3_Version => "INetSim POP3 Server", POP3_Banner => "INetSim POP3 Server ready", POP3_Hostname => "pop3host", POP3_MBOXDirName => $datadir . "pop3", POP3_MBOXMaxMails => 10, POP3_MBOXReRead => 180, POP3_MBOXReBuild => 60, POP3_EnableAPOP => 1, POP3_EnableCapabilities => 1, POP3_Capabilities => {}, POP3_AuthReversibleOnly => 0, POP3_KeyFileName => undef, POP3_CrtFileName => undef, POP3_DHFileName => undef, POP3_ServiceName => undef, POP3S_BindAddress => undef, POP3S_BindPort => 995, POP3S_MaxChilds => undef, POP3S_RunAsUser => undef, POP3S_RunAsGroup => undef, POP3S_Version => "INetSim POP3s Server", POP3S_Banner => "INetSim POP3s Server ready", POP3S_Hostname => "pop3host", POP3S_MBOXDirName => $datadir . "pop3", POP3S_MBOXMaxMails => 10, POP3S_MBOXReRead => 180, POP3S_MBOXReBuild => 60, POP3S_EnableAPOP => 1, POP3S_EnableCapabilities => 1, POP3S_Capabilities => {}, POP3S_AuthReversibleOnly => 0, POP3S_KeyFileName => undef, POP3S_CrtFileName => undef, POP3S_DHFileName => undef, POP3S_ServiceName => undef, Quotd_TCP_BindAddress => undef, Quotd_TCP_BindPort => 17, Quotd_TCP_MaxChilds => undef, Quotd_TCP_RunAsUser => undef, Quotd_TCP_RunAsGroup => undef, Quotd_TCP_ServiceName => undef, Quotd_UDP_BindAddress => undef, Quotd_UDP_BindPort => 17, Quotd_UDP_MaxChilds => undef, Quotd_UDP_RunAsUser => undef, Quotd_UDP_RunAsGroup => undef, Quotd_QuotesFileName => $datadir . "quotd/quotd.txt", Quotd_UDP_ServiceName => undef, SMTP_BindAddress => undef, SMTP_BindPort => 25, SMTP_MaxChilds => undef, SMTP_RunAsUser => undef, SMTP_RunAsGroup => undef, SMTP_Banner => "INetSim Mail Service ready.", SMTP_FQDN_Hostname => "mail.inetsim.org", SMTP_HELO_required => 0, SMTP_Extended_SMTP => 1, SMTP_Service_Extensions => {}, SMTP_MBOXFileName => $datadir . "smtp/smtp.mbox", SMTP_AuthReversibleOnly => 0, SMTP_AuthRequired => 0, SMTP_KeyFileName => undef, SMTP_CrtFileName => undef, SMTP_DHFileName => undef, SMTP_ServiceName => undef, SMTPS_BindAddress => undef, SMTPS_BindPort => 465, SMTPS_MaxChilds => undef, SMTPS_RunAsUser => undef, SMTPS_RunAsGroup => undef, SMTPS_Banner => "INetSim Mail Service ready.", SMTPS_FQDN_Hostname => "mail.inetsim.org", SMTPS_HELO_required => 0, SMTPS_Extended_SMTP => 1, SMTPS_Service_Extensions => {}, SMTPS_MBOXFileName => $datadir . "smtp/smtps.mbox", SMTPS_AuthReversibleOnly => 0, SMTPS_AuthRequired => 0, SMTPS_KeyFileName => undef, SMTPS_CrtFileName => undef, SMTPS_DHFileName => undef, SMTPS_ServiceName => undef, TFTP_BindAddress => undef, TFTP_BindPort => 69, TFTP_MaxChilds => undef, TFTP_RunAsUser => undef, TFTP_RunAsGroup => undef, TFTP_DocumentRoot => $datadir . "tftp/tftproot", TFTP_UploadDir => $datadir . "tftp/upload", TFTP_ServiceName => undef, TFTP_AllowOverwrite => 0, TFTP_EnableOptions => 1, TFTP_Options => {}, Time_TCP_BindAddress => undef, Time_TCP_BindPort => 37, Time_TCP_MaxChilds => undef, Time_TCP_RunAsUser => undef, Time_TCP_RunAsGroup => undef, Time_TCP_ServiceName => undef, Time_UDP_BindAddress => undef, Time_UDP_BindPort => 37, Time_UDP_MaxChilds => undef, Time_UDP_RunAsUser => undef, Time_UDP_RunAsGroup => undef, Time_UDP_ServiceName => undef, Finger_BindAddress => undef, Finger_BindPort => 79, Finger_MaxChilds => undef, Finger_RunAsUser => undef, Finger_RunAsGroup => undef, Finger_ServiceName => undef, Finger_DataDirName => $datadir . "finger", Dummy_TCP_BindAddress => undef, Dummy_TCP_BindPort => 1, Dummy_TCP_MaxChilds => undef, Dummy_TCP_RunAsUser => undef, Dummy_TCP_RunAsGroup => undef, Dummy_TCP_ServiceName => undef, Dummy_Banner => "220 ESMTP FTP +OK POP3 200 OK", Dummy_BannerWait => 5, Dummy_UDP_BindAddress => undef, Dummy_UDP_BindPort => 1, Dummy_UDP_MaxChilds => undef, Dummy_UDP_RunAsUser => undef, Dummy_UDP_RunAsGroup => undef, Dummy_UDP_ServiceName => undef, Redirect_Enabled => 0, Redirect_UnknownServices => 1, Redirect_ExternalAddress => undef, Redirect_ChangeTTL => 0, Redirect_StaticRules => {}, Redirect_IgnoreBootp => 0, Redirect_IgnoreNetbios => 0, Redirect_ICMP_Timestamp => 1, FTP_BindAddress => undef, FTP_BindPort => 21, FTP_DataPort => 20, FTP_MaxChilds => undef, FTP_RunAsUser => undef, FTP_RunAsGroup => undef, FTP_Version => "INetSim FTP Server", FTP_Banner => "INetSim FTP Service ready.", FTP_DocumentRoot => $datadir . "ftp/ftproot", FTP_UploadDir => $datadir . "ftp/upload", FTP_RecursiveDelete => 0, FTP_KeyFileName => undef, FTP_CrtFileName => undef, FTP_DHFileName => undef, FTP_ServiceName => undef, FTPS_BindAddress => undef, FTPS_BindPort => 990, FTPS_DataPort => 989, FTPS_MaxChilds => undef, FTPS_RunAsUser => undef, FTPS_RunAsGroup => undef, FTPS_Version => "INetSim FTPs Server", FTPS_Banner => "INetSim FTP Service ready.", FTPS_DocumentRoot => $datadir . "ftp/ftproot", FTPS_UploadDir => $datadir . "ftp/upload", FTPS_RecursiveDelete => 0, FTPS_KeyFileName => undef, FTPS_CrtFileName => undef, FTPS_DHFileName => undef, FTPS_ServiceName => undef, Syslog_BindAddress => undef, Syslog_BindPort => 514, Syslog_MaxChilds => undef, Syslog_RunAsUser => undef, Syslog_RunAsGroup => undef, Syslog_ServiceName => undef, Syslog_AcceptInvalid => 0, Syslog_TrimMaxLength => 0, IRC_BindAddress => undef, IRC_BindPort => 6667, IRC_MaxChilds => undef, IRC_RunAsUser => undef, IRC_RunAsGroup => undef, IRC_FQDN_Hostname => "irc.inetsim.org", IRC_Version => "INetSim IRC Server", IRC_ServiceName => undef, IRCS_BindAddress => undef, IRCS_BindPort => 994, IRCS_MaxChilds => undef, IRCS_RunAsUser => undef, IRCS_RunAsGroup => undef, IRCS_FQDN_Hostname => "irc.inetsim.org", IRCS_Version => "INetSim IRCs Server", IRCS_ServiceName => undef ); ############################################################# # Local variables my $lineNumber = 0; # compiled regular expressions for matching strings my $RE_signedInt = qr/^[-]{0,1}[\d]+$/; my $RE_unsignedInt = qr/^[\d]+$/; my $RE_printable = qr/^[\x20-\x7e]+$/; my $RE_validIP = qr/^(([01]?[0-9][0-9]?|2[0-4][0-9]|25[0-5])\.){3}([01]?[0-9][0-9]?|2[0-4][0-9]|25[0-5])$/; my $RE_validHostname = qr/^[a-zA-Z0-9]([-a-zA-Z0-9]*[a-zA-Z0-9]|)$/; my $RE_validDomainname = qr/^([a-zA-Z0-9]([-a-zA-Z0-9]*[a-zA-Z0-9]|)\.)*[a-zA-Z]+$/; my $RE_validFQDNHostname = qr/^([a-zA-Z0-9]([-a-zA-Z0-9]*[a-zA-Z0-9]|)\.)+[a-zA-Z]+$/; my $RE_validFilename = qr/^[a-zA-Z0-9\.\-\_]+$/; ############################################################# sub parse_config { my $log_dir = &INetSim::CommandLine::getCommandLineOption("log_dir"); if(defined $log_dir) { &setConfigParameter("LogDir", $log_dir); &setConfigParameter("MainLogfileName", $log_dir . "main.log"); &setConfigParameter("SubLogfileName", $log_dir . "service.log"); &setConfigParameter("DebugLogfileName", $log_dir . "debug.log"); } my $data_dir = &INetSim::CommandLine::getCommandLineOption("data_dir"); if(defined $data_dir) { &setConfigParameter("DataDir", $data_dir); # &setConfigParameter("CertDir", $data_dir . "certs/"); # &setConfigParameter("HTTP_DocumentRoot", $data_dir . "http/wwwroot"); &setConfigParameter("HTTP_MIMETypesFileName", $data_dir . "http/mime.types"); &setConfigParameter("HTTP_FakeFileDir", $data_dir . "http/fakefiles"); &setConfigParameter("HTTP_POSTDataDir", $data_dir . "http/postdata"); # &setConfigParameter("HTTPS_DocumentRoot", $data_dir . "http/wwwroot"); &setConfigParameter("HTTPS_MIMETypesFileName", $data_dir . "http/mime.types"); &setConfigParameter("HTTPS_FakeFileDir", $data_dir . "http/fakefiles"); &setConfigParameter("HTTPS_POSTDataDir", $data_dir . "http/postdata"); # &setConfigParameter("POP3_MBOXDirName", $data_dir . "pop3"); # &setConfigParameter("POP3S_MBOXDirName", $data_dir . "pop3"); # &setConfigParameter("Quotd_QuotesFileName", $data_dir . "quotd/quotd.txt"); # &setConfigParameter("SMTP_MBOXFileName", $data_dir . "smtp/smtp.mbox"); # &setConfigParameter("SMTPS_MBOXFileName", $data_dir . "smtp/smtps.mbox"); # &setConfigParameter("TFTP_DocumentRoot", $data_dir . "tftp/tftproot"); &setConfigParameter("TFTP_UploadDir", $data_dir . "tftp/upload"); # &setConfigParameter("Finger_DataDirName", $data_dir . "finger"); # &setConfigParameter("FTP_DocumentRoot", $data_dir . "ftp/ftproot"); &setConfigParameter("FTP_UploadDir", $data_dir . "ftp/upload"); # &setConfigParameter("FTPS_DocumentRoot", $data_dir . "ftp/ftproot"); &setConfigParameter("FTPS_UploadDir", $data_dir . "ftp/upload"); } my $report_dir = &INetSim::CommandLine::getCommandLineOption("report_dir"); if(defined $report_dir) { &setConfigParameter("ReportDir", $report_dir); } # Initialize logfiles &INetSim::Log::init(); &INetSim::Log::MainLog("Using log directory: " . &getConfigParameter("LogDir")); &INetSim::Log::MainLog("Using data directory: " . &getConfigParameter("DataDir")); &INetSim::Log::MainLog("Using report directory: " . &getConfigParameter("ReportDir")); my @args = (); my %dns_statichosttoip = (); my %dns_staticiptohost = (); my %http_fakefile_exttoname = (); my %http_fakefile_exttomimetype = (); my %http_static_fakefile_pathtoname = (); my %http_static_fakefile_pathtomimetype = (); my %https_fakefile_exttoname = (); my %https_fakefile_exttomimetype = (); my %https_static_fakefile_pathtoname = (); my %https_static_fakefile_pathtomimetype = (); my %redirect_static_rules = (); my %smtp_service_extensions = (); my %smtps_service_extensions = (); my %pop3_capabilities = (); my %pop3s_capabilities = (); my %tftp_options = (); my $configfilename = &INetSim::CommandLine::getCommandLineOption("config"); if (defined $configfilename) { if ($configfilename =~ /^\//) { &setConfigParameter("ConfigFileName", $configfilename); } else { &setConfigParameter("ConfigFileName", $currentdir . "/" . $configfilename); } } else { $configfilename = &getConfigParameter("ConfigFileName"); } &INetSim::Log::MainLog("Using configuration file: " . &getConfigParameter("ConfigFileName")); open (CONFIGFILE, "<$configfilename") or &INetSim::error_exit("Unable to open configuration file '$configfilename': $!", 1); &INetSim::Log::MainLog("Parsing configuration file."); while () { $lineNumber++; # remove whitespaces at beginning of line s/^[\s]+//g; # remove cr/lf from end of line s/[\r\n]+$//g; if (!length()) { # skip blank line next; } elsif (/^[\#]/) { next; # skip comment } else { @args = &splitline($_); ################################################# # start_service if ($args[0] =~ /^start_service$/i) { my $serviceName = lc($args[1]); if (grep(/^$serviceName$/,@SERVICES) == 1) { if (grep/^$serviceName$/, @ServicesToStart) { &config_warn("Service '$serviceName' already listed"); } else { push (@ServicesToStart, $serviceName); } } elsif (grep(/^$serviceName$/,@SSLSERVICES) == 1) { if (grep/^$serviceName$/, @ServicesToStart) { &config_warn("Service '$serviceName' already listed"); } elsif (! $SSL) { &config_warn("Service '$serviceName' listed, but no SSL support"); } else { push (@ServicesToStart, $serviceName); } } else { &config_warn("Unknown service name '$serviceName'"); } } ################################################# # Create_Reports elsif ($args[0] =~ /^create_reports$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("Create_Reports", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("Create_Reports", 0); } else { &config_error("Invalid argument '$args[1]'"); } } ################################################# # ReportLanguage elsif ($args[0] =~ /^report_language$/i) { if ($args[1] =~ /^(de|en)$/i) { &setConfigParameter("ReportLanguage", lc($args[1])); } else { &config_error("'$args[1]' is not a valid language"); } } ################################################# # Faketime elsif ($args[0] =~ /^faketime_init_delta$/i) { if ($args[1] =~ $RE_signedInt) { my $cur_secs = time(); my $delta = $args[1]; my $faketimemax = &getConfigParameter("Faketime_Max"); if (($cur_secs + $delta) > $faketimemax) { &config_error("Fake time exceeds maximum system time"); } elsif (($cur_secs + $delta) < 0 ) { &config_error("Fake time init delta too small"); } &setConfigParameter("Faketime_Delta", $delta); } else { &config_error("'$args[1]' is not numeric"); } } ################################################# # Faketime_AutoDelay elsif ($args[0] =~ /^faketime_auto_delay$/i) { if (($args[1] =~ $RE_unsignedInt) && int($args[1] >= 0) && int($args[1] < 86401)) { &setConfigParameter("Faketime_AutoDelay", int($args[1])); } else { &config_error("'$args[1]' is not an integer value of range [0..86400]"); } } ################################################# # Faketime_AutoIncrement elsif ($args[0] =~ /^faketime_auto_increment$/i) { if ($args[1] =~ $RE_signedInt && int($args[1] > -31536001) && int($args[1] < 31536001)) { &setConfigParameter("Faketime_AutoIncrement", int($args[1])); } else { &config_error("'$args[1]' is not an integer value of range [-31536000..31536000]"); } } # service_max_childs elsif ($args[0] =~ /^service_max_childs$/i) { if (($args[1] =~ $RE_unsignedInt) && int($args[1] > 0) && int($args[1] < 31)) { &setConfigParameter("Default_MaxChilds", int($args[1])); } else { &config_error("'$args[1]' is not an integer value of range [1..30]"); } } # service_bind_address elsif ($args[0] =~ /^service_bind_address$/i) { # if ($args[1] =~ /^0.0.0.0$/) { # &config_error("service_bind_address '0.0.0.0' not allowed"); # } ($args[1] =~ $RE_validIP) ? &setConfigParameter("Default_BindAddress", $args[1]) : &config_error("'$args[1]' is not a valid IP address"); } # service_run_as_user elsif ($args[0] =~ /^service_run_as_user$/i) { my $user = $args[1]; if ($args[1] !~ $RE_printable) { &config_error("'$user' is not a valid username"); } else { my $uid = getpwnam($user); if (defined $uid) { &setConfigParameter("Default_RunAsUser", $user); } else { &config_error("User '$user' does not exist on this system"); } } } # service_timeout elsif ($args[0] =~ /^service_timeout$/i) { if ($args[1] =~ $RE_unsignedInt && int($args[1] > 0) && int($args[1] < 601)) { &setConfigParameter("Default_TimeOut", int($args[1])); } else { &config_error("'$args[1]' is not an integer value of range [1..600]"); } } ################################################# # Chargen ################################################# # Chargen_BindPort elsif ($args[0] =~ /^chargen_bind_port$/i) { if (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) { &setConfigParameter("Chargen_TCP_BindPort", $args[1]); &setConfigParameter("Chargen_UDP_BindPort", $args[1]); } else { &config_error("'$args[1]' is not a valid port number"); } } ################################################# # Daytime ################################################# # Daytime_BindPort elsif ($args[0] =~ /^daytime_bind_port$/i) { if (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) { &setConfigParameter("Daytime_TCP_BindPort", $args[1]); &setConfigParameter("Daytime_UDP_BindPort", $args[1]); } else { &config_error("'$args[1]' is not a valid port number"); } } ################################################# # Discard ################################################# # Discard_BindPort elsif ($args[0] =~ /^discard_bind_port$/i) { if (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) { &setConfigParameter("Discard_TCP_BindPort", $args[1]); &setConfigParameter("Discard_UDP_BindPort", $args[1]); } else { &config_error("'$args[1]' is not a valid port number"); } } ################################################# # DNS ################################################# # DNS_BindPort elsif ($args[0] =~ /^dns_bind_port$/i) { (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) ? &setConfigParameter("DNS_BindPort", $args[1]) : &config_error("'$args[1]' is not a valid port number"); } # DNS_Default_IP elsif ($args[0] =~ /^dns_default_ip$/i) { ($args[1] =~ $RE_validIP) ? &setConfigParameter("DNS_Default_IP", $args[1]) : &config_error("'$args[1]' is not a valid IP address"); } # DNS_Default_Hostname elsif ($args[0] =~ /^dns_default_hostname$/i) { ($args[1] =~ $RE_validHostname) ? &setConfigParameter("DNS_Default_Hostname", $args[1]) : &config_error("'$args[1]' is not a valid hostname"); } # DNS_Default_Domainname elsif ($args[0] =~ /^dns_default_domainname$/i) { ($args[1] =~ $RE_validDomainname) ? &setConfigParameter("DNS_Default_Domainname", $args[1]) : &config_error("'$args[1]' is not a valid domainname"); } # DNS_Version elsif ($args[0] =~ /^dns_version$/i) { ($args[1] =~ $RE_printable) ? &setConfigParameter("DNS_Version", $args[1]) : &config_error("'$args[1]' is not a valid version string"); } # DNS_Static elsif ($args[0] =~ /^dns_static$/i) { if ($args[1] !~ $RE_validFQDNHostname) { &config_error("'$args[1]' is not a valid FQDN hostname"); } elsif ($args[2] !~ $RE_validIP) { &config_error("'$args[2]' is not a valid IP address"); } else { $dns_statichosttoip{lc($args[1])} = $args[2]; my @ip = split(/\./, $args[2]); my $reverse_ip = $ip[3] . "." . $ip[2] . "." . $ip[1] . "." . $ip[0] . ".in-addr.arpa"; $dns_staticiptohost{$reverse_ip} = lc($args[1]); } } ################################################# # Echo ################################################# # Echo_BindPort elsif ($args[0] =~ /^echo_bind_port$/i) { if (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) { &setConfigParameter("Echo_TCP_BindPort", $args[1]); &setConfigParameter("Echo_UDP_BindPort", $args[1]); } else { &config_error("'$args[1]' is not a valid port number"); } } ################################################# # Ident ################################################# # Ident_BindPort elsif ($args[0] =~ /^ident_bind_port$/i) { (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) ? &setConfigParameter("Ident_BindPort", $args[1]) : &config_error("'$args[1]' is not a valid port number"); } ################################################# # HTTP ################################################# # HTTP_BindPort elsif ($args[0] =~ /^http_bind_port$/i) { (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) ? &setConfigParameter("HTTP_BindPort", $args[1]) : &config_error("'$args[1]' is not a valid port number"); } # HTTP_Version elsif ($args[0] =~ /^http_version$/i) { ($args[1] =~ $RE_printable) ? &setConfigParameter("HTTP_Version", $args[1]) : &config_error("'$args[1]' is not a valid HTTP version string"); } # HTTP_FakeMode elsif ($args[0] =~ /^http_fakemode$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("HTTP_FakeMode", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("HTTP_FakeMode", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # HTTP_FakeFile elsif ($args[0] =~ /^http_fakefile$/i) { if (!$args[3]) { &config_error("missing argument for http_fakefile"); } elsif ($args[1] !~ /^[a-zA-Z0-9]+$/) { &config_error("'$args[1]' is not a valid extension"); } elsif ($args[2] !~ $RE_validFilename) { &config_error("'$args[2]' is not a valid filename"); } elsif ($args[3] !~ /^[a-zA-Z0-9\+\-\/]+$/) { &config_error("'$args[3]' is not a valid MIME type"); } else { $http_fakefile_exttoname{$args[1]} = $args[2]; $http_fakefile_exttomimetype{$args[1]} = $args[3]; } } # HTTP_Default_FakeFile elsif ($args[0] =~ /^http_default_fakefile$/i) { if (!$args[2]) { &config_error("missing argument for http_default_fakefile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } elsif ($args[2] !~ /^[a-zA-Z0-9\+\-\/]+$/) { &config_error("'$args[2]' is not a valid MIME type"); } else { &setConfigParameter("HTTP_Default_FakeFileName", $args[1]); &setConfigParameter("HTTP_Default_FakeFileMIMEType", $args[2]); } } # HTTP_Static_FakeFile elsif ($args[0] =~ /^http_static_fakefile$/i) { if (!$args[3]) { &config_error("missing argument for http_static_fakefile"); } elsif (($args[1] !~ /^\/[[:graph:]]+$/) || ($args[1] =~ /\?/)) { &config_error("'$args[1]' is not a valid path"); } elsif ($args[2] !~ $RE_validFilename) { &config_error("'$args[2]' is not a valid filename"); } elsif ($args[3] !~ /^[a-zA-Z0-9\+\-\/]+$/) { &config_error("'$args[3]' is not a valid MIME type"); } else { $http_static_fakefile_pathtoname{$args[1]} = $args[2]; $http_static_fakefile_pathtomimetype{$args[1]} = $args[3]; } } # HTTP_KeyFileName elsif ($args[0] =~ /^http_ssl_keyfile$/i) { if (! $args[1]) { &config_error("missing argument for http_ssl_keyfile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } else { &setConfigParameter("HTTP_KeyFileName", $args[1]); } } # HTTP_CrtFileName elsif ($args[0] =~ /^http_ssl_certfile$/i) { if (! $args[1]) { &config_error("missing argument for http_ssl_certfile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } else { &setConfigParameter("HTTP_CrtFileName", $args[1]); } } # HTTP_DHFileName elsif ($args[0] =~ /^http_ssl_dhfile$/i) { if (! $args[1]) { &config_error("missing argument for http_ssl_dhfile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } else { &setConfigParameter("HTTP_DHFileName", $args[1]); } } ################################################# # HTTPS ################################################# # HTTPS_BindPort elsif ($args[0] =~ /^https_bind_port$/i) { (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) ? &setConfigParameter("HTTPS_BindPort", $args[1]) : &config_error("'$args[1]' is not a valid port number"); } # HTTPS_Version elsif ($args[0] =~ /^https_version$/i) { ($args[1] =~ $RE_printable) ? &setConfigParameter("HTTPS_Version", $args[1]) : &config_error("'$args[1]' is not a valid HTTP version string"); } # HTTPS_FakeMode elsif ($args[0] =~ /^https_fakemode$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("HTTPS_FakeMode", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("HTTPS_FakeMode", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # HTTPS_FakeFile elsif ($args[0] =~ /^https_fakefile$/i) { if (!$args[3]) { &config_error("missing argument for https_fakefile"); } elsif ($args[1] !~ /^[a-zA-Z0-9]+$/) { &config_error("'$args[1]' is not a valid extension"); } elsif ($args[2] !~ $RE_validFilename) { &config_error("'$args[2]' is not a valid filename"); } elsif ($args[3] !~ /^[a-zA-Z0-9\+\-\/]+$/) { &config_error("'$args[3]' is not a valid MIME type"); } else { $https_fakefile_exttoname{$args[1]} = $args[2]; $https_fakefile_exttomimetype{$args[1]} = $args[3]; } } # HTTPS_Default_FakeFile elsif ($args[0] =~ /^https_default_fakefile$/i) { if (!$args[2]) { &config_error("missing argument for https_default_fakefile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } elsif ($args[2] !~ /^[a-zA-Z0-9\+\-\/]+$/) { &config_error("'$args[2]' is not a valid MIME type"); } else { &setConfigParameter("HTTPS_Default_FakeFileName", $args[1]); &setConfigParameter("HTTPS_Default_FakeFileMIMEType", $args[2]); } } # HTTPS_Static_FakeFile elsif ($args[0] =~ /^https_static_fakefile$/i) { if (!$args[3]) { &config_error("missing argument for https_static_fakefile"); } elsif (($args[1] !~ /^\/[[:graph:]]+$/) || ($args[1] =~ /\?/)) { &config_error("'$args[1]' is not a valid path"); } elsif ($args[2] !~ $RE_validFilename) { &config_error("'$args[2]' is not a valid filename"); } elsif ($args[3] !~ /^[a-zA-Z0-9\+\-\/]+$/) { &config_error("'$args[3]' is not a valid MIME type"); } else { $https_static_fakefile_pathtoname{$args[1]} = $args[2]; $https_static_fakefile_pathtomimetype{$args[1]} = $args[3]; } } # HTTPS_KeyFileName elsif ($args[0] =~ /^https_ssl_keyfile$/i) { if (! $args[1]) { &config_error("missing argument for https_ssl_keyfile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } else { &setConfigParameter("HTTPS_KeyFileName", $args[1]); } } # HTTPS_CrtFileName elsif ($args[0] =~ /^https_ssl_certfile$/i) { if (! $args[1]) { &config_error("missing argument for https_ssl_certfile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } else { &setConfigParameter("HTTPS_CrtFileName", $args[1]); } } # HTTPS_DHFileName elsif ($args[0] =~ /^https_ssl_dhfile$/i) { if (! $args[1]) { &config_error("missing argument for https_ssl_dhfile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } else { &setConfigParameter("HTTPS_DHFileName", $args[1]); } } ################################################# # NTP ################################################# # NTP_BindPort elsif ($args[0] =~ /^ntp_bind_port$/i) { (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) ? &setConfigParameter("NTP_BindPort", $args[1]) : &config_error("'$args[1]' is not a valid port number"); } # NTP_Server_IP elsif ($args[0] =~ /^ntp_server_ip$/i) { if ($args[1] =~ /^0.0.0.0$/) { &config_error("ntp_server_ip '0.0.0.0' not allowed"); } ($args[1] =~ $RE_validIP) ? &setConfigParameter("NTP_Server_IP", $args[1]) : &config_error("'$args[1]' is not a valid IP address"); } # NTP_StrictChecks elsif ($args[0] =~ /^ntp_strict_checks$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("NTP_StrictChecks", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("NTP_StrictChecks", 0); } else { &config_error("Invalid argument '$args[1]'"); } } ################################################# # POP3 ################################################# # POP3_BindPort elsif ($args[0] =~ /^pop3_bind_port$/i) { (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) ? &setConfigParameter("POP3_BindPort", $args[1]) : &config_error("'$args[1]' is not a valid port number"); } # POP3_Version elsif ($args[0] =~ /^pop3_version$/i) { ($args[1] =~ $RE_printable) ? &setConfigParameter("POP3_Version", $args[1]) : &config_error("'$args[1]' is not a valid version string"); } # POP3_Banner elsif ($args[0] =~ /^pop3_banner$/i) { ($args[1] =~ $RE_printable) ? &setConfigParameter("POP3_Banner", $args[1]) : &config_error("'$args[1]' is not a valid POP3 banner string"); } # POP3_Hostname elsif ($args[0] =~ /^pop3_hostname$/i) { ($args[1] =~ $RE_validHostname) ? &setConfigParameter("POP3_Hostname", $args[1]) : &config_error("'$args[1]' is not a valid hostname"); } # POP3_MBOXMaxMails elsif ($args[0] =~ /^pop3_mbox_maxmails$/i) { ($args[1] =~ /[\d]+/) ? &setConfigParameter("POP3_MBOXMaxMails", $args[1]) : &config_error("'$args[1]' is not an integer value"); } # POP3_MBOXReRead elsif ($args[0] =~ /^pop3_mbox_reread$/i) { ($args[1] =~ /[\d]+/) ? &setConfigParameter("POP3_MBOXReRead", $args[1]) : &config_error("'$args[1]' is not an integer value"); } # POP3_MBOXReBuild elsif ($args[0] =~ /^pop3_mbox_rebuild$/i) { ($args[1] =~ /[\d]+/) ? &setConfigParameter("POP3_MBOXReBuild", $args[1]) : &config_error("'$args[1]' is not an integer value"); } # POP3_AuthReversibleOnly elsif ($args[0] =~ /^pop3_auth_reversibleonly$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("POP3_AuthReversibleOnly", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("POP3_AuthReversibleOnly", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # POP3_EnableAPOP elsif ($args[0] =~ /^pop3_enable_apop$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("POP3_EnableAPOP", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("POP3_EnableAPOP", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # POP3_EnableCapabilities elsif ($args[0] =~ /^pop3_enable_capabilities$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("POP3_EnableCapabilities", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("POP3_EnableCapabilities", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # POP3_Capabilities elsif ($args[0] =~ /^pop3_capability$/i) { my $capability; my $options; # for details see: http://www.iana.org/assignments/pop3-extension-mechanism if ($args[1] =~ /^(TOP|USER|SASL|RESP-CODES|LOGIN-DELAY|PIPELINING|EXPIRE|UIDL|IMPLEMENTATION|AUTH-RESP-CODE|STLS)$/i) { $capability = uc($args[1]); my $arg_num = 2; while ($arg_num <= 10 && defined ($args[$arg_num]) && $args[$arg_num] ne "") { last if ($args[$arg_num] =~ /^#/); $options .= "$args[$arg_num] "; $arg_num++; } $options =~ s/[\s\t]+$// if (defined ($options)); if (defined ($options) && $options =~ /^([\x20-\x7E]+)$/) { $pop3_capabilities{$capability} = $options; } elsif (! defined ($options) || $options eq "") { $pop3_capabilities{$capability} = ""; } else { &config_warn("Invalid option for POP3 capability '$capability'"); } } else { &config_warn("'$args[1]' is not a valid POP3 capability"); } } # POP3_KeyFileName elsif ($args[0] =~ /^pop3_ssl_keyfile$/i) { if (! $args[1]) { &config_error("missing argument for pop3_ssl_keyfile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } else { &setConfigParameter("POP3_KeyFileName", $args[1]); } } # POP3_CrtFileName elsif ($args[0] =~ /^pop3_ssl_certfile$/i) { if (! $args[1]) { &config_error("missing argument for pop3_ssl_certfile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } else { &setConfigParameter("POP3_CrtFileName", $args[1]); } } # POP3_DHFileName elsif ($args[0] =~ /^pop3_ssl_dhfile$/i) { if (! $args[1]) { &config_error("missing argument for pop3_ssl_dhfile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } else { &setConfigParameter("POP3_DHFileName", $args[1]); } } ################################################# # POP3S ################################################# # POP3S_BindPort elsif ($args[0] =~ /^pop3s_bind_port$/i) { (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) ? &setConfigParameter("POP3S_BindPort", $args[1]) : &config_error("'$args[1]' is not a valid port number"); } # POP3S_Version elsif ($args[0] =~ /^pop3s_version$/i) { ($args[1] =~ $RE_printable) ? &setConfigParameter("POP3S_Version", $args[1]) : &config_error("'$args[1]' is not a valid version string"); } # POP3S_Banner elsif ($args[0] =~ /^pop3s_banner$/i) { ($args[1] =~ $RE_printable) ? &setConfigParameter("POP3S_Banner", $args[1]) : &config_error("'$args[1]' is not a valid POP3 banner string"); } # POP3S_Hostname elsif ($args[0] =~ /^pop3s_hostname$/i) { ($args[1] =~ $RE_validHostname) ? &setConfigParameter("POP3S_Hostname", $args[1]) : &config_error("'$args[1]' is not a valid hostname"); } # POP3S_MBOXMaxMails elsif ($args[0] =~ /^pop3s_mbox_maxmails$/i) { ($args[1] =~ /[\d]+/) ? &setConfigParameter("POP3S_MBOXMaxMails", $args[1]) : &config_error("'$args[1]' is not an integer value"); } # POP3S_MBOXReRead elsif ($args[0] =~ /^pop3s_mbox_reread$/i) { ($args[1] =~ /[\d]+/) ? &setConfigParameter("POP3S_MBOXReRead", $args[1]) : &config_error("'$args[1]' is not an integer value"); } # POP3S_MBOXReBuild elsif ($args[0] =~ /^pop3s_mbox_rebuild$/i) { ($args[1] =~ /[\d]+/) ? &setConfigParameter("POP3S_MBOXReBuild", $args[1]) : &config_error("'$args[1]' is not an integer value"); } # POP3S_AuthReversibleOnly elsif ($args[0] =~ /^pop3s_auth_reversibleonly$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("POP3S_AuthReversibleOnly", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("POP3S_AuthReversibleOnly", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # POP3S_EnableAPOP elsif ($args[0] =~ /^pop3s_enable_apop$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("POP3S_EnableAPOP", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("POP3S_EnableAPOP", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # POP3S_EnableCapabilities elsif ($args[0] =~ /^pop3s_enable_capabilities$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("POP3S_EnableCapabilities", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("POP3S_EnableCapabilities", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # POP3S_Capabilities elsif ($args[0] =~ /^pop3s_capability$/i) { my $capability; my $options; # for details see: http://www.iana.org/assignments/pop3-extension-mechanism if ($args[1] =~ /^(TOP|USER|SASL|RESP-CODES|LOGIN-DELAY|PIPELINING|EXPIRE|UIDL|IMPLEMENTATION|AUTH-RESP-CODE|STLS)$/i) { $capability = uc($args[1]); my $arg_num = 2; while ($arg_num <= 10 && defined ($args[$arg_num]) && $args[$arg_num] ne "") { last if ($args[$arg_num] =~ /^#/); $options .= "$args[$arg_num] "; $arg_num++; } $options =~ s/[\s\t]+$// if (defined ($options)); if (defined ($options) && $options =~ /^([\x20-\x7E]+)$/) { $pop3s_capabilities{$capability} = $options; } elsif (! defined ($options) || $options eq "") { $pop3s_capabilities{$capability} = ""; } else { &config_warn("Invalid option for POP3S capability '$capability'"); } } else { &config_warn("'$args[1]' is not a valid POP3S capability"); } } # POP3S_KeyFileName elsif ($args[0] =~ /^pop3s_ssl_keyfile$/i) { if (! $args[1]) { &config_error("missing argument for pop3s_ssl_keyfile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } else { &setConfigParameter("POP3S_KeyFileName", $args[1]); } } # POP3S_CrtFileName elsif ($args[0] =~ /^pop3s_ssl_certfile$/i) { if (! $args[1]) { &config_error("missing argument for pop3s_ssl_certfile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } else { &setConfigParameter("POP3S_CrtFileName", $args[1]); } } # POP3S_DHFileName elsif ($args[0] =~ /^pop3s_ssl_dhfile$/i) { if (! $args[1]) { &config_error("missing argument for pop3s_ssl_dhfile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } else { &setConfigParameter("POP3S_DHFileName", $args[1]); } } ################################################# # Quotd ################################################# # Quotd_BindPort elsif ($args[0] =~ /^quotd_bind_port$/i) { if (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) { &setConfigParameter("Quotd_TCP_BindPort", $args[1]); &setConfigParameter("Quotd_UDP_BindPort", $args[1]); } else { &config_error("'$args[1]' is not a valid port number"); } } ################################################# # SMTP ################################################# # SMTP_BindPort elsif ($args[0] =~ /^smtp_bind_port$/i) { (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) ? &setConfigParameter("SMTP_BindPort", $args[1]) : &config_error("'$args[1]' is not a valid port number"); } # SMTP_FQDN_Hostname elsif ($args[0] =~ /^smtp_fqdn_hostname$/i) { ($args[1] =~ $RE_validFQDNHostname) ? &setConfigParameter("SMTP_FQDN_Hostname", $args[1]) : &config_error("'$args[1]' is not a valid FQDN hostname"); } # SMTP_Banner elsif ($args[0] =~ /^smtp_banner$/i) { ($args[1] =~ $RE_printable) ? &setConfigParameter("SMTP_Banner", $args[1]) : &config_error("'$args[1]' is not a valid SMTP banner string"); } # SMTP_HELO_required elsif ($args[0] =~ /^smtp_helo_required$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("SMTP_HELO_required", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("SMTP_HELO_required", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # SMTP_Extended_SMTP elsif ($args[0] =~ /^smtp_extended_smtp$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("SMTP_Extended_SMTP", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("SMTP_Extended_SMTP", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # SMTP_Service_Extensions elsif ($args[0] =~ /^smtp_service_extension$/i) { my $extension; my $options; # for details see: http://www.iana.org/assignments/mail-parameters if ($args[1] =~ /^(SEND|SOML|SAML|VRFY|EXPN|HELP|TURN|8BITMIME|SIZE|VERB|ONEX|CHUNKING|BINARYMIME|CHECKPOINT|DELIVERBY|PIPELINING|DSN|ETRN|ENHANCEDSTATUSCODES|STARTTLS|NO-SOLICITING|MTRK|SUBMITTER|ATRN|AUTH|FUTURERELEASE|UTF8SMTP|VERP)$/i) { $extension = uc($args[1]); my $arg_num = 2; while ($arg_num <= 10 && defined ($args[$arg_num]) && $args[$arg_num] ne "") { last if ($args[$arg_num] =~ /^#/); $options .= "$args[$arg_num] "; $arg_num++; } $options =~ s/[\s\t]+$// if (defined ($options)); if (defined ($options) && $options =~ /^([\x20-\x7E]+)$/) { $smtp_service_extensions{$extension} = $options; } elsif (! defined ($options) || $options eq "") { $smtp_service_extensions{$extension} = ""; } else { &config_warn("Invalid option for SMTP extension '$extension'"); } } else { &config_warn("'$args[1]' is not a valid SMTP extension"); } } # SMTP_AuthReversibleOnly elsif ($args[0] =~ /^smtp_auth_reversibleonly$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("SMTP_AuthReversibleOnly", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("SMTP_AuthReversibleOnly", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # SMTP_AuthRequired elsif ($args[0] =~ /^smtp_auth_required$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("SMTP_AuthRequired", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("SMTP_AuthRequired", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # SMTP_KeyFileName elsif ($args[0] =~ /^smtp_ssl_keyfile$/i) { if (! $args[1]) { &config_error("missing argument for smtp_ssl_keyfile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } else { &setConfigParameter("SMTP_KeyFileName", $args[1]); } } # SMTP_CrtFileName elsif ($args[0] =~ /^smtp_ssl_certfile$/i) { if (! $args[1]) { &config_error("missing argument for smtp_ssl_certfile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } else { &setConfigParameter("SMTP_CrtFileName", $args[1]); } } # SMTP_DHFileName elsif ($args[0] =~ /^smtp_ssl_dhfile$/i) { if (! $args[1]) { &config_error("missing argument for smtp_ssl_dhfile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } else { &setConfigParameter("SMTP_DHFileName", $args[1]); } } ################################################# # SMTPS ################################################# # SMTPS_BindPort elsif ($args[0] =~ /^smtps_bind_port$/i) { (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) ? &setConfigParameter("SMTPS_BindPort", $args[1]) : &config_error("'$args[1]' is not a valid port number"); } # SMTPS_FQDN_Hostname elsif ($args[0] =~ /^smtps_fqdn_hostname$/i) { ($args[1] =~ $RE_validFQDNHostname) ? &setConfigParameter("SMTPS_FQDN_Hostname", $args[1]) : &config_error("'$args[1]' is not a valid FQDN hostname"); } # SMTPS_Banner elsif ($args[0] =~ /^smtps_banner$/i) { ($args[1] =~ $RE_printable) ? &setConfigParameter("SMTPS_Banner", $args[1]) : &config_error("'$args[1]' is not a valid SMTP banner string"); } # SMTPS_HELO_required elsif ($args[0] =~ /^smtps_helo_required$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("SMTPS_HELO_required", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("SMTPS_HELO_required", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # SMTPS_Extended_SMTP elsif ($args[0] =~ /^smtps_extended_smtp$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("SMTPS_Extended_SMTP", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("SMTPS_Extended_SMTP", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # SMTPS_Service_Extensions elsif ($args[0] =~ /^smtps_service_extension$/i) { my $extension; my $options; # for details see: http://www.iana.org/assignments/mail-parameters if ($args[1] =~ /^(SEND|SOML|SAML|VRFY|EXPN|HELP|TURN|8BITMIME|SIZE|VERB|ONEX|CHUNKING|BINARYMIME|CHECKPOINT|DELIVERBY|PIPELINING|DSN|ETRN|ENHANCEDSTATUSCODES|STARTTLS|NO-SOLICITING|MTRK|SUBMITTER|ATRN|AUTH|FUTURERELEASE|UTF8SMTP|VERP)$/i) { $extension = uc($args[1]); my $arg_num = 2; while ($arg_num <= 10 && defined ($args[$arg_num]) && $args[$arg_num] ne "") { last if ($args[$arg_num] =~ /^#/); $options .= "$args[$arg_num] "; $arg_num++; } $options =~ s/[\s\t]+$// if (defined ($options)); if (defined ($options) && $options =~ /^([\x20-\x7E]+)$/) { $smtps_service_extensions{$extension} = $options; } elsif (! defined ($options) || $options eq "") { $smtps_service_extensions{$extension} = ""; } else { &config_warn("Invalid option for SMTP extension '$extension'"); } } else { &config_warn("'$args[1]' is not a valid SMTP extension"); } } # SMTPS_AuthReversibleOnly elsif ($args[0] =~ /^smtps_auth_reversibleonly$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("SMTPS_AuthReversibleOnly", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("SMTPS_AuthReversibleOnly", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # SMTPS_AuthRequired elsif ($args[0] =~ /^smtps_auth_required$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("SMTPS_AuthRequired", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("SMTPS_AuthRequired", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # SMTPS_KeyFileName elsif ($args[0] =~ /^smtps_ssl_keyfile$/i) { if (! $args[1]) { &config_error("missing argument for smtps_ssl_keyfile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } else { &setConfigParameter("SMTPS_KeyFileName", $args[1]); } } # SMTPS_CrtFileName elsif ($args[0] =~ /^smtps_ssl_certfile$/i) { if (! $args[1]) { &config_error("missing argument for smtps_ssl_certfile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } else { &setConfigParameter("SMTPS_CrtFileName", $args[1]); } } # SMTPS_DHFileName elsif ($args[0] =~ /^smtps_ssl_dhfile$/i) { if (! $args[1]) { &config_error("missing argument for smtps_ssl_dhfile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } else { &setConfigParameter("SMTPS_DHFileName", $args[1]); } } ################################################# # TFTP ################################################# # TFTP_BindPort elsif ($args[0] =~ /^tftp_bind_port$/i) { (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) ? &setConfigParameter("TFTP_BindPort", $args[1]) : &config_error("'$args[1]' is not a valid port number"); } # TFTP_AllowOverwrite elsif ($args[0] =~ /^tftp_allow_overwrite$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("TFTP_AllowOverwrite", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("TFTP_AllowOverwrite", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # TFTP_EnableOptions elsif ($args[0] =~ /^tftp_enable_options$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("TFTP_EnableOptions", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("TFTP_EnableOptions", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # TFTP_Options elsif ($args[0] =~ /^tftp_option$/i) { my $option; my $values; if ($args[1] =~ /^(blksize|timeout|tsize|multicast)$/i) { $option = lc($args[1]); my $arg_num = 2; while ($arg_num <= 3 && defined ($args[$arg_num]) && $args[$arg_num] ne "") { last if ($args[$arg_num] =~ /^#/); $values .= "$args[$arg_num] "; $arg_num++; } $values =~ s/[\s\t]+$// if (defined ($values)); if (defined ($values) && $values =~ /^([\x20-\x7E]+)$/) { $tftp_options{$option} = $values; } elsif (! defined ($values) || $values eq "") { $tftp_options{$option} = ""; } else { &config_warn("Invalid value for TFTP option '$option'"); } } else { &config_warn("'$args[1]' is not a valid TFTP option"); } } ################################################# # Time ################################################# # Time_BindPort elsif ($args[0] =~ /^time_bind_port$/i) { if (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) { &setConfigParameter("Time_TCP_BindPort", $args[1]); &setConfigParameter("Time_UDP_BindPort", $args[1]); } else { &config_error("'$args[1]' is not a valid port number"); } } ################################################# # Finger ################################################# # Finger_BindPort elsif ($args[0] =~ /^finger_bind_port$/i) { (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) ? &setConfigParameter("Finger_BindPort", $args[1]) : &config_error("'$args[1]' is not a valid port number"); } ################################################# # Dummy ################################################# # Dummy_BindPort elsif ($args[0] =~ /^dummy_bind_port$/i) { if (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) { &setConfigParameter("Dummy_TCP_BindPort", $args[1]); &setConfigParameter("Dummy_UDP_BindPort", $args[1]); } else { &config_error("'$args[1]' is not a valid port number"); } } # Dummy_Banner elsif ($args[0] =~ /^dummy_banner$/i) { if (defined ($args[1]) && $args[1] =~ $RE_printable) { &setConfigParameter("Dummy_Banner", $args[1]); } elsif (defined ($args[1]) && $args[1] =~ /^$/) { &setConfigParameter("Dummy_Banner", ""); } elsif (! defined ($args[1])) { &config_error("'' is not a valid banner string"); } else { &config_error("'$args[1]' is not a valid banner string"); } } # Dummy_BannerWait elsif ($args[0] =~ /^dummy_banner_wait$/i) { if ($args[1] =~ $RE_unsignedInt && int($args[1] >= 0) && int($args[1] < 601)) { &setConfigParameter("Dummy_BannerWait", int($args[1])); } else { &config_error("'$args[1]' is not an integer value of range [0..600]"); } } ################################################# # Redirect ################################################# # Redirect_Enabled elsif ($args[0] =~ /^redirect_enabled$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("Redirect_Enabled", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("Redirect_Enabled", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # Redirect_UnknownServices elsif ($args[0] =~ /^redirect_unknown_services$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("Redirect_UnknownServices", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("Redirect_UnknownServices", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # Redirect_ExternalAddress elsif ($args[0] =~ /^redirect_external_address$/i) { if ($args[1] =~ $RE_validIP) { if ($args[1] =~ /^0.0.0.0$/) { &config_error("redirect_external_address '0.0.0.0' not allowed"); } &setConfigParameter("Redirect_ExternalAddress", $args[1]); } else { &config_error("'$args[1]' is not a valid IP address"); } } # Redirect_ChangeTTL elsif ($args[0] =~ /^redirect_change_ttl$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("Redirect_ChangeTTL", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("Redirect_ChangeTTL", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # Redirect_StaticRules elsif ($args[0] =~ /^redirect_static_rule$/i) { my $re_ip_port = qr/^(([01]?[0-9][0-9]?|2[0-4][0-9]|25[0-5])\.){3}([01]?[0-9][0-9]?|2[0-4][0-9]|25[0-5]):([\d]{1,5})$/; my $re_ip_type = qr/^(([01]?[0-9][0-9]?|2[0-4][0-9]|25[0-5])\.){3}([01]?[0-9][0-9]?|2[0-4][0-9]|25[0-5]):(any|echo-reply|destination-unreachable|source-quench|redirect|echo-request|router-advertisement|router-solicitation|time-exceeded|parameter-problem|timestamp-request|timestamp-reply|address-mask-request|address-mask-reply)$/i; my $re_ip = qr/^(([01]?[0-9][0-9]?|2[0-4][0-9]|25[0-5])\.){3}([01]?[0-9][0-9]?|2[0-4][0-9]|25[0-5]):?$/; my $re_port = qr/^:([\d]{1,5})$/; my $re_type = qr/^:(any|echo-reply|destination-unreachable|source-quench|redirect|echo-request|router-advertisement|router-solicitation|time-exceeded|parameter-problem|timestamp-request|timestamp-reply|address-mask-request|address-mask-reply)$/i; if ($args[1] =~ /^(tc|ud)p$/i) { if ($args[2] !~ $re_ip_port && $args[2] !~ $re_ip && $args[2] !~ $re_port) { &config_error("'$args[2]' is not a valid $args[1] source ip:port value"); } elsif ($args[3] !~ $re_ip_port && $args[3] !~ $re_ip && $args[3] !~ $re_port) { &config_error("'$args[3]' is not a valid $args[1] destination ip:port value"); } else { my $key = lc($args[1]) . "," . $args[2]; $redirect_static_rules{$key} = $args[3]; } } elsif ($args[1] =~ /^icmp$/i) { if ($args[2] !~ $re_ip_type && $args[2] !~ $re_ip && $args[2] !~ $re_type) { &config_error("'$args[2]' is not a valid $args[1] source ip:type value"); } elsif ($args[3] !~ $re_ip) { &config_error("'$args[3]' is not a valid $args[1] destination ip value"); } else { my $key = lc($args[1]) . "," . $args[2]; $redirect_static_rules{$key} = $args[3]; } } else { &config_error("'$args[1]' is not a valid protocol"); } } # Redirect_ExcludePort elsif ($args[0] =~ /^redirect_exclude_port$/i) { if ($args[1] =~ /^(tcp|udp):([\d]{1,5})$/i) { my $proto = lc($1); my $port = $2; if (($port =~ /[\d]+/) && ($port > 0) && ($port < 65535)) { push (@usedPorts, $args[1]); } else { &config_error("'$port' is not a valid port number"); } } else { &config_error("'$args[1]' is not a valid protocol:port value"); } } # Redirect_IgnoreBootp elsif ($args[0] =~ /^redirect_ignore_bootp$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("Redirect_IgnoreBootp", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("Redirect_IgnoreBootp", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # Redirect_IgnoreNetbios elsif ($args[0] =~ /^redirect_ignore_netbios$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("Redirect_IgnoreNetbios", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("Redirect_IgnoreNetbios", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # Redirect_ICMP_Timestamp elsif ($args[0] =~ /^redirect_icmp_timestamp$/i) { if ($args[1] =~ /^ms$/i) { &setConfigParameter("Redirect_ICMP_Timestamp", 1); } elsif ($args[1] =~ /^sec$/i) { &setConfigParameter("Redirect_ICMP_Timestamp", 2); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("Redirect_ICMP_Timestamp", 0); } else { &config_error("Invalid argument '$args[1]'"); } } ################################################# # FTP ################################################# # FTP_BindPort elsif ($args[0] =~ /^ftp_bind_port$/i) { (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) ? &setConfigParameter("FTP_BindPort", $args[1]) : &config_error("'$args[1]' is not a valid port number"); } # FTP_DataPort elsif ($args[0] =~ /^ftp_data_port$/i) { (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) ? &setConfigParameter("FTP_DataPort", $args[1]) : &config_error("'$args[1]' is not a valid port number"); } # FTP_Version elsif ($args[0] =~ /^ftp_version$/i) { ($args[1] =~ $RE_printable) ? &setConfigParameter("FTP_Version", $args[1]) : &config_error("'$args[1]' is not a valid version string"); } # FTP_Banner elsif ($args[0] =~ /^ftp_banner$/i) { ($args[1] =~ $RE_printable) ? &setConfigParameter("FTP_Banner", $args[1]) : &config_error("'$args[1]' is not a valid FTP banner string"); } # FTP_RecursiveDelete elsif ($args[0] =~ /^ftp_recursive_delete$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("FTP_RecursiveDelete", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("FTP_RecursiveDelete", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # FTP_KeyFileName elsif ($args[0] =~ /^ftp_ssl_keyfile$/i) { if (! $args[1]) { &config_error("missing argument for ftp_ssl_keyfile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } else { &setConfigParameter("FTP_KeyFileName", $args[1]); } } # FTP_CrtFileName elsif ($args[0] =~ /^ftp_ssl_certfile$/i) { if (! $args[1]) { &config_error("missing argument for ftp_ssl_certfile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } else { &setConfigParameter("FTP_CrtFileName", $args[1]); } } # FTP_DHFileName elsif ($args[0] =~ /^ftp_ssl_dhfile$/i) { if (! $args[1]) { &config_error("missing argument for ftp_ssl_dhfile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } else { &setConfigParameter("FTP_DHFileName", $args[1]); } } ################################################# # FTPS ################################################# # FTPS_BindPort elsif ($args[0] =~ /^ftps_bind_port$/i) { (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) ? &setConfigParameter("FTPS_BindPort", $args[1]) : &config_error("'$args[1]' is not a valid port number"); } # FTPS_DataPort elsif ($args[0] =~ /^ftps_data_port$/i) { (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) ? &setConfigParameter("FTPS_DataPort", $args[1]) : &config_error("'$args[1]' is not a valid port number"); } # FTPS_Version elsif ($args[0] =~ /^ftps_version$/i) { ($args[1] =~ $RE_printable) ? &setConfigParameter("FTPS_Version", $args[1]) : &config_error("'$args[1]' is not a valid version string"); } # FTPS_Banner elsif ($args[0] =~ /^ftps_banner$/i) { ($args[1] =~ $RE_printable) ? &setConfigParameter("FTPS_Banner", $args[1]) : &config_error("'$args[1]' is not a valid FTP banner string"); } # FTPS_RecursiveDelete elsif ($args[0] =~ /^ftps_recursive_delete$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("FTPS_RecursiveDelete", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("FTPS_RecursiveDelete", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # FTPS_KeyFileName elsif ($args[0] =~ /^ftps_ssl_keyfile$/i) { if (! $args[1]) { &config_error("missing argument for ftps_ssl_keyfile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } else { &setConfigParameter("FTPS_KeyFileName", $args[1]); } } # FTPS_CrtFileName elsif ($args[0] =~ /^ftps_ssl_certfile$/i) { if (! $args[1]) { &config_error("missing argument for ftps_ssl_certfile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } else { &setConfigParameter("FTPS_CrtFileName", $args[1]); } } # FTPS_DHFileName elsif ($args[0] =~ /^ftps_ssl_dhfile$/i) { if (! $args[1]) { &config_error("missing argument for ftps_ssl_dhfile"); } elsif ($args[1] !~ $RE_validFilename) { &config_error("'$args[1]' is not a valid filename"); } else { &setConfigParameter("FTPS_DHFileName", $args[1]); } } ################################################# # Syslog ################################################# # Syslog_BindPort elsif ($args[0] =~ /^syslog_bind_port$/i) { (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) ? &setConfigParameter("Syslog_BindPort", $args[1]) : &config_error("'$args[1]' is not a valid port number"); } # Syslog_TrimMaxLength elsif ($args[0] =~ /^syslog_trim_maxlength$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("Syslog_TrimMaxLength", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("Syslog_TrimMaxLength", 0); } else { &config_error("Invalid argument '$args[1]'"); } } # Syslog_AcceptInvalid elsif ($args[0] =~ /^syslog_accept_invalid$/i) { if ($args[1] =~ /^yes$/i) { &setConfigParameter("Syslog_AcceptInvalid", 1); } elsif ($args[1] =~ /^no$/i) { &setConfigParameter("Syslog_AcceptInvalid", 0); } else { &config_error("Invalid argument '$args[1]'"); } } ################################################# # IRC ################################################# # IRC_BindPort elsif ($args[0] =~ /^irc_bind_port$/i) { (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) ? &setConfigParameter("IRC_BindPort", $args[1]) : &config_error("'$args[1]' is not a valid port number"); } # IRC_FQDN_Hostname elsif ($args[0] =~ /^irc_fqdn_hostname$/i) { ($args[1] =~ $RE_validFQDNHostname) ? &setConfigParameter("IRC_FQDN_Hostname", $args[1]) : &config_error("'$args[1]' is not a valid FQDN hostname"); } # IRC_Version elsif ($args[0] =~ /^irc_version$/i) { ($args[1] =~ $RE_printable) ? &setConfigParameter("IRC_Version", $args[1]) : &config_error("'$args[1]' is not a valid version string"); } ################################################# # IRCS ################################################# # IRCS_BindPort elsif ($args[0] =~ /^ircs_bind_port$/i) { (($args[1] =~ /[\d]+/) && ($args[1] > 0) && ($args[1] < 65535)) ? &setConfigParameter("IRCS_BindPort", $args[1]) : &config_error("'$args[1]' is not a valid port number"); } # IRCS_FQDN_Hostname elsif ($args[0] =~ /^ircs_fqdn_hostname$/i) { ($args[1] =~ $RE_validFQDNHostname) ? &setConfigParameter("IRCS_FQDN_Hostname", $args[1]) : &config_error("'$args[1]' is not a valid FQDN hostname"); } # IRCS_Version elsif ($args[0] =~ /^ircs_version$/i) { ($args[1] =~ $RE_printable) ? &setConfigParameter("IRCS_Version", $args[1]) : &config_error("'$args[1]' is not a valid version string"); } ################################################# # Unknown keyword else { &config_warn("Unknown keyword '$args[0]'"); } } } close(CONFIGFILE); # store static dns configuration &setConfigHash("DNS_StaticHostToIP", %dns_statichosttoip); &setConfigHash("DNS_StaticIPToHost", %dns_staticiptohost); # store http fakefile configuration &setConfigHash("HTTP_FakeFileExtToName", %http_fakefile_exttoname); &setConfigHash("HTTP_FakeFileExtToMIMEType", %http_fakefile_exttomimetype); &setConfigHash("HTTP_Static_FakeFilePathToName", %http_static_fakefile_pathtoname); &setConfigHash("HTTP_Static_FakeFilePathToMIMEType", %http_static_fakefile_pathtomimetype); # store https fakefile configuration &setConfigHash("HTTPS_FakeFileExtToName", %https_fakefile_exttoname); &setConfigHash("HTTPS_FakeFileExtToMIMEType", %https_fakefile_exttomimetype); &setConfigHash("HTTPS_Static_FakeFilePathToName", %https_static_fakefile_pathtoname); &setConfigHash("HTTPS_Static_FakeFilePathToMIMEType", %https_static_fakefile_pathtomimetype); # store static rules for redirect &setConfigHash("Redirect_StaticRules", %redirect_static_rules); # store smtp extensions &setConfigHash("SMTP_Service_Extensions", %smtp_service_extensions); # store smtps extensions &setConfigHash("SMTPS_Service_Extensions", %smtps_service_extensions); # store pop3 capabilities &setConfigHash("POP3_Capabilities", %pop3_capabilities); # store pop3s capabilities &setConfigHash("POP3S_Capabilities", %pop3s_capabilities); # store tftp options &setConfigHash("TFTP_Options", %tftp_options); &setConfigParameter("Chargen_TCP_ServiceName", "chargen_" . &getConfigParameter("Chargen_TCP_BindPort") . "_tcp"); &setConfigParameter("Chargen_UDP_ServiceName", "chargen_" . &getConfigParameter("Chargen_UDP_BindPort") . "_udp"); &setConfigParameter("Daytime_TCP_ServiceName", "daytime_" . &getConfigParameter("Daytime_TCP_BindPort") . "_tcp"); &setConfigParameter("Daytime_UDP_ServiceName", "daytime_" . &getConfigParameter("Daytime_UDP_BindPort") . "_udp"); &setConfigParameter("Discard_TCP_ServiceName", "discard_" . &getConfigParameter("Discard_TCP_BindPort") . "_tcp"); &setConfigParameter("Discard_UDP_ServiceName", "discard_" . &getConfigParameter("Discard_UDP_BindPort") . "_udp"); &setConfigParameter("DNS_ServiceName", "dns_" . &getConfigParameter("DNS_BindPort") . "_tcp_udp"); &setConfigParameter("Echo_TCP_ServiceName", "echo_" . &getConfigParameter("Echo_TCP_BindPort") . "_tcp"); &setConfigParameter("Echo_UDP_ServiceName", "echo_" . &getConfigParameter("Echo_UDP_BindPort") . "_udp"); &setConfigParameter("HTTP_ServiceName", "http_" . &getConfigParameter("HTTP_BindPort") . "_tcp"); &setConfigParameter("HTTPS_ServiceName", "https_" . &getConfigParameter("HTTPS_BindPort") . "_tcp"); &setConfigParameter("Ident_ServiceName", "ident_" . &getConfigParameter("Ident_BindPort") . "_tcp"); &setConfigParameter("NTP_ServiceName", "ntp_" . &getConfigParameter("NTP_BindPort") . "_udp"); &setConfigParameter("POP3_ServiceName", "pop3_" . &getConfigParameter("POP3_BindPort") . "_tcp"); &setConfigParameter("POP3S_ServiceName", "pop3s_" . &getConfigParameter("POP3S_BindPort") . "_tcp"); &setConfigParameter("Quotd_TCP_ServiceName", "quotd_" . &getConfigParameter("Quotd_TCP_BindPort") . "_tcp"); &setConfigParameter("Quotd_UDP_ServiceName", "quotd_" . &getConfigParameter("Quotd_UDP_BindPort") . "_udp"); &setConfigParameter("SMTP_ServiceName", "smtp_" . &getConfigParameter("SMTP_BindPort") . "_tcp"); &setConfigParameter("SMTPS_ServiceName", "smtps_" . &getConfigParameter("SMTPS_BindPort") . "_tcp"); &setConfigParameter("Time_TCP_ServiceName", "time_" . &getConfigParameter("Time_TCP_BindPort") . "_tcp"); &setConfigParameter("Time_UDP_ServiceName", "time_" . &getConfigParameter("Time_UDP_BindPort") . "_udp"); &setConfigParameter("TFTP_ServiceName", "tftp_" . &getConfigParameter("TFTP_BindPort") . "_udp"); &setConfigParameter("Finger_ServiceName", "finger_" . &getConfigParameter("Finger_BindPort") . "_tcp"); &setConfigParameter("Dummy_TCP_ServiceName", "dummy_" . &getConfigParameter("Dummy_TCP_BindPort") . "_tcp"); &setConfigParameter("Dummy_UDP_ServiceName", "dummy_" . &getConfigParameter("Dummy_UDP_BindPort") . "_udp"); &setConfigParameter("FTP_ServiceName", "ftp_" . &getConfigParameter("FTP_BindPort") . "_tcp"); &setConfigParameter("FTPS_ServiceName", "ftps_" . &getConfigParameter("FTPS_BindPort") . "_tcp"); &setConfigParameter("Syslog_ServiceName", "syslog_" . &getConfigParameter("Syslog_BindPort") . "_udp"); &setConfigParameter("IRC_ServiceName", "irc_" . &getConfigParameter("IRC_BindPort") . "_tcp"); &setConfigParameter("IRCS_ServiceName", "ircs_" . &getConfigParameter("IRCS_BindPort") . "_tcp"); # check command line options if (my $session = &INetSim::CommandLine::getCommandLineOption("session")) { &setConfigParameter("SessionID", $session); } if (my $faketime_initdelta = &INetSim::CommandLine::getCommandLineOption("faketime_initdelta")) { &setConfigParameter("Faketime_Delta", int($faketime_initdelta)); } if (my $faketime_autodelay = &INetSim::CommandLine::getCommandLineOption("faketime_autodelay")) { &setConfigParameter("Faketime_AutoDelay", int($faketime_autodelay)); } if (my $faketime_autoincr = &INetSim::CommandLine::getCommandLineOption("faketime_autoincr")) { &setConfigParameter("Faketime_AutoIncrement", int($faketime_autoincr)); } if (my $default_max_childs = &INetSim::CommandLine::getCommandLineOption("max_childs")) { &setConfigParameter("Default_MaxChilds", int($default_max_childs)); } if (my $bind_address = &INetSim::CommandLine::getCommandLineOption("bind_address")) { &setConfigParameter("Default_BindAddress", $bind_address); } if (my $user = &INetSim::CommandLine::getCommandLineOption("user")) { &setConfigParameter("Default_RunAsUser", $user); } &INetSim::Log::MainLog("Configuration file parsed successfully."); } sub splitline { # split up a line into words # multiple words in quotes count as one word # return an array containing the words my $line = shift; my $i; my $char = ""; my $word = ""; my $in_word = 0; my $in_quotes = 0; my @words = (); for ($i=0; $i exit &INetSim::error_exit("getConfigParameter() called without parameter"); } elsif (exists $ConfigOptions{$key}) { # if (UNIVERSAL::isa ($ConfigOptions{$key}, "ARRAY")) { # # we have an array # return @{$ConfigOptions{$key}}; # } # elsif (UNIVERSAL::isa ($ConfigOptions{$key}, "HASH")) { # # we have a hash # return %{$ConfigOptions{$key}}; # } # else { # # we have a scalar return $ConfigOptions{$key}; # } } else { # programming error -> exit &INetSim::error_exit("No such configuration parameter '$key'"); } } sub getConfigHash { my $key = shift; if (! defined $key) { # programming error -> exit &INetSim::error_exit("getConfigHash() called without parameter."); } elsif (exists $ConfigOptions{$key}) { return %{$ConfigOptions{$key}}; } else { # programming error -> exit &INetSim::error_exit("No such configuration parameter '$key'."); } } sub setConfigHash { my ($key, %values) = @_; if (! defined $key) { # programming error -> exit &INetSim::error_exit("setConfigHash() called without key parameter."); } # elsif (! %values) { # # programming error -> exit # &INetSim::error_exit("setConfigHash() called without values."); # } elsif (exists $ConfigOptions{$key}) { %{$ConfigOptions{$key}} = %values; } else { # programming error -> exit &INetSim::error_exit("No such configuration option '$key'."); } } sub setConfigParameter { my $key = shift; my $value = shift; if (! defined $key) { # programming error -> exit &INetSim::error_exit("setConfigParameter() called without key parameter."); } elsif (! defined $value) { # programming error -> exit &INetSim::error_exit("setConfigParameter() called without value."); } elsif (exists $ConfigOptions{$key}) { $ConfigOptions{$key} = $value; } else { # programming error -> exit &INetSim::error_exit("No such configuration option '$key'."); } } sub getServicesToStart { return @ServicesToStart; } sub getUsedPorts { my %seen = (); foreach my $key (keys %ConfigOptions) { if (defined ($key) && $key && $key) { if ($key =~ /TCP_BindPort$/ || $key =~ /(DNS|HTTP|Ident|POP3|SMTP|Finger|FTP|IRC)_BindPort$/ || ($SSL && $key =~ /(HTTPS|POP3S|SMTPS|FTPS|IRCS)_BindPort$/)) { push (@usedPorts, "tcp:$ConfigOptions{$key}"); } if ($key =~ /UDP_BindPort$/ || $key =~ /(DNS|NTP|TFTP|Syslog)_BindPort$/) { push (@usedPorts, "udp:$ConfigOptions{$key}"); } # for future use ! # if ($key =~ /(FTP|FTPS|IRC)_DataPort$/) { # push (@usedPorts, "tcp:$ConfigOptions{$key}"); # } } } return (grep { ! $seen{ $_ }++ } @usedPorts); } 1; ############################################################# # # History: # # Version 0.105 (2013-11-02) th # - set config parameter HTTP(S)_POSTDataDir correctly # if '--data-dir' command line option is used # # Version 0.104 (2012-10-01) th # - changed ServiceName format # # Version 0.103 (2010-11-03) th # - changed regexp check with http(s)_static_fakefile # # Version 0.102 (2010-09-18) th # - added support for HTTP(S) static fakefiles # # Version 0.101 (2010-04-19) me # - added configuration variables 'IRC[S]_FQDN_Hostname' and 'IRC[S]_Version' # - added configuration options 'irc[s]_fqdn_hostname' and 'irc[s]_version' # # Version 0.100 (2010-04-15) me # - added better checks for SSL support # - added warning for enabled SSL services without SSL support # # Version 0.99 (2010-04-11) th # - changed possible value for 'Redirect_ICMP_Timestamp' # from empty string to 'no' # # Version 0.98 (2010-04-02) me # - added new variable 'Redirect_ICMP_Timestamp' # # Version 0.97 (2010-02-19) me # - added support for icmp redirects # # Version 0.96 (2009-12-20) th # - changed default filenames for SSL certificate and keyfile # # Version 0.95 (2009-12-19) me # - added variables 'CertDir', 'Default_KeyFileName', 'Default_CrtFileName' # and 'Default_DHFileName' # - changed path to certificate locations # # Version 0.94 (2009-12-18) th # - added path to certificate locations for config options # # Version 0.93 (2009-12-15) th # - changed default SSL certificate locations # # Version 0.92 (2009-10-12) me # - removed 'TFTP_UploadData', 'TFTP_UploadIndex' and 'TFTP_EnableUpload' # - added new variables 'TFTP_UploadDir', 'TFTP_AllowOverwrite' # and 'TFTP_EnableOptions' # - added configuration hash 'TFTP_Options' # # Version 0.91 (2009-10-06) me # - added configuration options '*_ssl_dhfile' and variables # '*_DHFileName' for optional Diffie-Hellman parameter files # - added configuration options 'smtp[s]_auth_required' and # variables 'SMTP[S]_AuthRequired' # # Version 0.90 (2009-10-04) me # - bugfix: changed *ssl_crtfile to *ssl_certfile # # Version 0.89 (2009-10-02) me # - added configuration options for IRC[s] # # Version 0.88 (2009-09-25) me # - added variables 'FTP[S]_Version', 'POP3[S]_Version' # # Version 0.87 (2009-09-24) me # - added variable 'DNS_Version' # # Version 0.86 (2009-09-23) me # - added service IRC # # Version 0.85 (2009-09-07) me # - added variables 'POP3[S]_EnableAPOP', 'POP3[S]_EnableCapabilities' # - added configuration hashes 'POP3[s]_Capabilities' # # Version 0.84 (2009-09-05) me # - added cert file options for HTTP (RFC 2817) # - disabled 'Debug' flag # # Version 0.83 (2009-09-04) me # - changed default path for smtps cert files # - added variable 'FTP_DataPort' # - services POP3, HTTP and FTP prepared for using SSL # # Version 0.82 (2009-09-03) me # - added GenericServer configuration options for SMTPS # # Version 0.81 (2009-09-02) me # - added variables 'SMTP_KeyFileName' and 'SMTP_CrtFileName' # # Version 0.80 (2008-09-26) me # - changed default timeout for services to 120 seconds # - bugfix: stop parameter parsing for smtp extensions after '#' # - added variables 'Dummy_Banner' and 'Dummy_BannerWait' # - bugfix: added setConfigParameter for ftp path variables # # Version 0.79 (2008-09-21) me # - added variable 'SMTP_Extended_SMTP' as SMTP/ESMTP switch # - added configuration hash 'SMTP_Service_Extensions' for ESMTP # extensions to use # - removed SMTP 'Enhanced-Status-Codes' stuff, because it can # now be configured via 'SMTP_Service_Extensions' hash # # Version 0.78 (2008-09-20) me # - added variable 'SMTP_EnhancedStatusCodes' and configuration # option 'smtp_enhanced_statuscodes' # - added variable 'FTP_RecursiveDelete' and configuration option # 'ftp_recursive_delete' # - added service syslog to function getUsedPorts() # # Version 0.77 (2008-09-08) me # - added service syslog # # Version 0.76 (2008-08-28) me # - added configuration variable 'FTP_UploadDir' # # Version 0.75 (2008-08-27) me # - added configuration variables 'Redirect_IgnoreBootp' and # 'Redirect_IgnoreNetbios' # - added configuration variable 'FTP_DocumentRoot' # # Version 0.74 (2008-08-27) me # - moved check for '0.0.0.0' in bind_address to redirect module # # Version 0.73 (2008-08-24) me # - added GenericServer configuration options for FTP # - added service FTP to function getUsedPorts() # - added variable 'ReportLanguage' and configuration option 'report_language' # # Version 0.72 (2008-08-20) me # - added service FTP # # Version 0.71 (2008-08-09) th # - added 'Create_Reports' # # Version 0.70 (2008-08-02) th # - added HTTP_POSTDataDir # # Version 0.69 (2008-07-06) th # - changed default for 'Redirect_Enabled' to '0' # # Version 0.68 (2008-06-26) th # - Bugfix: full string match on configuration options # - renamed configuration option 'default_timeout' to 'service_timeout' # - renamed configuration option 'default_max_childs' to 'service_max_childs' # - renamed configuration option 'default_run_as_user' to 'service_run_as_user' # - renamed configuration option 'bind_address' to 'service_bind_address' # # Version 0.67 (2008-06-24) me # - added configuration option 'redirect_exclude_port' # # Version 0.66 (2008-06-15) me # - changed Default_MaxChilds value to 10 # # Version 0.65 (2008-06-13) th # - removed bind_address configuration options for # individual services # - renamed default_bind_adress to bind_address # - disallow '0.0.0.0' for bind_address, ntp_server_ip and # redirect_external_address # # Version 0.64 (2008-03-25) me # - changed protocol for NTP_ServiceName to udp # # Version 0.63 (2008-03-19) me # - added configuration option Default_TimeOut # # Version 0.62 (2008-03-17) me # - fixed some typos # # Version 0.61 (2008-03-17) me # - added configuration option Redirect_Enabled # - bugfix: disabled check for empty hash in function setConfigHash() # # Version 0.60 (2008-03-16) me # - added function getUsedPorts() # - added configuration variables Redirect_UnknownServices, # Redirect_ExternalAddress, Redirect_ChangeTTL and # Redirect_StaticRules for 'Redirect' module # # Version 0.59 (2008-03-15) me # - added configuration variable NTP_StrictChecks # # Version 0.58 (2008-03-06) me # - added GenericServer configuration options for "Dummy" TCP/UDP # # Version 0.57 (2007-12-09) me # - added configuration variable POP3_AuthReversibleOnly # - added configuration variable SMTP_AuthReversibleOnly # # Version 0.56 (2007-11-07) me # - added GenericServer configuration options for Finger # # Version 0.55 (2007-10-21) th # - bugfix: also use default SubLogfileName "service.log" # instead of "sub.log" if commandline option "log_dir" is used # - bugfix: POP3_MBOXDirName was not set if commandline option # "data_dir" used # - removed unused configuration variable POP3_MBOXFileName # - changed POP3_MBOXDirName from "pop3/" to "pop3" # - changed default POP3_MBOXMaxMails to 10 # # Version 0.54 (2007-10-20) me # - added configuration variable POP3_MBOXMaxMails # - added configuration variable POP3_MBOXReRead # - added configuration variable POP3_MBOXReBuild # # Version 0.53 (2007-10-12) th # - changed default SubLogfileName to "service.log" # # Version 0.52 (2007-05-24) th # - renamed HTTP_Default_FakeFileType to HTTP_Default_FakeFileMIMEType # - now MIME type must be specified instead of file extension for # default fake file # - renamed HTTP_FakeFiles to HTTP_FakeFileExtToMIMEType # - new variable HTTP_FakeFileExtToMIMEType # - now MIME type must be specified for every fake file # - added variable TFTP_EnableUpload # # Version 0.51 (2007-05-18) th # - changed $basedir to $currentdir # - add full path to ConfigFileName # # Version 0.50 (2007-05-16) th # - added missing setConfigParameter for DebugLogfileName # when log-dir specified on command line # - added configuration variables LogDir and DataDir # - added logging of LogDir, DataDir, ReportDir and # ConfigFileName # # Version 0.49 (2007-05-15) th # - check if users specified to run services exist on system # - added configuration variables DNS_RunAsUser, DNS_RunAsGroup # and DNS_MaxChilds # # Version 0.48 (2007-05-14) th # - changed DNS default IP to 127.0.0.1 # # Version 0.47 (2007-05-02) th # - merged versions 0.45b and 0.46 # - added configuration variables "Debug" and "DebugLogfileName" # # Version 0.46 (2007-04-30) th # - set Default_RunAsGroup to 'inetsim' and removed # configuration file parsing for this option # - after parsing configuration file, check command line options # with getCommandLineOption() # - added function getServicesToStart() # # Version 0.45b (2007-04-28) me # - added configuration variable POP3_MBOXDirName # - changed default value for POP3_MBOXFileName to pop3.mbx # # Version 0.45 (2007-04-29) th # - moved command line parser to CommandLine.pm # # Version 0.44 (2007-04-27) th # - added functions getConfigHash and setConfigHash # - moved global configuration variables for DNS, HTTP to shared hash # - added configuration variable ReportDir # - moved global configuration variables for SessionID, # ConfigFileName, MainLogfileName, SubLogfileName to shared hash # # Version 0.43 (2007-04-26) th # - moved global configuration variables for Chargen, Discard, # Echo, Ident, NTP, POP3, Quotd, SMTP, TFTP, Time to shared hash # # Version 0.42 (2007-04-25) th # - added shared hash for config parameters # - added functions getConfigParameter and setConfigParameter # - moved global configuration variables for FakeTime and DayTime # to shared hash # # Version 0.41 (2007-04-25) me # - fixed a typo with commandline option delay # # Version 0.40 (2007-04-24) me # - removed basedir option # - added log-dir option # - added data-dir option # - added delta option # - added configuration option $INetSim::Config::LogDir # - added configuration option $INetSim::Config::DataDir # # Version 0.39 (2007-04-22) th # - use INetSim::error_exit() instead of die() and exit() # - changed some error messages # - set default $INetSim::Config::BaseDir to cwd() instead of "." # # Version 0.38 (2007-04-21) me # - merged th's and me's current version # - changed handling of basedir option # - changed handling of session option # # Version 0.37 (2007-04-21) th # - changed handling of HTTP default fakefile # - added configuration option $INetSim::Config::HTTP_Default_FakeFileType # - added configuration option $INetSim::Config::HTTP_Default_FakeFileName # # Version 0.36 (2007-04-20) me # - added configuration option $INetSim::Config::SessionID # - added parsing of 'session' ($INetSim::Config::SessionID) # # Version 0.35 (2007-04-19) me # - added parsing of commandline options # - added reg-ex for unsigned integer # # Version 0.34 (2007-04-09) th # - renamed INetSim::Config::FakeTimeDelta # to INetSim::Config::FakeTimeInitDelta # - added configuration options # INetSim::Config::FakeTimeAutoDelay # INetSim::Config::FakeTimeAutoIncrement # # Version 0.33 (2007-04-06) th # - added parsing of BindAddress and BindPort for all services # # Version 0.32 (2007-04-05) th # - changed default values for MaxChilds, BindAddress, # RunAsUser and RunAsGroup to 'undef' for all services # - added parsing of default_max_childs, default_bind_address, # default_run_as_user and default_run_as_group # - generate service names with configured bind port # # Version 0.31 (2007-04-02) th # - added configuration options INetSim::Config::DNS_StaticHostToIP # and INetSim::Config::DNS_StaticIPToHost # # Version 0.30 (2007-04-01) th # - merged me's and th's current version # # Version 0.29 (2007-03-30) me # - added GenericServer configuration options for TFTP # # Version 0.28 (2007-03-29) th # - fixed bug if a configuration parameter is '0' # - added configuration option $INetSim::Config::HTTP_FakeMode # - added configuration option $INetSim::Config::HTTP_FakeFileDir # - added configuration option %INetSim::Config::HTTP_FakeFiles # # Version 0.27 (2007-03-28) th # - added configuration option $INetSim::Config::HTTP_Version # - added configuration option $INetSim::Config::HTTP_MIMETypesFile # # Version 0.26 (2007-03-27) th # - added configuration option $INetSim::Config::Quotd_QuotesFileName # # Version 0.25 (2007-03-26) th # - added GenericServer configuration options for SMTP # - added GenericServer configuration options for POP3 # - added configuration option $INetSim::Config::SMTP_HELO_required # - added configuration option $INetSim::Config::SMTP_MBOXFileName # - added configuration option $INetSim::Config::POP3_MBOXFileName # - added GenericServer configuration options for Daytime TCP/UDP # - added GenericServer configuration options for Time TCP/UDP # - added GenericServer configuration options for Quotd TCP/UDP # - added GenericServer configuration options for Discard TCP/UDP # - added GenericServer configuration options for NTP # - added GenericServer configuration options for Ident # # Version 0.24 (2007-03-24) th # - added GenericServer configuration options for Chargen TCP/UDP # - added GenericServer configuration options for HTTP # # Version 0.23 (2007-03-20) th # - added GenericServer configuration options for Echo TCP/UDP # # Version 0.22 (2007-03-18) th # - added min/max checks for fake time delta # - added configuration options # INetSim::Config::SMTP_FQDN_Hostname # INetSim::Config::SMTP_Banner # INetSim::Config::NTP_Server_IP # # Version 0.21 (2007-03-17) th # - added configuration options # INetSim::Config::DNS_Default_IP # INetSim::Config::DNS_Default_Hostname # INetSim::Config::DNS_Default_Domainname # # Version 0.2 (2007-03-16) th # - added configuration options # INetSim::Config::ServicesToStart # INetSim::Config::FakeTimeDelta # ############################################################# inetsim-1.2.7/lib/INetSim/Chargen.pm0000644000175000017500000000141313173076432015345 0ustar rgyrgy# -*- perl -*- # # INetSim::Chargen - Base package for Chargen::TCP and Chargen::UDP # # RFC 864 - Character Generator Protocol # # (c)2007 Matthias Eckert, Thomas Hungenberg # # Version 0.1 (2007-03-24) # # For history/changelog see bottom of this file. # ############################################################# package INetSim::Chargen; use strict; use warnings; use base qw(INetSim::GenericServer); sub chars{ my $self = shift; my $offset = shift; my $chars; foreach (0..94){ $chars .= chr($_ + 32); } $chars .= $chars; return substr($chars, $offset, 72); } 1; ############################################################# # # History: # # Version 0.1 (2007-03-24) th # ############################################################# inetsim-1.2.7/lib/INetSim/Daytime.pm0000644000175000017500000000071113173076432015372 0ustar rgyrgy# -*- perl -*- # # INetSim::Daytime - Base package for Daytime::TCP and Dayime::UDP # # (c)2007 Thomas Hungenberg, Matthias Eckert # # Version 0.1 (2007-03-26) # ############################################################# # # History: # # Version 0.1 (2007-03-26) th # ############################################################# package INetSim::Daytime; use strict; use warnings; use base qw(INetSim::GenericServer); # no shared functions 1; # inetsim-1.2.7/lib/INetSim/GenericServer.pm0000644000175000017500000000113713173076432016544 0ustar rgyrgy# -*- perl -*- # # INetSim::GenericServer - Generic server base package # # (c)2007-2008 Thomas Hungenberg, Matthias Eckert # # Version 0.2 (2008-06-27) # # For history/changelog see bottom of this file. # ############################################################# package INetSim::GenericServer; use base qw(INetSim::Fork); # no shared functions 1; ############################################################# # # History: # # Version 0.2 (2008-06-27) th # - changed base class to INetSim::Fork # # Version 0.1 (2007-03-24) th # ############################################################# inetsim-1.2.7/lib/INetSim/Echo.pm0000644000175000017500000000070313173076432014655 0ustar rgyrgy# -*- perl -*- # # INetSim::Echo - Base package for Echo::TCP and Echo::UDP # # (c)2007-2008 Thomas Hungenberg, Matthias Eckert # # Version 0.1 (2007-03-24) # ############################################################# # # History: # # Version 0.1 (2007-03-24) th # ############################################################# package INetSim::Echo; use strict; use warnings; use base qw(INetSim::GenericServer); # no shared functions 1; # inetsim-1.2.7/lib/INetSim/Quotd/0000755000175000017500000000000013173076432014535 5ustar rgyrgyinetsim-1.2.7/lib/INetSim/Quotd/TCP.pm0000644000175000017500000001020413173076432015516 0ustar rgyrgy# -*- perl -*- # # INetSim::Quotd::TCP - A fake TCP quotd server # # RFC 865 - Quote of the Day Protocol # # (c)2007-2009 Matthias Eckert, Thomas Hungenberg # # Version 0.29 (2009-10-28) # # For history/changelog see bottom of this file. # ############################################################# package INetSim::Quotd::TCP; use strict; use warnings; use base qw(INetSim::Quotd); sub configure_hook { my $self = shift; $self->{server}->{host} = &INetSim::Config::getConfigParameter("Default_BindAddress"); # bind to address $self->{server}->{port} = &INetSim::Config::getConfigParameter("Quotd_TCP_BindPort"); # bind to port $self->{server}->{proto} = 'tcp'; # TCP protocol $self->{server}->{user} = &INetSim::Config::getConfigParameter("Default_RunAsUser"); # user to run as $self->{server}->{group} = &INetSim::Config::getConfigParameter("Default_RunAsGroup"); # group to run as $self->{server}->{setsid} = 0; # do not daemonize $self->{server}->{no_client_stdout} = 1; # do not attach client to STDOUT $self->{server}->{log_level} = 0; # do not log anything $self->{servicename} = &INetSim::Config::getConfigParameter("Quotd_TCP_ServiceName"); $self->{max_childs} = &INetSim::Config::getConfigParameter("Default_MaxChilds"); my ($author, $quote) = &INetSim::Quotd::select_quote(&INetSim::Config::getConfigParameter("Quotd_TCP_ServiceName")); $self->{logtext} = "$quote ($author)"; $quote =~ s/(.{1,72})(\s+|$)|(.{1,72})/$1\r\n/gm; $self->{outtext} = "$quote\r\n-- $author\r\n"; } sub pre_loop_hook { my $self = shift; $0 = "inetsim_$self->{servicename}"; &INetSim::Log::MainLog("started (PID $$)", $self->{servicename}); } sub pre_server_close_hook { my $self = shift; &INetSim::Log::MainLog("stopped (PID $$)", $self->{servicename}); } sub fatal_hook { my $self = shift; &INetSim::Log::MainLog("failed!", $self->{servicename}); exit 0; } sub process_request { my $self = shift; my $client = $self->{server}->{client}; my $rhost = $self->{server}->{peeraddr}; my $rport = $self->{server}->{peerport}; my $stat_success = 0; &INetSim::Log::SubLog("[$rhost:$rport] connect", $self->{servicename}, $$); if ($self->{server}->{numchilds} >= $self->{max_childs}) { print $client "Maximum number of connections ($self->{max_childs}) exceeded.\n"; &INetSim::Log::SubLog("[$rhost:$rport] Connection refused - maximum number of connections ($self->{max_childs}) exceeded.", $self->{servicename}, $$); } else { print $client $self->{outtext}; &INetSim::Log::SubLog("[$rhost:$rport] send: $self->{logtext}", $self->{servicename}, $$); $stat_success = 1; } &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] stat: $stat_success", $self->{servicename}, $$); } 1; ############################################################# # # History: # # Version 0.29 (2009-10-28) me # - improved some code parts # # Version 0.28 (2008-08-27) me # - added logging of process id # # Version 0.27 (2007-12-31) th # - change process name # # Version 0.26 (2007-10-16) th # - fixed bug in quote line wrapping # # Version 0.25 (2007-04-26) th # - use getConfigParameter # # Version 0.24 (2007-04-24) th # - moved quote selection to configure_hook # # Version 0.23 (2007-04-21) me # - added logging of status for use with &INetSim::Report::GenReport() # # Version 0.22 (2007-04-05) th # - changed check for MaxChilds, BindAddress, RunAsUser and # RunAsGroup # # Version 0.21 (2007-03-27) th # - return same quote for all connections # # Version 0.2 (2007-03-26) th # - split TCP and UDP servers to separate modules # - rewrote module to use INetSim::GenericServer # - added logging of refused connections # # Version 0.11 (2007-03-19) th # - fixed problem with uninitialized value of $line in select_quote # # Version 0.1 (2007-03-19) me # ############################################################# inetsim-1.2.7/lib/INetSim/Quotd/UDP.pm0000644000175000017500000001033713173076432015527 0ustar rgyrgy# -*- perl -*- # # INetSim::Quotd::UDP - A fake UDP quotd server # # RFC 865 - Quote of the Day Protocol # # (c)2007-2009 Matthias Eckert, Thomas Hungenberg # # Version 0.29 (2009-10-28) # # For history/changelog see bottom of this file. # ############################################################# package INetSim::Quotd::UDP; use strict; use warnings; use base qw(INetSim::Quotd); sub configure_hook { my $self = shift; $self->{server}->{host} = &INetSim::Config::getConfigParameter("Default_BindAddress"); # bind to address $self->{server}->{port} = &INetSim::Config::getConfigParameter("Quotd_UDP_BindPort"); # bind to port $self->{server}->{proto} = 'udp'; # UDP protocol $self->{server}->{user} = &INetSim::Config::getConfigParameter("Default_RunAsUser"); # user to run as $self->{server}->{group} = &INetSim::Config::getConfigParameter("Default_RunAsGroup"); # group to run as $self->{server}->{setsid} = 0; # do not daemonize $self->{server}->{no_client_stdout} = 1; # do not attach client to STDOUT $self->{server}->{log_level} = 0; # do not log anything # $self->{server}->{udp_recv_len} = 1024; # default is 4096 $self->{servicename} = &INetSim::Config::getConfigParameter("Quotd_UDP_ServiceName"); $self->{max_childs} = &INetSim::Config::getConfigParameter("Default_MaxChilds"); my ($author, $quote) = &INetSim::Quotd::select_quote(&INetSim::Config::getConfigParameter("Quotd_UDP_ServiceName")); $self->{logtext} = "$quote ($author)"; $quote =~ s/(.{1,72})(\s+|$)|(.{1,72})/$1\r\n/gm; $self->{outtext} = "$quote\r\n-- $author\r\n"; } sub pre_loop_hook { my $self = shift; $0 = "inetsim_$self->{servicename}"; &INetSim::Log::MainLog("started (PID $$)", $self->{servicename}); } sub pre_server_close_hook { my $self = shift; &INetSim::Log::MainLog("stopped (PID $$)", $self->{servicename}); } sub fatal_hook { my $self = shift; &INetSim::Log::MainLog("failed!", $self->{servicename}); exit 0; } sub process_request { my $self = shift; my $client = $self->{server}->{client}; my $rhost = $self->{server}->{peeraddr}; my $rport = $self->{server}->{peerport}; my $stat_success = 0; &INetSim::Log::SubLog("[$rhost:$rport] connect", $self->{servicename}, $$); if ($self->{server}->{numchilds} >= $self->{max_childs}) { print $client "Maximum number of connections ($self->{max_childs}) exceeded.\n"; &INetSim::Log::SubLog("[$rhost:$rport] Connection refused - maximum number of connections ($self->{max_childs}) exceeded.", $self->{servicename}, $$); } else { $client->send($self->{outtext}); &INetSim::Log::SubLog("[$rhost:$rport] send: $self->{logtext}", $self->{servicename}, $$); $stat_success = 1; } &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] stat: $stat_success", $self->{servicename}, $$); } 1; ############################################################# # # History: # # Version 0.29 (2009-10-28) me # - improved some code parts # # Version 0.28 (2008-08-27) me # - added logging of process id # # Version 0.27 (2007-12-31) th # - change process name # # Version 0.26 (2007-10-16) th # - fixed bug in quote line wrapping # # Version 0.25 (2007-04-26) th # - use getConfigParameter # # Version 0.24 (2007-04-24) th # - moved quote selection to configure_hook # # Version 0.23 (2007-04-21) me # - added logging of status for use with &INetSim::Report::GenReport() # # Version 0.22 (2007-04-05) th # - changed check for MaxChilds, BindAddress, RunAsUser and # RunAsGroup # # Version 0.21 (2007-03-27) th # - return same quote for all connections # # Version 0.2 (2007-03-26) th # - split TCP and UDP servers to separate modules # - rewrote module to use INetSim::GenericServer # - added logging of refused connections # # Version 0.11 (2007-03-19) th # - fixed problem with uninitialized value of $line in select_quote # # Version 0.1 (2007-03-19) me # ############################################################# inetsim-1.2.7/lib/INetSim/HTTP.pm0000644000175000017500000012330513173076432014562 0ustar rgyrgy# -*- perl -*- # # INetSim::HTTP - An HTTP server with real and fake mode # # RFC 2616 and others - HYPERTEXT TRANSFER PROTOCOL (HTTP) # # (c)2007-2014 Thomas Hungenberg, Matthias Eckert # # Version 0.77 (2014-05-23) # # For history/changelog see bottom of this file. # ############################################################# package INetSim::HTTP; use strict; use warnings; use base qw(INetSim::GenericServer); use Digest::SHA; my $SSL = 0; eval { require IO::Socket::SSL; }; if (! $@) { $SSL = 1; }; my $RE_validIPPort = qr/^(([01]?[0-9][0-9]?|2[0-4][0-9]|25[0-5])\.){3}([01]?[0-9][0-9]?|2[0-4][0-9]|25[0-5])(\:[0-9]{1,5}|)$/; my $RE_validHostnamePort = qr/^[a-zA-Z0-9]([-a-zA-Z0-9]*[a-zA-Z0-9]|)(\:[0-9]{1,5}|)$/; my $RE_validFQDNHostnamePort = qr/^([a-zA-Z0-9]([-a-zA-Z0-9]*[a-zA-Z0-9]|)\.)+[a-zA-Z]+(\:[0-9]{1,5}|)$/; sub configure_hook { my $self = shift; my $server = $self->{server}; $self->{server}->{host} = &INetSim::Config::getConfigParameter("Default_BindAddress"); # bind to address $self->{server}->{proto} = 'tcp'; # TCP protocol $self->{server}->{user} = &INetSim::Config::getConfigParameter("Default_RunAsUser"); # user to run as $self->{server}->{group} = &INetSim::Config::getConfigParameter("Default_RunAsGroup"); # group to run as $self->{server}->{setsid} = 0; # do not daemonize $self->{server}->{no_client_stdout} = 1; # do not attach client to STDOUT $self->{server}->{log_level} = 0; # do not log anything # cert directory $self->{cert_dir} = &INetSim::Config::getConfigParameter("CertDir"); if (defined $self->{server}->{'SSL'} && $self->{server}->{'SSL'}) { $self->{servicename} = &INetSim::Config::getConfigParameter("HTTPS_ServiceName"); if (! $SSL) { &INetSim::Log::MainLog("failed! Library IO::Socket::SSL not installed", $self->{servicename}); exit 1; } $self->{ssl_key} = $self->{cert_dir} . (defined &INetSim::Config::getConfigParameter("HTTPS_KeyFileName") ? &INetSim::Config::getConfigParameter("HTTPS_KeyFileName") : &INetSim::Config::getConfigParameter("Default_KeyFileName")); $self->{ssl_crt} = $self->{cert_dir} . (defined &INetSim::Config::getConfigParameter("HTTPS_CrtFileName") ? &INetSim::Config::getConfigParameter("HTTPS_CrtFileName") : &INetSim::Config::getConfigParameter("Default_CrtFileName")); $self->{ssl_dh} = (defined &INetSim::Config::getConfigParameter("HTTPS_DHFileName") ? &INetSim::Config::getConfigParameter("HTTPS_DHFileName") : &INetSim::Config::getConfigParameter("Default_DHFileName")); if (! -f $self->{ssl_key} || ! -r $self->{ssl_key} || ! -f $self->{ssl_crt} || ! -r $self->{ssl_crt} || ! -s $self->{ssl_key} || ! -s $self->{ssl_crt}) { &INetSim::Log::MainLog("failed! Unable to read SSL certificate files", $self->{servicename}); exit 1; } # $self->{ssl_enabled} = 1; $self->{server}->{port} = &INetSim::Config::getConfigParameter("HTTPS_BindPort"); # bind to port $self->{http_version} = &INetSim::Config::getConfigParameter("HTTPS_Version"); $self->{http_fakemode} = &INetSim::Config::getConfigParameter("HTTPS_FakeMode"); $self->{mimetypes_filename} = &INetSim::Config::getConfigParameter("HTTPS_MIMETypesFileName"); $self->{document_root} = &INetSim::Config::getConfigParameter("HTTPS_DocumentRoot"); $self->{fakeFileDir} = &INetSim::Config::getConfigParameter("HTTPS_FakeFileDir"); $self->{postdata_dirname} = &INetSim::Config::getConfigParameter("HTTPS_POSTDataDir"); $self->{fakefile_exttoname} = &INetSim::Config::getConfigParameter("HTTPS_FakeFileExtToName"); $self->{fakefile_exttomimetype} = &INetSim::Config::getConfigParameter("HTTPS_FakeFileExtToMIMEType"); $self->{default_fakefilename} = &INetSim::Config::getConfigParameter("HTTPS_Default_FakeFileName"); $self->{default_fakefilemimetype} = &INetSim::Config::getConfigParameter("HTTPS_Default_FakeFileMIMEType"); $self->{static_fakefile_pathtoname} = &INetSim::Config::getConfigParameter("HTTPS_Static_FakeFilePathToName"); $self->{static_fakefile_pathtomimetype} = &INetSim::Config::getConfigParameter("HTTPS_Static_FakeFilePathToMIMEType"); } else { $self->{servicename} = &INetSim::Config::getConfigParameter("HTTP_ServiceName"); $self->{ssl_key} = $self->{cert_dir} . (defined &INetSim::Config::getConfigParameter("HTTP_KeyFileName") ? &INetSim::Config::getConfigParameter("HTTP_KeyFileName") : &INetSim::Config::getConfigParameter("Default_KeyFileName")); $self->{ssl_crt} = $self->{cert_dir} . (defined &INetSim::Config::getConfigParameter("HTTP_CrtFileName") ? &INetSim::Config::getConfigParameter("HTTP_CrtFileName") : &INetSim::Config::getConfigParameter("Default_CrtFileName")); $self->{ssl_dh} = (defined &INetSim::Config::getConfigParameter("HTTP_DHFileName") ? &INetSim::Config::getConfigParameter("HTTP_DHFileName") : &INetSim::Config::getConfigParameter("Default_DHFileName")); $self->{ssl_enabled} = 0; $self->{server}->{port} = &INetSim::Config::getConfigParameter("HTTP_BindPort"); # bind to port $self->{http_version} = &INetSim::Config::getConfigParameter("HTTP_Version"); $self->{http_fakemode} = &INetSim::Config::getConfigParameter("HTTP_FakeMode"); $self->{mimetypes_filename} = &INetSim::Config::getConfigParameter("HTTP_MIMETypesFileName"); $self->{document_root} = &INetSim::Config::getConfigParameter("HTTP_DocumentRoot"); $self->{fakeFileDir} = &INetSim::Config::getConfigParameter("HTTP_FakeFileDir"); $self->{postdata_dirname} = &INetSim::Config::getConfigParameter("HTTP_POSTDataDir"); $self->{fakefile_exttoname} = &INetSim::Config::getConfigParameter("HTTP_FakeFileExtToName"); $self->{fakefile_exttomimetype} = &INetSim::Config::getConfigParameter("HTTP_FakeFileExtToMIMEType"); $self->{default_fakefilename} = &INetSim::Config::getConfigParameter("HTTP_Default_FakeFileName"); $self->{default_fakefilemimetype} = &INetSim::Config::getConfigParameter("HTTP_Default_FakeFileMIMEType"); $self->{static_fakefile_pathtoname} = &INetSim::Config::getConfigParameter("HTTP_Static_FakeFilePathToName"); $self->{static_fakefile_pathtomimetype} = &INetSim::Config::getConfigParameter("HTTP_Static_FakeFilePathToMIMEType"); } # warn about missing dh file and disable if (defined $self->{ssl_dh} && $self->{ssl_dh}) { $self->{ssl_dh} = $self->{cert_dir} . $self->{ssl_dh}; if (! -f $self->{ssl_dh} || ! -r $self->{ssl_dh}) { &INetSim::Log::MainLog("Warning: Unable to read Diffie-Hellman parameter file '$self->{ssl_dh}'", $self->{servicename}); $self->{ssl_dh} = undef; } } $self->{maxchilds} = &INetSim::Config::getConfigParameter("Default_MaxChilds"); $self->{default_documents} = "index.html index.htm"; $self->{error_text}{100} = "Continue"; $self->{error_text}{101} = "Switching Protocols"; $self->{error_text}{200} = "OK"; $self->{error_text}{201} = "Created"; $self->{error_text}{202} = "Accepted"; $self->{error_text}{203} = "Non-Authoritative Information"; $self->{error_text}{204} = "No Content"; $self->{error_text}{205} = "Reset Content"; $self->{error_text}{206} = "Partial Content"; $self->{error_text}{300} = "Multiple Choices"; $self->{error_text}{301} = "Moved Permanently"; $self->{error_text}{302} = "Moved Temporarily"; $self->{error_text}{303} = "See Other"; $self->{error_text}{304} = "Not Modified"; $self->{error_text}{305} = "Use Proxy"; $self->{error_text}{400} = "Bad Request"; $self->{error_text}{401} = "Unauthorized"; $self->{error_text}{402} = "Payment Required"; $self->{error_text}{403} = "Forbidden"; $self->{error_text}{404} = "Not Found"; $self->{error_text}{405} = "Method Not Allowed"; $self->{error_text}{406} = "Not Acceptable"; $self->{error_text}{407} = "Proxy Authentication Required"; $self->{error_text}{408} = "Request Time-out"; $self->{error_text}{409} = "Conflict"; $self->{error_text}{410} = "Gone"; $self->{error_text}{411} = "Length Required"; $self->{error_text}{412} = "Precondition Failed"; $self->{error_text}{413} = "Request Entity Too Large"; $self->{error_text}{414} = "Request-URI Too Large"; $self->{error_text}{415} = "Unsupported Media Type"; $self->{error_text}{500} = "Internal Server Error"; $self->{error_text}{501} = "Method Not Implemented"; $self->{error_text}{502} = "Bad Gateway"; $self->{error_text}{503} = "Service Unavailable"; $self->{error_text}{504} = "Gateway Time-out"; $self->{error_text}{505} = "HTTP Version not supported"; # read mime types if (! open (MIMEFILE, "< $self->{mimetypes_filename}")) { &INetSim::Log::MainLog("Warning: Unable to open MIME types file '$self->{mimetypes_filename}': $!", $self->{servicename}); &INetSim::Log::MainLog("Warning: No MIME types available. Using built-in MIME types instead.", $self->{servicename}); # if mime types file is not available, set some basic mime types $self->{mimetypes}{'htm'} = 'text/html'; $self->{mimetypes}{'html'} = 'text/html'; $self->{mimetypes}{'shtml'} = 'text/html'; } else { # build mime types database my @columns; my $mimetype; my $extension; while () { s/^[\s]+//g; # remove leading blanks s/[\r\n]+$//g; # remove trailing line breaks next if /^[\#]/; # skip comments @columns = split (/\s+/); $mimetype = shift @columns; next unless (@columns); foreach $extension (@columns) { $self->{mimetypes}{$extension} = $mimetype; } } close (MIMEFILE); } # foreach (keys %{$self->{mimetypes}}) { # print STDOUT "$_ $self->{mimetypes}{$_}\n"; # } # check DocumentRoot directory if (! -d $self->{document_root}) { &INetSim::Log::MainLog("failed! DocumentRoot directory '$self->{document_root}' does not exist", $self->{servicename}); exit 1; } # check FakeFile directory if (! -d $self->{fakeFileDir}) { &INetSim::Log::MainLog("failed! FakeFile directory '$self->{fakeFileDir}' does not exist", $self->{servicename}); exit 1; } # check POST data directory $self->{postdata_dirname} =~ /^(.*)$/; # evil untaint! $self->{postdata_dirname} = $1; if (! -d $self->{postdata_dirname}) { &INetSim::Log::MainLog("failed! POST data directory '$self->{postdata_dirname}' does not exist", $self->{servicename}); exit 1; } my ($dev, $inode, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks, $grpname) = undef; $gid = getgrnam("inetsim"); if (! defined $gid) { &INetSim::Log::MainLog("Warning: Unable to get GID for group 'inetsim'", $self->{servicename}); } chown -1, $gid, $self->{postdata_dirname}; ($dev, $inode, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat $self->{postdata_dirname}; # check for group owner 'inetsim' $grpname = getgrgid $gid; if ($grpname ne "inetsim") { &INetSim::Log::MainLog("Warning: Group owner of POST data directory '$self->{postdata_dirname}' is not 'inetsim' but '$grpname'", $self->{servicename}); } # check for group r/w permissions if ((($mode & 0060) >> 3) != 6) { &INetSim::Log::MainLog("Warning: No group r/w permissions on POST data directory '$self->{postdata_dirname}'", $self->{servicename}); } } sub pre_loop_hook { my $self = shift; $0 = 'inetsim_' . $self->{servicename}; &INetSim::Log::MainLog("started (PID $$)", $self->{servicename}); } sub pre_server_close_hook { my $self = shift; &INetSim::Log::MainLog("stopped (PID $$)", $self->{servicename}); } sub fatal_hook { my $self = shift; &INetSim::Log::MainLog("failed!", $self->{servicename}); exit 1; } sub process_request { my $self = shift; my $client = $self->{server}->{client}; my $rhost = $self->{server}->{peeraddr}; my $rport = $self->{server}->{peerport}; if ($self->{ssl_enabled} && ! $self->upgrade_to_ssl()) { &INetSim::Log::SubLog("[$rhost:$rport] connect", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] info: Error setting up SSL: $self->{last_ssl_error}", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$); return; } elsif ($self->{server}->{numchilds} >= $self->{maxchilds}) { &INetSim::Log::SubLog("[$rhost:$rport] connect", $self->{servicename}, $$); print $client "Maximum number of connections ($self->{maxchilds}) exceeded.\n"; &INetSim::Log::SubLog("[$rhost:$rport] Connection refused - maximum number of connections ($self->{maxchilds}) exceeded.", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$); return; } &INetSim::Log::SubLog("[$rhost:$rport] connect", $self->{servicename}, $$); $self->{http_request}{method} = ""; $self->{http_request}{request_uri} = ""; $self->{http_request}{request_uri_orig} = ""; $self->{http_request}{request_uri_decoded} = undef; $self->{http_request}{version} = ""; $self->{http_request}{headers} = (); $self->{http_request}{pathfile} = ""; $self->{postdata_pathfile} = ""; $self->{http_response}{body} = ""; $self->{http_response}{status} = 0; $self->{http_response}{errormessage} = ""; $self->{http_response}{filename} = ""; $self->{http_response}{headers} = {}; $self->{http_response}{headers}{'Connection'} = "Close"; $self->{http_response}{headers}{'Server'} = $self->{http_version}; # read HTTP request if ($self->read_http_request) { if ($self->{http_response}{status}) { # error in processing request header $self->send_http_response; } else { # log requested URL my $fullreq; if (($self->{http_request}{request_uri_orig} !~ /^https?:\/\//) && (defined $self->{http_request}{headers}{'Host'})) { if ($self->{ssl_enabled}) { $fullreq = "https://" . $self->{http_request}{headers}{'Host'} . $self->{http_request}{request_uri_orig}; } else { $fullreq = "http://" . $self->{http_request}{headers}{'Host'} . $self->{http_request}{request_uri_orig}; } } else { $fullreq = $self->{http_request}{request_uri_orig}; } # replace non-printable characters with "" before logging $fullreq =~ s/[^\x20-\x7e]/\/g; &INetSim::Log::SubLog("[$rhost:$rport] info: Request URL: $fullreq", $self->{servicename}, $$); # if request contains hex encoded chars, log decoded request if (defined $self->{http_request}{request_uri_decoded}) { if (($self->{http_request}{request_uri_orig} !~ /^https?:\/\//) && (defined $self->{http_request}{headers}{'Host'})) { if ($self->{ssl_enabled}) { $fullreq = "https://" . $self->{http_request}{headers}{'Host'} . $self->{http_request}{request_uri_decoded}; } else { $fullreq = "http://" . $self->{http_request}{headers}{'Host'} . $self->{http_request}{request_uri_decoded}; } } else { $fullreq = $self->{http_request}{request_uri_decoded}; } # replace non-printable characters with "" before logging $fullreq =~ s/[^\x20-\x7e]/\/g; &INetSim::Log::SubLog("[$rhost:$rport] info: Decoded URL: $fullreq", $self->{servicename}, $$); } # for HEAD/GET/POST requests read fake/real file if (($self->{http_request}{method} eq "HEAD") || ($self->{http_request}{method} eq "GET") || ($self->{http_request}{method} eq "POST")) { if($self->{http_fakemode}) { if (defined $self->{http_request}{headers}{Host} && $self->{http_request}{headers}{Host} =~ /^checkip\.dyndns\.(org|com)/i) { $self->fake_dyndns; } elsif (defined ($fullreq) && ($fullreq =~ /.*\/wpad.dat$/i || $fullreq =~ /.*\/proxy.pac$/i)) { $self->send_wpadfile; } else { $self->read_fakefile; } } else { $self->read_file; } } # for OPTIONS request, set response headers elsif ($self->{http_request}{method} eq "OPTIONS") { $self->{http_response}{headers}{'Content-Length'} = 0; $self->set_response_status(200); } # no status set - should not occur if (!$self->{http_response}{status}) { $self->set_response_status(500, "Do not know how to handle your request."); } # send HTTP response $self->send_http_response; } } if ($@ !~ /TIMEOUT/) { &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$); } } sub read_http_request { my $self = shift; my $server = $self->{server}; my $client = $server->{client}; my $rhost = $server->{peeraddr}; my $rport = $server->{peerport}; my $timeout = &INetSim::Config::getConfigParameter("Default_TimeOut"); my @request = (); eval { local $SIG{'ALRM'} = sub { die "TIMEOUT" }; alarm($timeout); # read full request from client while (<$client>) { alarm($timeout); s/[\r\n]+$//g; if ($_ ne "") { # check for non-printable characters if (! /^[\x20-\x7e]+$/) { s/[^\x20-\x7e]/\./g; &INetSim::Log::SubLog("[$rhost:$rport] recv: $_", $self->{servicename}, $$); $self->set_response_status(400, "Your request contains illegal non-printable characters."); return 1; } else { push (@request, $_); &INetSim::Log::SubLog("[$rhost:$rport] recv: $_", $self->{servicename}, $$); } } last if ($_ eq ""); } alarm(0); }; if ($@ =~ /TIMEOUT/) { &INetSim::Log::SubLog("[$rhost:$rport] disconnect (timeout)", $self->{servicename}, $$); return 0; } if (scalar @request == 0) { # no data received &INetSim::Log::SubLog("[$rhost:$rport] info: Client sent no data", $self->{servicename}, $$); return 0; } # get first line of request my $first_line = shift @request; # must be of format METHOD REQUEST-URI HTTP-VERSION my @args = split(/ /, $first_line); if ((scalar @args) != 3) { $self->set_response_status(400); # Bad Request return 1; } # implemented methods if (($args[0] eq "GET") || ($args[0] eq "HEAD") || ($args[0] eq "POST") || ($args[0] eq "OPTIONS")) { $self->{http_request}{method} = $args[0]; } else { $self->set_response_status(501, "Method '$args[0]' not implemented."); $self->{http_response}{headers}{'Allow'} = "GET, HEAD, POST, OPTIONS"; return 1; } # supported versions if (($args[2] eq "HTTP/1.0") || ($args[2] eq "HTTP/1.1")) { $self->{http_request}{version} = $args[2]; } else { $self->set_response_status(505, "Version '$args[2]' not supported."); return 1; } # check if Request-URI is absoluteURI or abs_path (RFC 2616) # (starts with "/" or "http[s]://") if ($args[1] !~ /^(\/|\*|https?:\/\/)/) { $self->set_response_status(400); # Bad Request return 1; } # store original Request-URI $self->{http_request}{request_uri_orig} = $args[1]; # decode hex chars in Request-URI my $request_uri_decoded = $args[1]; my $chars_decoded = 0; my $prefix = ""; my $hexchars = ""; my $suffix = ""; my $dec = 0; while ($request_uri_decoded =~ /^(.*)\%(..)(.*)$/) { $prefix = $1; $hexchars = $2; $suffix = $3; $chars_decoded++; # check for malformed hex characters if ($hexchars !~ /^[0-9a-fA-F][0-9a-fA-F]$/) { $self->set_response_status(400, "Your request contains malformed hex characters."); return 1; } else { $dec = hex($hexchars); # check for non-printable characters if (($dec < 32) || ($dec > 127)) { $self->set_response_status(400, "Your request contains illegal characters in hex notation."); return 1; } $request_uri_decoded = $prefix . chr($dec) . $suffix; } } # check if decoded Request-URI still contains an '%' if ($request_uri_decoded =~ /\%/) { $self->set_response_status(400, "Your request contains malformed hex notation."); return 1; } # store Request-URI if ($chars_decoded > 0) { $self->{http_request}{request_uri_decoded} = $request_uri_decoded; $self->{http_request}{request_uri} = $request_uri_decoded; } else { $self->{http_request}{request_uri} = $self->{http_request}{request_uri_orig}; } # check Request-URI for illegal characters # NEEDS WORK! # if ($self->{http_request}{request_uri} =~ /[\@\:]/) { # $self->set_response_status(400, "Your request contains illegal characters."); # return 1; # } # get additional HTTP headers my $key; my $value; foreach (@request) { /^([^: ]+)(: )(.*)$/; if (! defined $2) { $self->set_response_status(400, "Invalid header."); return 1; } $key = $1; $value = $3; if (defined $key && defined $value) { if ($value =~ /^[\s]+$/) { $self->set_response_status(400, "Invalid header."); return 1; } else { $self->{http_request}{headers}{$key} = $value; } } else { $self->set_response_status(400); return 1; } } # HTTP/1.1 needs "Host" header if ($self->{http_request}{version} eq "HTTP/1.1") { if (! defined $self->{http_request}{headers}{'Host'}) { # no 'Host' header $self->set_response_status(400); return 1; } if (!(($self->{http_request}{headers}{'Host'} =~ $RE_validIPPort) || ($self->{http_request}{headers}{'Host'} =~ $RE_validHostnamePort) || ($self->{http_request}{headers}{'Host'} =~ $RE_validFQDNHostnamePort))) { # no valid IP or (fqdn) hostname $self->set_response_status(400); return 1; } } # ignore everything after first '?' my @parts = split(/\?/, $self->{http_request}{request_uri}); my $req = $parts[0]; if ($req =~ /^https?:\/\//) { # absoluteURI $req =~ /^(https?:\/\/)([^\/]*)(|\/.*)$/; my $host = ""; my $pathfile = ""; if (defined $2) { $host = $2; } if (defined $3) { $pathfile = $3; } if ($host eq "") { # invalid absoluteURI $self->set_response_status(400); return 1; } else { if (!(($host =~ $RE_validIPPort) || ($host =~ $RE_validHostnamePort) || ($host =~ $RE_validFQDNHostnamePort))) { # no valid IP or (fqdn) hostname $self->set_response_status(400); return 1; } if ($pathfile ne "") { $self->{http_request}{pathfile} = $pathfile; } else { $self->{http_request}{pathfile} = "/"; } } } else { # abs_path $self->{http_request}{pathfile} = $req; } # remove trailing slashes # $self->{http_request}{pathfile} =~ s/[\/]+$//g; # check for directory traversal "/.." if ($self->{http_request}{pathfile} =~ /\/\.\./) { $self->set_response_status(403, "Specification of parent directories not allowed."); return 1; } if ($self->{http_request}{method} eq "POST") { # read and store POST data # check Content-Length header if (defined $self->{http_request}{headers}{'Content-Length'}) { my $contentLength = $self->{http_request}{headers}{'Content-Length'}; if ($contentLength !~ /^[0-9]+$/) { $self->set_response_status(400, "Invalid Content-Length header value."); return 1; } if ($contentLength > 1000000) { $self->set_response_status(400, "Content-Length header value larger than 1000000."); return 1; } if ($contentLength > 0) { # initialize random number generator srand(time() ^($$ + ($$ <<15))); my $sha = Digest::SHA->new(); $sha->add(int(rand(100000000))); $sha->add(time()); my $postFileName = $self->{postdata_dirname} . "/" . $sha->hexdigest; $self->{postdata_pathfile} = $postFileName; if (! open (POSTFILE, "> $postFileName")) { &INetSim::Log::MainLog("Error: Unable to create HTTP POST data file '$postFileName'", $self->{servicename}); } else { binmode (POSTFILE); chmod 0660, $postFileName; eval { local $SIG{'ALRM'} = sub { die "TIMEOUT" }; alarm($timeout); my $buffer; my $bytesRead = read $client, $buffer, $contentLength; # print STDOUT "Content-Length: $contentLength\n"; # print STDOUT "Bytes read: $bytesRead\n"; print POSTFILE $buffer; &INetSim::Log::SubLog("[$rhost:$rport] recv: <(POSTDATA)>", $self->{servicename}, $$); if ($contentLength != $bytesRead) { &INetSim::Log::SubLog("[$rhost:$rport] info: Content-Length header value is $contentLength, but client sent only $bytesRead bytes", $self->{servicename}, $$); } alarm(0); }; close POSTFILE; &INetSim::Log::SubLog("[$rhost:$rport] info: POST data stored to: $postFileName", $self->{servicename}, $$); if ($@ =~ /TIMEOUT/) { &INetSim::Log::SubLog("[$rhost:$rport] disconnect (timeout)", $self->{servicename}, $$); return 0; } } } else { # Content-Length is 0 &INetSim::Log::SubLog("[$rhost:$rport] info: 'Content-Length' header value is 0 - not storing POST data", $self->{servicename}, $$); } } else { # no Content-Length header &INetSim::Log::SubLog("[$rhost:$rport] info: Client did not send 'Content-Length' header - not storing POST data", $self->{servicename}, $$); } } elsif ($self->{http_request}{method} eq "OPTIONS") { $self->{http_response}{headers}{'Allow'} = "GET, HEAD, POST, OPTIONS"; } return 1; } sub send_http_response { my $self = shift; my $server = $self->{server}; my $client = $server->{client}; my $rhost = $server->{peeraddr}; my $rport = $server->{peerport}; $self->{http_response}{headers}{'Date'} = &get_gmdate(); # if error occured, generate body if ($self->{http_response}{status} >= 400) { $self->{http_response}{headers}{'Content-Type'} = "text/html"; $self->{http_response}{body} .= "\n"; $self->{http_response}{body} .= " \n"; $self->{http_response}{body} .= " $self->{http_response}{status} $self->{error_text}{$self->{http_response}{status}}\n"; $self->{http_response}{body} .= " \n"; $self->{http_response}{body} .= " \n"; $self->{http_response}{body} .= "

$self->{error_text}{$self->{http_response}{status}}

\n"; $self->{http_response}{body} .= "

Your browser sent a request that this server could not understand.

\n"; if ($self->{http_response}{errormessage}) { $self->{http_response}{body} .= "

$self->{http_response}{errormessage}

\n"; } $self->{http_response}{body} .= "
\n"; $self->{http_response}{body} .= "
" . $self->{http_version} . "
\n"; $self->{http_response}{body} .= " \n"; $self->{http_response}{body} .= "\n"; } # place headers into response my $buffer = "HTTP/1.1 $self->{http_response}{status} $self->{error_text}{$self->{http_response}{status}}\r\n"; &INetSim::Log::SubLog("[$rhost:$rport] send: HTTP/1.1 $self->{http_response}{status} $self->{error_text}{$self->{http_response}{status}}", $self->{servicename}, $$); foreach my $header (keys %{$self->{http_response}{headers}}) { $buffer .= "$header: $self->{http_response}{headers}{$header}\r\n"; &INetSim::Log::SubLog("[$rhost:$rport] send: $header: $self->{http_response}{headers}{$header}", $self->{servicename}, $$); } $buffer .= "\r\n"; # send header to client print $client $buffer; # send body to client if (($self->{http_request}{method} eq "GET") || ($self->{http_request}{method} eq "POST")) { print $client $self->{http_response}{body}; if ($self->{http_response}{filename} ne "") { &INetSim::Log::SubLog("[$rhost:$rport] info: Sending file: $self->{http_response}{filename}", $self->{servicename}, $$); } } my $url; if (($self->{http_request}{request_uri_orig} !~ /^https?:\/\//) && (defined $self->{http_request}{headers}{'Host'})) { if ($self->{ssl_enabled}) { $url = "https://" . $self->{http_request}{headers}{'Host'} . $self->{http_request}{request_uri_orig}; } else { $url = "http://" . $self->{http_request}{headers}{'Host'} . $self->{http_request}{request_uri_orig}; } } else { $url = $self->{http_request}{request_uri_orig}; } if ($self->{http_response}{status} < 400) { &INetSim::Log::SubLog("[$rhost:$rport] stat: 1 method=$self->{http_request}{method} url=$url sent=$self->{http_response}{filename} postdata=$self->{postdata_pathfile}", $self->{servicename}, $$); } else { &INetSim::Log::SubLog("[$rhost:$rport] stat: 0 method=$self->{http_request}{method} url=$url sent=$self->{http_response}{filename} postdata=$self->{postdata_pathfile}", $self->{servicename}, $$); } } sub set_response_status { my $self = shift; my $statuscode = shift; my $errormessage = shift; $self->{http_response}{status} = $statuscode; $self->{http_response}{errormessage} = $errormessage; } sub read_file { my $self = shift; my $filename = $self->{document_root} . $self->{http_request}{pathfile}; if (! -e $filename) { # check if filepath exists $self->set_response_status(404, "No such file or directory."); return; } elsif (! -r $filename) { # check if filepath is readable $self->set_response_status(403, "Permission denied."); return; } else { if (-d $filename) { # filepath is a directory # check if it contains a default document my @default_documents = split (/\s+/, $self->{default_documents}); my $newfilename = ""; foreach (@default_documents) { my $checkfilename = $filename . "/" . $_; if (-e $checkfilename) { $newfilename = $checkfilename; last; } } if ($newfilename eq "") { # no default document found $self->set_response_status(403, "Directory listing not allowed."); return; } else { # default document found $filename = $newfilename; if (! -r $filename) { $self->set_response_status(403, "Permission denied."); return; } } } $self->{http_response}{filename} = $filename; # read the file into HTTP response body # determine file size my $filesize = (-s $filename); $self->{http_response}{headers}{'Content-Length'} = $filesize; # read file open (FILE, "<$filename") or $self->error_exit("Unable to open file '$filename': $!"); binmode (FILE); read (FILE, $self->{http_response}{body}, $filesize); close (FILE); # determine Content-Type my @parts = split (/\./, $filename); my $extension = lc(pop @parts); if(defined $self->{mimetypes}{$extension}) { $self->{http_response}{headers}{'Content-Type'} = $self->{mimetypes}{$extension}; } else { $self->{http_response}{headers}{'Content-Type'} = "application/octet-stream"; } # set status 200 OK $self->set_response_status(200); } } sub read_fakefile { my $self = shift; my $server = $self->{server}; my $client = $server->{client}; my $rhost = $server->{peeraddr}; my $rport = $server->{peerport}; my $fakefilename; # check for static fakefile if (defined $self->{static_fakefile_pathtoname}{$self->{http_request}{pathfile}}) { # configured static fakefile found $fakefilename = $self->{fakeFileDir} . "/" . $self->{static_fakefile_pathtoname}{$self->{http_request}{pathfile}}; # set content-type $self->{http_response}{headers}{'Content-Type'} = $self->{static_fakefile_pathtomimetype}{$self->{http_request}{pathfile}}; &INetSim::Log::SubLog("[$rhost:$rport] info: Sending static fake file configured for path '$self->{http_request}{pathfile}'.", $self->{servicename}, $$); } else { # get extension from requested file my $extension = undef; my @parts = split (/\./, $self->{http_request}{pathfile}); if ((scalar @parts) > 1) { $extension = lc(pop @parts); } # select fake file if((defined $extension) && (defined $self->{fakefile_exttoname}{$extension})) { # extension configured $fakefilename = $self->{fakeFileDir} . "/" . $self->{fakefile_exttoname}{$extension}; # set content-type $self->{http_response}{headers}{'Content-Type'} = $self->{fakefile_exttomimetype}{$extension}; &INetSim::Log::SubLog("[$rhost:$rport] info: Sending fake file configured for extension '$extension'.", $self->{servicename}, $$); } else { # extension not configured, check for default fakefile if((defined $self->{default_fakefilename}) && (defined $self->{default_fakefilemimetype})) { $fakefilename = $self->{fakeFileDir} . "/" . $self->{default_fakefilename}; $self->{http_response}{headers}{'Content-Type'} = $self->{default_fakefilemimetype}; &INetSim::Log::SubLog("[$rhost:$rport] info: No matching file extension configured. Sending default fake file.", $self->{servicename}, $$); } else { # no default fakefile configured - return 404 Not Found $self->set_response_status(404, "No such file or directory."); &INetSim::Log::SubLog("[$rhost:$rport] warn: No matching file extension or default fake file configured.", $self->{servicename}, $$); return; } } } if (! -f $fakefilename) { # check if fakefile exists $self->set_response_status(404, "No such file or directory."); &INetSim::Log::SubLog("[$rhost:$rport] warn: Fake file $fakefilename does not exist", $self->{servicename}, $$); return; } elsif (! -r $fakefilename) { # check if fakefile is readable $self->set_response_status(403, "Permission denied."); &INetSim::Log::SubLog("[$rhost:$rport] warn: No permission to read fake file $fakefilename", $self->{servicename}, $$); return; } $self->{http_response}{filename} = $fakefilename; # determine file size my $filesize = (-s $fakefilename); $self->{http_response}{headers}{'Content-Length'} = $filesize; # read file open (FILE, "<$fakefilename") or $self->error_exit("Unable to open fake file '$fakefilename': $!"); binmode (FILE); read (FILE, $self->{http_response}{body}, $filesize); close (FILE); $self->set_response_status(200); } sub fake_dyndns { my $self = shift; my $server = $self->{server}; my $client = $server->{client}; my $rhost = $server->{peeraddr}; my $rport = $server->{peerport}; # set server string to dyndns-checkip $self->{http_response}{headers}{'Server'} = "DynDNS-CheckIP/1.0"; # set content-type $self->{http_response}{headers}{'Content-Type'} = "text/html"; # set additional header $self->{http_response}{headers}{'Cache-Control'} = "no-cache"; $self->{http_response}{headers}{'Pragma'} = "no-cache"; # build content body $self->{http_response}{body} = "Current IP CheckCurrent IP Address: ".$rhost."\r\n"; # determine content length $self->{http_response}{headers}{'Content-Length'} = length($self->{http_response}{body}); # set filename to 'none' for logging $self->{http_response}{filename} = "none"; $self->set_response_status(200); } sub send_wpadfile { my $self = shift; my $server = $self->{server}; my $client = $server->{client}; my $rhost = $server->{peeraddr}; my $rport = $server->{peerport}; my $localaddress = &INetSim::Config::getConfigParameter("Default_BindAddress"); # set content-type $self->{http_response}{headers}{'Content-Type'} = "application/x-ns-proxy-autoconfig"; # build content body $self->{http_response}{body} = "function FindProxyForURL(url, host)\n"; $self->{http_response}{body} .= "{\n"; $self->{http_response}{body} .= " if (isInNet(host, \"192.168.1.0\", \"255.255.255.0\"))\n"; # this is an example only, should be removed later !!! $self->{http_response}{body} .= " return \"DIRECT\";\n"; $self->{http_response}{body} .= " else\n"; $self->{http_response}{body} .= " return \"PROXY $localaddress:8080\";\n"; $self->{http_response}{body} .= "}\n"; # determine content length $self->{http_response}{headers}{'Content-Length'} = length($self->{http_response}{body}); # set filename to 'none' for logging $self->{http_response}{filename} = "none"; $self->set_response_status(200); } sub get_gmdate { # return current GMT date my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); my @weekDays = qw(Sun Mon Tue Wed Thu Fri Sat); my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = gmtime(&INetSim::FakeTime::get_faketime()); $year += 1900; my $gmdate = sprintf("%3s, %02d %3s %4d %02d:%02d:%02d GMT", $weekDays[$wday], $mday, $months[$mon], $year, $hour, $min, $sec); return $gmdate; } sub upgrade_to_ssl { my $self = shift; my %ssl_params = ( SSL_version => "SSLv23", SSL_cipher_list => "ALL", SSL_server => 1, SSL_use_cert => 1, SSL_key_file => $self->{ssl_key}, SSL_cert_file => $self->{ssl_crt} ); $self->{last_ssl_error} = ""; if (defined $self->{ssl_dh} && $self->{ssl_dh}) { $ssl_params{'SSL_dh_file'} = $self->{ssl_dh}; } my $result = IO::Socket::SSL::socket_to_SSL( $self->{server}->{client}, %ssl_params ); if (defined $result) { # $status{tls_cipher} = lc($result->get_cipher()); return 1; } else { $self->{last_ssl_error} = IO::Socket::SSL::errstr(); return 0; } } sub error_exit { my $self = shift; my $msg = shift; my $server = $self->{server}; my $client = $server->{client}; my $rhost = $server->{peeraddr}; my $rport = $server->{peerport}; if (! defined $msg) { $msg = "Unknown error"; } &INetSim::Log::MainLog("$msg. Closing connection.", $self->{servicename}); &INetSim::Log::SubLog("[$rhost:$rport] error: $msg. Closing connection.", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$); exit 1; } 1; ############################################################# # # History: # # Version 0.77 (2014-05-23) th # - changed SSL_version to "SSLv23" # # Version 0.76 (2010-11-03) th # - add HTTP Version to status code response # # Version 0.75 (2010-09-18) th # - bugfix: HTTPS fakefile mode used configuration for HTTP service # - bugfix: take care of HTTPs absolute URIs # - added support for HTTP(S) static fakefiles # # Version 0.74 (2009-12-19) me # - added new configuration variable 'CertDir' # # Version 0.73 (2009-10-27) me # - added support for SSL (https) # - removed some unnecessary variables # - added .com as top level domain for dyndns # # Version 0.72 (2008-09-05) th # - added support for OPTIONS method # # Version 0.71 (2008-08-27) me # - added logging of process id # # Version 0.70 (2008-08-25) th # - changed regexp for 'wpad' request matching # # Version 0.69 (2008-08-20) me # - added function 'send_wpadfile()' to FakeMode # # Version 0.68 (2008-08-09) th # - check data directories on startup # # Version 0.67 (2008-08-08) th # - support port numbers in 'Host' header and absoluteURI # # Version 0.66 (2008-08-03) th # - improved HTTP POST support # # Version 0.65 (2008-08-02) th # - added basic support for HTTP POST # # Version 0.64 (2008-06-26) th # - changed status logging for bad requests # # Version 0.63 (2008-06-15) th # - code cleanup # # Version 0.62 (2008-06-14) th # - bugfix in header value parsing # # Version 0.61 (2008-06-14) th # - bugfix in regexp for check of empty header values # # Version 0.6 (2008-06-13) th # - improved handling of Request-URI # - support absoluteURI (RFC 2616) # # Version 0.52 (2008-04-01) th # - added timeout after client inactivity of n seconds, # using new config parameter Default_TimeOut # # Version 0.51 (2008-02-27) th # - temporarily disable a check for invalid chars in request # because it causes problems # # Version 0.50 (2007-12-31) th # - change process name # # Version 0.49 (2007-10-24) me # - fixed uninitialized value if host header isn't given # # Version 0.48 (2007-10-14) th # - added "info:" to logging of "Requested URL" and "Sending file" # # Version 0.47 (2007-09-22) me # - added fake_dyndns() to FakeMode # # Version 0.46 (2007-06-05) th # - decode hex chars in request earlier # - if request contains hex encoded chars, log decoded request # - fixed bug in check for malformed hex notation # - check for non-printable hex-decoded chars # # Version 0.45 (2007-06-04) th # - fixed bug in processing GET queries # # Version 0.44 (2007-05-31) th # - added some comments # # Version 0.43 (2007-05-24) th # - MIME types for fake files are not determined via mime.types anymore # but must be specified in configuration file # # Version 0.42 (2007-05-07) th # - check for non-printable characters in request # - check for illegal hex characters while decoding hex # # Version 0.41 (2007-04-27) th # - fixed uninitialized value when logging 'stat' for a bad request # - use getConfigParameter, getConfigHash # # Version 0.40 (2007-04-25) me # - changed failed! message and exit() if mimetype file is not # available to warning message only - no exit # # Version 0.39 (2007-04-22) th # - added error_exit() # - replaced die()-calls with error_exit() # - changed status logging # # Version 0.38 (2007-04-21) me # - added logging of status for use with &INetSim::Report::GenReport() # # Version 0.37 (2007-04-21) th # - fixed if-condition so error messages are returned to client again # - changed handling of default fake file # # Version 0.36 (2007-04-20) th # - check if fake file exists and is readable # # Version 0.35 (2007-04-11) th # - check if no data was received from client # - added logging of 'connect' and 'disconnect' messages # # Version 0.34 (2007-04-10) th # - get fake time via &INetSim::FakeTime::get_faketime() # instead of accessing $INetSim::Config::FakeTimeDelta # # Version 0.33 (2007-04-06) th # - added logging of files sent # # Version 0.32 (2007-04-05) th # - changed check for MaxChilds, BindAddress, RunAsUser and # RunAsGroup # # Version 0.31 (2007-03-29) th # - added function get_gmdate() # - added FakeMode # # Version 0.3 (2007-03-28) th # - completely rewritten again because the example from # Net::Server was crap # # Version 0.2 (2007-03-24) th # - completely rewritten using example from Net::Server # # Version 0.1 (2007-03-19) th # ############################################################# inetsim-1.2.7/lib/INetSim/NTP.pm0000644000175000017500000005012213173076432014440 0ustar rgyrgy# -*- perl -*- # # INetSim::NTP - A fake NTP server # # RFC 1305, 2030 - (Simple) Network Time Protocol v1-4 # # (c)2007-2013 Matthias Eckert, Thomas Hungenberg # # Version 0.49 (2009-08-28) # # For history/changelog see bottom of this file. # ############################################################# package INetSim::NTP; use strict; use warnings; use Time::HiRes; use base qw(INetSim::GenericServer); use constant NTP_ADJ => 2208988800; sub configure_hook { my $self = shift; $self->{server}->{host} = &INetSim::Config::getConfigParameter("Default_BindAddress"); # bind to address $self->{server}->{port} = &INetSim::Config::getConfigParameter("NTP_BindPort"); # bind to port $self->{server}->{proto} = 'udp'; # UDP protocol $self->{server}->{user} = &INetSim::Config::getConfigParameter("Default_RunAsUser"); # user to run as $self->{server}->{group} = &INetSim::Config::getConfigParameter("Default_RunAsGroup"); # group to run as $self->{server}->{setsid} = 0; # do not daemonize $self->{server}->{no_client_stdout} = 1; # do not attach client to STDOUT $self->{server}->{log_level} = 0; # do not log anything # $self->{server}->{udp_recv_len} = 960; # default is 4096 $self->{servicename} = &INetSim::Config::getConfigParameter("NTP_ServiceName"); $self->{max_childs} = &INetSim::Config::getConfigParameter("Default_MaxChilds"); $self->{server_ip} = &INetSim::Config::getConfigParameter("NTP_Server_IP"); $self->{strict_checks} = &INetSim::Config::getConfigParameter("NTP_StrictChecks"); } sub pre_loop_hook { my $self = shift; $0 = "inetsim_$self->{servicename}"; &INetSim::Log::MainLog("started (PID $$)", $self->{servicename}); } sub pre_server_close_hook { my $self = shift; &INetSim::Log::MainLog("stopped (PID $$)", $self->{servicename}); } sub fatal_hook { my $self = shift; &INetSim::Log::MainLog("failed!", $self->{servicename}); exit 0; } sub process_request { my $self = shift; my $client = $self->{server}->{client}; my $rhost = $self->{server}->{peeraddr}; my $rport = $self->{server}->{peerport}; my $stat_success = 0; my $diff_seconds = 0; ##### init for variables my $recvmsg = ""; my $sendmsg = ""; my $ReceiveTime = 0; my $cur_time = 0; my $valid = 1; ##### client my $C_Byte1 = 0; my $C_Leap_Indicator = 0; my $C_NTP_Version = 0; my $C_Mode = 0; my $C_Stratum = 0; my $C_Poll = 0; my $C_Precision = 0; my $C_Root_Delay_w1 = 0; my $C_Root_Delay_w2 = 0; my $C_Root_Delay = 0; my $C_Root_Dispersion_w1 = 0; my $C_Root_Dispersion_w2 = 0; my $C_Root_Dispersion = 0; my $C_Reference_Clock_Identifier = 0; my $C_Reference_Time_w1 = 0; my $C_Reference_Time_w2 = 0; my $C_Reference_Time = 0; my $C_Originate_Time_w1 = 0; my $C_Originate_Time_w2 = 0; my $C_Originate_Time = 0; my $C_Receive_Time_w1 = 0; my $C_Receive_Time_w2 = 0; my $C_Receive_Time = 0; my $C_Transmit_Time_w1 = 0; my $C_Transmit_Time_w2 = 0; my $C_Transmit_Time = 0; ##### server my $S_Byte1 = 0; my $S_Leap_Indicator = 0; my $S_NTP_Version = 4; my $S_Mode = 2; my $S_Stratum = 2; my $S_Poll = 6; my $S_Precision = -20; my $S_Root_Delay_w1 = 0; my $S_Root_Delay_w2 = 0; my $S_Root_Delay = 0; my $S_Root_Dispersion_w1 = 0; my $S_Root_Dispersion_w2 = 0; my $S_Root_Dispersion = 0; my $S_Reference_Clock_Identifier = unpack("N", pack("C4", split(/\./, $self->{server_ip}))); my $S_Reference_Time_w1 = 0; my $S_Reference_Time_w2 = 0; my $S_Reference_Time = 0; my $S_Originate_Time_w1 = 0; my $S_Originate_Time_w2 = 0; my $S_Originate_Time = 0; my $S_Receive_Time_w1 = 0; my $S_Receive_Time_w2 = 0; my $S_Receive_Time = 0; my $S_Transmit_Time_w1 = 0; my $S_Transmit_Time_w2 = 0; my $S_Transmit_Time = 0; &INetSim::Log::SubLog("[$rhost:$rport] connect", $self->{servicename}, $$); if ($self->{server}->{numchilds} >= $self->{max_childs}) { print $client "Maximum number of connections ($self->{max_childs}) exceeded.\n"; &INetSim::Log::SubLog("[$rhost:$rport] Connection refused - maximum number of connections ($self->{max_childs}) exceeded.", $self->{servicename}, $$); } else { $recvmsg = $self->{server}->{udp_data}; # check packet length - valid packets must be 48 or 68 bytes long if (length($recvmsg) != 48 && length($recvmsg) != 68) { &INetSim::Log::SubLog("[$rhost:$rport] recv: invalid ntp packet (packet length is not 48 or 68 bytes)", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$); return; } # if packet size equals to 68, drop the last 20 bytes if (length($recvmsg) == 68) { $recvmsg = substr($recvmsg, 0, 48); } # arrival time of the client packet $ReceiveTime = &INetSim::FakeTime::get_faketime(); # split the packet ( $C_Byte1, $C_Stratum, $C_Poll, $C_Precision, $C_Root_Delay_w1, $C_Root_Delay_w2, $C_Root_Dispersion_w1, $C_Root_Dispersion_w2, $C_Reference_Clock_Identifier, $C_Reference_Time_w1, $C_Reference_Time_w2, $C_Originate_Time_w1, $C_Originate_Time_w2, $C_Receive_Time_w1, $C_Receive_Time_w2, $C_Transmit_Time_w1, $C_Transmit_Time_w2 ) = unpack ("C3 c n B16 n B16 a4 N B32 N B32 N B32 N B32", $recvmsg); # if byte 1 is zero -> abort if (! $C_Byte1) { &INetSim::Log::SubLog("[$rhost:$rport] recv: invalid ntp packet (first byte is zero)", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$); return; } # originate timestamp AND receive timestamp must not be zero if ($self->{strict_checks} && ($C_Originate_Time_w1 || $C_Receive_Time_w1)) { &INetSim::Log::SubLog("[$rhost:$rport] recv: invalid ntp packet (originate and/or receive timestamps are not zero)", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$); return; } # split byte 1 $C_Leap_Indicator = ($C_Byte1 & 192) >> 6; $C_NTP_Version = ($C_Byte1 & 56) >> 3; $C_Mode = $C_Byte1 & 7; # if leap indicator not 0 or 3 -> abort if ($self->{strict_checks} && ($C_Leap_Indicator != 0 && $C_Leap_Indicator != 3)) { &INetSim::Log::SubLog("[$rhost:$rport] recv: invalid ntp packet (wrong leap indicator value)", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$); return; } # according to the rfc, ntp version must be taken from client packet, therefore it should be between 1 and 4 if ($C_NTP_Version >= 1 && $C_NTP_Version <= 4) { $S_NTP_Version = $C_NTP_Version; } else { &INetSim::Log::SubLog("[$rhost:$rport] recv: invalid ntp packet (wrong ntp version)", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$); return; } # mode must be 4 (server), if client mode was 3 (client), else 2 (symmetric passive) if ($C_Mode == 3) { $S_Mode = 4; } elsif ($C_Mode == 1 || $C_Mode == 2) { $S_Mode = 2; } else { # if mode is not between 1 and 3 -> abort &INetSim::Log::SubLog("[$rhost:$rport] recv: invalid ntp packet (wrong client mode)", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$); return; } # stratum should be 0 (unspecified) if ($self->{strict_checks} && ($C_Stratum != 0)) { &INetSim::Log::SubLog("[$rhost:$rport] recv: invalid ntp packet (wrong stratum)", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$); return; } # poll is taken from client and should be in range 1-14 if ($C_Poll) { # set to 1..17 as temp. workaround ==> ToDo if ($C_Poll >= 1 && $C_Poll <= 17) { $S_Poll = $C_Poll; } else { # poll not in range and not 0 -> abort &INetSim::Log::SubLog("[$rhost:$rport] recv: invalid ntp packet (poll interval out of range)", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$); return; } } else { # else set poll to 6 (64s) $S_Poll = 6; } $S_Root_Delay_w2 = &frac2bin($S_Root_Delay_w1); $S_Root_Dispersion_w2 = &frac2bin($S_Root_Dispersion_w1); $cur_time = &INetSim::FakeTime::get_faketime(); # last sync time for server clock $S_Reference_Time_w1 = $cur_time + NTP_ADJ - 59; ##### fraction to ^^^ $S_Reference_Time_w2 = &frac2bin($S_Reference_Time_w1); #### RFC-konform ??? ToDo !!!!!!! # #if ($S_NTP_Version == 4 && $S_Stratum >= 2){ # $S_Reference_Clock_Identifier = $S_Reference_Time_w2 >> 33; #} # # Reference Identifier: # ... In NTP Version 3 secondary servers, this is the 32-bit IPv4 # address of the reference source. In NTP Version 4 secondary servers, # this is the low order 32 bits of the latest transmit timestamp of the # reference source.... (rfc 2030, page 10) # # ^^^^^^^^^^^ #### # hmm, could be another check built in here !? if ($C_Transmit_Time_w1) { # check transmit timestamp from client $S_Originate_Time_w1 = $C_Transmit_Time_w1; # last packet from other connection endpoint. Servers have to take the transmit timestamp from client $S_Originate_Time_w2 = $C_Transmit_Time_w2; # fraction to transmit timestamp } else { $S_Originate_Time_w1 = 0; $S_Originate_Time_w2 = &frac2bin($S_Originate_Time_w1); } $S_Receive_Time_w1 = $ReceiveTime + NTP_ADJ; # arrival time of the last packet $S_Receive_Time_w2 = &frac2bin($S_Receive_Time_w1); # fraction to ^^^ $S_Transmit_Time_w1 = $cur_time + NTP_ADJ; # packet sending time $S_Transmit_Time_w2 = &frac2bin($S_Transmit_Time_w1); # fraction to ^^^ # build byte 1 $S_Leap_Indicator = ($S_Leap_Indicator << 6) ^ 63; # bits 0+1, => SHL 6, XOR with 00111111 $S_NTP_Version = ($S_NTP_Version << 3) ^ 199; # bits 2+3+4 => SHL 3, XOR with 11000111 $S_Mode = $S_Mode ^ 248; # bits 5+6+7 => XOR with 11111000 $S_Byte1 = ($S_Leap_Indicator & $S_NTP_Version & $S_Mode); # put it all together wit AND # build response packet $sendmsg = pack ("C3 c n B16 n B16 N N B32 N B32 N B32 N B32", $S_Byte1, $S_Stratum, $S_Poll, $S_Precision, $S_Root_Delay_w1, $S_Root_Delay_w2, $S_Root_Dispersion_w1, $S_Root_Dispersion_w2, $S_Reference_Clock_Identifier, $S_Reference_Time_w1, $S_Reference_Time_w2, $S_Originate_Time_w1, $S_Originate_Time_w2, $S_Receive_Time_w1, $S_Receive_Time_w2, $S_Transmit_Time_w1, $S_Transmit_Time_w2 ); # send out as fast as possible $client->send($sendmsg); $stat_success = 1; # analyse and log the client packet if ($C_Precision) { $C_Precision = sprintf("%1.4e",2**$C_Precision); } else { $C_Precision = 0; } if ($C_Root_Delay_w1 && $C_Root_Delay_w2) { $C_Root_Delay_w1 += bin2frac($C_Root_Delay_w2); $C_Root_Delay = sprintf("%.4f", $C_Root_Delay_w1); } else { $C_Root_Delay = 0; } if ($C_Root_Dispersion_w1 && $C_Root_Dispersion_w2) { $C_Root_Dispersion_w1 += bin2frac($C_Root_Dispersion_w2); $C_Root_Dispersion = sprintf("%.4f", $C_Root_Dispersion_w1); } else { $C_Root_Dispersion = 0; } if ($C_Stratum && $C_Reference_Clock_Identifier) { if ($C_Stratum == 2 && $C_NTP_Version) { if ($C_NTP_Version >= 1 && $C_NTP_Version <= 3) { $C_Reference_Clock_Identifier = join(".", unpack("C4", pack("N", $C_Reference_Clock_Identifier))); } elsif ($C_NTP_Version == 4) { $C_Reference_Clock_Identifier = "low 32bits of latest TX timestamp of reference src"; } } } if ($C_Reference_Clock_Identifier) { # replace non-printable characters with "." $C_Reference_Clock_Identifier =~ s/([^\x20-\x7e])/\./g; if (! $C_Reference_Clock_Identifier || $C_Reference_Clock_Identifier =~ /^\x00/){$C_Reference_Clock_Identifier = "unspec"}; } else{ $C_Reference_Clock_Identifier = "unspec" } if ($C_Reference_Time_w1 && $C_Reference_Time_w2) { $C_Reference_Time_w1 += bin2frac($C_Reference_Time_w2); $C_Reference_Time = sprintf("%10.5f", $C_Reference_Time_w1 - NTP_ADJ); } else { $C_Reference_Time = sprintf("%10.5f", 0); } if ($C_Originate_Time_w1 && $C_Originate_Time_w2) { $C_Originate_Time_w1 += bin2frac($C_Originate_Time_w2); $C_Originate_Time = sprintf("%10.5f", $C_Originate_Time_w1 - NTP_ADJ); } else { $C_Originate_Time = sprintf("%10.5f", 0); } if ($C_Receive_Time_w1 && $C_Receive_Time_w2) { $C_Receive_Time_w1 += bin2frac($C_Receive_Time_w2); $C_Receive_Time = sprintf("%10.5f", $C_Receive_Time_w1 - NTP_ADJ); } else { $C_Receive_Time = sprintf("%10.5f", 0); } if ($C_Transmit_Time_w1 && $C_Transmit_Time_w2) { $C_Transmit_Time_w1 += bin2frac($C_Transmit_Time_w2); $C_Transmit_Time = sprintf("%10.5f", $C_Transmit_Time_w1 - NTP_ADJ); } else { $C_Transmit_Time = sprintf("%10.5f", 0); } &INetSim::Log::SubLog("[$rhost:$rport] recv: VN = $C_NTP_Version, Mode = $C_Mode, LI = $C_Leap_Indicator", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] recv: Stratum = $C_Stratum, Poll = $C_Poll, Precision = $C_Precision", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] recv: Root Delay = $C_Root_Delay, Root Dispersion = $C_Root_Dispersion", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] recv: Reference Identifier = $C_Reference_Clock_Identifier", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] recv: Reference Timestamp = $C_Reference_Time", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] recv: Originate Timestamp = $C_Originate_Time", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] recv: Receive Timestamp = $C_Receive_Time", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] recv: Transmit Timestamp = $C_Transmit_Time", $self->{servicename}, $$); # log the response packet $S_Leap_Indicator = $S_Leap_Indicator >> 6; $S_NTP_Version = ($S_NTP_Version & 56) >> 3; $S_Mode = $S_Mode & 7; $S_Precision = sprintf("%1.4e",2**$S_Precision); $S_Root_Delay_w1 += bin2frac($S_Root_Delay_w2); $S_Root_Delay = sprintf("%.4f", $S_Root_Delay_w1); $S_Root_Dispersion_w1 += bin2frac($S_Root_Dispersion_w2); $S_Root_Dispersion = sprintf("%.4f", $S_Root_Dispersion_w1); $S_Reference_Time_w1 += bin2frac($S_Reference_Time_w2); $S_Reference_Time = sprintf("%10.5f",$S_Reference_Time_w1 - NTP_ADJ); $S_Originate_Time_w1 += bin2frac($S_Originate_Time_w2); $S_Originate_Time = sprintf("%10.5f",$S_Originate_Time_w1 - NTP_ADJ); $S_Receive_Time_w1 += bin2frac($S_Receive_Time_w2); $S_Receive_Time = sprintf("%10.5f",$S_Receive_Time_w1 - NTP_ADJ); $S_Transmit_Time_w1 += bin2frac($S_Transmit_Time_w2); $S_Transmit_Time = sprintf("%10.5f",$S_Transmit_Time_w1 - NTP_ADJ); &INetSim::Log::SubLog("[$rhost:$rport] send: VN = $S_NTP_Version, Mode = $S_Mode, LI = $S_Leap_Indicator", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] send: Stratum = $S_Stratum, Poll = $S_Poll, Precision = $S_Precision", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] send: Root Delay = $S_Root_Delay, Root Dispersion = $S_Root_Dispersion", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] send: Reference Identifier = $S_Reference_Clock_Identifier", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] send: Reference Timestamp = $S_Reference_Time ".scalar(localtime($S_Reference_Time)), $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] send: Originate Timestamp = $S_Originate_Time ".scalar(localtime($S_Originate_Time)), $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] send: Receive Timestamp = $S_Receive_Time ".scalar(localtime($S_Receive_Time)), $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] send: Transmit Timestamp = $S_Transmit_Time ".scalar(localtime($S_Transmit_Time)), $self->{servicename}, $$); } &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$); if ($stat_success == 1) { $S_Originate_Time = sprintf("%d", $S_Originate_Time); $S_Transmit_Time = sprintf("%d", $S_Transmit_Time); if ($S_Originate_Time > $S_Transmit_Time) { $diff_seconds = $S_Originate_Time - $S_Transmit_Time; } elsif ($S_Originate_Time < $S_Transmit_Time) { $diff_seconds = $S_Transmit_Time - $S_Originate_Time; } &INetSim::Log::SubLog("[$rhost:$rport] stat: $stat_success client=$S_Originate_Time server=$S_Transmit_Time secsdiff=$diff_seconds", $self->{servicename}, $$); } else { &INetSim::Log::SubLog("[$rhost:$rport] stat: $stat_success", $self->{servicename}, $$); } } sub bin2frac { # convert a binary string to fraction my $input = shift; my @bin = split '', $input; my $frac = 0; while (@bin) { $frac = ($frac + pop @bin)/2; } $frac; } sub frac2bin{ # convert a fraction to binary string (B32) my $input = shift; my $frac = $input; my $bin =""; while (length($bin) < 32) { $bin = $bin . int($frac*2); $frac = $frac*2 - int($frac*2); } $bin; } 1; ############################################################# # # History: # # Version 0.49 (2013-08-28) me # - changed allowed poll range to 1..17 as temp. workaround # # Version 0.48 (2009-10-28) me # - improved some code parts # # Version 0.47 (2009-09-01) me # - changed comments # # Version 0.46 (2008-08-27) me # - added logging of process id # # Version 0.45 (2008-03-15) me # - added configuration option 'NTP_StrictChecks' to enable/disable # strict packet checks # - changed check for non-printable characters in $C_Reference_Clock_Identifier # variable # # Version 0.44 (2008-03-15) me # - removed check for given reference timestamp from client, # because some operating systems sets this to a non-zero value # - changed logging messages for invalid packets # # Version 0.43 (2007-12-31) th # - change process name # # Version 0.42 (2007-04-29) me # - added some checks for valid packets # - added logging of every invalid packet # # Version 0.41 (2007-04-26) th # - use getConfigParameter # # Version 0.40 (2007-04-21) me # - added logging of status for use with &INetSim::Report::GenReport() # # Version 0.39 (2007-04-20) me # - fixed a ugly bug with byte 1 # - added check for byte 1 # - added flag for invalid packets # # # Version 0.38 (2007-04-10) th # - get fake time via &INetSim::FakeTime::get_faketime() # instead of accessing $INetSim::Config::FakeTimeDelta # # Version 0.37 (2007-04-05) me # - changed check for MaxChilds, BindAddress, RunAsUser and # RunAsGroup # # Version 0.36b-c (2007-03-30) me # - forgotten debug output removed *argh* # - fixed a typo # # Version 0.36 (2007-03-30) me # - small bug fixes with variables # # Version 0.35 (2007-03-29) me # - complete rewrite :-/ # - now checking some ranges from client packet # - ToDo: the if-condition at lines 189-191 # # Version 0.34 (2007-03-27) th # - fixed logging if *_Time_H undefined # - $S_Precision is negative, therefore cannot be pack'ed as # "C", so "C3" changed to "C2 c" when generating $send_msg # # Version 0.33 (2007-03-18) th # - added configuration option $INetSim::Config::NTP_Server_IP # - fixed double declaration of $S_Mode # # Version 0.32 (2007-03-16) th # - added configuration option $INetSim::Config::FakeTimeDelta # # Version 0.31 (2007-03-15) th # - small bug fixes with variables # # Version 0.3 (2007-03-14) me # ############################################################# inetsim-1.2.7/lib/INetSim/Dummy.pm0000644000175000017500000000072613173076432015077 0ustar rgyrgy# -*- perl -*- # # INetSim::Dummy - Base package for Dummy::TCP and Dummy::UDP # # (c)2008 Matthias Eckert, Thomas Hungenberg # # Version 0.1 (2008-03-06) # ############################################################# # # History: # # Version 0.1 (2008-03-06) me # - initial version # ############################################################# package INetSim::Dummy; use strict; use warnings; use base qw(INetSim::GenericServer); # no shared functions 1; # inetsim-1.2.7/lib/INetSim/Fork.pm0000644000175000017500000002367713173076432014717 0ustar rgyrgy# -*- perl -*- # # INetSim::Fork - base class for INetSim::GenericServer # # This module is a slightly modified version of Net::Server::Fork # for use with INetSim # # Net::Server::Fork is part of the Net::Server Perl library # available from , # see below for copyright notice. # # Modifications to this module for use with INetSim were made # by Thomas Hungenberg & Matthias Eckert # ################################################################ # # Net::Server::Fork - Net::Server personality # # $Id: Fork.pm,v 1.22 2007/02/03 05:41:29 rhandom Exp $ # # Copyright (C) 2001-2007 # # Paul Seamons # paul@seamons.com # http://seamons.com/ # # This package may be distributed under the terms of either the # GNU General Public License # or the # Perl Artistic License # # All rights reserved. # ################################################################ package INetSim::Fork; use base qw(Net::Server); use strict; use vars qw($VERSION); use Net::Server::SIG qw(register_sig check_sigs); use Socket qw(SO_TYPE SOL_SOCKET SOCK_DGRAM); use POSIX qw(WNOHANG); $VERSION = $Net::Server::VERSION; # done until separated ### override-able options for this package sub options { my $self = shift; my $prop = $self->{server}; my $ref = shift; $self->SUPER::options($ref); foreach ( qw(max_servers max_dequeue check_for_dead check_for_dequeue) ){ $prop->{$_} = undef unless exists $prop->{$_}; $ref->{$_} = \$prop->{$_}; } } ### make sure some defaults are set sub post_configure { my $self = shift; my $prop = $self->{server}; ### let the parent do the rest $self->SUPER::post_configure; ### what are the max number of processes $prop->{max_servers} = 256 unless defined $prop->{max_servers}; ### how often to see if children are alive ### only used when max_servers is reached $prop->{check_for_dead} = 60 unless defined $prop->{check_for_dead}; ### I need to know who is the parent $prop->{ppid} = $$; ### let the post bind set up a select handle for us $prop->{multi_port} = 1; } ### loop, fork, and process connections sub loop { my $self = shift; my $prop = $self->{server}; ### get ready for children $prop->{children} = {}; if ($ENV{HUP_CHILDREN}) { my %children = map {/^(\w+)$/; $1} split(/\s+/, $ENV{HUP_CHILDREN}); $children{$_} = {status => $children{$_}, hup => 1} foreach keys %children; $prop->{children} = \%children; } ### store number of children $prop->{numchilds} = 0; ### register some of the signals for safe handling register_sig(PIPE => 'IGNORE', INT => sub { $self->server_close() }, TERM => sub { $self->server_close() }, QUIT => sub { $self->server_close() }, HUP => sub { $self->sig_hup() }, CHLD => sub { while ( defined(my $chld = waitpid(-1, WNOHANG)) ){ last unless $chld > 0; $self->delete_child($chld); } }, ); my ($last_checked_for_dead, $last_checked_for_dequeue) = (time(), time()); ### this is the main loop while( 1 ){ ### make sure we don't use too many processes my $n_children = grep { $_->{status} !~ /dequeue/ } (values %{ $prop->{children} }); $prop->{numchilds} = scalar (keys %{ $prop->{children} }); while ($n_children > $prop->{max_servers}){ ### block for a moment (don't look too often) select(undef,undef,undef,5); &check_sigs(); ### periodically see which children are alive my $time = time(); if( $time - $last_checked_for_dead > $prop->{check_for_dead} ){ $last_checked_for_dead = $time; $self->log(2,"Max number of children reached ($prop->{max_servers}) -- checking for alive."); foreach (keys %{ $prop->{children} }){ ### see if the child can be killed kill(0,$_) or $self->delete_child($_); } } $n_children = grep { $_->{status} !~ /dequeue/ } (values %{ $prop->{children} }); } ### periodically check to see if we should clear a queue if( defined $prop->{check_for_dequeue} ){ my $time = time(); if( $time - $last_checked_for_dequeue > $prop->{check_for_dequeue} ){ $last_checked_for_dequeue = $time; if( defined($prop->{max_dequeue}) ){ my $n_dequeue = grep { $_->{status} =~ /dequeue/ } (values %{ $prop->{children} }); if( $n_dequeue < $prop->{max_dequeue} ){ $self->run_dequeue(); } } } } $self->pre_accept_hook; ### try to call accept ### accept will check signals as appropriate if( ! $self->accept() ){ last if $prop->{_HUP}; last if $prop->{done}; next; } $self->pre_fork_hook; ### fork a child so the parent can go back to listening my $pid = fork; ### trouble if( not defined $pid ){ $self->log(1,"Bad fork [$!]"); sleep(5); ### parent }elsif( $pid ){ close($prop->{client}) if ! $prop->{udp_true}; $prop->{children}->{$pid}->{status} = 'processing'; ### child }else{ ### the child will call post_accept_hook $self->run_client_connection; exit; } } ### fall back to the main run routine } sub pre_accept_hook {}; ### Net::Server::Fork's own accept method which ### takes advantage of safe signals sub accept { my $self = shift; my $prop = $self->{server}; ### block on trying to get a handle (select created because we specified multi_port) my (@socks) = $prop->{select}->can_read(2); ### see if any sigs occured if( &check_sigs() ){ return undef if $prop->{_HUP}; return undef unless @socks; # don't continue unless we have a connection } ### choose one at random (probably only one) my $sock = $socks[rand @socks]; return undef unless defined $sock; ### check if this is UDP if( SOCK_DGRAM == $sock->getsockopt(SOL_SOCKET,SO_TYPE) ){ $prop->{udp_true} = 1; $prop->{client} = $sock; $prop->{udp_true} = 1; $prop->{udp_peer} = $sock->recv($prop->{udp_data}, $sock->NS_recv_len, $sock->NS_recv_flags); ### Receive a SOCK_STREAM (TCP or UNIX) packet }else{ delete $prop->{udp_true}; $prop->{client} = $sock->accept(); return undef unless defined $prop->{client}; } } ### override a little to restore sigs sub run_client_connection { my $self = shift; ### close the main sock, we still have ### the client handle, this will allow us ### to HUP the parent at any time $_ = undef foreach @{ $self->{server}->{sock} }; ### restore sigs (for the child) $SIG{HUP} = $SIG{CHLD} = $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = 'DEFAULT'; $SIG{PIPE} = 'IGNORE'; delete $self->{server}->{children}; $self->SUPER::run_client_connection; } ### Stub function in case check_for_dequeue is used. sub run_dequeue { die "run_dequeue: virtual method not defined"; } sub close_children { my $self = shift; $self->SUPER::close_children(@_); check_sigs(); # since we have captured signals - make sure we handle them register_sig(PIPE => 'DEFAULT', INT => 'DEFAULT', TERM => 'DEFAULT', QUIT => 'DEFAULT', HUP => 'DEFAULT', CHLD => 'DEFAULT', ); } sub pre_fork_hook {} 1; __END__ =head1 NAME Net::Server::Fork - Net::Server personality =head1 SYNOPSIS use Net::Server::Fork; @ISA = qw(Net::Server::Fork); sub process_request { #...code... } __PACKAGE__->run(); =head1 DESCRIPTION Please read the pod on Net::Server first. This module is a personality, or extension, or sub class, of the Net::Server module. This personality binds to one or more ports and then waits for a client connection. When a connection is received, the server forks a child. The child handles the request and then closes. With the exception of parent/child signaling, this module will work (with basic functionality) on Win32 systems. =head1 ARGUMENTS =over 4 =item check_for_dead Number of seconds to wait before looking for dead children. This only takes place if the maximum number of child processes (max_servers) has been reached. Default is 60 seconds. =item max_servers The maximum number of children to fork. The server will not accept connections until there are free children. Default is 256 children. =item max_dequeue The maximum number of dequeue processes to start. If a value of zero or undef is given, no dequeue processes will be started. The number of running dequeue processes will be checked by the check_for_dead variable. =item check_for_dequeue Seconds to wait before forking off a dequeue process. It is intended to use the dequeue process to take care of items such as mail queues. If a value of undef is given, no dequeue processes will be started. =back =head1 CONFIGURATION FILE See L. =head1 PROCESS FLOW Process flow follows Net::Server until the post_accept phase. At this point a child is forked. The parent is immediately able to wait for another request. The child handles the request and then exits. =head1 HOOKS The Fork server has the following hooks in addition to the hooks provided by the Net::Server base class. See L =over 4 =item C<$self-Epre_accept_hook()> This hook occurs just before the accept is called. =item C<$self-Epre_fork_hook()> This hook occurs just after accept but before the fork. =item C<$self-Epost_accept_hook()> This hook occurs in the child after the accept and fork. =item C<$self-Erun_dequeue()> This hook only gets called in conjuction with the check_for_dequeue setting. =back =head1 TO DO See L =head1 AUTHOR Paul Seamons Rob Brown =head1 SEE ALSO Please see also L, L, L, L L =cut inetsim-1.2.7/lib/INetSim/Redirect.pm0000644000175000017500000015362713173076432015556 0ustar rgyrgy# -*- perl -*- # # INetSim::Redirect - A modul to redirect network connections # # RFC 1700, 791, 793, 768, 792... - IP, TCP, UDP and ICMP... # # (c)2008-2010 Matthias Eckert, Thomas Hungenberg # # Version 0.20 (2010-04-10) # # For history/changelog see bottom of this file. # ############################################################# package INetSim::Redirect; use strict; use warnings; use IPTables::IPv4::IPQueue qw(:constants); my $serviceName = "redirect"; my $iptables_cmd; my $externalAddress; my $changeTTL; my $redirectUnknown; my @usedPorts; my $dummyPortTCP; my $dummyPortUDP; my $ip_forward; my $nf_conntrack; my $icmp_ts = 0; my %FORWARD; my %REDIRECT; my %FULLNAT; my %IP; my %TCP; my %UDP; my %ICMP; my $MAC; my $PROTO; my $SRC_IP; my $DST_IP; my $TTL; my $SRC_PORT; my $DST_PORT; my $TYPE; my $CODE; my $IN_DEV; my $OUT_DEV; my $PID = $$; my $ipq; my %type = ( 0 => "echo-reply", 3 => "destination-unreachable", 4 => "source-quench", 5 => "redirect", 8 => "echo-request", 9 => "router-advertisement", 10 => "router-solicitation", 11 => "time-exceeded", 12 => "parameter-problem", 13 => "timestamp-request", 14 => "timestamp-reply", 17 => "address-mask-request", 18 => "address-mask-reply", "echo-reply" => 0, "destination-unreachable" => 3, "source-quench" => 4, "redirect" => 5, "echo-request" => 8, "router-advertisement" => 9, "router-solicitation" => 10, "time-exceeded" => 11, "parameter-problem" => 12, "timestamp-request" => 13, "timestamp-reply" => 14, "address-mask-request" => 17, "address-mask-reply" => 18 ); sub check_requirements { my $my_ip = &INetSim::Config::getConfigParameter("Default_BindAddress"); my @path = split (/:/, $ENV{PATH}); my $iptables; my $modprobe; if ( $> != 0 ) { &INetSim::Log::MainLog("failed! Error: Sorry, you must be root to run this module!", $serviceName); exit 1; } if ($my_ip eq '0.0.0.0') { &INetSim::Log::MainLog("failed! Error: Sorry, this module doesn't work together with address '0.0.0.0'!", $serviceName); exit 1; } foreach (@path) { # search iptables in path if (! $iptables && -x "$_/iptables") { $iptables = "$_/iptables"; } # search modprobe in path if (! $modprobe && -x "$_/modprobe") { $modprobe = "$_/modprobe"; } } # return 0 - iptables not found or executable if (! $iptables) { &INetSim::Log::MainLog("failed! Error: Unable to run iptables command!", $serviceName); exit 1; } $iptables_cmd = $iptables; # final check `$iptables_cmd -nL &>/dev/null`; if (! $?) { if ($modprobe) { foreach my $km (qw/x_tables ip_tables/) { `$modprobe $km &>/dev/null`; } } return 1; } &INetSim::Log::MainLog("failed! Error: Unable to run iptables command!", $serviceName); exit 1; } sub parse_static_rules { $redirectUnknown = &INetSim::Config::getConfigParameter("Redirect_UnknownServices"); $externalAddress = &INetSim::Config::getConfigParameter("Redirect_ExternalAddress"); $changeTTL = &INetSim::Config::getConfigParameter("Redirect_ChangeTTL"); $dummyPortTCP = &INetSim::Config::getConfigParameter("Dummy_TCP_BindPort"); $dummyPortUDP = &INetSim::Config::getConfigParameter("Dummy_UDP_BindPort"); my %rules = &INetSim::Config::getConfigHash("Redirect_StaticRules"); @usedPorts = &INetSim::Config::getUsedPorts(); $icmp_ts = &INetSim::Config::getConfigParameter("Redirect_ICMP_Timestamp"); my ($proto, $dst, $realdst); my ($dst_ip, $dst_port, $dst_type, $real_ip, $real_port); my ($key, $value); my $src_ip = ""; my $dummy; foreach (keys %rules) { ($proto, $dst, $dst_ip, $dst_port, $realdst, $real_ip, $real_port, $key, $value) = undef; ($proto, $dst) = split(/,/, $_, 2); if (! defined ($proto) || ! $proto || $proto !~ /^(tc|ud|icm)p$/) { next; } $proto = lc($proto); # tcp/udp if ($proto =~ /(tc|ud)p/) { ($dst_ip, $dst_port) = split (/:/, $dst, 2); $realdst = $rules{$_}; ($real_ip, $real_port) = split (/:/, $realdst, 2); if ((! defined ($dst_ip) || ! $dst_ip) && (! defined ($dst_port) || ! $dst_port)) { next; } if ((! defined ($real_ip) || ! $real_ip) && (! defined ($real_port) || ! $real_port)) { next; } $key = "$proto:$dst_ip:$dst_port"; $value = "$real_ip:$real_port"; if ((! defined ($real_ip) || ! $real_ip) && defined ($real_port) && $real_port) { # redirect to local port # 10.1.1.6:88 => :80 # *:6667 => :7 if (! defined ($REDIRECT{$key})) { $REDIRECT{$key} = $value; next; } } elsif (defined ($dst_ip) && $dst_ip && defined ($real_ip) && $real_ip && defined ($dst_port) && $dst_port && defined ($real_port) && $real_port && $dst_ip eq $real_ip && $dst_port eq $real_port) { # don't change anything - pass trough # 204.152.191.37:80 => 204.152.191.37:80 if (! defined ($FORWARD{$key})) { $FORWARD{$key} = $value; next; } } elsif (defined ($real_ip) && $real_ip && ((defined ($dst_port) && $dst_port) || (defined ($dst_ip) && $dst_ip))) { # redirect to external host # 193.99.144.80:80 => 72.14.221.104:80 # *:99 => 81.169.154.213:25 # 10.1.1.1:* => 192.168.1.1:* if (! defined ($FULLNAT{$key})) { $FULLNAT{$key} = $value; next; } } } # icmp else { ($dst_ip, $dst_type) = split (/:/, $dst, 2); $realdst = $rules{$_}; ($real_ip, $dummy) = split (/:/, $realdst, 2); if (! $dst_ip && ! $dst_type) { next; } if (! $real_ip) { next; } if (defined $dst_type && $dst_type) { $key = "$proto:$dst_ip:$type{$dst_type}"; } else { $key = "$proto:$dst_ip:"; } $value = "$real_ip"; if ($dst_ip && $real_ip && $dst_ip eq $real_ip) { # don't change anything - pass trough # 10.1.1.6:echo-request => 10.1.1.6 # 10.1.1.6: => 10.1.1.6 if (! defined ($FORWARD{$key})) { $FORWARD{$key} = $value; next; } } elsif (($dst_ip || $dst_type) && $real_ip) { # redirect to external host # 10.1.1.6:echo-request => 204.152.191.37 # 10.1.1.6: => 204.152.191.37 # :echo-request => 204.152.191.37 if (! defined ($FULLNAT{$key})) { $FULLNAT{$key} = $value; next; } } } } } sub ipt { my $cmd_opts = shift; if (defined ($cmd_opts) && $cmd_opts) { $cmd_opts =~ /([\x20-\x7e]+)/; $cmd_opts = $1; my $res = `$iptables_cmd $cmd_opts` || '-'; ($?) or return 1; &INetSim::Log::DebugLog("Error: 'iptables $cmd_opts' $res", $serviceName, $$); } return 0; } sub ip_forward { my $cmd = shift || "status"; my $value; if (open (PROC, "/proc/sys/net/ipv4/ip_forward")) { chomp($value = ); close PROC; } $cmd =~ /(status|enable|disable)/; $cmd = $1; $value =~ /(0|1)/; $value = $1; if (defined ($cmd)) { if ((! $value && $cmd eq "enable") && open (PROC, "> /proc/sys/net/ipv4/ip_forward")) { print PROC "1\n"; close PROC; &INetSim::Log::SubLog("IP forward enabled.", $serviceName, $$); return 2; } elsif (($value && $cmd eq "disable") && open (PROC, "> /proc/sys/net/ipv4/ip_forward")) { print PROC "0\n"; close PROC; &INetSim::Log::SubLog("IP forward disabled.", $serviceName, $$); return 1; } elsif ($cmd eq "status") { return $value; } } return 0; } sub nf_conntrack { my $cmd = shift || "status"; my $value; # kernel version < 2.6.29 => return (-f "/proc/sys/net/netfilter/nf_conntrack_acct") or return; # kernel version >= 2.6.29 => toggle nf_conntrack if (open (CTL, "/proc/sys/net/netfilter/nf_conntrack_acct")) { chomp($value = ); close CTL; } $cmd =~ /(status|enable|disable)/; $cmd = $1; $value =~ /(0|1)/; $value = $1; ($cmd) or return; if ((! $value && $cmd eq "enable") && open (CTL, ">", "/proc/sys/net/netfilter/nf_conntrack_acct")) { print CTL "1\n"; close CTL; &INetSim::Log::SubLog("Connection tracking enabled.", $serviceName, $$); return 2; } elsif (($value && $cmd eq "disable") && open (CTL, ">", "/proc/sys/net/netfilter/nf_conntrack_acct")) { print CTL "0\n"; close CTL; &INetSim::Log::SubLog("Connection tracking disabled.", $serviceName, $$); return 1; } elsif ($cmd eq "status") { return $value; } return 0; } sub create_chains { # save original value for ip_forward $ip_forward = &ip_forward("status"); # save original value for nf_conntrack $nf_conntrack = &nf_conntrack("status"); # enable nf_conntrack &nf_conntrack("enable"); # create chain in mangle table for userspace queueing of packets &ipt("-t mangle -N INetSim_$PID"); # create chain for redirecting packets to local ports &ipt("-t nat -N INetSim_REDIRECT_$PID"); # create chain for changing the destination ip/port of packets &ipt("-t nat -N INetSim_DNAT_$PID"); # create chain for complete forward &ipt("-t mangle -N INetSim_FORWARD_$PID"); # create chain for changing the source ip/port of packets &ipt("-t nat -N INetSim_SNAT_$PID"); # add rule to redirect all packets with state NEW to userspace &ipt("-t mangle -A INetSim_$PID -m state --state NEW -j QUEUE"); # add rule to redirect all icmp timestamp replies to userspace &ipt("-t mangle -A INetSim_$PID -p icmp --icmp-type 14 -j QUEUE"); # now redirect all packets to inetsim chains # queue &ipt("-t mangle -A PREROUTING -j INetSim_$PID"); # redirect &ipt("-t nat -A PREROUTING -j INetSim_REDIRECT_$PID"); # dnat &ipt("-t nat -A PREROUTING -j INetSim_DNAT_$PID"); # forward &ipt("-t mangle -A FORWARD -j INetSim_FORWARD_$PID"); # snat &ipt("-t nat -A POSTROUTING -j INetSim_SNAT_$PID"); # ttl change &ipt("-t mangle -I PREROUTING -j CONNMARK --restore-mark"); if ($changeTTL) { foreach (34..64) { &ipt("-t mangle -A POSTROUTING -m connmark --mark $_ -j TTL --ttl-set $_"); } } } sub delete_chains { # set original value for ip_forward if (defined $ip_forward && $ip_forward == 0) { &ip_forward("disable"); } # queue &ipt("-t mangle -D PREROUTING -j INetSim_$PID"); # redirect &ipt("-t nat -D PREROUTING -j INetSim_REDIRECT_$PID"); # dnat &ipt("-t nat -D PREROUTING -j INetSim_DNAT_$PID"); # forward &ipt("-t mangle -D FORWARD -j INetSim_FORWARD_$PID"); # snat &ipt("-t nat -D POSTROUTING -j INetSim_SNAT_$PID"); # ttl change &ipt("-t mangle -D PREROUTING -j CONNMARK --restore-mark"); if ($changeTTL) { foreach (34..64) { &ipt("-t mangle -D POSTROUTING -m connmark --mark $_ -j TTL --ttl-set $_"); } } # delete SNAT chain &ipt("-t nat -F INetSim_SNAT_$PID"); &ipt("-t nat -X INetSim_SNAT_$PID"); # delete FORWARD chain &ipt("-t mangle -F INetSim_FORWARD_$PID"); &ipt("-t mangle -X INetSim_FORWARD_$PID"); # delete DNAT chain &ipt("-t nat -F INetSim_DNAT_$PID"); &ipt("-t nat -X INetSim_DNAT_$PID"); # delete REDIRECT chain &ipt("-t nat -F INetSim_REDIRECT_$PID"); &ipt("-t nat -X INetSim_REDIRECT_$PID"); # delete chains in mangle table &ipt("-t mangle -D INetSim_$PID -p icmp --icmp-type 14 -j QUEUE"); &ipt("-t mangle -D INetSim_$PID -m state --state NEW -j QUEUE"); &ipt("-t mangle -F INetSim_$PID"); &ipt("-t mangle -X INetSim_$PID"); # set original value for nf_conntrack if (defined $nf_conntrack && $nf_conntrack == 0) { &nf_conntrack("disable"); } } sub process_packet_icmp { my $full = "icmp:" . $DST_IP . ":" . $TYPE; my $type = "icmp::" . $TYPE; my $host = "icmp:" . $DST_IP . ":"; my $my_ip = &INetSim::Config::getConfigParameter("Default_BindAddress"); my $ignore_bootp = &INetSim::Config::getConfigParameter("Redirect_IgnoreBootp"); my $ignore_netbios = &INetSim::Config::getConfigParameter("Redirect_IgnoreNetbios"); my $real_ip; my $ttl_dec; my $ttl_set; my $used; my $dummy; my %pp = ( 8 => 0, 13 => 14, 17 => 18 ); if ((defined ($FULLNAT{$full}) && $FULLNAT{$full}) || (defined ($FULLNAT{$type}) && $FULLNAT{$type}) || (defined ($FULLNAT{$host}) && $FULLNAT{$host})) { if (defined ($FULLNAT{$full}) && $FULLNAT{$full}) { ($real_ip, $dummy) = split(/:/, $FULLNAT{$full}, 2); # 172.16.1.2:echo-request => 10.1.1.1 } elsif (defined ($FULLNAT{$type}) && $FULLNAT{$type}) { ($real_ip, $dummy) = split(/:/, $FULLNAT{$type}, 2); # :echo-request => 10.1.1.1 } elsif (defined ($FULLNAT{$host}) && $FULLNAT{$host}) { ($real_ip, $dummy) = split(/:/, $FULLNAT{$host}, 2); # 172.16.1.2: => 10.1.1.1 } if (defined ($real_ip) && $real_ip) { if (! defined ($externalAddress) || ! $externalAddress) { &INetSim::Log::SubLog("[$SRC_IP:$type{$TYPE}] ERROR: Network Address Translation from '$DST_IP:$type{$TYPE}' to '$real_ip:$type{$TYPE}' is impossible because external address is unset!", $serviceName, $$); return 0; } # enable ip forward if disabled if (! &ip_forward) { if (! &ip_forward("enable")) { &INetSim::Log::SubLog("[$SRC_IP:$type{$TYPE}] ERROR: Network Address Translation from '$DST_IP:$type{$TYPE}' to '$real_ip:$type{$TYPE}' is impossible because cannot enable ip_forward!", $serviceName, $$); return 0; } } # dnat rule &ipt("-t nat -A INetSim_DNAT_$PID -s $SRC_IP -d $DST_IP -p $PROTO --icmp-type $TYPE -j DNAT --to-destination $real_ip"); # snat rule &ipt("-t nat -A INetSim_SNAT_$PID -s $SRC_IP -d $real_ip -p $PROTO --icmp-type $TYPE -j SNAT --to-source $externalAddress"); # mark rule for more packets with the same properties if ($TYPE == 14 && $icmp_ts) { # mark timestamp reply packets with 2 &ipt("-t mangle -I INetSim_$PID -s $SRC_IP -d $DST_IP -p $PROTO --icmp-type $TYPE -j MARK --set-mark 2"); if (defined $pp{$TYPE}) { &ipt("-t mangle -I INetSim_$PID -s $real_ip -d $externalAddress -p $PROTO --icmp-type $pp{$TYPE} -j MARK --set-mark 2"); } else { &ipt("-t mangle -I INetSim_$PID -s $real_ip -d $externalAddress -p $PROTO -j MARK --set-mark 2"); } } else { &ipt("-t mangle -I INetSim_$PID -s $SRC_IP -d $DST_IP -p $PROTO --icmp-type $TYPE -j MARK --set-mark 1"); if (defined $pp{$TYPE}) { &ipt("-t mangle -I INetSim_$PID -s $real_ip -d $externalAddress -p $PROTO --icmp-type $pp{$TYPE} -j MARK --set-mark 1"); } else { &ipt("-t mangle -I INetSim_$PID -s $real_ip -d $externalAddress -p $PROTO -j MARK --set-mark 1"); } } # change ttl if ($changeTTL) { $ttl_set = int(rand(30) + 34); &ipt("-t mangle -I INetSim_$PID -s $SRC_IP -d $DST_IP -p $PROTO --icmp-type $TYPE -m connmark --mark 0 -j CONNMARK --set-mark $ttl_set"); &INetSim::Log::SubLog("[$SRC_IP:$type{$TYPE}] Translating $PROTO connections from host '$SRC_IP' ($MAC), source changed from '$SRC_IP' to '$externalAddress', destination changed from '$DST_IP:$type{$TYPE}' to '$real_ip:$type{$TYPE}', TTL set to $ttl_set.", $serviceName, $$); } else { &INetSim::Log::SubLog("[$SRC_IP:$type{$TYPE}] Translating $PROTO connections from host '$SRC_IP' ($MAC), source changed from '$SRC_IP' to '$externalAddress', destination changed from '$DST_IP:$type{$TYPE}' to '$real_ip:$type{$TYPE}'.", $serviceName, $$); } return 1; } } elsif (defined ($FORWARD{$full}) && $FORWARD{$full}) { # enable ip forward if disabled if (! &ip_forward) { if (! &ip_forward("enable")) { &INetSim::Log::SubLog("[$SRC_IP:$type{$TYPE}] ERROR: Forward to '$DST_IP:$type{$TYPE}' is impossible because cannot enable ip_forward!", $serviceName, $$); return 0; } } # forward rules &ipt("-t mangle -A INetSim_FORWARD_$PID -s $SRC_IP -d $DST_IP -p $PROTO --icmp-type $TYPE -j FORWARD"); &ipt("-t mangle -A INetSim_FORWARD_$PID -d $SRC_IP -s $DST_IP -p $PROTO -j FORWARD"); # mark rules for more packets with the same properties if ($TYPE == 14 && $icmp_ts) { # mark timestamp reply packets with 2 &ipt("-t mangle -I INetSim_$PID -s $SRC_IP -d $DST_IP -p $PROTO --icmp-type $TYPE -j MARK --set-mark 2"); if (defined $pp{$TYPE}) { &ipt("-t mangle -I INetSim_$PID -d $SRC_IP -s $DST_IP -p $PROTO --icmp-type $pp{$TYPE} -j MARK --set-mark 2"); } else { &ipt("-t mangle -I INetSim_$PID -d $SRC_IP -s $DST_IP -p $PROTO -j MARK --set-mark 2"); } } else { &ipt("-t mangle -I INetSim_$PID -s $SRC_IP -d $DST_IP -p $PROTO --icmp-type $TYPE -j MARK --set-mark 1"); if (defined $pp{$TYPE}) { &ipt("-t mangle -I INetSim_$PID -d $SRC_IP -s $DST_IP -p $PROTO --icmp-type $pp{$TYPE} -j MARK --set-mark 1"); } else { &ipt("-t mangle -I INetSim_$PID -d $SRC_IP -s $DST_IP -p $PROTO -j MARK --set-mark 1"); } } # change ttl if ($changeTTL) { $ttl_set = int(rand(30) + 34); &ipt("-t mangle -I INetSim_$PID -s $SRC_IP -d $DST_IP -p $PROTO --icmp-type $TYPE -m connmark --mark 0 -j CONNMARK --set-mark $ttl_set"); &INetSim::Log::SubLog("[$SRC_IP:$type{$TYPE}] Forwarding $PROTO connections from host '$SRC_IP' ($MAC) to destination '$DST_IP:$type{$TYPE}', TTL set to $ttl_set.", $serviceName, $$); } else { &INetSim::Log::SubLog("[$SRC_IP:$type{$TYPE}] Forwarding $PROTO connections from host '$SRC_IP' ($MAC) to destination '$DST_IP:$type{$TYPE}'.", $serviceName, $$); } return 1; } else { # mark rule for more packets with the same properties if ($TYPE == 14 && $icmp_ts) { # mark timestamp reply packets with 2 &ipt("-t mangle -I INetSim_$PID -s $SRC_IP -d $DST_IP -p $PROTO --icmp-type $TYPE -j MARK --set-mark 2"); } else { &ipt("-t mangle -I INetSim_$PID -s $SRC_IP -d $DST_IP -p $PROTO --icmp-type $TYPE -j MARK --set-mark 1"); } &INetSim::Log::SubLog("[$SRC_IP:$type{$TYPE}] No rule for $PROTO connections from host '$SRC_IP' ($MAC) to destination '$DST_IP:$type{$TYPE}' - ignored.", $serviceName, $$); } return 0; } sub process_packet_tcpudp { my $full = "$PROTO:$DST_IP:$DST_PORT"; my $port = "$PROTO" . "::" . "$DST_PORT"; my $host = "$PROTO:$DST_IP:"; my $my_ip = &INetSim::Config::getConfigParameter("Default_BindAddress"); my $ignore_bootp = &INetSim::Config::getConfigParameter("Redirect_IgnoreBootp"); my $ignore_netbios = &INetSim::Config::getConfigParameter("Redirect_IgnoreNetbios"); my ($real_ip, $real_port); my $ttl_dec; my $ttl_set; my $used; # if configured, ignore dhcp packets if ($ignore_bootp && $PROTO eq "udp" && ("$SRC_IP:$SRC_PORT" eq "0.0.0.0:68" && "$DST_IP:$DST_PORT" eq "255.255.255.255:67" || "$DST_IP:$DST_PORT" eq "0.0.0.0:68" && "$SRC_IP:$SRC_PORT" eq "255.255.255.255:67")) { return 0; } # if configured, ignore netbios packets if ($ignore_netbios && $PROTO eq "udp" && $SRC_PORT == $DST_PORT && ($SRC_PORT == 137 || $SRC_PORT == 138) && ($DST_IP =~ /\.255$/ || $SRC_IP =~ /\.255$/)) { return 0; } if ((defined ($FULLNAT{$full}) && $FULLNAT{$full}) || (defined ($FULLNAT{$port}) && $FULLNAT{$port}) || (defined ($FULLNAT{$host}) && $FULLNAT{$host})) { ($real_ip, $real_port) = undef; if (defined ($FULLNAT{$full}) && $FULLNAT{$full}) { ($real_ip, $real_port) = split(/:/, $FULLNAT{$full}, 2); } elsif (defined ($FULLNAT{$port}) && $FULLNAT{$port}) { ($real_ip, $real_port) = split(/:/, $FULLNAT{$port}, 2); } elsif (defined ($FULLNAT{$host}) && $FULLNAT{$host}) { ($real_ip, $real_port) = split(/:/, $FULLNAT{$host}, 2); } if (! defined ($real_port) || ! $real_port) { $real_port = $DST_PORT; } if (defined ($real_ip) && $real_ip) { if (! defined ($externalAddress) || ! $externalAddress) { &INetSim::Log::SubLog("[$SRC_IP:$SRC_PORT] ERROR: Network Address Translation from '$DST_IP:$DST_PORT' to '$real_ip:$real_port' is impossible because external address is unset!", $serviceName, $$); return 0; } # enable ip forward if disabled if (! &ip_forward) { if (! &ip_forward("enable")) { &INetSim::Log::SubLog("[$SRC_IP:$SRC_PORT] ERROR: Network Address Translation from '$DST_IP:$DST_PORT' to '$real_ip:$real_port' is impossible because cannot enable ip_forward!", $serviceName, $$); return 0; } } # dnat rule &ipt("-t nat -A INetSim_DNAT_$PID -s $SRC_IP -d $DST_IP -p $PROTO --dport $DST_PORT -j DNAT --to-destination $real_ip:$real_port"); # snat rule &ipt("-t nat -A INetSim_SNAT_$PID -s $SRC_IP -d $real_ip -p $PROTO --dport $real_port -j SNAT --to-source $externalAddress"); # mark rule for more packets with the same properties &ipt("-t mangle -I INetSim_$PID -s $SRC_IP -d $DST_IP -p $PROTO --dport $DST_PORT -j MARK --set-mark 1"); &ipt("-t mangle -I INetSim_$PID -s $real_ip -d $externalAddress -p $PROTO --sport $real_port -j MARK --set-mark 1"); # change ttl if ($changeTTL) { $ttl_set = int(rand(30) + 34); &ipt("-t mangle -I INetSim_$PID -s $SRC_IP -d $DST_IP -p $PROTO --dport $DST_PORT -m connmark --mark 0 -j CONNMARK --set-mark $ttl_set"); &INetSim::Log::SubLog("[$SRC_IP:$SRC_PORT] Translating $PROTO connections from host '$SRC_IP' ($MAC), source changed from '$SRC_IP' to '$externalAddress', destination changed from '$DST_IP:$DST_PORT' to '$real_ip:$real_port', TTL set to $ttl_set.", $serviceName, $$); } else { &INetSim::Log::SubLog("[$SRC_IP:$SRC_PORT] Translating $PROTO connections from host '$SRC_IP' ($MAC), source changed from '$SRC_IP' to '$externalAddress', destination changed from '$DST_IP:$DST_PORT' to '$real_ip:$real_port'.", $serviceName, $$); } return 1; } } elsif (defined ($FORWARD{$full}) && $FORWARD{$full}) { # enable ip forward if disabled if (! &ip_forward) { if (! &ip_forward("enable")) { &INetSim::Log::SubLog("[$SRC_IP:$SRC_PORT] ERROR: Forward to '$DST_IP:$DST_PORT' is impossible because cannot enable ip_forward!", $serviceName, $$); return 0; } } # forward rules &ipt("-t mangle -A INetSim_FORWARD_$PID -s $SRC_IP -d $DST_IP -p $PROTO --dport $DST_PORT -j FORWARD"); &ipt("-t mangle -A INetSim_FORWARD_$PID -d $SRC_IP -s $DST_IP -p $PROTO --sport $DST_PORT -j FORWARD"); # mark rules for more packets with the same properties &ipt("-t mangle -I INetSim_$PID -s $SRC_IP -d $DST_IP -p $PROTO --dport $DST_PORT -j MARK --set-mark 1"); &ipt("-t mangle -I INetSim_$PID -d $SRC_IP -s $DST_IP -p $PROTO --sport $DST_PORT -j MARK --set-mark 1"); # change ttl if ($changeTTL) { $ttl_set = int(rand(30) + 34); &ipt("-t mangle -I INetSim_$PID -s $SRC_IP -d $DST_IP -p $PROTO --dport $DST_PORT -m connmark --mark 0 -j CONNMARK --set-mark $ttl_set"); &INetSim::Log::SubLog("[$SRC_IP:$SRC_PORT] Forwarding $PROTO connections from host '$SRC_IP' ($MAC) to destination '$DST_IP:$DST_PORT', TTL set to $ttl_set.", $serviceName, $$); } else { &INetSim::Log::SubLog("[$SRC_IP:$SRC_PORT] Forwarding $PROTO connections from host '$SRC_IP' ($MAC) to destination '$DST_IP:$DST_PORT'.", $serviceName, $$); } return 1; } elsif ((defined ($REDIRECT{$full}) && $REDIRECT{$full}) || (defined ($REDIRECT{$port}) && $REDIRECT{$port})) { ($real_ip, $real_port) = undef; if (defined ($REDIRECT{$full}) && $REDIRECT{$full}) { ($real_ip, $real_port) = split(/:/, $REDIRECT{$full}, 2); } elsif (defined ($REDIRECT{$port}) && $REDIRECT{$port}) { ($real_ip, $real_port) = split(/:/, $REDIRECT{$port}, 2); } if (defined ($real_port) && $real_port && (! defined ($real_ip) || ! $real_ip)) { # redirect rule &ipt("-t nat -A INetSim_REDIRECT_$PID -s $SRC_IP -d $DST_IP -p $PROTO --dport $DST_PORT -j REDIRECT --to $real_port"); # mark rule for more packets with the same properties &ipt("-t mangle -I INetSim_$PID -s $SRC_IP -d $DST_IP -p $PROTO --dport $DST_PORT -j MARK --set-mark 1"); # change ttl if ($changeTTL) { $ttl_set = int(rand(30) + 34); &ipt("-t mangle -I INetSim_$PID -s $SRC_IP -d $DST_IP -p $PROTO --dport $DST_PORT -m connmark --mark 0 -j CONNMARK --set-mark $ttl_set"); &INetSim::Log::SubLog("[$SRC_IP:$SRC_PORT] Redirecting $PROTO connections from host '$SRC_IP' ($MAC), destination changed from '$DST_IP:$DST_PORT' to '$my_ip:$real_port', TTL set to $ttl_set.", $serviceName, $$); } else { &INetSim::Log::SubLog("[$SRC_IP:$SRC_PORT] Redirecting $PROTO connections from host '$SRC_IP' ($MAC), destination changed from '$DST_IP:$DST_PORT' to '$my_ip:$real_port'.", $serviceName, $$); } return 1; } } elsif ($redirectUnknown) { foreach $used (@usedPorts) { if ($used eq "$PROTO:$DST_PORT") { if ($DST_IP eq $my_ip) { # mark rule for more packets with the same properties &ipt("-t mangle -I INetSim_$PID -s $SRC_IP -d $DST_IP -p $PROTO --dport $DST_PORT -j MARK --set-mark 1"); # change ttl if ($changeTTL) { $ttl_set = int(rand(30) + 34); &ipt("-t mangle -I INetSim_$PID -s $SRC_IP -d $DST_IP -p $PROTO --dport $DST_PORT -m connmark --mark 0 -j CONNMARK --set-mark $ttl_set"); &INetSim::Log::SubLog("[$SRC_IP:$SRC_PORT] No redirect needed for $PROTO connections from host '$SRC_IP' ($MAC) to destination '$DST_IP:$DST_PORT', TTL set to $ttl_set.", $serviceName, $$); } else { &INetSim::Log::SubLog("[$SRC_IP:$SRC_PORT] No redirect needed for $PROTO connections from host '$SRC_IP' ($MAC) to destination '$DST_IP:$DST_PORT'.", $serviceName, $$); } return 0; } else { # redirect rule &ipt("-t nat -A INetSim_REDIRECT_$PID -s $SRC_IP -d $DST_IP -p $PROTO --dport $DST_PORT -j REDIRECT --to $DST_PORT"); # mark rule for more packets with the same properties &ipt("-t mangle -I INetSim_$PID -s $SRC_IP -d $DST_IP -p $PROTO --dport $DST_PORT -j MARK --set-mark 1"); # change ttl if ($changeTTL) { $ttl_set = int(rand(30) + 34); &ipt("-t mangle -I INetSim_$PID -s $SRC_IP -d $DST_IP -p $PROTO --dport $DST_PORT -m connmark --mark 0 -j CONNMARK --set-mark $ttl_set"); &INetSim::Log::SubLog("[$SRC_IP:$SRC_PORT] Redirecting $PROTO connections from host '$SRC_IP' ($MAC), destination changed from '$DST_IP:$DST_PORT' to '$my_ip:$DST_PORT', TTL set to $ttl_set.", $serviceName, $$); } else { &INetSim::Log::SubLog("[$SRC_IP:$SRC_PORT] Redirecting $PROTO connections from host '$SRC_IP' ($MAC), destination changed from '$DST_IP:$DST_PORT' to '$my_ip:$DST_PORT'.", $serviceName, $$); } return 1; } } } if ($PROTO eq "tcp" && defined ($dummyPortTCP) && $dummyPortTCP) { # redirect rule &ipt("-t nat -A INetSim_REDIRECT_$PID -s $SRC_IP -d $DST_IP -p $PROTO --dport $DST_PORT -j REDIRECT --to $dummyPortTCP"); # mark rule for more packets with the same properties &ipt("-t mangle -I INetSim_$PID -s $SRC_IP -d $DST_IP -p $PROTO --dport $DST_PORT -j MARK --set-mark 1"); # change ttl if ($changeTTL) { $ttl_set = int(rand(30) + 34); &ipt("-t mangle -I INetSim_$PID -s $SRC_IP -d $DST_IP -p $PROTO --dport $DST_PORT -m connmark --mark 0 -j CONNMARK --set-mark $ttl_set"); &INetSim::Log::SubLog("[$SRC_IP:$SRC_PORT] Redirecting $PROTO connections from host '$SRC_IP' ($MAC), destination changed from '$DST_IP:$DST_PORT' to '$my_ip:$dummyPortTCP', TTL set to $ttl_set.", $serviceName, $$); } else { &INetSim::Log::SubLog("[$SRC_IP:$SRC_PORT] Redirecting $PROTO connections from host '$SRC_IP' ($MAC), destination changed from '$DST_IP:$DST_PORT' to '$my_ip:$dummyPortTCP'.", $serviceName, $$); } return 1; } elsif ($PROTO eq "udp" && defined ($dummyPortUDP) && $dummyPortUDP) { # redirect rule &ipt("-t nat -A INetSim_REDIRECT_$PID -s $SRC_IP -d $DST_IP -p $PROTO --dport $DST_PORT -j REDIRECT --to $dummyPortUDP"); # mark rule for more packets with the same properties &ipt("-t mangle -I INetSim_$PID -s $SRC_IP -d $DST_IP -p $PROTO --dport $DST_PORT -j MARK --set-mark 1"); # change ttl if ($changeTTL) { $ttl_set = int(rand(30) + 34); &ipt("-t mangle -I INetSim_$PID -s $SRC_IP -d $DST_IP -p $PROTO --dport $DST_PORT -m connmark --mark 0 -j CONNMARK --set-mark $ttl_set"); &INetSim::Log::SubLog("[$SRC_IP:$SRC_PORT] Redirecting $PROTO connections from host '$SRC_IP' ($MAC), destination changed from '$DST_IP:$DST_PORT' to '$my_ip:$dummyPortUDP', TTL set to $ttl_set.", $serviceName, $$); } else { &INetSim::Log::SubLog("[$SRC_IP:$SRC_PORT] Redirecting $PROTO connections from host '$SRC_IP' ($MAC), destination changed from '$DST_IP:$DST_PORT' to '$my_ip:$dummyPortUDP'.", $serviceName, $$); } return 1; } } else { # mark rule for more packets with the same properties &ipt("-t mangle -I INetSim_$PID -s $SRC_IP -d $DST_IP -p $PROTO --dport $DST_PORT -j MARK --set-mark 1"); &INetSim::Log::SubLog("[$SRC_IP:$SRC_PORT] No rule for $PROTO connections from host '$SRC_IP' ($MAC) to destination '$DST_IP:$DST_PORT' - ignored.", $serviceName, $$); } return 0; } sub close_queue { $ipq->close(); } sub process_queue { while () { my $msg = $ipq->get_message(); if (!defined $msg) { next if IPTables::IPv4::IPQueue->errstr eq 'Timeout'; } my $mac = $msg->hw_addr(); my $ip_packet = $msg->payload(); $IN_DEV = $msg->indev_name(); $OUT_DEV = $msg->outdev_name(); my $mark = $msg->mark(); my $new_packet; my $changed = 0; if (! $mark) { &split_mac($mac); &split_ip($ip_packet); if ($PROTO eq "tcp") { &split_tcp($IP{data}); &process_packet_tcpudp; } elsif ($PROTO eq "udp") { &split_udp($IP{data}); &process_packet_tcpudp; } elsif ($PROTO eq "icmp") { &split_icmp($IP{data}); &process_packet_icmp; # handle icmp timestamp replies, if configured if ($icmp_ts && $TYPE == 14) { my $ts_reply = &fake_ts_reply; if ($ts_reply) { $ICMP{receive} = $ts_reply; $ICMP{transmit} = $ts_reply; $IP{data} = &build_icmp; $new_packet = &build_ip; $changed = 1; } } } } elsif ($icmp_ts && $mark == 2) { &split_mac($mac); &split_ip($ip_packet); if ($PROTO eq "icmp") { &split_icmp($IP{data}); if ($TYPE == 14) { my $ts_reply = &fake_ts_reply; if ($ts_reply) { $ICMP{receive} = $ts_reply; $ICMP{transmit} = $ts_reply; $IP{data} = &build_icmp; $new_packet = &build_ip; $changed = 1; } } } } if (! $changed) { $ipq->set_verdict($msg->packet_id, NF_ACCEPT) or die IPTables::IPv4::IPQueue->errstr; } else { $ipq->set_verdict($msg->packet_id, NF_ACCEPT, length ($new_packet), $new_packet) or die IPTables::IPv4::IPQueue->errstr; } } $ipq->close(); } sub fake_ts_reply { ($icmp_ts) or return; if ($icmp_ts == 1) { # ms return int((&INetSim::FakeTime::get_faketime() % 86400) * 1000); } elsif ($icmp_ts == 2) { # sec return int(&INetSim::FakeTime::get_faketime() | 2147483648); } return; } sub split_mac { $MAC = unpack('H12', shift); $MAC =~ s/(..)/$1:/g; $MAC =~ s/:$//; } sub split_ip { my $raw = shift; my ($IPVersion, $HeaderLength, $Flags, $FragOffset, $SrcIP, $DstIP, $Options, $Data); my $OptionLength; my $OptionBytes; # unpack my ($Byte1, $TOS, $Length, $ID, $Word1, $ttl, $Protocol, $Checksum, $Source, $Destination, $Options_Data) = unpack ("C C n n n C C n N N a*", $raw); # get ip version $IPVersion = ($Byte1 & 240) >> 4; # get header length $HeaderLength = $Byte1 & 15; # get flags $Flags = $Word1 >> 13; # get fragmentation offset $FragOffset = ($Word1 & 8191) << 3; # get source and destination ip (dotted quad) $SrcIP = sprintf("%d.%d.%d.%d", (($Source & 0xFF000000) >> 24), (($Source & 0x00FF0000) >> 16), (($Source & 0x0000FF00) >> 8), ($Source & 0x000000FF)); $DstIP = sprintf("%d.%d.%d.%d", (($Destination & 0xFF000000) >> 24), (($Destination & 0x00FF0000) >> 16), (($Destination & 0x0000FF00) >> 8), ($Destination & 0x000000FF)); # get the length of options (header length minus 5*4 bytes) $OptionLength = $HeaderLength - 5; if ($OptionLength < 0) { $OptionLength = 0; } # length of options is option length * 4 byte (RFC 791, page 11) $OptionBytes = $OptionLength * 4; # split options and data ($Options, $Data) = unpack ("a$OptionBytes a*", $Options_Data); %IP = (); %IP = ( "ip_version" => $IPVersion, "hdr_length" => $HeaderLength, "tos" => $TOS, "length" => $Length, "id" => $ID, "flags" => $Flags, "frag_offset" => $FragOffset, "ttl" => $ttl, "protocol" => $Protocol, "checksum" => $Checksum, "src_ip" => $SrcIP, "dst_ip" => $DstIP, "options" => $Options, "data" => $Data ); if ($Protocol == 6) { $PROTO = "tcp"; } elsif ($Protocol == 17) { $PROTO = "udp"; } elsif ($Protocol == 1) { $PROTO = "icmp"; } else { $PROTO = ""; } $SRC_IP = $SrcIP; $DST_IP = $DstIP; $TTL = $ttl; } sub build_ip { my $Checksum; my $IPVersion; my $HeaderLength; my $Byte1; my $Word4; my $Word; my $Flags; my $Number; my $Header; my ($Source, $Destination); # set checksum to zero for recalculation $Checksum = 0; # ip version and ip header length $IPVersion = $IP{ip_version} << 4; $Byte1 = $IPVersion | $IP{hdr_length}; # flags and fragmentation offset $Flags = $IP{flags} << 13; $Word4 = $Flags | $IP{frag_offset}; # src and dst ip $Source = gethostbyname($IP{src_ip}); $Destination = gethostbyname($IP{dst_ip}); # build the header for checksumming $Header = pack ("C C n n n C C n a4 a4 a*", $Byte1, $IP{tos}, $IP{length}, $IP{id}, $Word4, $IP{ttl}, $IP{protocol}, $Checksum, $Source, $Destination, $IP{options}); # get the number of words $Number = int (length ($Header) / 2); # now compute the checksum foreach $Word ( unpack ("S$Number", $Header) ) { $Checksum += $Word; } $Checksum = ($Checksum >> 16) + ($Checksum & 65535); $Checksum = unpack ("n", pack ("S", ~(($Checksum >> 16) + $Checksum) & 65535)); $IP{checksum} = $Checksum; # pack return ( pack ("C C n n n C C n a4 a4 a* a*", $Byte1, $IP{tos}, $IP{length}, $IP{id}, $Word4, $IP{ttl}, $IP{protocol}, $Checksum, $Source, $Destination, $IP{options}, $IP{data}) ); } sub split_icmp { my $raw = shift; my $Payload; my ($Identifier, $SeqNumber); my ($Pointer, $Unused, $Orig_IPHeader, $Orig_Data64); my ($OriginateTime, $ReceiveTime, $TransmitTime); my $Gateway; my $GatewayIP; my ($Type, $Code, $Checksum, $Data) = unpack ("C C n a*", $raw); %ICMP = (); # echo-request or echo-reply if ($Type == 8 || $Type == 0) { ($Identifier, $SeqNumber, $Payload) = unpack ("n n a*", $Data); %ICMP = ( "identifier" => $Identifier, "seqnumber" => $SeqNumber, "payload" => $Payload ); } # parameter problem elsif ($Type == 12) { ($Pointer, $Unused, $Orig_IPHeader, $Orig_Data64) = unpack ("C C3 a20 a8", $Data); %ICMP = ( "pointer" => $Pointer, "unused" => $Unused, "ipheader" => $Orig_IPHeader, "data64" => $Orig_Data64 ); } # timestamp-request or timestamp-reply elsif ($Type == 13 || $Type == 14) { ($Identifier, $SeqNumber, $OriginateTime, $ReceiveTime, $TransmitTime) = unpack ("n n N N N", $Data); %ICMP = ( "identifier" => $Identifier, "seqnumber" => $SeqNumber, "originate" => $OriginateTime, "receive" => $ReceiveTime, "transmit" => $TransmitTime ); } # information-request or information-reply elsif ($Type == 15 || $Type == 16) { ($Identifier, $SeqNumber) = unpack ("n n", $Data); %ICMP = ( "identifier" => $Identifier, "seqnumber" => $SeqNumber ); } # destination-unreachable or source-quench or time-exceeded elsif ($Type == 3 || $Type == 4 || $Type == 11) { ($Unused, $Orig_IPHeader, $Orig_Data64) = unpack ("C4 a20 a8", $Data); %ICMP = ( "unused" => $Unused, "ipheader" => $Orig_IPHeader, "data64" => $Orig_Data64 ); } # redirect elsif ($Type == 5) { ($Gateway, $Orig_IPHeader, $Orig_Data64) = unpack ("N a20 a8", $Data); $GatewayIP = sprintf ("%d.%d.%d.%d", (($GatewayIP & 0xFF000000) >> 24), (($GatewayIP & 0x00FF0000) >> 16), (($GatewayIP & 0x0000FF00) >> 8), ($GatewayIP & 0x000000FF)); %ICMP = ( "gateway" => $Gateway, "ipheader" => $Orig_IPHeader, "data64" => $Orig_Data64, "gatewayip" => $GatewayIP ); } $TYPE = $ICMP{type} = $Type; $CODE = $ICMP{code} = $Code; $ICMP{checksum} = $Checksum; $ICMP{rawdata} = $Data; } sub build_icmp { my $Packet; my ($Number, $Checksum, $Word); # set checksum to zero for recalculation $Checksum = 0; # echo-request or echo-reply if ($ICMP{type} == 8 || $ICMP{type} == 0) { $Packet = pack ("C C n n n a*", $ICMP{type}, $ICMP{code}, $Checksum, $ICMP{identifier}, $ICMP{seqnumber}, $ICMP{payload}); } # parameter problem elsif ($ICMP{type} == 12) { $Packet = pack ("C C n C C3 a20 a8", $ICMP{type}, $ICMP{code}, $Checksum, $ICMP{pointer}, $ICMP{unused}, $ICMP{ipheader}, $ICMP{data64}); } # timestamp-request or timestamp-reply elsif ($ICMP{type} == 13 || $ICMP{type} == 14) { $Packet = pack ("C C n n n N N N", $ICMP{type}, $ICMP{code}, $Checksum, $ICMP{identifier}, $ICMP{seqnumber}, $ICMP{originate}, $ICMP{receive}, $ICMP{transmit}); } # information-request or information-reply elsif ($ICMP{type} == 15 || $ICMP{type} == 16) { $Packet = pack ("C C n n n", $ICMP{type}, $ICMP{code}, $Checksum, $ICMP{identifier}, $ICMP{seqnumber}); } # destination-unreachable or source-quench or time-exceeded elsif ($ICMP{type} == 3 || $ICMP{type} == 4 || $ICMP{type} == 11) { $Packet = pack ("C C n C4 a20 a8", $ICMP{type}, $ICMP{code}, $Checksum, $ICMP{unused}, $ICMP{ipheader}, $ICMP{data64}); } # redirect elsif ($ICMP{type} == 5) { $Packet = pack ("C C n N a20 a8", $ICMP{type}, $ICMP{code}, $Checksum, $ICMP{gateway}, $ICMP{ipheader}, $ICMP{data64}); } # unknown type, leave it unchanged else { $Packet = pack ("C C n a*", $ICMP{type}, $ICMP{code}, $Checksum, $ICMP{rawdata}); } # get the number of words $Number = int (length ($Packet) / 2); # now compute the checksum foreach $Word ( unpack ("S$Number", $Packet) ) { $Checksum += $Word; } $Checksum = ($Checksum >> 16) + ($Checksum & 65535); $Checksum = pack ("S", ~(($Checksum >> 16) + $Checksum) & 65535); return ( substr($Packet, 0, 2) . $Checksum . substr($Packet, 4) ); } sub split_udp { my $raw = shift; # unpack my ($SrcPort, $DstPort, $Length, $Checksum, $Data) = unpack ("n n n n a*", $raw); %UDP = (); %UDP = ( "src_port" => $SrcPort, "dst_port" => $DstPort, "length" => $Length, "checksum" => $Checksum, "data" => $Data ); $SRC_PORT = $SrcPort; $DST_PORT = $DstPort; } sub build_udp { my $Packet; my $PseudoHeader; my $UDPHeader; my $PseudoPacket; my ($Source, $Destination, $Protocol); # some ip parts are required for pseudo header (RFC 768, page 2) my ($SrcPort, $DstPort, $Length, $Checksum, $Data); my $Number; my $Word; # set checksum to zero for recalculation $Checksum = 0; # get the packet length $Length = length( $UDP{data} ) + 8; # src and dst ip $Source = gethostbyname($IP{src_ip}); $Destination = gethostbyname($IP{dst_ip}); # build the pseudo header $PseudoHeader = pack ("a4 a4 C C n", $Source, $Destination, 0, 17, $Length); # build the udp header $UDPHeader = pack ("n n n n", $UDP{src_port}, $UDP{dst_port}, $UDP{length}, $Checksum); # pack data $Data = pack ("a*", $UDP{data}); # padding data if length mod 2 = 1 if (length($Data) % 2) { $Data .= pack ("a", 0); } # putting it all together for checksumming $PseudoPacket = $PseudoHeader . $UDPHeader . $Data; # get the number of words $Number = int (length ($PseudoPacket) / 2); # now compute the checksum foreach $Word ( unpack ("S$Number", $PseudoPacket) ) { $Checksum += $Word; } $Checksum = ($Checksum >> 16) + ($Checksum & 65535); $Checksum = unpack ("n", pack ("S", ~(($Checksum >> 16) + $Checksum) & 65535)); $UDP{checksum} = $Checksum; # pack return ( pack ("n n n n a*", $UDP{src_port}, $UDP{dst_port}, $Length, $UDP{checksum}, $UDP{data}) ); } sub split_tcp { my $raw = shift; my ($Reserved, $DataOffset, $ControlBits, $Options, $Data); my $OptionLength; my $OptionBytes; my ($SrcPort, $DstPort, $SeqNumber, $AckNumber, $Word1, $Window, $Checksum, $UrgPointer, $Options_Data) = unpack ("n n N N n n n n a*", $raw); # get the data offset $DataOffset = ($Word1 & 61440) >> 12; # get reserved field $Reserved = ($Word1 & 4032) >> 6; # get the control bits (aka flags) $ControlBits = $Word1 & 63; # get the length of options (data offset minus 5*4 bytes) $OptionLength = $DataOffset - 5; if ($OptionLength < 0) { $OptionLength = 0; } # length of options is option length * 4 byte (RFC 793, page 16) $OptionBytes = $OptionLength * 4; # split options and data ($Options, $Data) = unpack ("a$OptionBytes a*", $Options_Data); %TCP = (); %TCP = ( "src_port" => $SrcPort, "dst_port" => $DstPort, "seq_number" => $SeqNumber, "ack_number" => $AckNumber, "data_offset" => $DataOffset, "reserved" => $Reserved, "flags" => $ControlBits, "window" => $Window, "checksum" => $Checksum, "urg_pointer" => $UrgPointer, "options" => $Options, "data" => $Data ); $SRC_PORT = $SrcPort; $DST_PORT = $DstPort; } sub build_tcp { my $Packet; my $PseudoHeader; my $TCPHeader; my $PseudoPacket; my ($Source, $Destination, $Protocol); # some ip parts are required for pseudo header (RFC 793, page 16) my ($SrcPort, $DstPort, $Length, $Checksum, $Data); my $DataOffset; my $Reserved; my $Number; my $Word; my $Word4; # set checksum to zero for recalculation $Checksum = 0; # get the packet length $Length = 20 + length( $TCP{options} ) + length( $TCP{data} ); # src and dst ip $Source = gethostbyname($IP{src_ip}); $Destination = gethostbyname($IP{dst_ip}); # build the pseudo header $PseudoHeader = pack ("a4 a4 C C n", $Source, $Destination, 0, 6, $Length); # build the tcp header $DataOffset = $TCP{data_offset} << 12; $Reserved = $TCP{reserved} << 6; $Word4 = $DataOffset | $Reserved | $TCP{flags}; # pack $TCPHeader = pack ("n n N N n n n n a*", $TCP{src_port}, $TCP{dst_port}, $TCP{seq_number}, $TCP{ack_number}, $Word4, $TCP{window}, $Checksum, $TCP{urg_pointer}, $TCP{options}); # pack data $Data = pack ("a*", $TCP{data}); # padding data if length mod 2 = 1 if (length($Data) % 2) { $Data .= pack ("a", 0); } # putting it all together for checksumming $PseudoPacket = $PseudoHeader . $TCPHeader . $Data; # get the number of words $Number = int (length ($PseudoPacket) / 2); # now compute the checksum foreach $Word ( unpack ("S$Number", $PseudoPacket) ) { $Checksum += $Word; } $Checksum = ($Checksum >> 16) + ($Checksum & 65535); $Checksum = unpack ("n", pack ("S", ~(($Checksum >> 16) + $Checksum) & 65535)); $TCP{checksum} = $Checksum; # pack return ( pack ("n n N N n n n n a* a*", $TCP{src_port}, $TCP{dst_port}, $TCP{seq_number}, $TCP{ack_number}, $Word4, $TCP{window}, $Checksum, $TCP{urg_pointer}, $TCP{options}, $TCP{data}) ); } sub run { $0 = "inetsim [$serviceName]"; $SIG{'INT'} = $SIG{'HUP'} = $SIG{'PIPE'} = $SIG{'QUIT'} = $SIG{'TERM'} = 'IGNORE'; $ENV{PATH} = "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin"; # check for uid=0 and iptables &check_requirements; # check - is ipqueue runnable ? eval { $ipq = new IPTables::IPv4::IPQueue(copy_mode => IPQ_COPY_PACKET, copy_range => 1500) or die IPTables::IPv4::IPQueue->errstr; }; # isn't => exit if ($@) { &INetSim::Log::MainLog("failed! Error: $@", $serviceName); exit 1; } &parse_static_rules; &INetSim::Log::MainLog("started (PID $$)", $serviceName); $SIG{'TERM'} = sub { &delete_chains; &close_queue; &INetSim::Log::MainLog("stopped (PID $$)", $serviceName); exit 0;}; &create_chains; &process_queue; } 1; ############################################################# # # History: # # Version 0.20 (2010-04-10) me # - bugfix: change all timestamp replies, not just the first packet # - some small changes in functions check_requirements() and ipt() # # Version 0.19 (2010-04-02) me # - changed code for icmp-timestamp replies (should be done yet) # # Version 0.18 (2010-03-31) me # - added workaround for nf_conntrack in kernels >= 2.6.29, because # the nf_conntrack functionality is disabled by default for these. # Therefore added function nf_conntrack() # - fix: do not die on IPQueue timeouts # - added basic support to modify the timestamps in icmp-timestamp # packets (needs more work) # # Version 0.17 (2010-02-19) me # - added function split_mac() # - added logging of mac address # - changed signal handlers a bit # - added basic icmp support # # Version 0.16 (2008-08-27) me # - added code to ignore bootp and netbios packets # - added use of new configuration variables Redirect_IgnoreBootp # and Redirect_IgnoreNetbios # # Version 0.15 (2008-08-27) me # - added logging of process id # - added check for Default_BindAddress in function check_requirements() # # Version 0.14 (2008-06-24) me # - code cleanup # # Version 0.13 (2008-06-19) me # - small bugfix in function 'process_packet_tcpudp' # # Version 0.12 (2008-06-14) me # - changed 'localhost' to 'Default_BindAddress' in function # process_packet_tcpudp() # # Version 0.11 (2008-06-13) me # - changed redirect code for use with configuration variable # 'Default_BindAddress' # - fixed the code for random ttl values !! :-D # - changed some rules in functions create_chains() and # delete_chains() # - renamed function process_packet() to process_packet_tcpudp() # # Version 0.10 (2008-06-12) me # - changed code for redirects to used ports # # Version 0.9 (2008-03-19) me # - removed logging of source port in function process_packet() # # Version 0.8 (2008-03-18) me # - added functions split_icmp() and build_icmp() ;-) # - changed error messages in function check_requirements() # - added simple check for ipqueue kernel support # - added check for uid=0 in check_requirements() # # Version 0.7 (2008-03-17) me # - disabled code for changing ttl values :-/ # - fixed a typo in function process_packet() # - code cleanup # # Version 0.6 (2008-03-16) me # - changed ttl code, set 'ttl-dec' to 'ttl-set' # - added function ipt() # - added function ip_forward() # - added function process_packet() # - removed functions add_redirect() and add_dnat() # - changed rule for queue-target, so only new connections are # handled # - removed code for different interfaces # - moved configuration options to Config.pm and inetsim.conf # # Version 0.5 (2008-03-15) me # - added check for 'IPTables::IPv4::IPQueue' (moved to INetSim.pm) # - added function check_requirements() # - added/removed support for changing uid and gid and for sudo, # because ipqueue doesn't work without root privileges *argh* # - changed code for random ttl values (again and again...) # - added function parse_static_rules() # # Version 0.4 (2008-03-12) me # - added code to randomize ttl values, but this won't work # for redirected packets :-/ (possible TTL target bug ?) # # Version 0.3 (2008-03-09) me # - complete rewrite, now using iptables for redirect # - added functions create_chains() and delete_chains() # - added function add_redirect() for redirects to local ports # - added function add_dnat() for redirects to remote hosts/ports # - changed function process_queue() to work with add_redirect() # and add_dnat() # - added pid to all chain names # - added fwmark value != 0 for new rules # - changed create_chains() and process_queue() to process packets # with fwmark=0 only # - ToDo: * change process uid and gid # * add sudo for iptables command # * add a rule parser # * move configuration options and rules to inetsim.conf # * add function for randomizing of ttl values ? :-) # # Version 0.2 (2008-03-08) me # - fixed a bug with frag_offset in function split_ip() - added # left shift with 3 # - removed code for splitting IP and TCP options # - added function build_udp() for udp reassembly # - added function build_tcp() for tcp reassembly # - added function build_ip() for ip reassembly # # Version 0.1 (2008-03-07) me # - initial version # ############################################################# inetsim-1.2.7/lib/INetSim/TFTP.pm0000644000175000017500000012263213173076432014562 0ustar rgyrgy# -*- perl -*- # # INetSim::TFTP - A fake TFTP server # # RFC 1350 - Trivial File Transfer Protocol # # (c)2007-2009 Matthias Eckert, Thomas Hungenberg # # Version 0.59 (2009-12-18) # # For history/changelog see bottom of this file. # ############################################################# package INetSim::TFTP; use strict; use warnings; use POSIX; use IO::Socket; use IO::Select; use Digest::SHA; use Fcntl ':flock'; # RFC 2347 my %OPT_AVAIL = ( blksize => 2, # RFC 2348 timeout => 2, # RFC 2349 tsize => 1, # RFC 2349 multicast => 0 # RFC 2090 ); # status: 3 of 4 my %ERR = ( 0 => "Not defined, see error message", 1 => "File not found", 2 => "Access violation", 3 => "Disk full or allocation exceeded", 4 => "Illegal TFTP operation", 5 => "Unknown transfer ID", 6 => "File already exists", 7 => "No such user", 8 => "Terminate transfer due to option negotiation" ); my %TFTP_OPT; my %VFS; my %CONN; sub configure_hook { my $self = shift; my ($dev, $inode, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks, $grpname); $self->{server}->{host} = &INetSim::Config::getConfigParameter("Default_BindAddress"); # bind to address $self->{server}->{port} = &INetSim::Config::getConfigParameter("TFTP_BindPort"); $self->{server}->{proto} = 'udp'; # UDP protocol $self->{server}->{type} = SOCK_DGRAM; $self->{server}->{user} = &INetSim::Config::getConfigParameter("Default_RunAsUser"); # user to run as $self->{server}->{group} = &INetSim::Config::getConfigParameter("Default_RunAsGroup"); # group to run as $self->{servicename} = &INetSim::Config::getConfigParameter("TFTP_ServiceName"); $self->{maxchilds} = &INetSim::Config::getConfigParameter("Default_MaxChilds"); $self->{timeout} = &INetSim::Config::getConfigParameter("Default_TimeOut"); # $self->{document_root} = &INetSim::Config::getConfigParameter("TFTP_DocumentRoot"); $self->{upload_dir} = &INetSim::Config::getConfigParameter("TFTP_UploadDir"); $self->{allow_overwrite} = &INetSim::Config::getConfigParameter("TFTP_AllowOverwrite"); $self->{options} = &INetSim::Config::getConfigParameter("TFTP_EnableOptions"); $self->{sessionfile} = "$self->{upload_dir}/tftp.session"; $self->{sessionfile} =~ /^(.*)$/; # evil untaint! $self->{sessionfile} = $1; # check DocumentRoot directory if (! -d $self->{document_root}) { &INetSim::Log::MainLog("failed! DocumentRoot directory '$self->{document_root}' does not exist", $self->{servicename}); exit 1; } # check Upload directory $self->{upload_dir} =~ /^(.*)$/; # evil untaint! $self->{upload_dir} = $1; if (! -d $self->{upload_dir}) { &INetSim::Log::MainLog("failed! Upload directory '$self->{upload_dir}' does not exist", $self->{servicename}); exit 1; } $gid = getgrnam("inetsim"); if (! defined $gid) { &INetSim::Log::MainLog("Warning: Unable to get GID for group 'inetsim'", $self->{servicename}); } chown -1, $gid, $self->{upload_dir}; ($dev, $inode, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat $self->{upload_dir}; # check for group owner 'inetsim' $grpname = getgrgid $gid; if ($grpname ne "inetsim") { &INetSim::Log::MainLog("Warning: Group owner of Upload directory '$self->{upload_dir}' is not 'inetsim' but '$grpname'", $self->{servicename}); } # check for group r/w permissions if ((($mode & 0060) >> 3) != 6) { &INetSim::Log::MainLog("Warning: No group r/w permissions on Upload directory '$self->{upload_dir}'", $self->{servicename}); } # register options from config file $self->register_options(); # initialize the virtual filesystem $self->init_VFS; } sub pre_loop_hook { my $self = shift; $0 = 'inetsim_' . $self->{servicename}; &INetSim::Log::MainLog("started (PID $$)", $self->{servicename}); } sub pre_server_close_hook { my $self = shift; $self->_save_vfs_changes(); &INetSim::Log::MainLog("stopped (PID $$)", $self->{servicename}); } sub fatal_hook { my ($self, $msg) = @_; if (defined $msg) { $msg =~ s/[\r\n]*//; &INetSim::Log::MainLog("failed! $msg", $self->{servicename}); } else { &INetSim::Log::MainLog("failed!", $self->{servicename}); } exit 1; } sub process_request { my $self = shift; my $client = $self->{server}->{client}; my $rhost = $client->peerhost; my $rport = $client->peerport; my $packet = $self->{server}->{data}; my $bytes = length($packet); # check minimum packet size -> 4 bytes ($bytes >= 4) or return; # check maximum packet size -> 516 bytes (or 65468 bytes with blocksize option) ($bytes <= 516 || ($self->{options} && $bytes <= 65468)) or return; # get the opcode my ($opcode, $data) = unpack ("n a*", $packet); # check opcode ($opcode && $opcode < 7) or return; # process packet if ($opcode == 1) { $self->RRQ($data); } elsif ($opcode == 2) { $self->WRQ($data); } elsif ($opcode == 3) { $self->DATA($data); } elsif ($opcode == 4) { $self->ACK($data); } elsif ($opcode == 5) { $self->ERROR($data); } elsif ($opcode == 6) { # OACK # don't waste time with option acknowledge packets } } sub check_timeout { my $self = shift; my $client; my $now = time(); foreach $client (keys %CONN) { my ($rhost, $rport, $request, $file, $timeout, $lastrecv, $lastsend, $retries) = ($CONN{$client}->{rhost}, $CONN{$client}->{rport}, $CONN{$client}->{request}, $CONN{$client}->{file}, $CONN{$client}->{timeout}, $CONN{$client}->{last_send}, $CONN{$client}->{last_recv}, $CONN{$client}->{retries}); my $diffrecv = $now - $lastrecv; my $diffsend = $now - $lastsend; (defined $timeout && $timeout) or $timeout = 5; ($diffrecv > $timeout && $diffsend > $timeout) or next; if (! $retries) { $self->send_(pack ("n n a*", 5, 0, "Timeout\x00")); &INetSim::Log::SubLog("[$rhost:$rport] send: ERROR : " . $ERR{0} . " : 'Timeout'", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] disconnect (timeout)", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] stat: 0", $self->{servicename}, $$); if ($request eq "WRQ") { # delete incomplete files from virtual filesystem $self->_vfs_del_file($file); } delete $CONN{$client}; } else { $CONN{$client}->{is_retry} = 1; $CONN{$client}->{last_block} = $CONN{$client}->{block}; if ($request eq "RRQ") { $self->send_DATA($client); } elsif ($request eq "WRQ") { $self->send_ACK($client); } } } } sub RRQ { my ($self, $data) = @_; my $client = $self->{server}->{client}; # already connected ? (! defined $CONN{$client}) or return; # check for invalid packet (defined $data && $data) or return; # get mode and file name my ($file, $mode, $options) = split(/\x00/, $data, 3); # check mode argument (defined $mode && $mode && $mode =~ /^(netascii|octet|mail)\z/i) or return; $mode = lc($mode); # register client my $rhost = $client->peerhost; my $rport = $client->peerport; $CONN{$client} = { rhost => $rhost, rport => $rport, request => "RRQ", file => undef, mode => undef, options => 0, blksize => undef, timeout => undef, tsize => undef, expected => undef, block => 0, bytes => 0, last_send => 0, last_recv => time(), last_block => 0, is_retry => 0, retries => 2, realfile => undef }; # i know, it's udp - but the first packet is like a connect :-) $self->slog_("connect"); # check options if any my $opt = $self->check_options($options); # only for logging: replace non-printable characters in the file name with "." my $filtered = $file; $filtered =~ s/([^\x20-\x7e])/\./g; # log request if ($opt) { $self->slog_("recv: RRQ $filtered $mode (options: $opt)"); } else { $self->slog_("recv: RRQ $filtered $mode (options: none)"); } # option not accepted if (! defined $opt) { $self->send_ERROR(8, "Option or value not accepted"); $self->slog_("disconnect"); $self->slog_("stat: 0"); delete $CONN{$client}; return; } # mode "mail" is not yet implemented -> error if ($mode eq "mail") { $self->send_ERROR(0, "Mode 'mail' not implemented"); $self->slog_("disconnect"); $self->slog_("stat: 0"); delete $CONN{$client}; return; } $CONN{$client}->{mode} = $mode; # check file argument if (! defined $file || ! $file || $file !~ /^([\x20-\x7E]+)$/) { $self->send_ERROR(2, "Invalid file name"); $self->slog_("disconnect"); $self->slog_("stat: 0"); delete $CONN{$client}; return; } # check if file exists my $vfile = $self->_vfs_file_exists($file); if (! defined $vfile || ! $vfile) { $self->send_ERROR(1, "No such file"); $self->slog_("disconnect"); $self->slog_("stat: 0"); delete $CONN{$client}; return; } my ($flag, $type, $rpath) = split (/\|/, $VFS{"$vfile"}); if (! defined $type || $type ne "f" || ! defined $rpath || ! -f $rpath || ! -r $rpath) { $self->send_ERROR(1, "File not found"); $self->slog_("disconnect"); $self->slog_("stat: 0"); delete $CONN{$client}; return; } $CONN{$client}->{file} = $file; $CONN{$client}->{realfile} = $rpath; if ($CONN{$client}->{options}) { # -> OACK -> ACK -> DATA $self->send_OACK(); } else { # -> DATA $self->send_DATA(); } } sub WRQ { my ($self, $data) = @_; my $client = $self->{server}->{client}; # already connected ? (! defined $CONN{$client}) or return; # check for invalid packet (defined $data && $data) or return; # get mode and file name my ($file, $mode, $options) = split(/\x00/, $data, 3); # check mode argument (defined $mode && $mode && $mode =~ /^(netascii|octet|mail)\z/i) or return; $mode = lc($mode); # register client my $rhost = $client->peerhost; my $rport = $client->peerport; $CONN{$client} = { rhost => $rhost, rport => $rport, request => "WRQ", file => undef, mode => undef, options => 0, blksize => undef, timeout => undef, tsize => undef, expected => undef, block => 0, bytes => 0, last_send => 0, last_recv => time(), last_block => 0, is_retry => 0, retries => 2, realfile => undef }; # i know, it's udp - but the first packet is like a connect :-) $self->slog_("connect"); # check options if any my $opt = $self->check_options($options); # only for logging: replace non-printable characters in the file name with "." my $filtered = $file; $filtered =~ s/([^\x20-\x7e])/\./g; # log request if ($opt) { $self->slog_("recv: WRQ $filtered $mode (options: $opt)"); } else { $self->slog_("recv: WRQ $filtered $mode (options: none)"); } # option not accepted if (! defined $opt) { $self->send_ERROR(8, "Option or value not accepted"); $self->slog_("disconnect"); $self->slog_("stat: 0"); delete $CONN{$client}; return; } # mode "mail" is not yet implemented -> error if ($mode eq "mail") { $self->send_ERROR(0, "Mode 'mail' not implemented"); $self->slog_("disconnect"); $self->slog_("stat: 0"); delete $CONN{$client}; return; } $CONN{$client}->{mode} = $mode; # check file argument if (! defined $file || ! $file || $file !~ /^([\x20-\x7E]+)$/) { $self->send_ERROR(2, "Invalid file name"); $self->slog_("disconnect"); $self->slog_("stat: 0"); delete $CONN{$client}; return; } # check if file already exists if (! $self->{allow_overwrite}) { my $vfile = $self->_vfs_file_exists($file); if (defined $vfile && $vfile) { $self->send_ERROR(6, "File already exists"); $self->slog_("disconnect"); $self->slog_("stat: 0"); delete $CONN{$client}; return; } } $CONN{$client}->{file} = $file; if ($CONN{$client}->{options}) { # -> OACK $self->send_OACK(); } else { # -> ACK $self->send_ACK(); } } sub send_OACK { my $self = shift; my $client = $self->{server}->{client}; my $opt; my $log; (defined $CONN{$client}) or return; (defined $CONN{$client}->{options} && $CONN{$client}->{options}) or return; $CONN{$client}->{last_send} = time(); if ($CONN{$client}->{request} eq "RRQ") { $CONN{$client}->{expected} = "ACK"; if (defined $CONN{$client}->{tsize} && -f $CONN{$client}->{realfile}) { $CONN{$client}->{tsize} = -s $CONN{$client}->{realfile}; } } elsif ($CONN{$client}->{request} eq "WRQ") { $CONN{$client}->{expected} = "DATA"; } foreach (qw/blksize timeout tsize/) { (defined $CONN{$client}->{$_} && $CONN{$client}->{$_}) or next; $opt .= "$_\x00$CONN{$client}->{$_}\x00"; $log .= "$_ $CONN{$client}->{$_} "; } $log =~ s/\s+$//; $self->slog_("send: OACK $log"); $self->send_(pack ("n a*", 6, $opt)); } sub DATA { my ($self, $raw) = @_; my $client = $self->{server}->{client}; my $blocksize; # connected ? (defined $client && defined $CONN{$client}) or return; # check for invalid packet (defined $raw && $raw) or return; # was the initial packet a WRQ and therefore we expect a data packet ? ($CONN{$client}->{request} eq "WRQ" && $CONN{$client}->{expected} eq "DATA") or return; # get block number and data my ($block, $data) = unpack ("n a*", $raw); # block number should not be zero if (! $block) { $self->send_ERROR(4, "Invalid block number"); $self->slog_("disconnect"); $self->slog_("stat: 0"); delete $CONN{$client}; return; } $CONN{$client}->{last_recv} = time(); # get length my $length = length($data); # check for valid block number ($block == int($CONN{$client}->{block} + 1)) or return; # set block size if (defined $CONN{$client}->{blksize} && $CONN{$client}->{blksize}) { $blocksize = $CONN{$client}->{blksize}; # check for stupid clients (atftp) and correct the blocksize if ($block == 1 && $length > $CONN{$client}->{blksize}) { $CONN{$client}->{blksize} = $length; $self->slog_("w00t: The client lies about his block size, adjusted to $length :-/"); } } else { $blocksize = 512; } # creating file, if block = 1 if ($block == 1) { srand(time() ^($$ + ($$ <<15))); my $sha = Digest::SHA->new(); $sha->add(int(rand(100000000))); $sha->add(time()); $CONN{$client}->{realfile} = $self->{upload_dir} . "/" . $sha->hexdigest; } my $rpath = $CONN{$client}->{realfile}; # try to open if (! open (DAT, ">> $rpath")) { $self->send_ERROR(0, "Unable to write"); $self->slog_("disconnect"); $self->slog_("stat: 0"); delete $CONN{$client}; return; } chmod 0660, $rpath; binmode (DAT); if ($block) { print DAT $data; } close DAT; # save the file in virtual file system my $result = $self->_vfs_add_file($CONN{$client}->{file}, $CONN{$client}->{realfile}); $CONN{$client}->{block} = $block; $CONN{$client}->{bytes} += $length; $self->send_ACK(); if ($length < $blocksize) { $self->slog_("recv: DATA (blocks: $block, block size: $blocksize bytes, file size: $CONN{$client}->{bytes} bytes)"); $self->slog_("info: Stored $CONN{$client}->{bytes} bytes of data to: $rpath, original file name: $CONN{$client}->{file}"); $self->slog_("disconnect"); $self->slog_("stat: 1 request=write mode=$CONN{$client}->{mode} name=$CONN{$client}->{file}"); delete $CONN{$client}; } } sub ACK { my ($self, $data) = @_; my $client = $self->{server}->{client}; (defined $CONN{$client}) or return; (defined $data && $data) or return; my $block = unpack ("n", $data); (defined $block) or return; ($CONN{$client}->{request} eq "RRQ" && $CONN{$client}->{block} == $block) or return; if ($CONN{$client}->{expected} eq "ACK") { if ($block == 0) { $self->slog_("recv: ACK block $block"); } $self->send_DATA(); } elsif ($CONN{$client}->{expected} eq "LASTACK") { $self->slog_("recv: ACK block $block"); $self->slog_("disconnect"); $self->slog_("stat: 1 request=read mode=$CONN{$client}->{mode} name=$CONN{$client}->{file}"); delete $CONN{$client}; } } sub ERROR { my ($self, $data) = @_; my $client = $self->{server}->{client}; (defined $CONN{$client}) or return; (defined $data && $data) or return; my ($code, $message) = unpack ("n a*", $data); (defined $code && defined $message && $message) or return; ($code >= 0 && $code <= 8) or return; $message =~ s/\x00$//; $message =~ s/([^\x20-\x7e])/\./g; $self->slog_("recv: ERROR : $ERR{$code} : '$message'"); $self->slog_("disconnect"); $self->slog_("stat: 0"); if ($CONN{$client}->{request} eq "WRQ") { # delete incomplete file from virtual filesystem $self->_vfs_del_file($CONN{$client}->{file}); } delete $CONN{$client}; } sub send_DATA { my ($self, $client) = @_; (defined $client && $client) or $client = $self->{server}->{client}; my $blocksize; (defined $CONN{$client}) or return; my $rpath = $CONN{$client}->{realfile}; my $block; if ($CONN{$client}->{is_retry}) { $block = $CONN{$client}->{last_block}; $CONN{$client}->{is_retry} = 0; $CONN{$client}->{retries}--; } else { $block = $CONN{$client}->{block} + 1; $CONN{$client}->{last_block} = $block; } # set block size if (defined $CONN{$client}->{blksize} && $CONN{$client}->{blksize}) { $blocksize = $CONN{$client}->{blksize}; } else { $blocksize = 512; } my $size = -s $rpath; my $offset = ($blocksize * ($block - 1)); if (! open(DAT, "$rpath")) { # should not happen $self->send_ERROR(0, "Internal server error"); $self->slog_("disconnect"); $self->slog_("stat: 0"); delete $CONN{$client}; return; } binmode (DAT); seek(DAT, $offset , 0); read(DAT, my $data, $blocksize); close DAT; my $length = length($data); if ($block == 1) { $self->slog_("info: Sending file: $rpath"); } if ($length == $blocksize) { $CONN{$client}->{expected} = "ACK"; } else { $CONN{$client}->{expected} = "LASTACK"; $self->slog_("send: DATA (blocks: $block, block size: $blocksize bytes, file size: $size bytes)"); } $CONN{$client}->{block} = $block; $CONN{$client}->{last_send} = time(); $self->send_(pack ("n n a*", 3, $block, $data)); } sub send_ACK { my ($self, $client) = @_; (defined $client && $client) or $client = $self->{server}->{client}; (defined $CONN{$client}) or return; my $block; if ($CONN{$client}->{is_retry}) { $block = $CONN{$client}->{last_block}; $CONN{$client}->{is_retry} = 0; $CONN{$client}->{retries}--; } else { $block = $CONN{$client}->{block}; $CONN{$client}->{last_block} = $block; } $CONN{$client}->{last_send} = time(); if ($block == 0) { $CONN{$client}->{expected} = "DATA"; $self->slog_("send: ACK block 0"); } $self->send_(pack ("n n", 4, $block)); } sub send_ERROR { my ($self, $code, $msg, $client) = @_; (defined $client && $client) or $client = $self->{server}->{client}; (defined $client) or return; (defined $code) or $code = 0; (defined $msg) or $msg = "unknown error"; $self->slog_("send: ERROR : " . $ERR{$code} . " : '$msg'", $client); $self->send_(pack ("n n a*", 5, $code, $msg . "\x00")); } sub check_options { my ($self, $options) = @_; my $client = $self->{server}->{client}; my ($option, $value); my ($min, $max); my $given = ""; (defined $options && $options) or return 0; my @opt = split(/\x00/, $options); while (1) { last if (@opt <= 1); $option = shift(@opt); $value = shift(@opt); (defined $option && $option && $option =~ /^(blksize|timeout|tsize|multicast)$/i) or next; (defined $value && ((length($value) && $value =~ /^\d+$/) || $option eq "multicast")) or next; $option = lc($option); $given .= "$option=$value "; ($self->{options}) or next; if ($option eq "blksize" && defined $TFTP_OPT{blksize}) { ($value >= 8 && $value <= 65464) or next; ($min, $max) = split(/\s+/, $TFTP_OPT{blksize}); # if block size defined, but smaller than client value -> set server value if ($value > $max) { $CONN{$client}->{blksize} = $TFTP_OPT{blksize}; } # do not accept values less than minimum value elsif ($value < $min) { $CONN{$client}->{blksize} = undef; } # ...else set the client value else { $CONN{$client}->{blksize} = $value; } } elsif ($option eq "timeout" && defined $TFTP_OPT{timeout}) { ($value >= 1 && $value <= 255) or next; ($min, $max) = split(/\s+/, $TFTP_OPT{timeout}); # do not accept values outside our range if ($value > $max || $value < $min) { $CONN{$client}->{timeout} = undef; } # ok, set client value else { $CONN{$client}->{timeout} = $value; } } elsif ($option eq "tsize" && defined $TFTP_OPT{tsize}) { if ($CONN{$client}->{request} eq "RRQ" && $value == 0) { $CONN{$client}->{tsize} = 0; } elsif ($CONN{$client}->{request} eq "WRQ") { # requested transfer size to big if ($value > $TFTP_OPT{tsize}) { return undef; } else { $CONN{$client}->{tsize} = $value; } } } } (! defined $CONN{$client}->{blksize} && ! defined $CONN{$client}->{timeout} && ! defined $CONN{$client}->{tsize}) or $CONN{$client}->{options} = 1; $given =~ s/\s+$//; return $given; } sub send_ { my ($self, $msg) = @_; my $sock = $self->{server}->{socket}; (defined $msg) or return; $sock->send($msg); } sub slog_ { my ($self, $msg, $sock) = @_; (defined $sock && $sock) or $sock = $self->{server}->{client}; my $rhost = $sock->peerhost; my $rport = $sock->peerport; (defined $msg) or return; $msg =~ s/[\r\n]*//; &INetSim::Log::SubLog("[$rhost:$rport] $msg", $self->{servicename}, $$); } sub dlog_ { my ($self, $msg, $sock) = @_; (defined $sock && $sock) or $sock = $self->{server}->{client}; my $rhost = $sock->peerhost; my $rport = $sock->peerport; (defined $msg) or return; $msg =~ s/[\r\n]*//; &INetSim::Log::DebugLog("[$rhost:$rport] $msg", $self->{servicename}, $$); } ### BEGIN: VFS stuff # key = file, value = flag|dirORfile|realpath sub init_VFS { my $self = shift; my @dirs; my $name; my $vname; my $mtime; my $dir; # read the session file, if exist $self->_read_vfs_changes; # # rebuild only if empty # return if (keys (%VFS) >= 1); # first, add '/' to the filesystem $mtime = int (&INetSim::FakeTime::get_faketime() - rand(7200)); $VFS{'/'} = "1|d|"; $self->{current_dir} = "/"; # now walk through the document root and add directories and files push (@dirs, $self->{document_root}); # push document root to the "stack" while (@dirs) { $dir = pop (@dirs); if (opendir (DIR, $dir)) { while (defined ($name = readdir (DIR))) { next if $name eq '.'; next if $name eq '..'; $vname = "$dir/$name"; $vname =~ s/^$self->{document_root}//; # chr00t ;-) $mtime = int (&INetSim::FakeTime::get_faketime() - rand(3600)); if (-d "$dir/$name") { push (@dirs, "$dir/$name"); $self->_vfs_add_dir($vname, "$dir/$name"); } elsif (-f "$dir/$name") { $self->_vfs_add_file($vname, "$dir/$name"); } } closedir DIR; } } } sub _vfs_add_file { my $self = shift; my $vpath = shift; # virtual path my $rpath = shift; # real path my $dir; if (defined ($vpath) && defined ($rpath)) { if (-f $rpath && -r $rpath) { # add base directory of the file $self->_vfs_add_dir($self->_dirname($vpath)); # check for absolute path if ($vpath !~ /^\//) { # build absolute virtual path name $vpath = "$self->{current_dir}/$vpath"; } # filter virtual path name $vpath = $self->_filter_pathstring($vpath); # add file to vfs (if not empty) if (defined ($vpath) && $vpath ne "" && $vpath ne "/") { $VFS{"$vpath"} = "1|f|$rpath"; return ($vpath); } } } return undef; } sub _vfs_del_file { my $self = shift; my $vpath = shift; # virtual path if (defined ($vpath)) { # check for absolute path if ($vpath !~ /^\//) { # build absolute virtual path name $vpath = "$self->{current_dir}/$vpath"; } # filter virtual path name $vpath = $self->_filter_pathstring($vpath); if (defined ($vpath) && $vpath ne "" && defined ($VFS{"$vpath"}) && $VFS{"$vpath"} !~ /^d/) { delete $VFS{"$vpath"}; return ($vpath); } } return undef; } sub _vfs_file_exists { my $self = shift; my $vpath = shift; # virtual path if (defined ($vpath)) { # check for absolute path if ($vpath !~ /^\//) { # build absolute virtual path name $vpath = "$self->{current_dir}/$vpath"; } # filter virtual path name $vpath = $self->_filter_pathstring($vpath); if (defined ($vpath) && $vpath ne "" && defined ($VFS{"$vpath"}) && $VFS{"$vpath"} !~ /^d/) { return ($vpath); } } return undef; } sub _vfs_add_dir { my $self = shift; my $vpath = shift; # virtual path if (defined ($vpath)) { # check for absolute path if ($vpath !~ /^\//) { # build absolute virtual path name $vpath = "$self->{current_dir}/$vpath"; } # filter virtual path name $vpath = $self->_filter_pathstring($vpath); # add directory to vfs (if not empty) if (defined ($vpath) && $vpath ne "" && $vpath ne "/") { $VFS{"$vpath"} = "1|d|"; return ($vpath); } } return undef; } sub _vfs_dir_exists { my $self = shift; my $vpath = shift; # virtual path if (defined ($vpath)) { # check for absolute path if ($vpath !~ /^\//) { # build absolute virtual path name $vpath = "$self->{current_dir}/$vpath"; } # filter virtual path name $vpath = $self->_filter_pathstring($vpath); if (defined ($vpath) && $vpath ne "" && defined ($VFS{"$vpath"}) && $VFS{"$vpath"} =~ /^d/) { return ($vpath); } } return undef; } sub _read_vfs_changes { my $self = shift; my %seen = (); my @raw; my $key; if (open (SES, "$self->{sessionfile}")) { chomp(@raw = ); close SES; foreach (grep { ! $seen{ $_ }++ } @raw) { my ($content, $vpath) = split (/\!/, $_, 2); chomp($vpath); $VFS{"$vpath"} = $content; } } return; } sub _save_vfs_changes { my $self = shift; my %seen = (); my @raw; my $key; while () { if (open (SES, "> $self->{sessionfile}")) { chmod 0660, $self->{sessionfile}; if (flock(SES, LOCK_EX)) { foreach $key (keys %VFS) { print SES "$VFS{$key}!$key\n"; } close SES; return 1; } close SES; } sleep 1; } return; } sub _filter_pathstring { my $self = shift; my $path = shift; my @parts; if (defined ($path) && $path ne "") { @parts = split(/\/+/, $path); @parts = ('', '') unless @parts; unshift (@parts, '') unless @parts > 1; for (my $i = 1; $i < @parts;) { if ($parts[$i] eq '.') { splice (@parts, $i, 1); } elsif ($parts[$i] eq '..' && $i == 1) { splice (@parts, $i, 1); } elsif ($parts[$i] eq '..') { splice (@parts, ($i - 1), 2); $i--; } else { $i++; } } unshift (@parts, '') unless @parts > 1; return (join ('/', @parts)); } return undef; } sub _basename { my $self = shift; my $path = shift; my @parts; if (defined ($path) && $path ne "") { if ($path eq '/') { return '/'; } else { @parts = split (m{/}, $path); return (pop @parts); } } return undef; } sub _dirname { my $self = shift; my $path = shift; if (defined ($path) && $path ne "") { if ($path eq '/') { return '/'; } else { my @parts = split (m{/}, $path); pop @parts; push (@parts, '') if @parts == 1; return (join ('/', @parts)); } } return undef; } ### BEGIN: Server stuff sub server_close { my $self = shift; $self->{server}->{socket}->close(); exit 0; } sub new { my $class = shift || die "Missing class"; my $args = @_ == 1 ? shift : {@_}; my $self = bless {server => { %$args }}, $class; return $self; } sub bind { my $self = shift; # evil untaint $self->{server}->{host} =~ /(.*)/; $self->{server}->{host} = $1; # bind to socket $self->{server}->{socket} = new IO::Socket::INET( LocalAddr => $self->{server}->{host}, LocalPort => $self->{server}->{port}, Proto => $self->{server}->{proto}, Type => $self->{server}->{type} ); (defined $self->{server}->{socket}) or $self->fatal_hook("$!"); # add socket to select $self->{server}->{select} = new IO::Select($self->{server}->{socket}); (defined $self->{server}->{select}) or $self->fatal_hook("$!"); # drop root privileges my $uid = getpwnam($self->{server}->{user}); my $gid = getgrnam($self->{server}->{group}); # group POSIX::setgid($gid); my $newgid = POSIX::getgid(); if ($newgid != $gid) { &INetSim::Log::MainLog("failed! (Cannot switch group)", $self->{servicename}); $self->server_close; } # user POSIX::setuid($uid); if ($< != $uid || $> != $uid) { $< = $> = $uid; # try again - reportedly needed by some Perl 5.8.0 Linux systems if ($< != $uid) { &INetSim::Log::MainLog("failed! (Cannot switch user)", $self->{servicename}); $self->server_close; } } # ignore SIG_INT, SIG_PIPE and SIG_QUIT $SIG{'INT'} = $SIG{'PIPE'} = $SIG{'QUIT'} = 'IGNORE'; # only "listen" for SIG_TERM from parent process $SIG{'TERM'} = sub { $self->pre_server_close_hook; $self->server_close; }; } sub run { my $self = ref($_[0]) ? shift() : shift->new; # configure this service $self->configure_hook; # open the socket and drop privilegies (set user/group) $self->bind; # just for compatibility with net::server $self->pre_loop_hook; # standard loop for: receive->process_request->check_timeout $self->loop; # just for compatibility with net::server $self->pre_server_close_hook; # shutdown socket and exit $self->server_close; } sub loop { my $self = shift; my $socket = $self->{server}->{socket}; my $select = $self->{server}->{select}; my $client; my $bytes; my $buffer; my $rhost; my $rport; while (1) { my @can_read = $select->can_read(0.1); $self->{number_of_clients} = int($select->count()); foreach $client (@can_read) { $bytes = $client->recv($buffer, 65468); (defined $bytes) or next; $self->{server}->{client} = $client; $self->{server}->{data} = $buffer; $self->process_request(); } my @can_write = $select->can_write(0.1); $self->{number_of_clients} = int($select->count()); foreach $client (@can_write) { $self->{server}->{client} = $client; $self->check_timeout(); } } } sub register_options { my $self = shift; my %option; if ($self->{options}) { %option = &INetSim::Config::getConfigHash("TFTP_Options"); foreach my $key (keys %option) { if (defined ($OPT_AVAIL{$key}) && $OPT_AVAIL{$key}) { if (! defined ($TFTP_OPT{$key})) { $option{$key} =~ s/[\s]+$//; # parameters are allowed if ($OPT_AVAIL{$key} == 2) { $TFTP_OPT{$key} = $option{$key}; } # parameters are not allowed else { $TFTP_OPT{$key} = ""; } } } } # resolve possible dependencies below... # # check range for blocksize parameters if (defined $TFTP_OPT{blksize}) { # nothing defined, set maximum range if (! $TFTP_OPT{blksize}) { $TFTP_OPT{blksize} = "8 65464"; } else { # some values defined, check that my ($min, $max) = split(/[\s\t]+/, $TFTP_OPT{blksize}, 2); # invalid ? set to minimum value if (! defined $min || ! $min || $min !~ /^\d+$/ || $min < 8 || $min > 65464) { $min = 8; } # invalid ? set to maximum if (! defined $max || ! $max || $max !~ /^\d+$/ || $max < 8 || $max > 65464) { $max = 65464; } # switch min & max, if min greater max if ($min > $max) { $TFTP_OPT{blksize} = "$max $min"; } else { $TFTP_OPT{blksize} = "$min $max"; } } } # check range for timeout if (defined $TFTP_OPT{timeout}) { # nothing defined -> maximum range if (! $TFTP_OPT{timeout}) { $TFTP_OPT{timeout} = "1 255"; } else { # some values defined... my ($min, $max) = split(/[\s\t]+/, $TFTP_OPT{timeout}, 2); # invalid ? set to minimum if (! defined $min || ! $min || $min !~ /^\d+$/ || $min < 1 || $min > 255) { $min = 1; } # invalid ? set to maximum if (! defined $max || ! $max || $max !~ /^\d+$/ || $max < 1 || $max > 255) { $max = 255; } # switch min & max, if min greater max if ($min > $max) { $TFTP_OPT{timeout} = "$max $min"; } else { $TFTP_OPT{timeout} = "$min $max"; } } } # check maximum transfer size if (defined $TFTP_OPT{tsize}) { # nothing defined -> maximum tsize = 10MB if (! $TFTP_OPT{tsize}) { $TFTP_OPT{tsize} = 10485760; } else { # defined value invalid ? then set to default if ($TFTP_OPT{tsize} !~ /^\d+$/ || $TFTP_OPT{tsize} < 1 || $TFTP_OPT{tsize} > 1073741824) { $TFTP_OPT{tsize} = 10485760; } } } } } sub error_exit { my ($self, $sock, $msg) = @_; my $rhost = $sock->peerhost; my $rport = $sock->peerport; if (! defined $msg) { $msg = "Unknown error"; } &INetSim::Log::MainLog("$msg. Closing connection.", $self->{servicename}); &INetSim::Log::SubLog("[$rhost:$rport] error: $msg. Closing connection.", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$); exit 1; } 1; ############################################################# # # History: # # Version 0.59 (2009-12-18) me # - do not log 'service stop' twice # # Version 0.58 (2009-10-13) me # - added function register_options() # - added pre_server_close_hook() to signal handler # - enhanced support for 'timeout' and 'tsize' option # - fixed a typo in check_options() # - some small bugfixes # # Version 0.57 (2009-10-12) me # - added configuration variables 'TFTP_UploadDir', 'TFTP_AllowOverwrite' # and 'TFTP_EnableOptions' # - added configuration hash 'TFTP_Options' # # Version 0.56 (2009-10-11) me # - added support for 'blksize' option (RFC 2348) # - added function check_timeout(), therefore added code to # repeat unanswered packets when the timeout occurs # - added support for 'timeout' and 'tsize' options (RFC 2349) # - small code cleanups # # Version 0.55 (2009-10-10) me # - removed use of Net::Server and IPC::Shareable # - added general routines to handle udp packets # - complete rewrite (oo-style) # - changed all data types in pack/unpack # - added the virtual filesystem from FTP module (slightly downsized), # so the old index and data files are no longer needed # - added general support for TFTP options (RFC 2347), # therefore added a function called send_OACK() # - removed a bunch of unnecessary variables # # Version 0.54 (2009-10-09) me # - prepared rewrite for work with IO::Select instead of Net::Server # - playing around with IO::Select and learned some things about # his behavior while using the udp protocol # # Version 0.53 (2008-08-27) me # - added logging of process id # # Version 0.52 (2007-12-31) th # - change process name # # Version 0.51 (2007-09-03) me # - create uploads.dat and uploads.idx if they do not exist # # Version 0.50 (2007-05-28) me # - changed DATA-section to work with new configuration option # "TFTP_EnableUpload" # # Version 0.49 (2007-05-26) me # - changed WRQ-section to work with new configuration option # "TFTP_EnableUpload" # # Version 0.48 (2007-04-26) th # - use getConfigParameter # # Version 0.47 (2007-04-24) th # - changed Shareable-GLUE to "TFTP" # # Version 0.46 (2007-04-24) th # - added function error_exit() # - replaced die() calls with error_exit() # # Version 0.45 (2007-04-21) me # - added logging of status for use with &INetSim::Report::GenReport() # # Version 0.44 (2007-04-19) me # - added check for minimal packet length of 4 bytes # - fixed a typo in configure hook # # Version 0.43 (2007-04-18) me # - logging of every DATA packet removed # # Version 0.42 (2007-04-05) th # - changed check for MaxChilds, BindAddress, RunAsUser and # RunAsGroup # # Version 0.41 (2007-04-02) me # - fix with handling of last ack # - fixed strange behavior, if tftp is under load (maybe) # # Version 0.4 (2007-03-31) me # - complete rewrite *argh* # - small bugfixes with variables (range check) # - added a filter for path- and filenames (that keeps # subdirectorys) # - ugly "brainbug" fixed: a very special case - lost bytes, # if [ filesize % 512 == 0 ] # - some tests with netcat performed - yeah, looks good :-) # - ToDo: FakeMode # - ToDo: use of temporary files should be removed # # Version 0.3 (2007-03-30) me # - rewrote module to use INetSim::GenericServer # - temporary files now uses /tmp/, because we can't write a # $BASEDIR.$somefile as "nobody:nogroup" :-( # (today is a good day to die, i think !!) # # Version 0.2 (2007-03-30) me # - small bugfixes with variables # # Version 0.1 (2007-03-29) me # - initial version - it works !!! (standalone) # ############################################################# inetsim-1.2.7/lib/INetSim/Finger.pm0000644000175000017500000003023513173076432015214 0ustar rgyrgy# -*- perl -*- # # INetSim::Finger - A fake Finger server # # RFC 1288 - Finger User Information Protocol # # (c)2007-2010 Matthias Eckert, Thomas Hungenberg # # Version 0.16 (2010-04-12) # # For history/changelog see bottom of this file. # ############################################################# package INetSim::Finger; use strict; use warnings; use base qw(INetSim::GenericServer); my @DATA; my $LASTREAD = 0; sub configure_hook { my $self = shift; $self->{server}->{host} = &INetSim::Config::getConfigParameter("Default_BindAddress"); # bind to address $self->{server}->{proto} = 'tcp'; # TCP protocol $self->{server}->{user} = &INetSim::Config::getConfigParameter("Default_RunAsUser"); # user to run as $self->{server}->{group} = &INetSim::Config::getConfigParameter("Default_RunAsGroup"); # group to run as $self->{server}->{setsid} = 0; # do not daemonize $self->{server}->{no_client_stdout} = 1; # do not attach client to STDOUT $self->{server}->{log_level} = 0; # do not log anything $self->{server}->{port} = &INetSim::Config::getConfigParameter("Finger_BindPort"); # bind to port # service name $self->{servicename} = &INetSim::Config::getConfigParameter("Finger_ServiceName"); # timeout $self->{timeout} = &INetSim::Config::getConfigParameter("Default_TimeOut"); # max childs $self->{maxchilds} = &INetSim::Config::getConfigParameter("Default_MaxChilds"); } sub pre_loop_hook { my $self = shift; $0 = 'inetsim_' . $self->{servicename}; &INetSim::Log::MainLog("started (PID $$)", $self->{servicename}); } sub pre_server_close_hook { my $self = shift; &INetSim::Log::MainLog("stopped (PID $$)", $self->{servicename}); } sub fatal_hook { my $self = shift; &INetSim::Log::MainLog("failed!", $self->{servicename}); exit 0; } sub process_request { my $self = shift; my $client = $self->{server}->{client}; my $rhost = $self->{server}->{peeraddr}; my $rport = $self->{server}->{peerport}; my $stat_success = 0; my $query; my @token; my $username; my $lasthop; my @dummy; if ($self->{server}->{numchilds} >= $self->{maxchilds}) { print $client "Maximum number of connections ($self->{maxchilds}) exceeded.\n"; &INetSim::Log::SubLog("[$rhost:$rport] Connection refused - maximum number of connections ($self->{maxchilds}) exceeded.", $self->{servicename}, $$); } else { eval { local $SIG{'ALRM'} = sub { die "TIMEOUT" }; alarm($self->{timeout}); &INetSim::Log::SubLog("[$rhost:$rport] connect", $self->{servicename}, $$); while ($query = <$client>){ alarm($self->{timeout}); if (defined ($query)) { $query =~ s/^[\r\n\s\t]+//g; $query =~ s/[\r\n\s\t]+$//g; # remove '/W' strings $query =~ s/\/W//g; &INetSim::Log::SubLog("[$rhost:$rport] recv: ".$query, $self->{servicename}, $$); &read_data_files(&INetSim::Config::getConfigParameter("Finger_DataDirName")); # restricted charset (my decision) if ($query && $query =~ /([^a-zA-Z0-9\-\_\@\.\s\t])/) { print $client "Your request contains illegal characters.\r\n"; &INetSim::Log::SubLog("[$rhost:$rport] send: Your request contains illegal characters.", $self->{servicename}, $$); last; } $query =~ s/[\t\s]+/\ /g; if ($query =~ /^$/) { foreach (@DATA) { if (/^\=\=\=/) { print $client "\r\n"; &INetSim::Log::SubLog("[$rhost:$rport] send: ", $self->{servicename}, $$); } else { print $client "$_\r\n"; &INetSim::Log::SubLog("[$rhost:$rport] send: $_", $self->{servicename}, $$); } } $stat_success = 1; last; } else { if ($query =~ /^.+$/) { @token = (); @token = split(/\@/, $query); if ($token[0]) { $username = $token[0]; $username =~ s/[\s]+//g; } if (@token >= 2) { $lasthop = pop(@token); $lasthop =~ s/[\s]+//g; } if ($username) { @dummy = (); @dummy = &search_name($username); if (@dummy) { if ($lasthop) { print $client "[$lasthop]\r\n"; &INetSim::Log::SubLog("[$rhost:$rport] send: [$lasthop]", $self->{servicename}, $$); } foreach (@dummy) { print $client "$_\r\n"; &INetSim::Log::SubLog("[$rhost:$rport] send: $_", $self->{servicename}, $$); } $stat_success = 1; last; } else { if ($lasthop) { print $client "[$lasthop]\r\n"; &INetSim::Log::SubLog("[$rhost:$rport] send: [$lasthop]", $self->{servicename}, $$); } print $client "finger: $username: no such user.\r\n"; &INetSim::Log::SubLog("[$rhost:$rport] send: finger: $username: no such user.", $self->{servicename}, $$); last; } } else { if ($lasthop) { print $client "[$lasthop]\r\n"; &INetSim::Log::SubLog("[$rhost:$rport] send: [$lasthop]", $self->{servicename}, $$); foreach (@DATA) { if (/^\=\=\=/) { print $client "\r\n"; &INetSim::Log::SubLog("[$rhost:$rport] send: ", $self->{servicename}, $$); } else { print $client "$_\r\n"; &INetSim::Log::SubLog("[$rhost:$rport] send: $_", $self->{servicename}, $$); } } $stat_success = 1; last; } else { print $client "finger: $query: no such user.\r\n"; &INetSim::Log::SubLog("[$rhost:$rport] send: finger: $query: no such user.", $self->{servicename}, $$); last; } } } last; } last; } else { print $client "finger: $query: no such user.\r\n"; &INetSim::Log::SubLog("[$rhost:$rport] send: finger: $query: no such user.", $self->{servicename}, $$); last; } last; } alarm(0); }; if ($@ =~ /TIMEOUT/) { &INetSim::Log::SubLog("[$rhost:$rport] disconnect (timeout)", $self->{servicename}, $$); } else { &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$); } } &INetSim::Log::SubLog("[$rhost:$rport] stat: $stat_success", $self->{servicename}, $$); } sub search_name { my $name = shift; my @tmp = (); my $match = 0; my $count = 0; foreach (@DATA) { if (/^\=\=\=/) { $match = 0; } if (m/^(Login.*?)(\s($name)\b)/i) { if ($count) { push (@tmp, ""); } push (@tmp, $_); $match = 1; $count++; next; } if ($match) { push (@tmp, $_); } } return (@tmp); } sub datetime { my $now = &INetSim::FakeTime::get_faketime(); my $delta = int(rand(3600) + 1); return (localtime ($now - $delta)); } sub tty { my %prefix = ( 0 => "tty", 1 => "pty", 2 => "pts/", 3 => "ttyp"); return ($prefix{int(rand(3))} . int(rand(6))); } sub shell { my %prefix = ( 0 => "/bin/sh", 1 => "/bin/bash", 2 => "/bin/zsh", 3 => "/bin/ksh"); return ($prefix{int(rand(3))}); } sub read_data_files { my $dir = shift; my @files; my @raw; my $content; my $time; my $tty; my $shell; my $now = &INetSim::FakeTime::get_faketime(); my $diff = $now - $LASTREAD; if ($diff > 60) { if (-d $dir) { chomp(@files=<$dir/*.finger>); if (@files) { foreach (@files) { next if (/^#/); if (open (FH, $_)) { chomp(@raw=); close FH; foreach (@raw) { next if (/^\#/); s/[\r\n]+$//g; if (/\{DATETIME\}/) { $time = &datetime; s/\{DATETIME\}/$time/g; } if (/\{TTY\}/) { $tty = &tty; s/\{TTY\}/$tty/g; } if (/\{SHELL\}/) { $shell = &shell; s/\{SHELL\}/$shell/g; } push (@DATA, $_); } } } } } if (! @DATA) { push (@DATA, "Login: devel Name: Developer"); push (@DATA, "Directory: /home/devel Shell: /bin/bash"); push (@DATA, "Never logged in."); push (@DATA, "No mail."); push (@DATA, "No Plan."); } } $LASTREAD = $now; } 1; ############################################################# # # History: # # Version 0.16 (2010-04-12) me # - do not filter non-printable characters because it's already # implemented in the log module # - some small changes # # Version 0.15 (2008-08-27) me # - added logging of process id # # Version 0.14 (2008-03-25) me # - added timeout after inactivity of n seconds, using new # config parameter Default_TimeOut # # Version 0.13 (2007-12-31) th # - change process name # # Version 0.12 (2007-12-07) me # - query charset restricted # - added a check for 'illegal' chars # - changed the regex in function 'search_name' # - removed unused variables # - removed some typos # # Version 0.11 (2007-11-09) me # - added functions 'datetime', 'tty' and 'shell' for dynamic content # generation # - changed function 'read_data_files' for work with variables in data files # - added an example data file entry with new variables DATETIME, TTY # and SHELL # # Version 0.1 (2007-11-07) me # - initial version with static content # ############################################################# inetsim-1.2.7/lib/INetSim/Time.pm0000644000175000017500000000070313173076432014675 0ustar rgyrgy# -*- perl -*- # # INetSim::Time - Base package for Time::TCP and Time::UDP # # (c)2007-2008 Thomas Hungenberg, Matthias Eckert # # Version 0.1 (2007-03-26) # ############################################################# # # History: # # Version 0.1 (2007-03-26) th # ############################################################# package INetSim::Time; use strict; use warnings; use base qw(INetSim::GenericServer); # no shared functions 1; # inetsim-1.2.7/lib/INetSim/Syslog.pm0000644000175000017500000001766013173076432015271 0ustar rgyrgy# -*- perl -*- # # INetSim::Syslog - A fake Syslog server # # RFC 3164 - The BSD syslog Protocol # # (c)2008-2010 Matthias Eckert, Thomas Hungenberg # # Version 0.3 (2010-04-12) # # For history/changelog see bottom of this file. # ############################################################# package INetSim::Syslog; use strict; use warnings; use base qw(INetSim::GenericServer); my %Facility = ( 0 => 'kernel', 1 => 'user', 2 => 'mail', 3 => 'system', 4 => 'security/authorization', 5 => 'syslog', 6 => 'printer', 7 => 'news', 8 => 'uucp', 9 => 'clock', 10 => 'security/authorization', 11 => 'ftp', 12 => 'ntp', 13 => 'log audit', 14 => 'log alert', 15 => 'clock', 16 => 'local0', 17 => 'local1', 18 => 'local2', 19 => 'local3', 20 => 'local4', 21 => 'local5', 22 => 'local6', 23 => 'local7' ); my %Severity = ( 0 => 'emergency', 1 => 'alert', 2 => 'critical', 3 => 'error', 4 => 'warning', 5 => 'notice', 6 => 'informational', 7 => 'debug' ); sub configure_hook { my $self = shift; my $server = $self->{server}; $server->{host} = &INetSim::Config::getConfigParameter("Default_BindAddress"); # bind to address $server->{port} = &INetSim::Config::getConfigParameter("Syslog_BindPort"); # bind to port $server->{proto} = 'udp'; # UDP protocol $server->{user} = &INetSim::Config::getConfigParameter("Default_RunAsUser"); # user to run as $server->{group} = &INetSim::Config::getConfigParameter("Default_RunAsGroup"); # group to run as $server->{setsid} = 0; # do not daemonize $server->{no_client_stdout} = 1; # do not attach client to STDOUT $server->{log_level} = 0; # do not log anything $server->{udp_recv_len} = 960; # default is 4096 } sub pre_loop_hook { $0 = 'inetsim_' . &INetSim::Config::getConfigParameter("Syslog_ServiceName"); &INetSim::Log::MainLog("started (PID $$)", &INetSim::Config::getConfigParameter("Syslog_ServiceName")); } sub pre_server_close_hook { &INetSim::Log::MainLog("stopped (PID $$)", &INetSim::Config::getConfigParameter("Syslog_ServiceName")); } sub fatal_hook { &INetSim::Log::MainLog("failed!", &INetSim::Config::getConfigParameter("Syslog_ServiceName")); exit 0; } sub process_request { my $self = shift; my $server = $self->{server}; my $client = $server->{client}; my $rhost = $server->{peeraddr}; my $rport = $server->{peerport}; my $serviceName = &INetSim::Config::getConfigParameter("Syslog_ServiceName"); my $maxchilds = &INetSim::Config::getConfigParameter("Default_MaxChilds"); my $trim_maxlength = &INetSim::Config::getConfigParameter("Syslog_TrimMaxLength"); my $accept_invalid = &INetSim::Config::getConfigParameter("Syslog_AcceptInvalid"); my $stat_success = 0; my $msg; my $priority; my $timestamp; my $content; my $facility; my $severity; my $length; my $valid = 0; my $relay = 0; my $hostname; my $header; my $message; if ($server->{numchilds} >= $maxchilds) { print $client "Maximum number of connections ($maxchilds) exceeded.\n"; &INetSim::Log::SubLog("[$rhost:$rport] Connection refused - maximum number of connections ($maxchilds) exceeded.", $serviceName, $$); } else { &INetSim::Log::SubLog("[$rhost:$rport] connect", $serviceName, $$); $msg = $server->{udp_data}; chomp($msg); $msg =~ s/^[\r\n\s\t]+//; $msg =~ s/[\r\n\s\t]+$//; if (! $msg) { &INetSim::Log::SubLog("[$rhost:$rport] recv: invalid syslog packet (empty)", $serviceName, $$); &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $serviceName, $$); return; } if ($trim_maxlength && length($msg) > 1024) { $msg = substr($msg, 0, 1024); &INetSim::Log::SubLog("[$rhost:$rport] info: Shortened syslog packet to maximum length of 1024 bytes", $serviceName, $$); } # check for valid priority and timestamp field if ($msg =~ /^\<([\d]{1,3})\>((Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)[\s]+[\d]{1,2}[\s]+\d\d:\d\d:\d\d)[\s]+(.*)$/) { if (defined ($1) && length($1) && defined ($2) && length($2) && defined ($4) && length($4)) { $priority = $1; $timestamp = $2; $content = $4; $length = int(length($priority) + 2 + length($timestamp) + 1 + length($content)); ($facility, $severity) = &dec_PRIORITY($priority); if (defined ($facility) && defined ($severity)) { if ($trim_maxlength && $length > 1024) { $content = substr($content, 0, int($length - ($length - 1024))); &INetSim::Log::SubLog("[$rhost:$rport] info: Shortened syslog packet to maximum length of 1024 bytes", $serviceName, $$); } $valid = 1; } } } elsif ($msg =~ /^\<([\d]{1,3})\>(.*)$/) { if (defined ($1) && length($1) && defined ($2) && length($2)) { $priority = $1; $timestamp = &_timestamp; $content = $2; $length = int(length($priority) + 2 + length($content)); ($facility, $severity) = &dec_PRIORITY($priority); if (defined ($facility) && defined ($severity)) { if ($trim_maxlength && $length > 1024) { $content = substr($content, 0, int($length - ($length - 1024))); &INetSim::Log::SubLog("[$rhost:$rport] info: Shortened syslog packet to maximum length of 1024 bytes", $serviceName, $$); } $valid = 1; } } } # build priority, timestamp and hostname for the packet if (! $valid && $accept_invalid) { $priority = 13; $timestamp = &_timestamp; $content = $msg; $length = int(length($priority) + 2 + length($timestamp) + 1 + length($content)); ($facility, $severity) = &dec_PRIORITY($priority); if (defined ($facility) && defined ($severity)) { if ($trim_maxlength && $length > 1024) { $content = substr($content, 0, int($length - ($length - 1024))); &INetSim::Log::SubLog("[$rhost:$rport] info: Shortened syslog packet to maximum length of 1024 bytes", $serviceName, $$); } $valid = 1; $relay = 1; } } # now log the "decoded" message if ($valid) { if ($accept_invalid && $relay) { &INetSim::Log::SubLog("[$rhost:$rport] recv: [Relayed] $facility.$severity $timestamp $content", $serviceName, $$); } else { &INetSim::Log::SubLog("[$rhost:$rport] recv: $facility.$severity $timestamp $content", $serviceName, $$); } $stat_success = 1; } else { &INetSim::Log::SubLog("[$rhost:$rport] recv: invalid syslog packet", $serviceName, $$); } &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $serviceName, $$); } if ($stat_success == 1) { &INetSim::Log::SubLog("[$rhost:$rport] stat: $stat_success facility=$facility severity=$severity", $serviceName, $$); } else { &INetSim::Log::SubLog("[$rhost:$rport] stat: $stat_success", $serviceName, $$); } } sub _timestamp { my @months = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/; my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(&INetSim::FakeTime::get_faketime()); $year += 1900; return (sprintf("%3s %2s %02d:%02d:%02d", $months[$mon], $mday, $hour, $min, $sec)); } sub dec_PRIORITY { my $pri = shift; my $fac; my $sev; if (defined ($pri) && length($pri) && $pri =~ /^[\d]{1,3}$/ && $pri >= 0 && $pri <= 191 && $pri ne "00" && $pri ne "000") { $fac = ($pri & 248) >> 3; $sev = $pri & 7; return ($Facility{$fac}, $Severity{$sev}); } return undef; } 1; ############################################################# # # History: # # Version 0.3 (2010-04-12) me # - do not filter non-printable characters because it's already # implemented in the log module # # Version 0.2 (2008-09-08) me # - changed syslog format because of messages without timestamp # # Version 0.1 (2008-09-08) me # - initial version # ############################################################# inetsim-1.2.7/lib/INetSim/CommandLine.pm0000644000175000017500000002040013173076432016161 0ustar rgyrgy# -*- perl -*- # # INetSim::CommandLine - INetSim command line parser # # (c)2007-2009 Thomas Hungenberg, Matthias Eckert # # Version 0.4 (2009-08-27) # # For history/changelog see bottom of this file. # ############################################################# package INetSim::CommandLine; use strict; use warnings; use Getopt::Long; my %CommandLineOptions = (); # compiled regular expressions for matching strings my $RE_signedInt = qr/^[-]{0,1}[\d]+$/; my $RE_unsignedInt = qr/^[\d]+$/; my $RE_printable = qr/^[\x20-\x7e]+$/; my $RE_validIP = qr/^(([01]?[0-9][0-9]?|2[0-4][0-9]|25[0-5])\.){3}([01]?[0-9][0-9]?|2[0-4][0-9]|25[0-5])$/; my $RE_validHostname = qr/^[a-zA-Z0-9]([-a-zA-Z0-9]*[a-zA-Z0-9]|)$/; my $RE_validDomainname = qr/^([a-zA-Z0-9]([-a-zA-Z0-9]*[a-zA-Z0-9]|)\.)*[a-zA-Z]+$/; my $RE_validFQDNHostname = qr/^([a-zA-Z0-9]([-a-zA-Z0-9]*[a-zA-Z0-9]|)\.)+[a-zA-Z]+$/; my $RE_validPathFilename = qr/^[a-zA-Z0-9\.\-\_\/]+$/; my $RE_validSession = qr/^[a-zA-Z0-9\.\-\_\/]+$/; sub parse_options { &Getopt::Long::Configure('pass_through', 'prefix_pattern=--'); my $result = GetOptions ( 'help' => \$CommandLineOptions{'help'}, 'version' => \$CommandLineOptions{'version'}, 'log-dir=s' => \$CommandLineOptions{'log_dir'}, 'data-dir=s' => \$CommandLineOptions{'data_dir'}, 'report-dir=s' => \$CommandLineOptions{'report_dir'}, 'config=s' => \$CommandLineOptions{'config'}, 'bind-address=s' => \$CommandLineOptions{'bind_address'}, 'max-childs=s' => \$CommandLineOptions{'max_childs'}, 'user=s' => \$CommandLineOptions{'user'}, 'faketime-init-delta=s' => \$CommandLineOptions{'faketime_initdelta'}, 'faketime-auto-delay=s' => \$CommandLineOptions{'faketime_autodelay'}, 'faketime-auto-incr=s' => \$CommandLineOptions{'faketime_autoincr'}, 'session=s' => \$CommandLineOptions{'session'}, 'pidfile=s' => \$CommandLineOptions{'pidfile'} ); if ($#ARGV > -1) { # unknown options foreach (@ARGV) { print STDOUT "Unknown command line option '$_'.\n"; } print STDOUT "See '$0 --help' for a list of available options.\n"; exit 1; } # check log-dir if (defined $CommandLineOptions{'log_dir'}) { if ($CommandLineOptions{'log_dir'} !~ $RE_validPathFilename) { &cmdline_error("'$CommandLineOptions{'log_dir'}' is not a valid filepath name", "log-dir"); } elsif (! -d $CommandLineOptions{'log_dir'}) { &cmdline_error("directory '$CommandLineOptions{'log_dir'}' does not exist", "log-dir"); } else { $CommandLineOptions{'log_dir'} =~ s/[\/]+$//; $CommandLineOptions{'log_dir'} .= "/"; } } # check data-dir if (defined $CommandLineOptions{'data_dir'}) { if ($CommandLineOptions{'data_dir'} !~ $RE_validPathFilename) { &cmdline_error("'$CommandLineOptions{'data_dir'}' is not a valid filepath name", "data-dir"); } elsif (! -d $CommandLineOptions{'data_dir'}) { &cmdline_error("directory '$CommandLineOptions{'data_dir'}' does not exist", "data-dir"); } else { $CommandLineOptions{'data_dir'} =~ s/[\/]+$//; $CommandLineOptions{'data_dir'} .= "/"; } } # check report-dir if (defined $CommandLineOptions{'report_dir'}) { if ($CommandLineOptions{'report_dir'} !~ $RE_validPathFilename) { &cmdline_error("'$CommandLineOptions{'report_dir'}' is not a valid filepath name", "report-dir"); } elsif (! -d $CommandLineOptions{'report_dir'}) { &cmdline_error("directory '$CommandLineOptions{'report_dir'}' does not exist", "report-dir"); } else { $CommandLineOptions{'report_dir'} =~ s/[\/]+$//; $CommandLineOptions{'report_dir'} .= "/"; } } # check config if ((defined $CommandLineOptions{'config'}) && ($CommandLineOptions{'config'} !~ $RE_validPathFilename)) { &cmdline_error("'$CommandLineOptions{'config'}' is not a valid filename", "config"); } # check bind-address if ((defined $CommandLineOptions{'bind_address'}) && ($CommandLineOptions{'bind_address'} !~ $RE_validIP)) { &cmdline_error("'$CommandLineOptions{'bind_address'}' is not a valid IP address", "bind-address"); } # check max-childs if (defined $CommandLineOptions{'max_childs'}) { if (($CommandLineOptions{'max_childs'} !~ $RE_signedInt) || ($CommandLineOptions{'max_childs'} < 1) || ($CommandLineOptions{'max_childs'} > 30)) { &cmdline_error("'$CommandLineOptions{'max_childs'}' is not an integer value of range [1..30]", "max_childs"); } } # check user if (defined $CommandLineOptions{'user'}) { if ($CommandLineOptions{'user'} !~ $RE_printable) { &cmdline_error("'$CommandLineOptions{'user'}' is not a valid username", "user"); } else { my $uid = getpwnam($CommandLineOptions{'user'}); if (! defined $uid) { # username does not exist &cmdline_error("User '$CommandLineOptions{'user'}' does not exist on this system", "user"); } } } # check faketime-init-delta if (defined $CommandLineOptions{'faketime_initdelta'}) { if ($CommandLineOptions{'faketime_initdelta'} !~ $RE_signedInt) { &cmdline_error("'$CommandLineOptions{'faketime_initdelta'}' is not numeric", "faketime-init-delta"); } else { # check if fake time is valid my $cur_secs = time(); my $faketimemax = 2147483647; if (($cur_secs + $CommandLineOptions{'faketime_initdelta'}) > $faketimemax) { &cmdline_error("Fake time exceeds maximum system time", "faketime-init-delta"); } elsif (($cur_secs + $CommandLineOptions{'faketime_initdelta'}) < 0 ) { &cmdline_error("Fake time init delta too small", "faketime-init-delta"); } } } # check faketime-auto-delay if (defined $CommandLineOptions{'faketime_autodelay'}) { if (($CommandLineOptions{'faketime_autodelay'} !~ $RE_signedInt) || ($CommandLineOptions{'faketime_autodelay'} < 0) || ($CommandLineOptions{'faketime_autodelay'} > 86400)) { &cmdline_error("'$CommandLineOptions{'faketime_autodelay'}' is not an integer value of range [0..86400]", "faketime-auto-delay"); } } # check faketime-auto-incr if (defined $CommandLineOptions{'faketime_autoincr'}) { if (($CommandLineOptions{'faketime_autoincr'} !~ $RE_signedInt) || ($CommandLineOptions{'faketime_autoincr'} < -31536000) || ($CommandLineOptions{'faketime_autoincr'} > 31536000)) { &cmdline_error("'$CommandLineOptions{'faketime_autoincr'}' is not an integer value of range [-31536000..31536000]", "faketime-auto-incr"); } } # check session if ((defined $CommandLineOptions{'session'}) && ($CommandLineOptions{'session'} !~ $RE_validSession)) { &cmdline_error("'$CommandLineOptions{'session'}' is not a valid session identifier", "session"); } # check pid file if ((defined $CommandLineOptions{'pidfile'}) && ($CommandLineOptions{'pidfile'} !~ $RE_validPathFilename)) { &cmdline_error("'$CommandLineOptions{'pidfile'}' is not a valid pid filename", "pidfile"); } # set default pid file if unset if ((! defined $CommandLineOptions{'pidfile'}) || (! $CommandLineOptions{'pidfile'})) { $CommandLineOptions{'pidfile'} = "/var/run/inetsim.pid"; } } sub cmdline_warn { my $msg = shift; my $opt = shift; &INetSim::Log::MainLog("Warning: " . $msg . " at option '$opt'."); } sub cmdline_error { my $msg = shift; my $opt = shift; print STDOUT "Error in command line option '$opt': $msg!\n"; exit 1; } sub getCommandLineOption { my $key = shift; if (! defined $key) { # programming error -> exit &INetSim::error_exit("getCommandLineOption() called without parameter."); } elsif (exists $CommandLineOptions{$key}) { return $CommandLineOptions{$key}; } else { # programming error -> exit &INetSim::error_exit("No such command line option '$key'."); } } 1; ############################################################# # # History: # # Version 0.4 (2009-08-27) me # - added commandline option 'version' # # Version 0.3 (2008-02-17) me # - added commandline option 'pidfile' # # Version 0.2 (2007-04-30) th # - mostly rewrote parser checks # - check for unknown commandline options # # Version 0.1 (2007-04-29) th # - moved command line parser from Config.pm to this module # - added function getCommandLineOption() # ############################################################# inetsim-1.2.7/lib/INetSim/Discard/0000755000175000017500000000000013173076432015012 5ustar rgyrgyinetsim-1.2.7/lib/INetSim/Discard/TCP.pm0000644000175000017500000001100113173076432015767 0ustar rgyrgy# -*- perl -*- # # INetSim::Discard::TCP - A fake TCP discard server # # RFC 863 - Discard Protocol # # (c)2007-2010 Matthias Eckert, Thomas Hungenberg # # Version 0.29 (2010-04-12) # # For history/changelog see bottom of this file. # ############################################################# package INetSim::Discard::TCP; use strict; use warnings; use base qw(INetSim::Discard); sub configure_hook { my $self = shift; $self->{server}->{host} = &INetSim::Config::getConfigParameter("Default_BindAddress"); # bind to address $self->{server}->{port} = &INetSim::Config::getConfigParameter("Discard_TCP_BindPort"); # bind to port $self->{server}->{proto} = 'tcp'; # TCP protocol $self->{server}->{user} = &INetSim::Config::getConfigParameter("Default_RunAsUser"); # user to run as $self->{server}->{group} = &INetSim::Config::getConfigParameter("Default_RunAsGroup"); # group to run as $self->{server}->{setsid} = 0; # do not daemonize $self->{server}->{no_client_stdout} = 1; # do not attach client to STDOUT $self->{server}->{log_level} = 0; # do not log anything $self->{servicename} = &INetSim::Config::getConfigParameter("Discard_TCP_ServiceName"); $self->{max_childs} = &INetSim::Config::getConfigParameter("Default_MaxChilds"); $self->{timeout} = &INetSim::Config::getConfigParameter("Default_TimeOut"); } sub pre_loop_hook { my $self = shift; $0 = "inetsim_$self->{servicename}"; &INetSim::Log::MainLog("started (PID $$)", $self->{servicename}); } sub pre_server_close_hook { my $self = shift; &INetSim::Log::MainLog("stopped (PID $$)", $self->{servicename}); } sub fatal_hook { my $self = shift; &INetSim::Log::MainLog("failed!", $self->{servicename}); exit 0; } sub process_request { my $self = shift; my $client = $self->{server}->{client}; my $rhost = $self->{server}->{peeraddr}; my $rport = $self->{server}->{peerport}; my $stat_success = 0; &INetSim::Log::SubLog("[$rhost:$rport] connect", $self->{servicename}, $$); if ($self->{server}->{numchilds} >= $self->{max_childs}) { print $client "Maximum number of connections ($self->{max_childs}) exceeded.\n"; &INetSim::Log::SubLog("[$rhost:$rport] Connection refused - maximum number of connections ($self->{max_childs}) exceeded.", $self->{servicename}, $$); } else { eval { local $SIG{'ALRM'} = sub { die "TIMEOUT" }; alarm($self->{timeout}); while (my $line = <$client>) { (defined $line) or next; $line =~ s/^[\r\n]+//g; $line =~ s/[\r\n]+$//g; if ($line ne "") { &INetSim::Log::SubLog("[$rhost:$rport] recv: $line", $self->{servicename}, $$); $stat_success = 1; } alarm($self->{timeout}); } alarm(0); }; } if ($@ =~ /TIMEOUT/) { &INetSim::Log::SubLog("[$rhost:$rport] disconnect (timeout)", $self->{servicename}, $$); } else { &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$); } &INetSim::Log::SubLog("[$rhost:$rport] stat: $stat_success", $self->{servicename}, $$); } 1; ############################################################# # # History: # # Version 0.29 (2010-04-12) me # - undo changes from version 0.24 because it's already implemented # in the log module # # Version 0.28 (2009-10-28) me # - improved some code parts # # Version 0.27 (2008-08-27) me # - added logging of process id # # Version 0.26 (2008-03-19) me # - added timeout after inactivity of n seconds, using new # config parameter Default_TimeOut # # Version 0.25 (2007-12-31) th # - change process name # # Version 0.24 (2007-05-08) th # - replace non-printable characters with "." before logging # # Version 0.23 (2007-04-26) th # - use getConfigParameter # # Version 0.22 (2007-04-21) me # - added logging of status for use with &INetSim::Report::GenReport() # # Version 0.21 (2007-04-05) th # - changed check for MaxChilds, BindAddress, RunAsUser and # RunAsGroup # # Version 0.2 (2007-03-26) th # - split TCP and UDP servers to separate modules # - rewrote module to use INetSim::GenericServer # - added logging of refused connections # # Version 0.1 (2007-03-18) me # ############################################################# inetsim-1.2.7/lib/INetSim/Discard/UDP.pm0000644000175000017500000000775313173076432016014 0ustar rgyrgy# -*- perl -*- # # INetSim::Discard::UDP - A fake UDP discard server # # RFC 863 - Discard Protocol # # (c)2007-2010 Matthias Eckert, Thomas Hungenberg # # Version 0.28 (2010-04-12) # # For history/changelog see bottom of this file. # ############################################################# package INetSim::Discard::UDP; use strict; use warnings; use base qw(INetSim::Discard); sub configure_hook { my $self = shift; $self->{server}->{host} = &INetSim::Config::getConfigParameter("Default_BindAddress"); # bind to address $self->{server}->{port} = &INetSim::Config::getConfigParameter("Discard_UDP_BindPort"); # bind to port $self->{server}->{proto} = 'udp'; # UDP protocol $self->{server}->{user} = &INetSim::Config::getConfigParameter("Default_RunAsUser"); # user to run as $self->{server}->{group} = &INetSim::Config::getConfigParameter("Default_RunAsGroup"); # group to run as $self->{server}->{setsid} = 0; # do not daemonize $self->{server}->{no_client_stdout} = 1; # do not attach client to STDOUT $self->{server}->{log_level} = 0; # do not log anything # $self->{server}->{udp_recv_len} = 1024; # default is 4096 $self->{servicename} = &INetSim::Config::getConfigParameter("Discard_UDP_ServiceName"); $self->{max_childs} = &INetSim::Config::getConfigParameter("Default_MaxChilds"); } sub pre_loop_hook { my $self = shift; $0 = "inetsim_$self->{servicename}"; &INetSim::Log::MainLog("started (PID $$)", $self->{servicename}); } sub pre_server_close_hook { my $self = shift; &INetSim::Log::MainLog("stopped (PID $$)", $self->{servicename}); } sub fatal_hook { my $self = shift; &INetSim::Log::MainLog("failed!", $self->{servicename}); exit 0; } sub process_request { my $self = shift; my $client = $self->{server}->{client}; my $rhost = $self->{server}->{peeraddr}; my $rport = $self->{server}->{peerport}; my $stat_success = 0; &INetSim::Log::SubLog("[$rhost:$rport] connect", $self->{servicename}, $$); if ($self->{server}->{numchilds} >= $self->{max_childs}) { print $client "Maximum number of connections ($self->{max_childs}) exceeded.\n"; &INetSim::Log::SubLog("[$rhost:$rport] Connection refused - maximum number of connections ($self->{max_childs}) exceeded.", $self->{servicename}, $$); } else { my $recvmsg = $self->{server}->{udp_data}; $recvmsg =~ s/^[\r\n]+//g; $recvmsg =~ s/[\r\n]+$//g; if ($recvmsg ne "") { &INetSim::Log::SubLog("[$rhost:$rport] recv: " . $recvmsg, $self->{servicename}, $$); $stat_success = 1; } } &INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$); &INetSim::Log::SubLog("[$rhost:$rport] stat: $stat_success", $self->{servicename}, $$); } 1; ############################################################# # # History: # # Version 0.28 (2010-04-12) me # - undo changes from version 0.24 because it's already implemented # in the log module # # Version 0.27 (2009-10-28) me # - improved some code parts # # Version 0.26 (2008-08-27) me # - added logging of process id # # Version 0.25 (2007-12-31) th # - change process name # # Version 0.24 (2007-05-08) th # - replace non-printable characters with "." before logging # # Version 0.23 (2007-04-26) th # - use getConfigParameter # # Version 0.22 (2007-04-21) me # - added logging of status for use with &INetSim::Report::GenReport() # # Version 0.21 (2007-04-05) th # - changed check for MaxChilds, BindAddress, RunAsUser and # RunAsGroup # # Version 0.2 (2007-03-26) th # - split TCP and UDP servers to separate modules # - rewrote module to use INetSim::GenericServer # - added logging of refused connections # # Version 0.1 (2007-03-18) me # ############################################################# inetsim-1.2.7/lib/INetSim/SMTP.pm0000644000175000017500000024752113173076432014575 0ustar rgyrgy# -*- perl -*- # # INetSim::SMTP - A fake SMTP server # # RFC 821/2821 - SIMPLE MAIL TRANSFER PROTOCOL (SMTP) # # (c)2007-2014 Matthias Eckert, Thomas Hungenberg # # Version 0.90 (2014-05-23) # # For history/changelog see bottom of this file. # ############################################################# package INetSim::SMTP; use strict; use warnings; use base qw(INetSim::GenericServer); use MIME::Base64; use Digest::SHA; my $SSL = 0; eval { require IO::Socket::SSL; }; if (! $@) { $SSL = 1; }; # http://www.iana.org/assignments/mail-parameters my %EXT_AVAIL = ( "HELP" => 1, # RFC 821, 2821 "SEND" => 1, # RFC 821, 2821 "SAML" => 1, # RFC 821, 2821 "SOML" => 1, # RFC 821, 2821 "VRFY" => 1, # RFC 821, 2821 "EXPN" => 1, # RFC 821, 2821 "TURN" => 1, # RFC 821, 2821 "DSN" => 1, # RFC 3461 "ETRN" => 1, # RFC 1985 "VERP" => 1, # http://tools.ietf.org/html/draft-varshavchik-verp-smtpext-00 "MTRK" => 1, # RFC 3885 "SIZE" => 2, # RFC 1870 "AUTH" => 2, # RFC 4954 "8BITMIME" => 1, # RFC 1652 "DELIVERBY" => 2, # RFC 2852 "SUBMITTER" => 1, # RFC 4405 "NO-SOLICITING" => 2, # RFC 3865 "FUTURERELEASE" => 2, # RFC 4865 "ENHANCEDSTATUSCODES" => 1, # RFC 2034 "ATRN" => 1, # RFC 2645 "VERB" => 0, # no RFC available (sendmail specific ?) "ONEX" => 0, # no RFC available (sendmail specific ?) "CHUNKING" => 1, # RFC 3030 "BINARYMIME" => 1, # RFC 3030 "CHECKPOINT" => 1, # RFC 1845 "PIPELINING" => 0, # RFC 2920 "STARTTLS" => 1, # RFC 3207 (2487) "UTF8SMTP" => 0 # RFC 5336 ); # status: 24 of 28 :-) my %MAIL_AVAIL = ( "DSN" => "RET,ENVID", "VERP" => "VERP", "MTRK" => "MTRK,ENVID", "SIZE" => "SIZE", "8BITMIME" => "BODY", "DELIVERBY" => "BY", "SUBMITTER" => "SUBMITTER", "NO-SOLICITING" => "SOLICIT", "FUTURERELEASE" => "HOLDFOR,HOLDUNTIL", "BINARYMIME" => "BODY", "CHECKPOINT" => "TRANSID", "UTF8SMTP" => "ALT-ADDRESS", "AUTH" => "AUTH" ); my %RCPT_AVAIL = ( "DSN" => "NOTIFY,ORCPT", "MTRK" => "ORCPT", "UTF8SMTP" => "ALT-ADDRESS" ); my %VRFY_AVAIL = ( "UTF8SMTP" => "UTF8REPLY" ); my %EXPN_AVAIL = ( "UTF8SMTP" => "UTF8REPLY" ); my %SMTP_EXT = (); my @RECIPIENTS = (); my %MAIL_PARAM = (); my %RCPT_PARAM = (); my %VRFY_PARAM = (); my %EXPN_PARAM = (); my %status; sub configure_hook { my $self = shift; $self->{server}->{host} = &INetSim::Config::getConfigParameter("Default_BindAddress"); # bind to address $self->{server}->{proto} = 'tcp'; # TCP protocol $self->{server}->{user} = &INetSim::Config::getConfigParameter("Default_RunAsUser"); # user to run as $self->{server}->{group} = &INetSim::Config::getConfigParameter("Default_RunAsGroup"); # group to run as $self->{server}->{setsid} = 0; # do not daemonize $self->{server}->{no_client_stdout} = 1; # do not attach client to STDOUT $self->{server}->{log_level} = 0; # do not log anything # cert directory $self->{cert_dir} = &INetSim::Config::getConfigParameter("CertDir"); if (defined $self->{server}->{'SSL'} && $self->{server}->{'SSL'}) { $self->{servicename} = &INetSim::Config::getConfigParameter("SMTPS_ServiceName"); if (! $SSL) { &INetSim::Log::MainLog("failed! Library IO::Socket::SSL not installed", $self->{servicename}); exit 1; } $self->{ssl_key} = $self->{cert_dir} . (defined &INetSim::Config::getConfigParameter("SMTPS_KeyFileName") ? &INetSim::Config::getConfigParameter("SMTPS_KeyFileName") : &INetSim::Config::getConfigParameter("Default_KeyFileName")); $self->{ssl_crt} = $self->{cert_dir} . (defined &INetSim::Config::getConfigParameter("SMTPS_CrtFileName") ? &INetSim::Config::getConfigParameter("SMTPS_CrtFileName") : &INetSim::Config::getConfigParameter("Default_CrtFileName")); $self->{ssl_dh} = (defined &INetSim::Config::getConfigParameter("SMTPS_DHFileName") ? &INetSim::Config::getConfigParameter("SMTPS_DHFileName") : &INetSim::Config::getConfigParameter("Default_DHFileName")); if (! -f $self->{ssl_key} || ! -r $self->{ssl_key} || ! -f $self->{ssl_crt} || ! -r $self->{ssl_crt} || ! -s $self->{ssl_key} || ! -s $self->{ssl_crt}) { &INetSim::Log::MainLog("failed! Unable to read SSL certificate files", $self->{servicename}); exit 1; } $self->{ssl_enabled} = 1; $self->{server}->{port} = &INetSim::Config::getConfigParameter("SMTPS_BindPort"); # bind to port # ESMTP $self->{ESMTP} = &INetSim::Config::getConfigParameter("SMTPS_Extended_SMTP"); # reversible authentication mechanisms only $self->{auth_reversible_only} = &INetSim::Config::getConfigParameter("SMTPS_AuthReversibleOnly"); # force authentication $self->{auth_required} = &INetSim::Config::getConfigParameter("SMTPS_AuthRequired"); # mbox file $self->{mboxFile} = &INetSim::Config::getConfigParameter("SMTPS_MBOXFileName"); $self->{mboxFile} =~ /^(.*)\z/; # evil untaint! $self->{mboxFile} = $1; # smtp banner $self->{banner} = &INetSim::Config::getConfigParameter("SMTPS_Banner"); # fqdn hostname $self->{fqdn_hostname} = &INetSim::Config::getConfigParameter("SMTPS_FQDN_Hostname"); # helo/ehlo required $self->{helo_required} = &INetSim::Config::getConfigParameter("SMTPS_HELO_required"); } else { $self->{servicename} = &INetSim::Config::getConfigParameter("SMTP_ServiceName"); $self->{ssl_key} = $self->{cert_dir} . (defined &INetSim::Config::getConfigParameter("SMTP_KeyFileName") ? &INetSim::Config::getConfigParameter("SMTP_KeyFileName") : &INetSim::Config::getConfigParameter("Default_KeyFileName")); $self->{ssl_crt} = $self->{cert_dir} . (defined &INetSim::Config::getConfigParameter("SMTP_CrtFileName") ? &INetSim::Config::getConfigParameter("SMTP_CrtFileName") : &INetSim::Config::getConfigParameter("Default_CrtFileName")); $self->{ssl_dh} = (defined &INetSim::Config::getConfigParameter("SMTP_DHFileName") ? &INetSim::Config::getConfigParameter("SMTP_DHFileName") : &INetSim::Config::getConfigParameter("Default_DHFileName")); $self->{ssl_enabled} = 0; $self->{server}->{port} = &INetSim::Config::getConfigParameter("SMTP_BindPort"); # bind to port # ESMTP $self->{ESMTP} = &INetSim::Config::getConfigParameter("SMTP_Extended_SMTP"); # reversible authentication mechanisms only $self->{auth_reversible_only} = &INetSim::Config::getConfigParameter("SMTP_AuthReversibleOnly"); # force authentication $self->{auth_required} = &INetSim::Config::getConfigParameter("SMTP_AuthRequired"); # mbox file $self->{mboxFile} = &INetSim::Config::getConfigParameter("SMTP_MBOXFileName"); $self->{mboxFile} =~ /^(.*)\z/; # evil untaint! $self->{mboxFile} = $1; # smtp banner $self->{banner} = &INetSim::Config::getConfigParameter("SMTP_Banner"); # fqdn hostname $self->{fqdn_hostname} = &INetSim::Config::getConfigParameter("SMTP_FQDN_Hostname"); # helo/ehlo required $self->{helo_required} = &INetSim::Config::getConfigParameter("SMTP_HELO_required"); } # warn about missing dh file and disable if (defined $self->{ssl_dh} && $self->{ssl_dh}) { $self->{ssl_dh} = $self->{cert_dir} . $self->{ssl_dh}; if (! -f $self->{ssl_dh} || ! -r $self->{ssl_dh}) { &INetSim::Log::MainLog("Warning: Unable to read Diffie-Hellman parameter file '$self->{ssl_dh}'", $self->{servicename}); $self->{ssl_dh} = undef; } } my ($dev, $inode, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks, $grpname) = undef; # timeout $self->{timeout} = &INetSim::Config::getConfigParameter("Default_TimeOut"); # max childs $self->{maxchilds} = &INetSim::Config::getConfigParameter("Default_MaxChilds"); if (! open (DAT, ">> $self->{mboxFile}")) { &INetSim::Log::MainLog("Warning: Unable to open SMTP mbox file '$self->{mboxFile}': $!", $self->{servicename}); } else { close DAT; chmod 0660, $self->{mboxFile}; $gid = getgrnam("inetsim"); if (! defined $gid) { &INetSim::Log::MainLog("Warning: Unable to get GID for group 'inetsim'", $self->{servicename}); } chown -1, $gid, $self->{mboxFile}; ($dev, $inode, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat $self->{mboxFile}; $grpname = getgrgid $gid; # check for group owner 'inetsim' if ($grpname ne "inetsim") { &INetSim::Log::MainLog("Warning: Group owner of SMTP mbox file '$self->{mboxFile}' is not 'inetsim' but '$grpname'", $self->{servicename}); } # check for group r/w permissions if ((($mode & 0060) >> 3) != 6) { &INetSim::Log::MainLog("Warning: No group r/w permissions on SMTP mbox file '$self->{mboxFile}'", $self->{servicename}); } } # register configured (and available) service extensions and guess the mail transmission type $self->register_extensions; # just a gimmick: simple replacing the word xSMTPx in the banner string with the mail transmission type ;-) if ($self->{banner} =~ /^(|.*\s)xSMTPx(|\s.*)\z/) { $self->{banner} =~ s/xSMTPx/$self->{mailTransmissionType}/; } } sub pre_loop_hook { my $self = shift; $0 = 'inetsim_' . $self->{servicename}; &INetSim::Log::MainLog("started (PID $$)", $self->{servicename}); } sub pre_server_close_hook { my $self = shift; &INetSim::Log::MainLog("stopped (PID $$)", $self->{servicename}); } sub fatal_hook { my $self = shift; &INetSim::Log::MainLog("failed!", $self->{servicename}); exit 1; } sub process_request { my $self = shift; my $client = $self->{server}->{client}; # status, counters ... $status{success} = 0; $status{auth_type} = ""; $status{credentials} = ""; $status{count_mails} = 0; $status{count_bytes} = 0; $status{count_recipients} = 0; $status{tls_used} = 0; $status{tls_cipher} = ""; # flags $self->{EHLO} = 0; $self->{auth_given} = 0; $self->{helo_given} = 0; $self->{sender_given} = 0; $self->{recipient_given} = 0; $self->{transaction} = 0; $self->{bdat_last} = 0; $self->{bdat_incomplete} = 0; $self->{using_tls} = 0; # other @RECIPIENTS = (); $self->{envelope_sender} = undef; $self->{envelope_recipient} = undef; $self->{transaction_type} = ""; $self->{body_mime} = ""; $self->{bdat_content} = ""; $self->{size} = 0; $self->{transid} = ""; if ($self->{ssl_enabled} && ! $self->upgrade_to_ssl()) { $self->slog_("connect"); $self->slog_("info: Error setting up SSL: $self->{last_ssl_error}"); $self->slog_("disconnect"); } elsif ($self->{server}->{numchilds} >= $self->{maxchilds}) { $self->slog_("connect"); $self->send_(421, "Maximum number of connections ($self->{maxchilds}) exceeded.", "4.3.2"); $self->slog_("disconnect"); } else { my $line = ""; eval { local $SIG{'ALRM'} = sub { die "TIMEOUT" }; alarm($self->{timeout}); $self->slog_("connect"); ### Server Greeting $self->send_(220, "$self->{fqdn_hostname} $self->{banner}"); # wait for command while ($line = <$client>) { chomp($line); $line =~ s/\r$//g; $line =~ s/[\r\n]+//g; $line =~ s/[\t]/\ /g; alarm($self->{timeout}); $self->slog_("recv: $line"); ### HELO if ($line =~ /^HELO(|([\s]+)(.*))$/i) { $self->HELO($3); } ### EHLO elsif ($self->{ESMTP} && $line =~ /^EHLO(|([\s]+)(.*))$/i) { $self->EHLO($3); } ### MAIL or SEND or SOML or SAML elsif ($line =~ /^(MAIL|SEND|SOML|SAML)(|([\s]+)(.*))$/i) { $self->MAIL(uc($1), $4); } ### RCPT elsif ($line =~ /^RCPT(|([\s]+)(.*))$/i) { $self->RCPT($3); } ### DATA elsif ($line =~ /^DATA(|([\s]+)(.*))$/i) { $self->DATA($3); } ### RSET elsif ($line =~ /^RSET(|([\s]+)(.*))$/i) { $self->RSET($3); } ### NOOP elsif ($line =~ /^NOOP(|([\s]+)(.*))$/i) { $self->NOOP($3); } ### QUIT elsif ($line =~ /^QUIT(|([\s]+)(.*))$/i) { $self->QUIT($3); } ### VRFY elsif ($line =~ /^VRFY(|([\s]+)(.*))$/i) { $self->VRFY($3); } ### EXPN elsif (defined $SMTP_EXT{EXPN} && $line =~ /^EXPN(|([\s]+)(.*))$/i) { $self->EXPN($3); } ### HELP elsif (defined $SMTP_EXT{HELP} && $line =~ /^HELP(|([\s]+)(.*))$/i) { $self->HELP($3); } ### TURN elsif (defined $SMTP_EXT{TURN} && $line =~ /^TURN(|([\s]+)(.*))$/i) { $self->TURN("TURN", $3); } ### ATRN elsif ($self->{ESMTP} && defined $SMTP_EXT{ATRN} && $line =~ /^ATRN(|([\s]+)(.*))$/i) { $self->TURN("ATRN", $3); } ### ETRN elsif ($self->{ESMTP} && defined $SMTP_EXT{ETRN} && $line =~ /^ETRN(|([\s]+)(.*))$/i) { $self->ETRN($3); } ### AUTH elsif ($self->{ESMTP} && defined $SMTP_EXT{AUTH} && $line =~ /^AUTH(|([\s]+)(.*))$/i) { $self->AUTH($3); } ### BDAT elsif ($self->{ESMTP} && defined $SMTP_EXT{CHUNKING} && $line =~ /^BDAT(|([\s]+)(.*))$/i) { $self->BDAT($3); } ### STARTTLS elsif ($self->{ESMTP} && defined $SMTP_EXT{STARTTLS} && $line =~ /^STARTTLS(|([\s]+)(.*))$/i) { $self->STARTTLS($3); } ### unknown else { $self->send_(500, "Error: unknown command", "5.5.1"); } last if ($self->{close_connection}); alarm($self->{timeout}); } }; alarm(0); if ($@ =~ /TIMEOUT/) { $self->send_(421, "Error: timeout exceeded", "4.4.2"); $self->slog_("disconnect (timeout)"); } else { if (defined ($self->{timed_out}) && $self->{timed_out}) { # only needed for turn/atrn $self->slog_("disconnect (timeout)"); } else { $self->slog_("disconnect"); } } # connection lost ? write incomplete, checkpointed message if ($self->{transid} && $self->{data_incomplete} && $self->{data_content}) { $self->write_message($self->{data_content}); } } if ($status{success} == 1) { $status{count_recipients} = @RECIPIENTS; # sum of all recipients ! $self->slog_("stat: $status{success} mails=$status{count_mails} recips=$status{count_recipients} auth=$status{auth_type} creds=$status{credentials} bytes=$status{count_bytes} tls=$status{tls_used} cipher=$status{tls_cipher}"); } else { $self->slog_("stat: $status{success}"); } } sub slog_ { my ($self, $msg) = @_; my $rhost = $self->{server}->{peeraddr}; my $rport = $self->{server}->{peerport}; if (defined ($msg)) { $msg =~ s/[\r\n]*//; &INetSim::Log::SubLog("[$rhost:$rport] $msg", $self->{servicename}, $$); } } sub send_ { my ($self, $code, $msg, $ecode) = @_; my $client = $self->{server}->{client}; if (defined ($code) && $code ne "" && defined ($msg) && $msg ne "") { alarm($self->{timeout}); $msg =~ s/[\r\n]*//; # workaround for non-multiline replies if ($code =~ /\d$/) { $code .= " "; } if ($self->{ESMTP} && defined ($SMTP_EXT{ENHANCEDSTATUSCODES}) && defined ($ecode) && $ecode ne "" && $ecode =~ /^(2|4|5)/ && substr($code, 0, 1) eq substr($ecode, 0, 1)) { print $client "$code$ecode $msg\r\n"; $self->slog_("send: $code$ecode $msg"); } elsif ($code =~ /^000/) { print $client "$msg\r\n"; $self->slog_("send: $msg"); } else { print $client "$code$msg\r\n"; $self->slog_("send: $code$msg"); } alarm($self->{timeout}); } } sub recv_ { my $self = shift; my $client = $self->{server}->{client}; my $line; alarm($self->{timeout}); $line = <$client>; alarm($self->{timeout}); if (! defined ($line)) { $line = ""; } chomp($line); $line =~ s/\r$//g; $line =~ s/[\r\n]+//g; $self->slog_("recv: $line"); return $line; } sub HELO { my ($self, $args) = @_; if (! defined $args || ! $args || $args =~ /^[\s\t]+\z/) { $self->syntax("HELO"); return; } # (re)set variables $self->{EHLO} = 0; $self->{helo_given} = 1; $self->{sender_given} = 0; $self->{recipient_given} = 0; $self->{envelope_sender} = undef; $self->{envelope_recipient} = undef; $self->{transaction} = 0; $self->{transaction_type} = ""; $self->{bdat_last} = 0; $self->{bdat_content} = ""; $self->{bdat_incomplete} = 0; $self->{body_mime} = ""; # output $self->send_(250, $self->{fqdn_hostname}); } sub EHLO { my ($self, $args) = @_; my @out = (); my $last; if (! defined $args || ! $args || $args =~ /^[\s\t]+\z/) { $self->syntax("EHLO"); return; } # (re)set variables $self->{EHLO} = 1; $self->{helo_given} = 1; $self->{sender_given} = 0; $self->{recipient_given} = 0; $self->{envelope_sender} = undef; $self->{envelope_recipient} = undef; $self->{transaction} = 0; $self->{transaction_type} = ""; $self->{bdat_last} = 0; $self->{bdat_content} = ""; $self->{bdat_incomplete} = 0; $self->{body_mime} = ""; # do multiline output push (@out, $self->{fqdn_hostname}); foreach (keys %SMTP_EXT) { if ($SMTP_EXT{$_} ne "") { push (@out, "$_ $SMTP_EXT{$_}"); } else { push (@out, "$_"); } } $last = pop(@out); foreach (@out) { $self->send_("250-", "$_"); } $self->send_(250, $last); } sub MAIL { my ($self, $cmd, $args) = @_; if ($cmd ne "MAIL" && ! defined $SMTP_EXT{$cmd}) { $self->send_(500, "Error: unknown command", "5.5.1"); return; } return if $self->helo_required; return if $self->auth_required; if (! defined $args || ! $args || $args =~ /^[\s\t]+\z/ || $args !~ /^FROM:/i) { $self->syntax($cmd); return; } $args =~ s/^FROM:([\s\t]+)?//i; my $sender = $self->get_parameters("MAIL", $args); # address invalid -> syntax error if (! defined $sender) { $self->syntax($cmd); return; } # unknown option/parameter if ($self->{invalid_keyword}) { $self->send_(555, "Error: Unsupported option", "5.5.4"); return; } # look for body parameter if (defined ($MAIL_PARAM{BODY}) && $MAIL_PARAM{BODY} =~ /^BINARYMIME/i) { $self->{body_mime} = "binary"; } elsif (defined ($MAIL_PARAM{BODY}) && $MAIL_PARAM{BODY} =~ /^7BIT/i) { $self->{body_mime} = "7bit"; } elsif (defined ($MAIL_PARAM{BODY}) && $MAIL_PARAM{BODY} =~ /^8BITMIME/i) { $self->{body_mime} = "8bit"; } else { $self->{body_mime} = ""; } # look for transaction id parameter if (defined ($MAIL_PARAM{TRANSID}) && $MAIL_PARAM{TRANSID} ne "") { $self->{transid} = $MAIL_PARAM{TRANSID}; } else { $self->{transid} = ""; } # look for size parameter if (defined ($MAIL_PARAM{SIZE}) && $MAIL_PARAM{SIZE} =~ /^([\d]+)/) { $self->{size} = $1; } else { $self->{size} = 0; } if ($sender =~ /^\<([\s]+)?\>$/) { # substitue '<>' with 'MAILER-DAEMON' $sender = "MAILER-DAEMON"; } else { # remove '<' and '>' $sender =~ s/\<(.*)\>/$1/g; } if (defined $self->{size} && $self->{size} && $self->{size} > $self->{max_message_size}) { $self->send_(552, "Error: Message exceeds maximum size", "5.2.3"); return; } if ($self->{transaction_type} eq "bdat") { $self->send_(503, "Error: bad sequence of commands", "5.5.1"); return; } if (! defined $sender || $sender eq "") { $self->syntax("MAIL"); return; } # body=binarymime not allowed without binarymime extension if (! defined $SMTP_EXT{BINARYMIME} && $self->{body_mime} eq "binary") { $self->send_(555, "Error: Unsupported option", "5.5.4"); return; } $self->{sender_given} = 1; $self->{envelope_sender} = $sender; $self->{recipient_given} = 0; $self->{envelope_recipient} = undef; $self->{transaction} = 1; # check for transid parameter if ($self->{transid}) { # searching for checkpoint $self->search_checkpoint($self->{transid}, $sender); # ok, checkpoint found if ($self->{checkpoint_found}) { $self->{recipient_given} = 1; # send code 355 and the offset $self->send_(355, "$self->{transaction_offset} is the transaction offset"); return; } } $self->send_(250, "Ok", "2.1.0"); } sub RCPT { my ($self, $args) = @_; return if $self->helo_required; return if $self->auth_required; if (! defined $args || ! $args || $args =~ /^[\s\t]+\z/ || $args !~ /^TO:/i) { $self->syntax("RCPT"); return; } if (! $self->{sender_given}) { $self->send_(503, "Error: need MAIL command", "5.5.1"); return; } if ($self->{transaction_type} eq "bdat") { $self->send_(503, "Error: bad sequence of commands", "5.5.1"); return; } $args =~ s/^TO:([\s\t]+)?//i; my $recipient = $self->get_parameters("RCPT", $args); # address invalid -> syntax error if (! defined $recipient) { $self->syntax("RCPT"); return; } # unknown option/parameter if ($self->{invalid_keyword}) { $self->send_(555, "Error: Unsupported option", "5.5.4"); return; } if ($recipient =~ /^\<([\s]+)?\>$/) { # substitute '<>' with 'POSTMASTER' $recipient = "POSTMASTER"; } else { # remove '<' and '>' $recipient =~ s/\<(.*)\>/$1/g; } if (! defined $recipient || $recipient eq "") { $self->syntax("RCPT"); return; } if ($self->{transid} && $self->{checkpoint_found}) { $self->{transid} = ""; } $self->{recipient_given} = 1; $self->{envelope_recipient} = $recipient if (! defined $self->{envelope_recipient}); push (@RECIPIENTS, $recipient); $self->send_(250, "Ok", "2.1.5"); } sub DATA { my ($self, $args) = @_; my $client = $self->{server}->{client}; my $data = ""; my $bytes = 0; my $queueid; my $err_size = 0; return if $self->helo_required; return if $self->auth_required; if (defined $args && $args && $args !~ /^[\s\t]+\z/) { $self->syntax("DATA"); return; } if (! $self->{recipient_given}) { $self->send_(503, "Error: need RCPT command", "5.5.1"); return; } if (! $self->{sender_given}) { $self->send_(503, "Error: need MAIL command", "5.5.1"); return; } # check for running bdat transaction if ($self->{transaction_type} eq "bdat") { $self->send_(503, "Error: Bad sequence of commands", "5.5.1"); return; } # check for BINARYMIME flag, because it cannot be used with DATA if ($self->{body_mime} eq "binary") { $self->send_(503, "Error: Bad sequence of commands", "5.5.1"); return; } $self->{transaction_type} = "data"; $self->{data_content} = ""; $self->{data_incomplete} = 1; if ($self->{transid}) { if ($self->{checkpoint_found}) { $self->send_(354, "Send previously checkpointed message starting at octet $self->{transaction_offset}"); } else { $self->send_(354, "Send checkpointed message, end data with ."); } } else { $self->send_(354, "End data with ."); } while (<$client>) { alarm($self->{timeout}); if(/^\.[\r\n]*$/) { $bytes = length($self->{data_content}); $status{count_mails}++; $status{count_bytes} += $bytes; $self->slog_("recv: <(MESSAGE)> ($bytes bytes)"); $self->slog_("recv: ."); $self->{data_incomplete} = 0; $queueid = $self->write_message($self->{data_content}); $self->{transaction_type} = ""; $self->{sender_given} = 0; $self->{recipient_given} = 0; if ($err_size) { $self->send_(452, "Error: Message size limit exceeded", "4.2.3"); $self->slog_("info: Message truncated"); return; } if (defined ($queueid)) { $status{success} = 1; $self->send_(250, "Ok: queued as $queueid", "2.6.0"); } else { $self->send_(451, "Error: local error in processing", "4.3.0"); } return; } elsif ($err_size || ($self->{max_message_size} && length($self->{data_content}) > $self->{max_message_size})) { $err_size = 1; } else { $self->{data_content} .= $_; } alarm($self->{timeout}); } } sub BDAT { my ($self, $args) = @_; my $client = $self->{server}->{client}; my $message_size = 0; my $chunk_length = 0; my $bytes = 0; my $received = ""; my $err_seq = 0; my $err_size = 0; my $fileName; my @message = (); return if $self->helo_required; return if $self->auth_required; if (! defined $args || ! $args || $args =~ /^[\s\t]+\z/) { $self->syntax("BDAT"); return; } if (! $self->{recipient_given}) { $self->send_(503, "Error: need RCPT command", "5.5.1"); return; } if (! $self->{sender_given}) { $self->send_(503, "Error: need MAIL command", "5.5.1"); return; } if ($self->{transaction_type} eq "data") { $self->send_(503, "Error: Bad sequence of commands", "5.5.1"); return; } if ($self->{transid}) { $self->send_(503, "Error: Bad sequence of commands", "5.5.1"); return; } $args =~ s/^[\s]+//; $args =~ s/[\s]+$//; if ($args !~ /^([\d]+|LAST|[\d]+[\s]+LAST)$/i) { $self->send_(501, "Error: invalid parameter syntax", "5.5.4"); return; } # quote from RFC: # "Any BDAT command sent after the BDAT LAST is illegal and # MUST be replied to with a 503 "Bad sequence of commands" reply code." if ($self->{bdat_last}) { $err_seq = 1; } $self->{transaction_type} = "bdat"; if ($args =~ /^([\d]+)$/) { # more chunks follow after this chunk $chunk_length = $1; } elsif ($args =~ /^([\d]+)[\s]+LAST$/i) { # this is the last chunk, size is given $self->{bdat_last} = 1; $chunk_length = $1; } elsif ($args =~ /^LAST$/i) { # this is the last chunk, no size parameter given $self->{bdat_last} = 1; $chunk_length = 0; } else { $self->send_(501, "Error: invalid parameter syntax", "5.5.4"); # hmm, could be some kind of DoS -> close connection $self->{close_connection} = 1; } # must receive all data, before return anything while ($bytes < $chunk_length) { alarm($self->{timeout}); $received = <$client>; alarm($self->{timeout}); if (! defined ($received)) { $received = ""; } $bytes += length($received); # if transaction is already completed or content reaches $maxlength, simply discard more data if (! $err_seq) { if ($bytes < $self->{max_chunk_length}) { $self->{bdat_content} .= $received; } else { $err_size = 1; } } } $self->slog_("recv: <(CHUNK)> ($bytes bytes)"); $message_size = length($self->{bdat_content}); if ($err_seq) { $self->send_(503, "Error: Bad sequence of commands", "5.5.1"); } elsif ($err_size) { $self->send_(452, "Error: Chunk size limit exceeded", "4.2.3"); $self->slog_("info: Chunk truncated"); $self->{bdat_incomplete} = 1; } else { if ($self->{bdat_last}) { $self->{body_mime} = ""; if ($self->write_message($self->{bdat_content})) { $status{count_bytes} += $message_size; $status{count_mails}++; if ($self->{max_message_size} && $message_size > $self->{max_message_size}) { $self->send_(452, "Error: Message size limit exceeded", "4.2.3"); } else { $self->send_(250, "Message OK, $message_size octets received", "2.6.0"); } if ($self->{bdat_incomplete}) { $self->slog_("info: Message incomplete"); $self->{bdat_incomplete} = 0; } } else { $self->send_(451, "Error: local error in processing", "5.3.0"); } } else { $self->send_(250, "$bytes octets received", "2.6.0"); } } } sub RSET { my ($self, $args) = @_; if (defined $args && $args && $args !~ /^[\s\t]+\z/) { $self->syntax("RSET"); return; } # reset variables $self->{sender_given} = 0; $self->{recipient_given} = 0; $self->{envelope_sender} = undef; $self->{envelope_recipient} = undef; $self->{transaction} = 0; $self->{transaction_type} = ""; $self->{bdat_last} = 0; $self->{bdat_content} = ""; $self->{bdat_incomplete} = 0; $self->{body_mime} = ""; # reply $self->send_(250, "Ok", "2.0.0"); } sub NOOP { my ($self, $args) = @_; if (defined $args && $args && $args !~ /^[\s\t]+\z/) { $self->syntax("NOOP"); return; } # reply $self->send_(250, "Ok", "2.0.0"); } sub QUIT { my ($self, $args) = @_; # if (defined $args && $args && $args !~ /^[\s\t]+\z/) { # $self->syntax("QUIT"); # return; # } $self->{close_connection} = 1; # reply $self->send_(221, "closing connection.", "2.0.0"); } sub VRFY { my ($self, $args) = @_; if (! defined $SMTP_EXT{VRFY}) { if ($self->{ESMTP}) { $self->send_(502, "Error: command not implemented", "5.5.1"); } else { $self->send_(500, "Error: unknown command", "5.5.1"); } return; } return if $self->auth_required; if ($self->{transaction_type} eq "bdat") { $self->send_(503, "Error: bad sequence of commands", "5.5.1"); return; } if (! defined $args || ! $args || $args =~ /^[\s\t]+\z/) { $self->syntax("VRFY"); return; } my $address = $self->get_parameters("VRFY", $args); # address invalid -> syntax error if (! defined $address || $address eq "") { $self->syntax("VRFY"); return; } # unknown option/parameter if ($self->{invalid_keyword}) { $self->send_(555, "Error: Unsupported option", "5.5.4"); return; } if ($address =~ /\<([\x21-\x7E]+)\>$/ || ($address !~ /[\<\>]/ && $address =~ /^([\x21-\x7E]+)$/)) { $address = $1; $address =~ s/[\<\>]//g; $self->send_(252, $address, "2.0.0"); } else { $self->send_(501, "Bad address syntax", "5.1.3"); } } sub EXPN { my ($self, $args) = @_; return if $self->auth_required; if ($self->{transaction_type} eq "bdat") { $self->send_(503, "Error: bad sequence of commands", "5.5.1"); return; } if (! defined $args || ! $args || $args =~ /^[\s\t]+\z/) { $self->syntax("EXPN"); return; } my $address = $self->get_parameters("EXPN", $args); # address invalid -> syntax error if (! defined $address || $address eq "") { $self->syntax("EXPN"); return; } # unknown option/parameter if ($self->{invalid_keyword}) { $self->send_(555, "Error: Unsupported option", "5.5.4"); return; } if ($address =~ /([^a-zA-Z0-9\-\.\_\+\=\s])/) { $self->send_(501, "Error: invalid parameter syntax", "5.5.4"); } elsif ($address =~ /[\s]/) { $self->syntax("EXPN"); } else { $self->send_("250-", "User foo ", "2.0.0"); $self->send_(250, "User bar ", "2.0.0"); } } sub ETRN { my ($self, $args) = @_; return if $self->helo_required; return if $self->auth_required; if (! defined $args || ! $args || $args =~ /^[\s\t]+\z/) { $self->syntax("ETRN"); return; } if ($self->{transaction_type} eq "bdat") { $self->send_(503, "Error: bad sequence of commands", "5.5.1"); return; } if ($args =~ /([^a-zA-Z0-9\-\.\s])/) { $self->send_(501, "Error: invalid parameter syntax", "5.5.4"); } else { $self->send_(250, "Queuing started", "2.0.0"); } } sub get_credentials { my ($self, $mech, $enc) = @_; my ($user, $pass, $other) = ""; my $dec; (defined $mech && $mech) or return 0; (defined $enc && $enc) or return 0; # decode base64 $enc =~ s/([^\x2B-\x7A])//g; $enc =~ s/([\x2C-\x2E])//g; $enc =~ s/([\x3A-\x3C])//g; $enc =~ s/([\x3E-\x40])//g; $enc =~ s/([\x5B-\x60])//g; $dec = b64_dec($enc); (defined $dec && $dec) or return 0; $dec =~ s/[\r\n]*$//; $dec =~ s/[\s\t]{2,}/\ /g; $dec =~ s/^[\s\t]+//; ($dec) or return 0; # ANONYMOUS: RFC 4505 [2245] if ($mech eq "anonymous") { $dec =~ s/[\s\t]+$//; # check maximum length (length($dec) <= 1024) or return 0; # replace non-printable characters with "." $dec =~ s/([^\x20-\x7e])/\./g; $user = $dec; $pass = ""; } # PLAIN: RFC 4616 [2595] elsif ($mech eq "plain") { # check maximum length (length($dec) <= 1024) or return 0; ($other, $user, $pass) = split(/\x00/, $dec, 3); (defined $user && $user && defined $pass && $pass) or return 0; $other = "" if (! defined $other); $dec =~ s/[\x00]+/\ /g; $dec =~ s/^\s+//g; $other =~ s/^\s+//; $user =~ s/^\s+//; $user =~ s/\s+$//; $pass =~ s/^\s+//; # replace non-printable characters with "." $dec =~ s/([^\x20-\x7e])/\./g; $other =~ s/([^\x20-\x7e])/\./g; $user =~ s/([^\x20-\x7e])/\./g; $pass =~ s/([^\x20-\x7e])/\./g; } # LOGIN: http://tools.ietf.org/html/draft-murchison-sasl-login-00 # check the username for login mechanism elsif ($mech eq "login_user") { $dec =~ s/[\s\t]+$//; # check maximum length (length($dec) < 64) or return 0; # replace non-printable characters with "." $dec =~ s/([^\x20-\x7e])/\./g; $user = $dec; } # check the password for login mechanism elsif ($mech eq "login_pass") { # check maximum length (length($dec) <= 1024) or return 0; # replace non-printable characters with "." $dec =~ s/([^\x20-\x7e])/\./g; $pass = $dec; } # CRAM-MD5/SHA1: RFC 2195 elsif ($mech eq "cram-md5" || $mech eq "cram-sha1") { $dec =~ s/\s+$//; # replace non-printable characters with "." $dec =~ s/([^\x20-\x7e])/\./g; ($user, $pass) = split(/\s+/, $dec, 2); (defined $user && $user && defined $pass && $pass) or return 0; $user =~ s/\s+$//; $pass =~ s/^\s+//; $pass =~ s/\s+$//; # check maximum length (length($user) <= 1024) or return 0; # check for valid md5 if ($mech eq "cram-md5" && $pass !~ /^[[:xdigit:]]{32}$/) { return 0; } # check for valid sha1 if ($mech eq "cram-sha1" && $pass !~ /^[[:xdigit:]]{40}$/) { return 0; } } return ($dec, $user, $pass, $other); } sub AUTH { my ($self, $args) = @_; my $client = $self->{server}->{client}; my @methods = split(/[\s\t]+/, $SMTP_EXT{AUTH}); my ($encoded, $decoded); my ($user, $pass, $other, $dummy); return if $self->helo_required; if ($self->{transaction_type} eq "bdat") { $self->send_(503, "Error: bad sequence of commands", "5.5.1"); return; } if ($self->{auth_given}) { $self->send_(503, "Already authenticated", "5.5.1"); return; } if ($self->{transaction}) { $self->send_(503, "Authentication not allowed in transaction state", "5.5.1"); return; } if (! defined $args || $args eq "" || $args =~ /^[\s\t]+\z/) { $self->syntax("AUTH"); return; } my ($mechanism, $string, $more) = split(/[\s\t]+/, $args, 3); if (defined $more && $more && $more !~ /^[\s\t]+\z/) { $self->syntax("AUTH"); return; } if (! defined $mechanism || ! $mechanism) { $self->syntax("AUTH"); return; } if ($mechanism !~ /^(ANONYMOUS|PLAIN|LOGIN|CRAM-MD5|CRAM-SHA1)$/i) { $self->send_(504, "Unknown authentication method", "5.7.4"); return; } $mechanism = lc($mechanism); # test for allowed methods my $found = 0; foreach (@methods) { if ($mechanism eq lc($_)) { $found = 1; last; } } if (! $found) { $self->send_(504, "Unknown authentication method", "5.7.4"); return; } ### ANONYMOUS or PLAIN if ($mechanism eq "anonymous" || $mechanism eq "plain") { if (! defined ($string) || $string eq "") { $self->send_(334, "Go on"); alarm($self->{timeout}); chomp($string = <$client>); alarm($self->{timeout}); $string =~ s/\r$//g; $string =~ s/[\r\n]+//g; # replace non-printable characters with "." $string =~ s/([^\x20-\x7e])/\./g; $self->slog_("recv: $string"); } if (! defined $string || $string eq "") { $self->send_(535, "Incorrect authentication data", "5.7.8"); return; } if ($string =~ /^\*/) { $self->send_(501, "Authentication cancelled", "5.7.0"); return; } ($decoded, $user, $pass, $other) = $self->get_credentials($mechanism, $string); if (! defined $decoded || ! $decoded) { $self->send_(535, "Incorrect authentication data", "5.7.8"); return; } $self->slog_("info: $string --> $decoded"); if (! defined $user || $user eq "") { $self->send_(535, "Incorrect authentication data", "5.7.8"); return; } } ### LOGIN elsif ($mechanism eq "login") { if (! defined ($string) || $string eq "") { # ask for username $self->send_(334, "VXNlcm5hbWU6"); $self->slog_("info: VXNlcm5hbWU6 --> Username:"); alarm($self->{timeout}); chomp($string = <$client>); alarm($self->{timeout}); $string =~ s/\r$//g; $string =~ s/[\r\n]+//g; # replace non-printable characters with "." $string =~ s/([^\x20-\x7e])/\./g; $self->slog_("recv: $string"); } if (! defined $string || $string eq "") { $self->send_(535, "Incorrect authentication data", "5.7.8"); return; } if ($string =~ /^\*/) { $self->send_(501, "Authentication cancelled", "5.7.0"); return; } ($decoded, $user, $dummy, $other) = $self->get_credentials("login_user", $string); if (! defined $decoded || ! $decoded) { $self->send_(535, "Incorrect authentication data", "5.7.8"); return; } $self->slog_("info: $string --> $decoded"); # ask for password $self->send_(334, "UGFzc3dvcmQ6"); $self->slog_("info: UGFzc3dvcmQ6 --> Password:"); alarm($self->{timeout}); chomp($string = <$client>); alarm($self->{timeout}); $string =~ s/\r$//g; $string =~ s/[\r\n]+//g; # replace non-printable characters with "." $string =~ s/([^\x20-\x7e])/\./g; $self->slog_("recv: $string"); if (! defined $string || $string eq "") { $self->send_(535, "Incorrect authentication data", "5.7.8"); return; } if ($string =~ /^\*/) { $self->send_(501, "Authentication cancelled", "5.7.0"); return; } ($decoded, $dummy, $pass, $other) = $self->get_credentials("login_pass", $string); if (! defined $decoded || ! $decoded) { $self->send_(535, "Incorrect authentication data", "5.7.8"); return; } $self->slog_("info: $string --> $decoded"); } ### CRAM-MD5 or CRAM-SHA1 elsif ($mechanism eq "cram-md5" || $mechanism eq "cram-sha1") { if (defined $string && $string) { $self->send_(501, "Error: invalid parameter syntax", "5.5.2"); return; } my $greeting = "<$$." . &INetSim::FakeTime::get_faketime() . '@' . "$self->{fqdn_hostname}>"; $encoded = encode_base64($greeting); $encoded =~ s/[\r\n]+$//; $self->send_(334, "$encoded"); $self->slog_("info: $encoded --> $greeting"); alarm($self->{timeout}); chomp($string = <$client>); alarm($self->{timeout}); ($decoded, $user, $pass, $other) = $self->get_credentials($mechanism, $string); $string =~ s/\r$//g; $string =~ s/[\r\n]+//g; # replace non-printable characters with "." $string =~ s/([^\x20-\x7e])/\./g; $self->slog_("recv: $string"); if (! defined $string || $string eq "") { $self->send_(535, "Incorrect authentication data", "5.7.8"); return; } if ($string =~ /^\*/) { $self->send_(501, "Authentication cancelled", "5.7.0"); return; } if (! defined $decoded || ! $decoded) { $self->send_(535, "Incorrect authentication data", "5.7.8"); return; } $self->slog_("info: $string --> $decoded"); } else { $self->send_(504, "Unknown authentication method", "5.7.4"); return; } ### Authentication successful... $status{auth_type} = "sasl/$mechanism"; $status{credentials} = "$user:$pass"; $self->{auth_given} = 1; $self->send_(235, "Authentication successful", "2.7.0"); } sub TURN { my ($self, $command, $args) = @_; my $line; my ($banner, $ehlo, $helo, $mail, $rcpt, $data, $content, $quit) = 0; return if $self->helo_required; return if $self->auth_required; if (defined $args && $args && $args !~ /^[\s\t]+\z/) { $self->syntax($command); return; } if ($self->{transaction_type} eq "bdat") { $self->send_(503, "Error: bad sequence of commands", "5.5.1"); return; } if ($self->{transaction}) { $self->send_(503, "Bad sequence of commands", "5.5.1"); return; } # additional tests for atrn if ($self->{ESMTP} && ! $self->{auth_given} && $command eq "ATRN") { $self->send_(530, "Authentication required", "5.5.1"); return; } $self->{close_connection} = 1; $self->send_(250, "OK now reversing the connection", "2.0.0"); # set up local timeout handler eval { local $SIG{'ALRM'} = sub { die "TIMEOUT" }; alarm($self->{timeout}); $line = $self->recv_(); if ($line =~ /^220[\s]+/) { # try ehlo first $self->send_("000", "EHLO $self->{fqdn_hostname}"); alarm($self->{timeout}); $line = $self->recv_(); alarm($self->{timeout}); if ($line =~ /^250-/) { $ehlo = 1; while ($line =~ /^250-/) { alarm($self->{timeout}); $line = $self->recv_(); alarm($self->{timeout}); last if ($line =~ /^250\s/); } } elsif ($line =~ /^250\s/) { $ehlo = 1; } elsif ($line =~ /^5\d\d\s/) { # try helo $self->send_("000", "HELO $self->{fqdn_hostname}"); alarm($self->{timeout}); $line = $self->recv_(); alarm($self->{timeout}); if ($line =~ /^250-/) { $helo = 1; while ($line =~ /^250-/) { alarm($self->{timeout}); $line = $self->recv_(); alarm($self->{timeout}); last if ($line =~ /^250\s/); } } elsif ($line =~ /^250\s/) { $helo = 1; } else { # wrong reply to helo return; } } else { # wrong status codes -> close the connection return; } # mail from if ($ehlo || $helo) { $self->send_("000", "MAIL FROM:"); alarm($self->{timeout}); $line = $self->recv_(); alarm($self->{timeout}); if ($line =~ /^25\d\s/) { $mail = 1; } else { return; } } # rcpt to if (($ehlo || $helo) && $mail) { $self->send_("000", "RCPT TO:"); alarm($self->{timeout}); $line = $self->recv_(); alarm($self->{timeout}); if ($line =~ /^25\d\s/) { $rcpt = 1; } else { return; } } # data if (($ehlo || $helo) && $mail && $rcpt) { $self->send_("000", "DATA"); alarm($self->{timeout}); $line = $self->recv_(); alarm($self->{timeout}); if ($line =~ /^354\s/) { $data = 1; } else { return; } } # content if (($ehlo || $helo) && $mail && $rcpt && $data) { $self->send_("000", "Subject: INetSim test mail\r\n"); $self->send_("000", "This is an INetSim test mail...\r\n"); $self->send_("000", "\r\n.\r\n"); alarm($self->{timeout}); $line = $self->recv_(); alarm($self->{timeout}); if ($line =~ /^25\d\s/ || $line =~ /^(4|5)5\d\s/) { $content = 1; } } else { return; } # quit if (($ehlo || $helo) && $mail && $rcpt && $data && $content) { $self->send_("000", "QUIT"); alarm($self->{timeout}); $line = $self->recv_(); alarm($self->{timeout}); if ($line =~ /^221\s/) { # for later use $quit = 1; } } } alarm($self->{timeout}); }; alarm(0); if ($@ =~ /TIMEOUT/) { $self->{timed_out} = 1; } } sub STARTTLS { my ($self, $args) = @_; # RFC 4954 says: # # ----------------------------------------------------------------- # "530 5.7.0 Authentication required # # This response SHOULD be returned by any command other than AUTH, # EHLO, HELO, NOOP, RSET, or QUIT..." # ----------------------------------------------------------------- # # but this makes no sense for STARTTLS !!!? # #return if $self->auth_required; if (defined $args && $args && $args !~ /^[\s\t]+\z/) { $self->syntax("STARTTLS"); return; } if ($self->{using_tls}) { $self->send_("454", "TLS not available due to temporary reason"); return; } $self->send_("220", "Ready to start TLS"); if ($self->upgrade_to_ssl()) { # reset variables $self->{helo_given} = 0; $self->{sender_given} = 0; $self->{recipient_given} = 0; $self->{envelope_sender} = undef; $self->{envelope_recipient} = undef; $self->{transaction} = 0; $self->{transaction_type} = ""; $self->{bdat_last} = 0; $self->{bdat_content} = ""; $self->{bdat_incomplete} = 0; $self->{body_mime} = ""; # deleting STARTTLS extension (rfc 2487, section 5.2) delete $SMTP_EXT{STARTTLS}; # set tls flag $self->{using_tls} = 1; $status{tls_used} = 1; # log success $self->slog_("info: Connection successfully upgraded to SSL"); } else { $self->slog_("info: Upgrade to SSL failed: $self->{last_ssl_error}"); $self->{close_connection} = 1; } } sub HELP { my ($self, $command) = @_; my $line = ""; my @verbs = qw/HELO MAIL RCPT DATA RSET NOOP QUIT/; # minimum requirement for smtp # add optional smtp verbs foreach my $key (sort keys %SMTP_EXT) { if ($key =~ /^(HELP|VRFY|EXPN|SEND|SOML|SAML|TURN)$/i) { push (@verbs, uc($key)); } } # add optional esmtp verbs if ($self->{ESMTP}) { # add the keyword ehlo push (@verbs, "EHLO"); foreach my $key (sort keys %SMTP_EXT) { if ($key =~ /^(ETRN|AUTH|ATRN)$/i) { push (@verbs, uc($key)); } } # add BDAT, if chunking enabled if (defined $SMTP_EXT{CHUNKING}) { push (@verbs, "BDAT"); } # add STARTTLS if enabled if (defined $SMTP_EXT{STARTTLS}) { push (@verbs, "STARTTLS"); } } # print topic help if (defined ($command) && $command ne "" && $command =~ /^[A-Za-z0-9\-]{3,16}/) { $command = uc($command); foreach (@verbs) { if ($_ eq $command) { if ($command eq "HELO" || $command eq "EHLO") { $self->send_("214-", "$command "); $self->send_("214-", " This command is used to identify"); $self->send_("214", " the client to the server."); return; } elsif ($command =~ /^(MAIL|SEND|SOML|SAML)$/) { $self->send_("214-", "$command FROM:
"); $self->send_("214-", " This command is used to initiate"); $self->send_("214", " a mail transaction."); return; } elsif ($command eq "RCPT") { $self->send_("214-", "RCPT TO:
"); $self->send_("214-", " This command is used to identify"); $self->send_("214", " an individual recipient."); return; } elsif ($command eq "DATA") { $self->send_("214-", "DATA"); $self->send_("214-", " This command causes the mail data to"); $self->send_("214", " be appended to the mail data buffer."); return; } elsif ($command eq "RSET") { $self->send_("214-", "RSET"); $self->send_("214-", " This command specifies that the current"); $self->send_("214-", " mail transaction will be aborted. All"); $self->send_("214", " buffers and state tables are cleared."); return; } elsif ($command eq "NOOP") { $self->send_("214-", "NOOP"); $self->send_("214-", " This command has no effect, but it may"); $self->send_("214", " useful to prevent timeouts."); return; } elsif ($command eq "HELP") { $self->send_("214-", "HELP []"); $self->send_("214-", " This command prints helpful information"); $self->send_("214", " about supported commands."); return; } elsif ($command eq "QUIT") { $self->send_("214-", "QUIT"); $self->send_("214-", " This command closes the"); $self->send_("214", " transmission channel."); return; } elsif ($command eq "VRFY") { $self->send_("214-", "VRFY
"); $self->send_("214-", " This command asks the receiver to"); $self->send_("214-", " confirm that the argument identifies"); $self->send_("214", " a user or mailbox."); return; } elsif ($command eq "EXPN") { $self->send_("214-", "EXPN "); $self->send_("214-", " This command asks the receiver to"); $self->send_("214-", " confirm that the argument identifies"); $self->send_("214", " a mailing list."); return; } elsif ($command eq "TURN") { $self->send_("214-", "TURN"); $self->send_("214-", " This command reverses"); $self->send_("214", " the connection."); return; } elsif ($command eq "ETRN") { $self->send_("214-", "ETRN [