Title: CMPE 587 Advanced Network Programming
1CMPE 587Advanced Network Programming
- PERL PROGRAMMING
- by
- Bugra Basaran
- Caner Kurtul
2 What is Perl?
- Perl is an acronym for "Practical Extraction and
Report Language - Initially designed as a glue language for Unix,
now Perl is available for most other operating
systems. - Because it runs nearly everywhere, Perl is one of
the most portable programming environments
available today. - Perl is a free software.
- Perl has taken good ideas from nearly everywhere
and installed them into an easy-to-use mental
framework.
3Compilation vs. Interpretation In Perl
- Perl is an interpreted language, you can just
execute it like a batch file or shell scripts.
4Basic Syntax
- Perl is free form - whitespace doesn't matter.
- All perl statements end in a (semicolon), like
C. - Case sensitive
- Comments
- begin with (pound sign)
- everything after the , and up to the end of the
line is ignored. - the needn't be at the beginning of the line.
- There is no way to comment out blocks of code
5A Basic Perl Program
!/usr/local/bin/perl Program to do the
obvious print 'Hello world.'
hello.pl
- How to run
- perl hello.pl (file is given as parameter to
perl interpreter) - hello.pl (first, file should be changed to
executable mode) - perl -w hello.pl (shows the warnings)
- perl -d hello.pl (run the program with a
debugger) - Without a file
- perl -e print "Hello world."
- How to take help
- perldoc f undef (to take help about undef
function) - perldoc -f localtime (to take help about
localtime function)
6Scalar Variables
No need to define types explicitly. A variable
can be assigned different types of values during
the execution of the program.
- answer 42 an integer
- pi 3.14159265 a real number
- avocados 6.02e23 scientific notation
- pet Camel a string
- sign I love my pet string with
interpolation - cost It costs 100 string without
interpolation - thence sign another variables value
- num answer pi result of an expression
- exit system(vi file1) numeric status of
a command - cwd pwd string output from a command
7Operations Assignments on Scalar Variables
- Perl uses all the usual C arithmetic operators
- a 1 2 Add 1 and 2 and store in a
- a 3 - 4 Subtract 4 from 3 and store in a
- a 5 6 Multiply 5 and 6
- a 7 / 8 Divide 7 by 8 to give 0.875
- a 9 10 Nine to the power of 10
- a 5 2 Remainder of 5 divided by 2
- a Increment a and then return it
- a Return a and then increment it
- --a Decrement a and then return it
- a-- Return a and then decrement it
- a b c 0
8Operations Assignments on Scalar Variables
(continued)
- For strings Perl has the following among others
- a b . c Concatenate b and c
- a b x c b repeated c times
- To assign values Perl includes
- a b Assign b to a
- a b Add b to a
- a - b Subtract b from a
- a . b Append b onto a
- when Perl assigns a value with a b it makes a
copy of b and then assigns that to a. Therefore
the next time you change b it will not alter a.
9Interpolation Details
- The following code prints apples and pears using
concatenation - a apples
- b pears
- print a. and .b
- print 'a and b' prints a and b
- print "a and b" prints apples and
pears -
10Logical Operators
11Some File Test Operators
Result
Name
Example
True if file named in a exists
Exists
-e a
True if file named in a readable
Readable
-r a
True if file named in a writable
Writable
-w a
True if file named in a is a directory
Directory
-d a
True if file named in a is a regular file
File
-f a
True if file named in a is a text file
Text File
-T a
12Some Numeric and String Comparison Operators
Return Value
String
Numeric
Comparison
True if a is equal to b
eq
Equal
True if a is not equal to b
ne
!
Not Equal
True if a is less then b
lt
lt
Less Than
True if a is greater then b
gt
gt
Greater Than
True if a is not greater then b
le
lt
Less than or Equal
True if a is not less then b
ge
gt
Greater than or equal
0 if equal, 1 if a greater, -1 if b greater
cmp
ltgt
Comparison
13Array Variables
- Array variable is a list of scalars (i.e. numbers
and strings). Array variables have the same
format as scalar variables except that they are
prefixed by an _at_ symbol - No need to define size for an array. It grows
automatically when new elements are added. - _at_food ("apples", "pears", "eels")
- _at_music ("whistle", "flute")
- _at_chars a..z
- _at_ints 1..20
- _at_chars2_at_chars chars2 gets all elements of
chars - The array is accessed by using indices starting
from 0, and square brackets are used to specify
the index - food2 returns eels
- food-1 returns eels
- food10 banana food3..food9 can be
uninitialized. - _at_moremusic ("organ", _at_music, "harp")
- _at_moremusic ("organ", "whistle", "flute",
"harp") - A neater way of adding elements is to use the
statement - push(_at_food, "eggs") pushes eggs to end of
the array _at_food
14Array Variables (continued I)
- To push two or more items onto the array
- push(_at_food, "eggs", "lard")
- push(_at_food, ("eggs", "lard"))
- push(_at_food, _at_morefood)
- The push function returns the length of the new
list. - To remove the last item from a list and return it
use the pop function. - grub pop(_at_food) Now grub has last
element of _at_food - To remove the first item from a list and return
it use the shift function. - grub shift _at_food
- It is also possible to assign an array to a
scalar variable - f _at_food assigns the length of _at_food
- f "_at_food" turns the list into a string
with a space - between each element
- This space can be replaced by any other string by
changing the value of the special " variable.
This variable is just one of Perl's many special
variables.
15Array Variables (continued II)
- Arrays can also be used to make multiple
assignments to scalar variables - (a, b) (c, d) Same as ac bd
- (a, b) _at_food a and b are the first
two - items of _at_food.
- (a, _at_somefood) _at_food a is the first
item of _at_food - _at_somefood is a list of the
- others.
- (_at_somefood, a) _at_food _at_somefood is _at_food
and - a is undefined.
- To find the index of the last element of a list
- food so lenght is food1
- To display arrays
- print _at_food applespearseels
- print "_at_food" apples pears eels
- print _at_food."" 3
16Summary of Array Functions
return a new list, the sorted from LIST
sort(LIST)
return a new list, the reverse of LIST
reverse(LIST)
return a string formed by concatenating each
element of LIST joined by EXPR
join(EXPR,LIST)
return a list/array formed from each substring of
EXPR bordered by PATTERN
split(PATTERN,EXPR)
add LIST to the end of _at_ARRAY
push(_at_ARRAY,LIST)
remove and return the last element of _at_ARRAY
pop(_at_ARRAY)
add LIST to the front of _at_ARRAY
unshift(_at_ARRAY,LIST)
remove and return the first element of _at_ARRAY
shift(_at_ARRAY)
return the number of elements in the array
scalar(_at_ARRAY)
17Hashes (Associative Arrays)
- Arrays elements of which consist of "key" and
"value" pairs - Hash declarations
-
- map (red,0xff0000, green,0x00ff00,
blue,0x0000ff) - or
- map (redgt0xff0000, greengt0x00ff00,
bluegt0x0000ff) - or
- map ()
- mapred 0xff0000
- mapgreen 0x00ff00
- mapblue 0x0000ff
- _at_arr map arr has 6 elements
18Some Hash Functions
Return a list of all the keys in HASH. The list
is "unordered" it depends on the hash function
used internally.
keys(HASH)
Return a list of all the values in HASH
values(HASH)
Each time this is called on an HASH, it will
return a 2 element list consisting of the next
key/value pair in the array.
each(HASH)
remove the pair associated with KEY from HASH.
delete(HASHKEY)
19Control Structures
- if else
- if (EXPRESSION) STATEMENTS
- elsif (EXPRESSION) STATEMENTS
- else STATEMENTS
- Note curly braces are not optional in contrast
to C. - unless
- unless (EXPRESSION) STATEMENTS
- while/do/until Loops
- while/until ( EXPRESSION ) STATEMENTS
- do STATEMENTS while/until ( EXPRESSION )
20Control Structures (continued)
- for loop
- for (INITIAL_EXPR COND_EXPR LOOP_EXPR )
- STATEMENTS
-
- foreach loop
- foreach tmp (_at_arr)
- do something with tmp
-
- All loops support the following two control
statements - last Declare that this is the last statement in
the loop completely exit the loop even if the
condition is still true, ignoring all statements
up to the loop's closing brace. - next Start a new iteration of the loop
21File Handling
- file '/etc/passwd' Name the file
- open(INFO, file) Open the file
- _at_lines ltINFOgt Read it into an array
- close(INFO) Close the file
- print _at_lines Print the array
- ltgt is line reading operator
- If the filename was given in quotes then it is
taken literally without shell expansion. To force
shell expansion then use angled brackets. Use
like lt/notes/todolistgt - open(INFO, file) Open for input
- open(INFO, "gtfile") Open for output
- open(INFO, "gtgtfile") Open for appending
- open(INFO, "ltfile") Also open for input
-
22File Handling (continued)
- To print a string to the file with the INFO
filehandle use - print INFO "This line goes to the file.\n"
- 3 predefined file handler STDIN, STDOUT, STDERR
- To open the standard input (usually the keyboard)
and standard output - open(INFO, '-') Open standard input
- open(INFO, 'gt-') Open standard output
-
- chop(numberltSTDINgt) input number and remove
newline - chop(numberltgt) input number and remove
newline - Which means
- numberltSTDINgt input number
- chop(number) remove newline
- print STDOUT The number is number. \n print
the number
23String Matching
- One of the most useful features of Perl is its
powerful string manipulation facilities. A
regular expression is contained in slashes, and
matching occurs with the operator. The
operator ! is used for spotting a non-match - sentence /the/ expression is true if
the string the appears in the variable - sentence ! /the/
- The RE is case sensitive
- if we assign the sentence to the special variable
_ which is of course a scalar -
- if (/under/)
-
- print "We're talking about rugby\n"
-
24String Matching (continued)
- Here are some special RE characters and their
meaning - . Any single character except a newline
- The beginning of the line or string
- The end of the line or string
- Zero or more of the last character
- One or more of the last character
- ? Zero or one of the last character
- qjk Either q or j or k
- qjk Neither q nor j nor k
- a-z Anything from a to z inclusive
- a-z No lower case letters
- a-zA-Z Any letter
- a-z Any non-zero sequence of lower case
letters - jellycream Either jelly or cream
- (egle)gs Either eggs or legs
- (da) Either da or dada or dadada or...
- .? It stops at first colon
25Substitution and Translation
- Perl can make substitutions based on matches
- sentence s/london/London/ To replace an
occurrence of london by London in the
string - s/london/London/ To do the same thing with
the _ variable - s/LlOoNnDdOoNn/London/g To make
global substitution - s/london/London/gi an easier way is to
use the i option (for "ignore case"). - sentence tr/abc/edf/ tr function allows
character- by-character translation - tr/a-z/A-Z/ This statement converts
_ to upper case
26Split
- The split function is used like this
- info "CaineMichaelActor14, Leafy Drive"
- _at_personal split(//, info)
- which has the same overall effect as
- _at_personal ("Caine", "Michael", "Actor", "14,
Leafy Drive") - If we have the information stored in the _
variable then we can just use this instead - _at_personal split(//)
- _at_chars split(//, word)
- _at_words split(/ /, sentence)
- _at_sentences split(/\./, paragraph)
27Subroutines
- sub printargs
- print "_at__\n"
- printargs("perly", "king") Example prints
perly king - printargs("frog", "and", "toad") Prints
"frog and toad" - sub printfirsttwo
-
- print "Your first argument was _0\n"
- print "and _1 was your second\n"
-
- indexed scalars _0, _1 and so on have
nothing to with the scalar _ - Result of a subroutine is always the last thing
evaluated - sub maximum
- if (_0 gt _1)
- _0
- else
- _1
-
28Example 1
- Finds users whose accounts were locked in a linux
computer. - open(FD,"/etc/shadow")
- _at_usersltFDgt
- foreach elem (_at_users)
-
- (user,passwdfield)split(//,elem)
- if (passwdfield /!/)
- print user."\n"
-
-
- Finds users whose accounts were locked in a
Solaris computer - open(FD,"/etc/shadow")
- _at_usersltFDgt
- foreach elem (_at_users)
-
- (user,passwdfield)split(//,elem)
- if (passwdfield eq "LK")
- print user."\n"
29Example 2
- Finds words in the dictionary file
/usr/dict/words that consists of only asdfjghjkl
letters - open(fd,"/usr/dict/words")
- while(lineltfdgt)
- if (line /asdfjklgh/)
- print line
-
30Example 3
- Counts of lines , of sentences, of
nonwhitespace chars and determines which word is
used how many times in the file whose name is
given as parameter or in the text which is input
from stdin if no parameter is given. - _at_textltgt
- foreach sentence (_at_text)
- sentencecount
- _at_wordssplit(/\s/,sentence)
- foreach word (_at_words)
- myhashword
- wordcount
- _at_charssplit(//,word)
- charcountscalar(_at_chars)
-
-
- print "Total Number of Lines
sentencecount\n" - print "Total Number of Words wordcount\n"
- print "Total Number of Nonwhitespace chars
charcount\n" - foreach word (sort keys myhash)
- print "word myhashword\n"
-
31Example 4
- open(FD,"/var/mail/basarabu") or die "No inbox"
- while (ltFDgt)
- print if /From/
- close FD
- open(FD,"/var/mail/basarabu") or die "No inbox"
- while (ltFDgt)
- print "1\n" if /From(.)/
- close FD
- open(FD,"/var/mail/basarabu") or die "No inbox"
- while (ltFDgt)
-
- next unless /From(.)/
- next if seen1
- print "1\n"
- seen11
-
- close FD
32Perl Socket Programming
- Perl socket functions have the same names as the
corresponding system calls in C. - Arguments tend to differ for two reasons
- Perl filehandles work differently than C file
descriptors - Perl already knows the length of its strings
- A sample TCP client using Internet-domain
sockets - use strict
- use Socket
- my (remote,port, iaddr, paddr, proto,
line) - remote shift 'localhost'
- port shift 2345 random port
- iaddr inet_aton(remote) die "no host
remote" - paddr sockaddr_in(port, iaddr)
- proto getprotobyname('tcp')
- socket(SOCK, PF_INET, SOCK_STREAM, proto)
die "socket !" - connect(SOCK, paddr) die "connect !"
- while (defined(line ltSOCKgt)) print line
- close (SOCK) die "close !"
33A Corresponding Server
- use strict
- use Socket
- use Carp
- EOL "\015\012" carriage return followed
by new line - sub logmsg print _0 at ", scalar localtime,
"\n" - my port shift 2345
- my proto getprotobyname('tcp')
- socket(Server, PF_INET, SOCK_STREAM, proto)
die "socket !" - setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
pack("l",1)) die "setsockopt!" - bind(Server, sockaddr_in(port, INADDR_ANY))
die "bind !" - listen(Server,SOMAXCONN) die "listen !"
- logmsg "server started on port port"
- my paddr
- for ( paddr accept(Client,Server) close
Client) - my(port, iaddr) sockaddr_in(paddr)
- my name gethostbyaddr(iaddr,AF_INET)
- logmsg "connection from name ",
inet_ntoa(iaddr), " at port port"
34Multithreaded Server
- use strict
- use Socket
- use Carp
- EOL "\015\012"
- sub spawn forward declaration
- sub logmsg print "_at__ at ", scalar localtime,
"\n" - my port shift 2345
- my proto getprotobyname('tcp')
- socket(Server, PF_INET, SOCK_STREAM, proto)
die "socket !" - setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
pack("l", 1)) - die "setsockopt !"
- bind(Server, sockaddr_in(port, INADDR_ANY))
die "bind !" - listen(Server,SOMAXCONN) die "listen !"
- logmsg "server started on port port"
- my waitedpid 0
- my paddr
35Multithreaded Server (cont. I)
- sub REAPER
- waitedpid wait
- SIGCHLD \REAPER loathe sysV
- logmsg "reaped waitedpid"
-
- SIGCHLD \REAPER
- for ( waitedpid 0
- (paddr accept(Client,Server)) waitedpid
- waitedpid 0, close Client)
-
- next if waitedpid and not paddr
- my(port,iaddr) sockaddr_in(paddr)
- my name gethostbyaddr(iaddr,AF_INET)
- logmsg Conn. from name ", inet_ntoa(iaddr),
" at port port" - spawn
36Multithreaded Server (cont. II)
- sub spawn
- my coderef shift
- unless (_at__ 0 coderef ref(coderef) eq
'CODE') - confess "usage spawn CODEREF"
-
- my pid
- if (!defined(pid fork))
- logmsg "cannot fork !"
- return
- elsif (pid)
- logmsg "begat pid"
- return I'm the parent
- else I'm the child -- go spawn
- open(STDIN, "ltClient") die "can't dup client
to stdin" open(STDOUT, "gtClient") die "can't
dup client to stdout" - print "Hello there, name, it's now ", scalar
localtime, EOL - exec '/usr/games/myGame or confess "can't exec
the game !" - exit
-
37A Sample Unix-domain Client
- !/usr/bin/perl -w
- use Socket
- use strict
- my (rendezvous, line)
- rendezvous shift '/tmp/catsock'
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) die
"socket !" - connect(SOCK, sockaddr_un(rendezvous)) die
"connect !" - while (defined(line ltSOCKgt))
-
- print line
-
- exit
38A Corresponding Server
- use strict
- use Socket
- use Carp
- sub logmsg print "_at__ at ", scalar localtime,
"\n" - my NAME '/tmp/catsock'
- my uaddr sockaddr_un(NAME)
- my proto getprotobyname('tcp')
- socket(Server,PF_UNIX,SOCK_STREAM,0) die
"socket !" - unlink(NAME)
- bind (Server, uaddr) die "bind !"
- listen(Server,SOMAXCONN) die "listen !"
- logmsg "server started on NAME"
- my waitedpid
- sub REAPER
- waitedpid wait
- SIGCHLD \REAPER
- logmsg "reaped waitedpid
-
39Corresponding Server (cont.)
- SIGCHLD \REAPER
- for (
- waitedpid 0
- accept(Client,Server) waitedpid
- waitedpid 0, close Client)
-
- next if waitedpid
- logmsg "connection on NAME"
- spawn sub
- print "Hello there, it's now ", scalar
localtime, "\n" - exec '/usr/games/myGame' or die "can't exec
myGame !" -
-
40Object-Oriented Network Programming
- Some basic modules
- IOSocket
- IOSocketINET, IOSocketUNIX
- NetInet
- NetFTP
- NetTCP
- NetUDP
- NetTelnet
- NetDNS
41IOSocket
- Built upon the IO interface and inherits all the
methods defined by IO - Only defines methods for those operations which
are common to all types of socket - Operations which are specific to a socket in a
particular domain have methods defined in sub
classes of IOSocket - Methods
- accept(PKG)
- timeout(VAL)
- Set or get the timeout value associated with this
socket - sockopt(OPT , VAL)
- If called with one argument then getsockopt is
called, otherwise setsockopt is called - sockdomain
- Returns the numerical number for the socket
domain type - socktype
- Returns the numerical number for the socket type
- protocol
- Returns the numerical number for the protocol
being used on the socket, if known
42IOSocketINET
- Object interface for AF_INET domain sockets
- Built upon the IO interface and inherits all the
methods defined by IO - key-value pairs accepted by construtor
- PeerAddr Remote host address lthostnamegtltportgt
- PeerPort Remote port or service ltservicegt(ltnogt)
ltnogt - LocalAddr Local host bind address
- LocalPort Local host bind port
- Proto Protocol name (or number) "tcp" "udp"
... - Type Socket type SOCK_STREAM SOCK_DGRAM ..
- Listen Queue size for listen
- Reuse Set SO_REUSEADDR before binding
- Timeout Timeout value for various operations
- MultiHomed Try all addresses for multi-homed
hosts
43IOSocketINET (cont.)
- Examples
- sock IOSocketINET-gtnew(
- PeerAddr gt 'www.perl.org',
- PeerPort gt 'http(80)',
- Proto gt 'tcp
- )
- sock IOSocketINET-gtnew(PeerAddr gt
'localhostsmtp(25)') - sock IOSocketINET-gtnew(
- Listen gt 5,
- LocalAddr gt 'localhost',
- LocalPort gt 9000,
- Proto gt 'tcp
- )
- sock IOSocketINET-gtnew(www.boun.edu.tr80'
)
44IOSocketUnix
- Object interface for AF_UNIX domain sockets
- key-value pairs accepted by construtor
- Type Type of socket (eg SOCK_STREAM or
SOCK_DGRAM) - Local Path to local fifo
- Peer Path to peer fifo
- Listen Create a listen socket
- Methods
- hostpath()
- Returns the pathname to the fifo at the local end
- peerpath()
- Returns the pathanme to the fifo at the peer end
45NetInet
- Provides basic services for handling socket-based
communications for the Internet protocol - Public Methods
- new
- obj new NetInet
- obj new NetInet host, service
- obj new NetInet \parameters
- obj new NetInet host, service,
\parameters - init
- return undef unless self-gtinit
- return undef unless self-gtinit(\parameters)
- return undef unless self-gtinit(host, service)
- return undef unless self-gtinit(host, service,
\parameters) - bind
- ok obj-gtbind
- ok obj-gtbind(host, service)
- ok obj-gtbind(host, service, \parameters)
46NetInet (cont. I)
- unbind
- obj-gtunbind
- connect
- ok obj-gtconnect
- ok obj-gtconnect(host, service)
- ok obj-gtconnect(host, service,
\parameters) - format_addr
- string obj-gtformat_addr(sockaddr)
- string obj-gtformat_addr(sockaddr,
numeric_only) - format_local_addr, format_remote_addr
- string obj-gtformat_local_addr
- string obj-gtformat_local_addr(numeric_only)
- string obj-gtformat_remote_addr
47NetInet (cont. II)
- Non-Method Subroutines
- inet_aton returns the packed AF_INET address in
network order - in_addr inet_aton('192.0.2.1')
- inet_addr a synonym for inet_aton()
- inet_ntoa returns the ASCII representation of
the AF_INET address provided - addr_string inet_ntoa(in_addr)
- htonl, htons, ntohl, ntohs
- pack_sockaddr_in returns the packed struct
sockaddr_in - connect_address pack_sockaddr_in(family,
port, in_addr) - connect_address pack_sockaddr_in(port,
in_addr) - unpack_sockaddr_in returns the address family,
port, and packed struct in_addr - (family, port, in_addr) unpack_sockaddr_in(c
onnected_address)
48NetFTP
- FTP Client class
- Methods
- new (HOST ,OPTIONS)
- Options are Firewall, Port, Timeout, Debug,
Passive - login (LOGIN ,PASSWORD , ACCOUNT )
- type (TYPE , ARGS)
- ascii (ARGS) binary(ARGS)
- rename ( OLDNAME, NEWNAME )
- delete ( FILENAME )
- cwd ( DIR )
- cdup ()
- pwd ()
- rmdir ( DIR )
- mkdir ( DIR , RECURSE )
- get ( REMOTE_FILE , LOCAL_FILE , WHERE )
49NetFTP (cont. I)
- put ( LOCAL_FILE , REMOTE_FILE )
- append ( LOCAL_FILE , REMOTE_FILE )
- mdtm ( FILE )
- modification time of a file
- size ( FILE )
- supported ( CMD )
- pasv ()
- pasv_xfer ( SRC_FILE, DEST_SERVER , DEST_FILE
) - do a file transfer between two remote ftp servers
- pasv_wait ( NON_PASV_SERVER )
- wait for a transfer to complete between a passive
server and a non-passive server - abort ()
- quit ()
50NetFTP (cont. II)
- Example
- use NetFTP
- ftp NetFTP-gtnew(ftp.boun.edu.tr")
- ftp-gtlogin("anonymous","me_at_boun.edu.tr")
- ftp-gtcwd("/pub")
- ftp-gtget("the.file")
- ftp-gtquit
51NetTCP
- Provides services for TCP communications over
sockets - Layered on top of the NetInet and NetGen
modules - Constructor
- obj new NetTCP
- obj new NetTCP host, service
- obj new NetTCP \parameters
- obj new NetTCP host, service,
\parameters
52NetUDP
- Provides services for UDP communications over
sockets - Layered on top of the NetInet and NetGen
modules - Constructor
- obj new NetUDP
- obj new NetUDP host, service
- obj new NetUDP \parameters
- obj new NetUDP host, service,
\parameters
53NetTelnet
- All output is flushed while all input is
buffered. Each object contains an input buffer - Simple Example
- use NetTelnet
- t new NetTelnet (Timeout gt 10, Prompt gt
'/bash\ /') - t-gtopen(yunus.cmpe.boun.edu.tr")
- t-gtlogin(username, passwd)
- _at_lines t-gtcmd("/usr/bin/who")
- print _at_lines
- In addition to a username and password, you must
also know the user's shell prompt, which for
this example is bash - The methods login() and cmd() use the prompt
setting in the object to determine when a login
or remote command is complete
54NetTelnet (cont. I)
- Example This example gets a weather forecast
- my(forecast, t)
- use NetTelnet
- t new NetTelnet
- t-gtopen("rainmaker.wunderground.com")
- Wait for first prompt and "hit return".
- t-gtwaitfor('/continue./')
- t-gtprint("")
- Wait for second prompt and respond with
city code. - t-gtwaitfor('/city code./')
- t-gtprint("BRD")
- Read and print the first page of
forecast. - (forecast) t-gtwaitfor('/ \tpress
return to continue/i') - print forecast
- t-gtclose
55NetTelnet (cont. II)
- Example This example checks a POP server if we
have mail - my(hostname, line, passwd, pop, username)
- hostname "your_destination_host_here"
- username "your_username_here"
- passwd "your_password_here"
- use NetTelnet ()
- Turn off the telnet mode since the port were
connecting is not telnet - pop new NetTelnet (Telnetmode gt 0)
- pop-gtopen(Host gt hostname, Port gt 110)
-
- Read connection message.
- line pop-gtgetline
- die line unless line /\OK/
-
- Send user name.
- pop-gtprint("user username")
- line pop-gtgetline
- die line unless line /\OK/
-
56NetTelnet (cont. III)
- Example This example downloads a file of any
type - my( block, filename, host, hostname,
k_per_sec, line, - num_read, passwd, prevblock, prompt, size,
size_bsd, - size_sysv, start_time, total_time,
username) - hostname "your_destination_host_here"
- username "your_username_here"
- passwd "your_password_here"
- filename "your_download_file_here"
- Connect and login.
- use NetTelnet ()
- host new NetTelnet (Timeout gt 30,
Prompt gt '/gt /') - host-gtopen(hostname)
- host-gtlogin(username, passwd)
- Make sure prompt won't match anything in
send data. - prompt '_funkyPrompt_'
- host-gtprompt("/prompt\/")
- host-gtcmd("set prompt 'prompt'")
57NetTelnet (cont. IV)
- Start sending the file.
- binmode STDOUT
- host-gtbinmode(1)
- host-gtprint("cat filename")
- host-gtgetline discard echoed back line
- Read file a block at a time.
- num_read 0
- prevblock ''
- start_time time
- while ((block host-gtget) and (block !
/prompt/o)) - if (length block gt length prompt)
- print prevblock
- num_read length prevblock
- prevblock block
-
- else
- prevblock . block
-
58Example 5
- Simple Client reads from standard input or from
file given as parameter and sends to the server.
Perl provides support for the socket API
natively. Although the interface is not that bad
anyway, there is also a very convenient module,
IOSocket that works like a wrapper on the
native API and provides a simpler and easier way
to deal with sockets. - use IOSocket
- my sock new IOSocketINET (
- PeerAddr gt
'ipsala.cc.boun.edu.tr', - PeerPort gt
'2581', - Proto gt 'tcp',
- Timeout gt '5',
- )
- die "Could not create socket !\n" unless
sock - while(lineltgt)
- print sock line
-
- close(sock)
59Example 5 (continued)
- Simple Server reads from the socket and writes to
the screen. It is an iterative server. - use IOSocket
- my sock new IOSocketINET (
- LocalHost gt
'ipsala.cc.boun.edu.tr', - LocalPort gt
'2581', - Proto gt 'tcp',
- Listen gt 1,
- Reuse gt 1,
- )
- die "Could not create socket !\n" unless sock
- while()
- my new_sock sock-gtaccept()
- if (defined(new_sock))
- print "Connected with client".new_sock-gtpee
rhost()."".new_sock-gtpeerport()."\n" - while(lineltnew_sockgt)
- print line
-
-
60Example 5 (continued II)
- use IOSocket
- sock new IOSocketINET ( LocalHost gt
'ipsala', LocalPort gt '2581', - Proto gt 'tcp',
Listen gt 5, Reuse gt 1,) - die "Could not create socket !\n" unless
sock - use IOSelect
- read_set new IOSelect() create handle
set for reading - read_set-gtadd(sock) add the main
socket to the set - while ()
- _at_readyread_set-gtcan_read()
- foreach rh (_at_ready)
- if (rh sock)
- ns rh-gtaccept()
- print "Connected with client".ns-gtpeerh
ost()."".ns-gtpeerport()."\n" - read_set-gtadd(ns)
-
- else
- buf ltrhgt
- if(buf)
- print rh-gtpeerhost()."".rh-gtpeerport
()." wrote gtgt"
61Example 6
- It finds all the DNS entries that belongs to a
network for example 193.140.196 network. - use NetPing
- use Socket
- unless (scalar(_at_ARGV)1)
- print "Usage ltprogram namegt ltnetwork in
xxx.yyy.zzz formatgt\n" - exit 0
-
- print "DNS Entries for the network (ARGV0)
\n" - for i (1..254)
- hostARGV0.".".i
- my Wert gethostbyaddr(inet_aton("host"),
AF_INET) - print "host---gtWert\n"
-
62Example 7
- It finds all the open computer without firewall
and corresponding DNS entries of a network for
example 193.140.196 network. - only root can run
- use NetPing
- use Socket
- unless (scalar(_at_ARGV)1)
- print "Usage ltprogram namegt ltnetwork in
xxx.yyy.zzz formatgt\n" - exit 0
-
- print "Alive Computers in network (ARGV0) are
\n" - for i (1..254)
- p NetPing-gtnew("icmp")
- hostARGV0.".".i
- if (p-gtping(host,1))
- my Wert gethostbyaddr(inet_aton("host"),
AF_INET) - print "host---gtWert\n"
-
- p-gtclose()
-
63Example 8
- Portscan the computer whose IP is given as
parameter ,starting from the given first port
number to the given second port number. - use IOSocket
- unless (scalar(_at_ARGV)3)
- print "Usage ltIPgt ltStartPortgt ltEndPortgt\n"
- exit 1
-
- for i (ARGV1..ARGV2)
- my sock new IOSocketINET ( PeerAddr gt
ARGV0, - PeerPort gt i,
- Proto gt 'tcp',
- Timeoutgt1,)
- if (sock) print "ok with ARGV0 on port
i\n" - close(sock)
- undef(sock)
-
-
64Example 9
- Sends a mail using the specified mail server from
the specified person and from the specified
domain to the specified person. - use IOSocketINET
- print "Your domain name" domainnameltSTDINgt
- print "Mail Server To Be Used"
mailserverltSTDINgt chop(mailserver) - print "Mail From" mailfromltSTDINgt
- print "Mail To" mailtoltSTDINgt
- print "Your message" _at_mesajltSTDINgt
- (mailfr1,mailfr2)split(/\_at_/,mailfrom)
- (mailto1,mailto2)split(/\_at_/,mailto)
- chop(mailfr2) chop(mailto2)
- socket IOSocketINET-gtnew("mailserver25")
- or die "Couldn't connect to port 25 of hisar
!" - ltsocketgt print socket "HELO domainname"
- ltsocketgt print socket "Mail from
ltmailfr1\_at_mailfr2gt\n" - ltsocketgt print socket "rcpt to
ltmailto1\_at_mailto2gt\n" - ltsocketgt print socket "data\n"
- ltsocketgt print socket "_at_mesaj \n "
- print socket "\r\n.\r\n"
65Example 10
- Simple Redirection
- !/usr/local/bin/perl
- print "Location http//www.boun.edu.tr\n\n"
- Prints environmental variables and time at the
server - !/usr/local/bin/perl
- print "Content-type text/html\n\n"
- print "lthtmlgtltbodygt"
- (sec, min, hour) localtime (time)
- time "hourminsec"
- print "Time at the server is ltbgtltbiggtltbiggttimelt
/biggtlt/biggtlt/bgtltbrgtltbrgt" - foreach elem (sort keys ENV)
-
- print "ltbgtelemlt/bgt ENVelemltbrgt"
-
- print "lt/htmlgtlt/bodygt"
66Example 11
- !/usr/local/bin/perl
- print "Content-type text/html", "\n\n"
- print "lthtmlgtltbodygt"
- tempdate '(at HMS in m/d/y)'
- system("echo ENV\"REMOTE_ADDR\" is visiting
your homepage at date '(at HMS in
m/d/y)' mail basarabu") - sayac_dosyasi"counter.log"
- if(open(SAYAC,sayac_dosyasi))
-
- ziyaretci_sayisiltSAYACgt
- close(SAYAC)
- if(open(SAYAC, "gtsayac_dosyasi"))
-
- ziyaretci_sayisi
- print SAYAC ziyaretci_sayisi
- close(SAYAC)
- print "ltCENTERgtltH2gtVisitor Number
ziyaretci_sayisilt/H2gtlt/CENTERgt" -
67Example 12
- My nslookup it can take both IP or domain name as
parameter - use Socket
- unless (scalar(_at_ARGV)1)
- print "Usage ltprogramnamegt ltIP or DNS
namegt\n" - exit 0
-
- if (ARGV0 /0-9/)
-
- addr inet_aton(ARGV0)
- x gethostbyaddr(addr, AF_INET)
- print "Name of the host x\n"
-
- else
-
- use Nethostent
- my h gethostbyname(ARGV0)
- if (h) print "IP of the host is
",inet_ntoa(h-gtaddr),"\n" - else print "No DNS entry was found \n"
-
68Example 13
- use IOSocketINET
- socket IOSocketINET-gtnew("www.boun.edu.tr8
0") - or die "Couldn't connect !"
- print socket "GET http//www.boun.edu.tr/scripts/
studsearch.asp?languageEngPage1namealisurnam
- ex0y0 HTTP/1.0\n\n"
- _at_altsocketgt
- print _at_a
- use LWPUserAgent
- use HTTPRequestCommon
- my ua LWPUserAgent-gtnew
- site"www.mit.edu"
- resua-gtrequest(GET "http//www.net.cmu.edu/cgi-
bin/netops.cgi?querysiteoptraceroute.submitS
ubmitQuery.cgifieldsop") - if (res-gtis_success) print res-gtcontent
69Example 14
- use NetFTP
- unless (scalar(_at_ARGV)3)
- print "usage ltprogram-namegt lthostaddressgt
ltusernamegt ltpasswordgt\n" - exit 0
-
- ftp NetFTP-gtnew(ARGV0) or die "Couldn't
connect _at_\n" - ftp-gtlogin(ARGV1,ARGV2) or die "Could not
login\n" - ftp-gtbinary
- my _at_items ftp-gtls("-lFa")
- print "Normal files in the account are \n"
- foreach elem (_at_items)
- unless (elem /d/) print elem."\n"
-
- print "Directories in the account are \n"
- foreach elem (_at_items)
- if (elem /d/) print elem."\n"
-
- ftp-gtquit
70Resources
- http//www.perl.org
- http//www.perldoc.com
- http//www.perlfect.com
- http//www.modperl.com
- http//www.perl.com
- http//forums.perlguru.com
- http//www.oreilly.com/catalog/pperl3
- http//www.engelschall.com/ar/perldoc/
- Programming Perl, OReilly, 3rd Edition
71