본문으로 바로가기

표준 Tcl 라이브러리 'Tcllib'

category 카테고리 없음 2024. 6. 25. 13:32

Tcllib is a collection of utility modules for Tcl. These modules provide a wide variety of functionality, from implementations of standard data structures to implementations of common networking protocols. The intent is to collect commonly used function into a single library, which users can rely on to be available and stable.

 

http://tcl.activestate.com/software/tcllib/

 

표준 Tcl Library는 보통 Tcl의 배포판에 기본으로 포함되며 Tcllib라 부릅니다. Tcllib는 범용으로 자주 쓰이는 편리한 루틴을 Tcl언어로 만든 확장 패키지의 집합입니다. 오픈소스의 개발진에 의해 개발되며 지금도 새로운 기능들로 버전업이 되고 있습니다. 여기서는 그중 편리하고 유용한 몇 개의 패키지에 관하여 알아보도록 합니다.

  • base64 : Base64 인코더/디코더
  • mime·smtp : SMTP를 사용한 전자메일 송신
  • pop3 : pop3를 사용한 전자메일 수신
  • ftp : FTP를 사용한 파일의 송/수신
  • csv : 텍스트 파일 해석기
  • uri : URL 해석기
  • fileutil : 디렉토리 재귀검색
  • cmdline : 옵션의 해석
  • ncgi : CGI 유틸리티
  • ftpd : FTP 데몬
  • smtpd : SMTP 데몬
  • struct : 데이타 제어
  • htmlparse : HTML 파서

base64

base64는 주로 PC상에서 이미지 등의 바이너리 데이터를 이메일로 상대방에게 보낼 때 사용되어지는 일종의 인코드 형식으로(전자메일은 8번째 비트를 갖는 문자를 송/수신할 수 없음) 7비트 형식의 아스키 문자로 표시됩니다. base64 패키지는 임의의 Tcl문자열을 base64 형식으로 변환하거나, base64 형식으로부터 원래의 문자열로 변환하는 기능을 제공합니다. 또한 Tcl/Tk 스크립트 내에 이미지 데이터를 내장할 수 있는데 이때 base64가 쓰이기도 합니다. 아래의 코드는 gif 포맷의 이미지를 읽어, base64 형식으로 변환한 후 Tcl 스크립트로 출력하는 예제입니다.

package require base64
 
set targetFileName "C:/tcl/lib/tk8.4/images/pwrdLogo100.gif"
set tempFileName   "tmptmp.tcl"
 
fconfigure [set fin [open $targetFileName r]] -translation binary
set buf [read $fin]
close $fin
 
set encoded_buf [base64::encode -maxlen 60 -wrapchar "\\\n" $buf ]
 
set fout [open $tempFileName w]
puts $fout \
   "set data {$encoded_buf}\n\
   image create photo Image1 -data \$data\n\
   button .cmda -image Image1 -command exit\n\
   pack .cmda\n\
   "
close $fout
puts "wrote. [file size $tempFileName] bytes. reading..."
source $tempFileName
# end.

실행 후 아래와 같은 코드를 얻을 수 있습니다.

set data {R0lGODlhQABkAPUAAP//////zP//mf//AP/MzP/Mmf/MAP+Zmf+ZZv+ZAMz/\
/8zM/8zMzMyZzMyZmcyZZsyZAMxmZsxmM8xmAMwzM8wzAJnMzJmZzJmZmZlm\
mZlmZplmM5kzM5kzAGaZzGaZmWZmzGZmmWZmZmYzZmYzMzNmzDNmmTMzmTMz\
ZgAzmQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH+BSAtZGwtACH5BAEKAAIALAAA\
AABAAGQAAAb+QIFwSCwaj0UE4hGJIJ/QKPHBjEgklIp2y+1qndLw0Esum70S\
cfi8NUy4k8EAwu5eKdkz5Vk3GLpyA391hHZ8ZxADb22ChY5caUhsBgNwjY+Y\
YEeTCVx+mKAPh2ZuW3GLoI5QEmeDWp9sEQQABXmYq61cimyzAL4EqbhmnVqJ\
ZxK9FyUlDA+gwmWoBsRlAQAXKdnZGM9PrGaou2WzINrmHLdPEYRxZgUAJeba\
KN1I63UJrl0PACby2qD2qCM0jYwEAOX+pUCHKRISBITEdSGATeEIMhMgoIJQ\
SovDIxDrVPISYYHCFPTIUNJHaQuHEiA8SGLTzguBeAoZeokzslj+TxLaZp6Z\
oO8Lg5MXo13SQnQL0GxCwVHbcvPk0DlwUI0IuokmHS4UTOasIAHBLGBbEqGq\
sBZFNhNRo62t8KDiPxIjTIC4oACArXxn3KYAERfj3AL+TpoLAeBbBQNfywiW\
2RUTAcXyIjTe0rMM18qPjmLWxu8bRzafjaSyixnFAQBt5npJXQSUhISjSRBA\
+5gNh7ejHEnAOZoCAGdsZXf5nYIy6EISEmM+wS/P1DLMoaSSrngEgQKm6jzV\
Dop7CvMLNzsaH9zRCXnESYN/tPUENEeCUWowj4I3/hQl3FfIVtmMgME/Idzz\
iFvOHeFYHcg9tRBr2WiQiltRPMjLARX+MJdCBxbIkxQoUAl4xiwMhJDNCRSE\
OE8qWpQ4UCHkJIaCBKx1AGMF50VhIY2iZUPCAx7MQ0IDASDnSAeDRbGBIxSZ\
Q4IDRZqDgnqO/CaFTnUUwBoHBOCWDWOgMLmlIwVUmU0FVZnzgX+FmBkFl2wc\
cCBA/chzwXyYpHBmIQjcuSYA75nDAIegBDinIw84oM0JFRAqDwFKPtIgEnQe\
42g2KBj3DwEaFrKGIxQcMM9B8vQXKiGjoinYjQCIeMCqdbRayAGvoiolFcFI\
gckBBMIqDwcI0MqGFB5g8oAGnOqqDQd8pgMFCA0xi5Kz2ZQKoxQmgLKpsPNU\
Ku0TkGbSbKz+2pCghS2PSFHuIxK8hwIH6K4pwQHiFiIKFClh8t4J9BY6ggTv\
5EvIvk/0S182AQs5AgoWKPiIJkgoXMc3T9EbXwoWGHsMFB5YzAYyEmS8wMYM\
wPiRESWMWIgvVXLAgJgpwCkcFCa4TMgBuMmsJkrRwgtFCjrXQUGQU7KGgcSP\
CIRECuoqWyUKDrCW8o5DR42JA/GgEEGQIiC67RNQw+iAPxKIlYIDO2rxRJFa\
g5KBCfQ223YFT5STKX1g+rP3uEX4fTebGcSN9dMLNSQuvoO7jfjfZwTwYARi\
30124pDUITkkNo99BMNcyKK5hp33+vmHXBwA6hb3NsHF5lyUXk/+EVXquIXo\
WwSQhe65azhr4wgcgZPtX/B2kEevaxhBSHcHb0RiXeBOFmxewL4FBbI/gjAR\
AIW+uharV2o9VY1TPET3XDwweQS2SOB6F7/fbb4Q6A9uxeAr079m48jfnb8A\
9eOf/4yQkHeRoQMc4AAJ8IICFBTqBBBsoARHQMERLHCBCcxgAjvAQTSwjFMJ\
XODDHDiaEppQHlEo1AlXyEIUDq2FMGxhFGJIwxPOUB4q1AZ6FAJBc+QwBT/8\
oYwQpw0QMCBIJljABVw0GA848QLSWYCajIhEKWrDAwxQG21oJw8qXrEcQUoB\
AyxggTAqwC5GZGIS1eRED9BsWl1kDQhoLJBEc1jgAgywmgpBoEQdWkCFTrTA\
xnAmDxNszAN0NAcIYMKdC9jFkGoywQXUVIIL0MxPl6uhJhXzwk160oVqUIMH\
SrBDTYbylEZwYwmEuEJUuhJkICjlP15JSzGM0jxwqaUudzmEIAAAOw==}
image create photo Image1 -data $data
button .cmda -image Image1 -command exit
pack .cmda

생성된 tmptmp.tcl 스크립트를 실행하면 내장된 이미지로 처음의 예제와 같은 결과를 얻을 수 있습니다.

mime과 smtp

mime과 smtp는 tcllib의 mime 디렉토리 내에 존재합니다. 이들은 임의의 문자열이나 파일을 첨부한 메일 메시지를 만들고, SMTP(Simple Mail Transfer Protocol)를 사용하여 메일을 송신하는 기능을 제공합니다. 2바이트 언어권 지원은 1바이트 언어권 국가에 비해 복잡하긴 하지만, MUA(Mailer)로 메일을 보내는 것과 같이 정상적으로 메일을 송신할 수 있습니다.

package require mime
package require smtp
 
set textmessage \
{ 테스트 메일을 송신합니다．
This is a test mail.
------------------------------------------------------}
 
proc sendTextMessage {textmessage} {
   set sendable [encoding convertto iso2022-kr $textmessage]
 
   set part [mime::initialize \
   -canonical "text/plain; charset=iso-2022-kr" -string $sendable]
 
   set r [smtp::sendmessage $part \
   -servers gmail.com \
   -ports 25 \
   -header [list From "Korea Tcl/Tk Community Administrator<<a href="mailto:inhak.min@gmail.com">inhak.min@gmail.com</a>>"] \
   -header [list To "Who<<a href="mailto:who@gmail.com">who@gmail.com</a>>"] \
   -header [list Subject "Test Message"] \
   ]
   puts "done. result: $r"
}
 
sendTextMessage $textmessage
# end.

 

Tcl 스크립트로 작성한 문자열이나, 이미 있는 파일의 내용을 위와 같이 간단하게 메일을 송신할수 있습니다. 영어로만 이루어진 메일의 전송은 아래와 같이 하면 됩니다.

  1. mime::initialize 커맨드로 Tcl 문자열이나, 파일로부터 MIME 메세지를 만듭니다.
  2. smtp::sendmessage 커맨드로 SMTP 메일서버로 메일을 송신합니다. 여기서 말한 SMTP서버는, sendmail 등의 메일러 데몬이 설치되어 작동되고 있는 서버를 말합니다.

현재 Tcl스크립트를 실행하고 있는 머신 자체가 메일서버가 아닌이상, smtp::sendmessage 커맨드에는 -servers 옵션에 SMTP 메일서버의 호스트이름(호스트가 여러 개일 때는 호스트의 이름을 리스트 형태로 입력해 줌), -ports 에는 포트이름을 지정합니다. 포트번호는 디폴트값 25로, 즉 SMTP의 디폴트이므로 보통 생략합니다. 위의 1,2번 방법대로 하면 한글 메시지는 깨집니다. 한글 취급 시 아래의 두 가지 점을 주의해야 합니다. 한국어는 encoding convertto의 서브 커맨드를 사용하여, iso2022-kr로 인코딩합니다. mime::initialize 커맨드의 -canonical 옵션에는 Content-Type의 값으로, text/plain; charset=iso-2022-kr 을 반드시 지정합니다. 디폴트값으로는, text/plain; charset="us-ascii"가 Content-Type이 되므로, 이 상태에서 한글을 사용한다고 강제로 지정해야 합니다. 위의 스크립트를 응용하여, 간단하게 메일을 보내는 스크립틀 만들어 보겠습니다. 커맨드 라인에 지정한 텍스트 파일을, 스크립트에 지정된 메일 어드레스로 송신해 보겠습니다.

package require mime
package require smtp
set filename [lindex $argv 0]

if {"$filename" == ""} {
   puts stderr "usage: $argv0 filename"; exit 1
}

proc sendTextFile {filename encoding} {

set fin [open $filename r]
fconfigure $fin -encoding $encoding
set buf [read $fin]
close $fin set sendable "\n[encoding convertto iso2022-kr $buf]"
set part [mime::initialize \
    -canonical "text/plain; charset=iso-2022-kr" \
    -string $sendable]
set r [smtp::sendmessage $part \
    -servers dynalith.com -ports 25 \
    -header [list From "Korea Tcl/Tk Community Adaministrator <<a href="mailto:inhak.min@gmail.com">inhak.min@gmail.com</a>>"] \
    -header [list To   "<a href="mailto:who@gmail.com">who@gmail.com</a>"] \
    -header [list Subject "SYSTEM REPORT"] ]}

sendTextFile $filename euc-kr

이번에는 이미지파일이나, 음성파일등의 바이너리 파일을 송신하기 위해, base64 인코드를 사용하여 메일을 보내 보도록 하겠습니다.

package require smtp
package require mime
set server "gmail.com"
set from "<a href="mailto:inhak.min@gmail.com">inhak.min@gmail.com</a>"
set to "Who <a href="mailto:who@gmail.com">who@gmail.com</a>"
set subject "your pic."
set imageFile "demo120.gif"
set tail [file tail $imageFile]
set part [mime::initialize -canonical "image/gif" \
    -encoding base64 -file $imageFile \
    -param [list "Content-Disposition" "attachment; filename=$tail"]]
set r [smtp::sendmessage $part -servers $server -ports 25 \
    -header [list From "$from"] -header [list To "$to"] \
    -header [list Subject "$subject"]]

 

바이너리 데이터를 보낼시, 그것이 파일이라면(바이너리 데이타를 Tcl스크립트로 내장한 것이 아니라면), mime::initialize 커맨드의 -file로 보내고자 하는 파일을 지정하고, -encoding으로 base64를 지정하기만 하면 됩니다. 예제의 Content-Disposition는 첨부파일에 포함할 파일을 가리키기 위해서 사용한 것입니다. 이것을 응용하여, 마지막으로 멀티퍼트 즉 첨부파일과 메시지를 한꺼번에 보내보도록 하겠습니다.

package require smtp
package require mime
set server "gmail.com"
set from "In-Hak Min <a href="mailto:inhak.min@gmail.com">inhak.min@gmail.com</a>"
set to "Who <a href="mailto:who@gmail.com">who@gmail.com</a>"
set subject "my message & your pic."
set textmessage \
    "테스트 메일을 송신합니다．\n\
    This is a test mail.\n\
    ??????????????????\n"

set imageFile "demo122.gif"

set sendable [encoding convertto iso2022-kr $textmessage]
set Tpart [mime::initialize \
    canonical "text/plain; charset=iso-2022-kr" -string $sendable]
set tail [file tail $imageFile]
set Ipart [mime::initialize -canonical "image/gif" \
    encoding base64 -file $imageFile \
    param [list "Content-Disposition" "attachment; filename=$tail"]]
set Mpart [mime::initialize -canonical multipart/mixed \
    parts [list $Tpart $Ipart]]
set r [smtp::sendmessage $Mpart \
    servers $server -ports 25 -header [list From "$from"] \
    header [list To "$to"] -header [list Subject "$subject"] ]
mime::finalize $Mpart

 

멀티퍼트의 메일을 보낼 때는, 먼저 각각의 퍼트를 mime::initialize를 하고, 마지막으로 mime::initialize로 -canonical multipart/mixed를 갖는 퍼트를 만들고, 이것을 송신하면 됩니다.

pop3

위와 같이 보내는 측이 있다면, 받는 측도 있어야 합니다. 이번에는 전자메일 수신 측의 설명입니다. pop3패키지는 POP3(Post Office Protocol)라고 하는 프로토콜을 사용하며, POP서버로부터 메일을 수신하거나, 수신한 메일을 POP서버 상으로부터 삭제하는 기능을 갖고 있습니다.

package require pop3
set popserver "gmail.com"
set user "*"
set password "*"

set con [pop3::open $popserver $user $password 110]
set r [pop3::status $con]
puts "[lindex $r 0]통의 메일 ([lindex $r 1]바이트)이 도착했습니다."

puts "첫번째 메일을 읽습니다."
set message [lindex [pop3::retrieve $con 1 1] 0]
puts [encoding convertfrom iso2022-kr $message]
pop3::close $con

 

예제에 대한 설명은 아래와 같습니다.

  1. 먼저 pop3::open을 사용하여 POP서버에 로그인합니다. 이 커맨드는 4개의 인자를 받아들이는데, POP서버, 사용자 아이디, 패스워드, POP의 포트를 받아들입니다. 포트번호를 생략하면 디폴트 110이 사용됩니다.
  2. pop3::status를 사용하면 메일의 수, 스풀(spool)의 사이즈를 리스트로 알아올 수 있습니다.
  3. pop3::retrieve를 사용하면, 메일을 수신합니다. 인자는 수신하고 싶은 메일의 범위입니다. 첫 번째 인자는 보고 싶은 메일의 번호이고, 두번째 인자는 보고싶은 메일의 끝번호입니다. pop3::retrieve에 리턴되는 값은, 각 번호의 메일 내용이 문자열로 이루어진 Tcl 리스트가 반환이 됩니다. 메일 내용은 한통이라도 반드시 리스트로 반환이 되기 때문에 lindex로 취급해야 합니다. 만약 lindex로 취급하지 않으면, 뒤에 나오는 encoding convertfrom 커맨드로 변환할 수 없기 때문에 문자열이 깨어지게 됩니다.
  4. 이제 수신이 끝났다면, 마지막으로 pop3::close 커맨드로 접속을 끊으면 됩니다. 위의 방법대로 한다면, 메시지를 받아도 POP서버의 메세지는 삭제되지 않습니다. 서버상의 메세지를 삭제하는 방법은 pop3::delete 커맨드를 사용합니다.

ftp

ftp 패키지는 가장 대중적인 프로토콜의 하나인 FTP(File Transfer Protocol)를 사용하여, 원격지의 컴퓨터로 파일을 송/수신할 수 있는 커맨드를 제공합니다. 사용법은 매우 간단합니다. 대략적인 사용방법은 아래와 같습니다.

  1. ftp::Open 커맨드를 사용하여 원격 컴퓨터에 로그인합니다. 접속 실패 시, ftp::Open 커맨드는 -1을 리턴합니다.
  2. ftp::Type 커맨드로 전송모드(아스키/바이너리)를 선택합니다.
  3. ftp::Cd 커맨드로 디렉토리를 이동합니다.
  4. ftp::NList 커맨드로 파일의 리스트를 list 형태로 받아들입니다.
  5. ftp::List커맨드는 ftp로 "dir" 커맨드와 같은 결과를 얻을 수 있지만, 2바이트 언어권의 파일명이 있을 때에 대비해 ftp::NList를 사용하는 것이 좋습니다.
  6. ftp::Get으로는 파일을 수신하며, ftp::Put으로 파일을 송신합니다.
  7. 마지막으로 ftp::Close로 접속을 끊습니다.

아래의 예는 지정된 ftp 서버의 *. txt나 *. dat라고 하는 텍스트 파일을 얻어, 로컬 디렉토리에 저장하는 스크립트 예제입니다. 애플리케이션의 백업용이나, 잡다한 백업 자동화에 딱 맞는 예제일 것 같습니다.

package require ftp
fconfigure stdout -encoding euc-kr
set REMOTEHOST 143.248.239.113
set USER test
set PASSWORD 1234
set REMOTEDIR /Upload(업로드폴더)

# FTP 서버에 접속
set con [::ftp::Open $REMOTEHOST $USER $PASSWORD]
::ftp::Type $con binary

# 파일의 리스트 얻음
::ftp::Cd $con $REMOTEDIR
set files [::ftp::NList $con]

# .dat나 .txt의 파일을 다운받습니다.
foreach e $files {
   if {[regexp {\.(da|tx)t$} [string tolower $e]]} {
      puts "$e 을 수신하고 있습니다…"
      ::ftp::Get $con $e
      puts "$e 을 수신했습니다．([file size $e] bytes)"
   }
}

::ftp::Close $con

 

위의 예는 fconfigure 커맨드로 stdout의 부호화 인코딩을 euc-kr로 합니다. 참고로 변수 ::ftp::DEBUG, ::ftp::VERBOSE를 1로 세팅 시, 접속 중 다양한 메시지가 표시됩니다.

csv

csv 패키지는 텍스트 파일을 해석하고, 각 필드를 Tcl리스트에 저장하거나, Tcl리스트로부터 해석하는 편리한 루틴입니다. 사용법도 간단합니다.

package require csv
set a {ABCD 한국어 {def,fg} 9876 "This is a pen."}
set b [::csv::join $a]
puts $b

set c {This is a pen,9876,"def,fg",한국어,ABCD}
set d [::csv::split $c]
puts $d

 

실행결과 

ABCD,한국어,"def,fg",9876,This is a pen.
{This is a pen} 9876 def,fg 한국어 ABCD

uri

URI(Uniformed Resource Identifier)란, URL(Uniformed Resource Locator)과 같은 개념으로 해석하면 됩니다. uri 패키지는 예를 들면, http://www.tcltk.co.kr:8000/data/log.dat?opt=1222 위와 같은 주소를, 프로토콜, 호스트이름, 포트번호, 디렉토리패스등으로 분할하여 Tcl 리스트로 리턴 시켜줍니다. uri::geturl 커맨드를 사용하면, 프로토콜이 http, ftp등인 경우, 실제로 그러한 프로토콜을 사용하여 URI가 가리키는 내용을 수신해 넘겨줍니다. 수신 데이터는, HTTP인 경우는 http::data 커맨드로 얻을 수 있습니다.  

package require uri
set baseurl "<a href="http://www.tcltk.co.kr/"">http://www.tcltk.co.kr/"</a>

while 1 {
   puts -nonewline "> ";
   flush stdout;
   set u [gets stdin]
   if {"$u" == ""} break
   # <a href="http://www.tcltk.co.kr:8000/data/log.dat">http://www.tcltk.co.kr:8000/data/log.dat</a>

   puts "split: [::uri::split $u]"
   # port 8000 path data/log.dat scheme http host <a href="http://www.tcltk.co.kr">www.tcltk.co.kr</a> query {}

   if [::uri::isrelative $u] {
      puts "Specified URI \"$u\" is relative:"
      puts "Resolved: [::uri::resolve $baseurl $u]"
   }
   set token [::uri::geturl $u]
   puts "******"
   puts [::http::data $token]
   puts "******"}

fileutil

디렉토리를 재귀검색으로 파일을 찿거나, 엔트리의 수를 얻거나하는 커맨드는 TclX 에서도 제공되고 있긴합니다만, 여기서는 Tcl 버전을 설명합니다. 먼저 파일을 패턴매치나 정규표현으로 파일을 찿는 커맨드는 fileutil::findByPattern 입니다. 사용은 간단하며, UNIX의 find 커맨드와 마찬가지로 탐색의 기점이 될 디렉토리 패스와, 찾고 싶은 패턴을 지정하면 해당한 파일의 풀패스가 리스트로 넘어옵니다.

package require fileutil
set basedir .
set result [::fileutil::findByPattern $basedir -glob *.tcl]
foreach e $result {
    puts "\[$e\]"
}

 

실행화면

E:/Temp/bravais/demo.tcl
E:/Temp/demo.tcl

 

그런데, 단순한 패턴 매치가 아니라, 좀 더 복잡한 검색 조건을 사용하고 싶은경우는, 좀더 로우레벨의 fileutil::find를 사용합니다. 이 커맨드는 기점 디렉토리와 필터를 정의한 커맨드를 지정합니다. 커맨드는 파일명(디렉토리 패스는 포함되지 않음)을 인자로 받아들이기 때문에, 1이나 0을 리턴 시켜 주도록 작성하면 됩니다. 아래의 예는 파일명에 em을 포함하고 있는 파일을 검색합니다.

package require fileutil
set basedir .

proc filtercmd filename {
   if {[regexp em $filename]} {return 1} {return 0}
}

set result [::fileutil::find $basedir filtercmd]
foreach e $result {
    puts "\[$e\]"
}

 

위의 예는 프로시져 filtercmd 내에서 단순한 정규표현식을 사용하고 있습니다. 추가적으로 fileutil에 포함된 커맨드 두 개를 소개합니다.

package require fileutil
set filename [lindex $argv 0]
set buf [::fileutil::cat $filename]
puts $buf

 

fileutil::cat 커맨드는, UNIX의 cat커맨드와 같이 지정한 파일의 내용을 읽어서 보여주는 커맨드입니다.

package require fileutil
set basedir .
foreach file [::fileutil::findByPattern $basedir -glob "*.tcl"] {
   foreach e [::fileutil::grep "require" $file] {
      puts $e
   }
}

 

실행화면

E:/Temp/bravais/demo.tcl:1:package require fileutil
E:/Temp/demo.tcl:1:package require fileutil
E:/Temp/demo.tcl:5: foreach e [::fileutil::grep "require" $file] {

 

fileutil::grep 커맨드는, UNIX의 grep커맨드와 같이, 텍스트 파일 안으로부터 지정한 정규표현을 포함한 행을 검색하여 돌려주는 커맨드입니다. 위의 예는 현재디렉토리부터 하위디렉토리의 tcl 파일을 검색하면서, require문자가 포함된 파일을 검색하고 있습니다.

cmdline

Tcl로 편리한 툴을 작성한다면 커맨드의 라인 옵션도 생각해 볼 문제입니다. 지금까지는 변수 argv의 각 요소를 조사하여 옵션을 처리했었지만, 이 cmdline 패키지를 사용한다면, 매우 간단하게 옵션을 해석할 수 있습니다.

package require cmdline
while 1 {
   puts -nonewline ">"; flush stdout
   set cmd [gets stdin]
   if {"$cmd" == ""} break
  # .arg 있다면, 옵션의 값으로 넣으준것을 지시합니다.
  # 이 경우 옵션를 붙이지 않는다면 -1이 되돌아갑니다．
   puts [::cmdline::getopt cmd {c d f.arg V} optvar valvar]
   puts "option: $optvar value: $valvar"
  # -f tmp.dat 라고 한다면，리턴값 1 optvar=f valvar=tmp.dat
  # -f         라고 한다면，리턴값 -1
  # -d         라고 한다면，리턴값 1 optvar=d valvar=1
  # -d 20      으로 한다면，리턴값 1 optvar=d valvar=1
  # tmp.dat    라고 한다면，리턴값 0 optvar=  valvar=
  # -- -f tmp.dat 라고 한다면，리턴값 0 optvar=  valvar=
}

 

cmdline::getopt 커맨드는 옵션을 해석하는 커맨드입니다. 처음의 인자는 커맨드라인의 문자열 변수이름, 다음의 인자는 스크립트가 받아들일 수 있는 가능한 옵션의 리스트입니다. 여기에서는 {c d f.arg V}로 지정하였는데, -c -d -f -V와 같이 4가지의 옵션이 가능한것입니다. .arg를 붙인다면, 그 옵션에 지정될 값을 넣어야 합니다. 위의 경우는 f.arg로 하고 있기 때문에, -f filename과 같은 옵션을 지정해야 합니다. 끝의 optvar과 valvar의 옵션과 같이, 변수의 이름을 지정하면, 해석결과가 저장됩니다. 첫 번째 인자에 지정한 커맨드 라인안에, 두 번째 인자에 지정한 옵션이 있다면 1을, 없는 경우는 0 또는 -1이 리턴됩니다.

ncgi

CGI(Common Gateway Interface)는 트랜잭션이 적은 개인 또는 소규모의 웹사이트에 주로 사용되었던 것으로, 사용자의 요청에 응하여 웹서버 측에서 어떠한 처리를 하거나, 동적인 웹 내용을 회신하거나 할 때 Perl이나 C가 자주 쓰여 왔습니다. 그러하기 때문에 범용 스크립트 언어인 Tcl이나 Python에서 CGI스크립트를 사용하는 것이, 이러한 범용 스크립트 언어의 실용성을 꾀한 하나의 목표로 되어 왔습니다. 그 때문에 범용 스크립트 언어의 대부분은 CGI를 간단하게 쓰기 위한 라이브러리가 내장 되거나, 확장 패키지 형태로 배포되고 있습니다. Tcl역시 CGI를 쓰기위한 라이브러리가 몇 가지 제공되었지만, ncgi패키지가 tcllib에 포함된 것으로 사실상 표준이 되어 버렸습니다. ncgi는 심플하면서도, 보통의 CGI기능을 내장하고 있으며, 이것을 사용하면 CGI의 내부처리를 세밀하게 처리하지 않아도 되므로, 개발 생산성을 올려주는 라이브러리라 할 수 있습니다. 우선 간단한 HTML폼의 페이지입니다.

<body bgcolor="white">
<form action="/cgi-bin/tcllib/test.cgi" method="put">
이름
<input type="text" size=20 maxlen=14 name="username">
메일주소
<input type="text" size=20 maxlen=14 name="mailaddress"><br>
<input type="submit" value="OK">
<input type="reset" value="Reset"><br>
</form></body>

 

위에 대응하는 CGI스크립트입니다.

#! /usr/bin/tclsh
package require ncgi

proc putsHeader {} {
   ncgi::header "text/html; charset=euc-kr"
   puts {
      <html><head><title>CGI의 처리 결과</title></head>
      <body bgcolor="white">
   }
}

proc putsFooter {} {
   puts {</body></html>}}

   set r [ncgi::query]
   set r [ncgi::parse]

   if {[ncgi::empty "username"]} {
     putsHeader
     puts {<h2>이름을 입력하세요.</h2>}
     putsFooter
     exit
   }

   set userName [ncgi::decode [ncgi::value "username"]]
   set mailAddress [ncgi::value "mailaddress" "<a href="mailto:unknown@a.com">unknown@a.com</a>"]

   set cookieName "customer"
   ncgi::setCookie -name $cookieName -value $userName
   set cookieName "mailaddr"
   ncgi::setCookie -name $cookieName -value $mailAddress

   putsHeader puts "<h2>어서오세요.</h2> ${userName}씨($mailAddress). 안녕하세요．<br>"
   puts "인터넷 쇼핑몰은 <a href=\"/cgi-bin/tcllib/test2.cgi\">이곳</a>을"
   puts "클릭해주세요．<br>"
   putsFooter
}

 

ncgi패키지를 사용한 CGI스크립트의 처리 순서는 아래와 같습니다.

  1. 먼저, 예와 같이 사용자로부터 입력폼으로 파라미터를 입력받은 경우, ncgi::query와 ncgi::parse를 사용하여, 파라미터를 CGI변수에 저장합니다.
  2. 저장된 CGI변수는, ncgi::value와 ncgi::decode를 사용하여 참조할 수 있습니다. ncgi::decode는 파라미터의 문자열의 공백을 '+'로 인코딩하기 때문에, 원래의 문자열로 복원하는 처리를 하는 것입니다.
  3. ncgi::header를 사용하여, HTTP헤더를 송신합니다.
  4. HTML문서의 본체를 puts로 표준출력에 쓰기 시작합니다. 그런데, HTTP의 통신에 있어, 현재 페이지의 입력된 파라미터의 정보를 다른 페이지에서 참조하고 싶은 경우는, 쿠키가 쓰입니다.

ncgi에서도 쿠키를 읽고/쓰는 커맨드가 있습니다.

set cookieName "customer"
ncgi::setCookie -name $cookieName -value $userName
set cookieName "mailaddr"
ncgi::setCookie -name $cookieName -value $mailAddress

 

위와 같이, ncgi::setCookie를 사용하여, 브라우저에 '이 이름에 이값의 쿠키를 설정하라' 라는 명령을 HTTP 헤더에 부가할 수 있습니다. 이말은 ngci::setCookie는 ncgi::header보다 먼저 실행하지 않으면 안되는것 입니다. 그러면 쿠키가 부라우저에 세트가 되더라도, 위의 ‘이곳’의 링크를 클릭했을 때 test2.cgi 페이지에서 쿠키를 인식할까요? 아래는 test2.cgi입니다.

#! /usr/bin/tclsh
package require ncgi

ncgi::header

set customer [lindex [ncgi::cookie "customer"] 0]
set mailmail [ncgi::cookie "mailaddr"]

puts "<body bgcolor=\"white\">"
if {"$customer" == ""} {
     puts {
<h2>브라우저에 쿠키가 설정되어 있지 않습니다．</h2>
<a href="/index.html">홈페이지로 돌아가기</a>
     }
} else {
    puts "<h2>${customer}님 추천 상품입니다.</h2>"
    puts "특별할인 가격이므로, ${mailmail}으로 자료를 보냅니다.<br>"
    puts "또 방문 해주세요.<br>"
}

puts "</body>"

ftpd

ftpd 패키지는 이름대로, 다른 컴퓨터의 FTP접속을 기다리는 서버 프로세스의 기능을 제공합니다. 도대체 스크립트 언어로 FTP서버의 기능을 제공하는 이유가 무엇인지 궁금하기도 합니다만, O/S표준의 패스워드 인증시스템을 사용하지 않기 때 문에, LDAP로 인증한 FTP서버등, O/S의 인증을 필요로 하지 않는 FTP서버를 잠시 사용하고 싶은 경우에 편리할 것입니다.

package require ftpd
proc authIP ip {
   puts "접속 요구가 발생했습니다. IP Address = $ip"
   return 1
}

proc authUser {account password} {
   puts "어카운트(Account) = $account"
   if {"$account" == "h2h1995" && "$password" == "1234"} {
      return 1
   } else {
      return 0
   }
}

::ftpd::config -authIpCmd authIP -authUsrCmd authUser # set
::ftpd::port 2002 ::ftpd::server

message .msg -text "현재 FTP 서버가 동작하고 있습니다."
button .b -text "종료" -command { exit }
pack .msg .b -side top

 

::ftpd::config 커맨드로, 클라이언트부터 접속되었을 때의 callback 스크립트를 작성합니다. -authIpCmd는 클라이언트의 IP어드레스를, -authUsrCmd는 클라이언트로부터 입력받은 사용자 이름과 패스워드를 인자에 받게 되어 있는데, 이러한 인증 처리는 해줄 필요가 있습니다. 건네받은 IP어드레스나 사용자 이름이나 패스워드를 사용하여 FTP에 접속을 한다면 1을, 그렇지 않다면 0을 리턴 시켜줍니다. 서버의 포트를 표준 21에서 바꾸고 싶은 경우, 변수 ::ftpd::port에 포트번호를 세팅하고 ::ftpd::server를 실행하면 됩니다. 접속된 다음의 기능이지만, HELP 커맨드로 서버에서 제공해 주는 커맨드의 리스트를 볼 수 있습니다. 많은 커맨드는 지원하지 않지만, 대충 FTP서버로 잠시 이용하고 싶은 분께는 유용하리라 생각이 듭니다.

smtpd

tcllib 1.2부터 smtpd 패키지가 추가되었습니다. SMTP(Simple Mail Transfer Protocol)는 전자메일의 송수신을 하는 서버 애플리케이션입니다. 일반적으로, MTA(Mail Transfer Agent)라고 불리는 애플리케이션을 에뮬레이트한 것입니다. smtpd가 하는 일은

  1. SMTP포트(일반적으로 25번)로 접속을 기다린다.
  2. 메일이 도착하면, MIME헤더를 해석하고, From, To 등 헤더의 타당성을 보고 메일의 수락/거절 기능을 제공한다.
  3. 도착한 메일에 대하여, 어떠한 처리를 하는 기능을 제공한다.

위에서 말한 어떠한 기능을 제공한다는 것을 간단하게 예를 들면, 인터넷 내부에서 이 서버에 보내진 메일에 대하여

  1. 서버의 스풀에 보관한다.
  2. 수신인을 보고 MTA에 메일을 전송한다.(릴레이기능)

이러한 기능은 고도(-_-)의 지식을 필요로 하기 때문에, 자세한 사용법은 다른 곳에서 제공되고 있는 매뉴얼을 보시면 됩니다. 하지만 이 패키지의 주된 사용방법은 메일의 송신 클라이언트를 개발할 때의 테스트용입니다.

package require smtpd
proc validateHostProc host {
    puts "서버：$host"
}

proc validateSenderProc sender {
    puts "송신 자：$sender"
    if {! [regexp {@gmail\.com$} $sender]} {
        error "송신자 에러（error）!!"
    }
}

proc validateRecipientProc recipient {
    puts "수신인：$recipient"
}

proc deliveredProc {sender recipients data} {
    if {[catch {eval array set saddr [mime::parseaddress $sender]}]} {
        error "invalid sender address \"$sender\""
    }
   
    set mail "From $saddr(address) [clock format [clock seconds]]"
    append mail "\n" [join $data "\n"]    
    foreach rcpt $recipients {
        if {! [catch {eval array set addr [mime::parseaddress $rcpt]}]} {
             puts $mail
        }
    }
}

::smtpd::configure -validate_host validateHostProc \
    -validate_sender validateSenderProc \
    -validate_recipient validateRecipientProc \
    -deliver deliveredProc

#::smtpd::start
::smtpd::start 0.0.0.0 8025

message .msg -text "현재 메일서버가 작동하고 있습니다."
button .b -text "종료" -command {::smtpd::stop; exit}
pack .msg .b -side top
# end.

smtpd의 사용방법도 ftpd의 사용방법과 비슷합니다. 먼저 configure 커맨드로

  1. 송신지 호스트의 IP어드레스의 타당성을 체크(-validate_host)
  2. 송신자(From:)의 타당성을 체크(-validate_sender)
  3. 수신인(To:)의 타당성을 체크(-validate_recipient)
  4. 송신 성공인 경우의 메일에 대하여 처리(-deliver)를 지정합니다.

타당성 체크 처리가 실패한 경우에는, error 커맨드를 사용하여 에러를 발생시키면 됩니다. 실제 서비스 시작 시 start 커맨드를 사용합니다. 인자는 대상의 네트워크 인터페이스와 포트번호입니다. 인자를 생략하면, 모든 네트워크 인터페이스에 대하여, 포트 25번으로 메일이 오기를 기다립니다.

struct

Tcllib에는 큐(queue), 스택(stack)등의 알고리즘으로 데이터를 조작할 수 있는 struct 패키지를 제공합니다. 여기서는 간단하게 struct의 패키지를 사용하여 stack을 사용해 봅니다.

package require struct
set stack [::struct::stack]
push $stack "one"
push $stack "two"
push $stack "three"

set value [$stack pop]
set value [$stack pop]
set value [$stack pop]

간단하게 위와 같은 모양이 됩니다. ::struct::stack 커맨드로 stack의 오브젝트를 만들고, 그 서브커맨드 push, pop을 사용하여 데이터를 조작하면 됩니다.

htmlparse

Perl에서는, HTML문서의 파싱이 정규 표현식으로 구현이 가능하다는 것으로 알려져 있습니다. 예를 들어 각 프로그래머가 개개의 루틴을 작성해 줄 필요가 없이, 루틴들이 표준화되어있다면 편리할 것입니다. 그래서 Tcl에서는 HTML파서의 표준화시도를 하고 있습니다. 바로 Tcllib 1.1에서부터 추가된 htmlparse 패키지를 이용하면, HTML문서의 파싱을 매우 간단하  게 할 수 있습니다. 우선 HTML 태그를 찾아서 표시하는, 간단한 예제입니다.

package require htmlparse
set htmlfilename [lindex $argv 0]
if {"$htmlfilename" == ““} {
   puts stderr "usage: $argv0 htmlfilename"
   exit
}

set fin [open $htmlfilename r]
set html [read $fin]
close $fin

proc callback {tag slash param textbehind} {
   puts "<$tag> <$slash> <$param> <$textbehind>"
}

::htmlparse::parse -cmd callback $html
# end.

 

해석은 ::htmlparse::parse 커맨드를 사용합니다. 해석한 HTML은 HTML문서 전체라도 한 행씩 처리가 가능합니다. 여기서는 HTML문서 전체를 read 커맨드로 읽어, 이것을 한 번에 처리하고 있습니다. ::htmlparse::parse는 HTML 태그를 찾을 때마다, 지정한 콜백루틴을 호출합니다. htmlparse는 디폴트로 ::htmlparse::defaultCallback로 쓰이며, -cmd 옵션을 줄수도 있는데 이때 4개의 인자가 자동으로 붙여집니다. 이것은 위의 예제 안의 tag, slash, param, textbehind입니다. 각각의 의미는 다음과 같습니다.

  • tag: HTML 태그(br, img..)가 들어갑니다.
  • slash: 여는 태그라면 "", 닫는 태그라면 "/"가 들어갑니다.
  • param: 태그의 속성 파라미터.
  • textbehind: 태그로부터, 다른 태그가 나타나기 전까지의 문자입니다. 태그로 둘려 싸여있는 본체라 보면 됩니다. 개행문자(\n)도 들어갑니다.

콜백루틴에 인자를 추가하는 것도 가능합니다. 자주 있는 일일 겁니다. HTML문서의 파일명을 건네주고 싶은 경우는 아래와 같이 합니다. 

proc callback {filename tag slash param textbehind} {
   puts "<$tag> <$slash> <$param> <$textbehind>"
}
::htmlparse::parse -cmd "callback $filename " $html

태그가 제대로 닫혔는지 체크하기

앞서 설명한 struct패키지의 stack과 HTML parse패키지를 조합하는 방법으로 HTML태그가 제대로 닫혔는지 체크하는 프로그램을 쉽게 작성할 수 있습니다. 원리는 매우 간단합니다. 시작되는 태그가 있다면, 스택에 집어넣고, 닫는 태그가 나타나면 스택의 맨 위에 있는 태그를 꺼내어서, 닫는 태그와 비교합니다. 일치하지 않는다면, 닫힌 태그가 없는 것으로 간주합니다. 단 HTML문서의 규약상, img태그나, br태그는 닫는 태그가 없기 때문에 이는 제외해야 합니다. 아래의 스크립트가 바로 태그가 제대로 닫혔는지를 체크하는 스크립트입니다. 커맨드 라인의 아규먼트로 HTML파일을 지정해 주면 해당 파일을, 디렉토리를 지정해주면 해당 디렉토리에 있는 HTML 모든 문서를 검색해서 체크합니다. 

package require struct
package require htmlparse
namespace eval Parser {
 # 닫지않아도 되는 태그의 경우는 1, 아니면 0을 리턴
 proc isoktag tag {
    set oktags {IMG BR HR LI INPUT META FRAME}
    if {[lsearch $oktags [string toupper $tag]] >= 0} {
       return 1
    } else {
       return 0
    }
 }

 proc callback {tag slash param textbehind} {
    variable stack
    variable lineno
    variable errorcount    # HTML의 처음에 가상적이게 붙이지고 콜된 태그(hmstart)는 건너뛰고 읽는다.
    if {"$tag" == "hmstart"} {return}    
    if {"$slash" == "/"} {
       # 종료 태그의 경우
       while 1 {
          if {[catch { set a [ $stack pop] }]} { break }
          set lasttag [lindex $a 0]
          set lastlineno [lindex $a 1]
          if {"$lasttag" != "$tag" } {
             if {! [isoktag $lasttag]} {
                puts "ERROR: 태그 $lasttag ($lastlineno)는 닫혀지지 않았습니다.($lineno)"
                incr errorcount
             }
            #  다시 한번 세팅 하고 고친다.
          } else { break }
       }
      # puts "종료($lineno) <$tag> <$param> <[string trim $textbehind]>"
    } else {
       # 시작되는 태그의 경우
       $stack push [list $tag $lineno]
      # puts "시작($lineno) <$tag> <$param> <[string trim $textbehind]>"
    }
 }

 proc start htmlfilename {
    variable stack
    variable lineno
    variable errorcount 0
    set stack [::struct::stack]
    set fin [open $htmlfilename r]
    for {set lineno 1} {! [eof $fin]} {incr lineno} {
       set html [gets $fin]
       ::htmlparse::parse -cmd [namespace current]::callback -incvar inc -- $html
    }
    close $fin
    puts "완료!! 에러수는 $errorcount 입니다."
 }
}

set htmlfilename [lindex $argv 0]
if {"$htmlfilename" == ““} {
 puts stderr "usage: $argv0 htmlfilename"
 exit
}

if {[file isfile $htmlfilename]} {
 ::Parser::start $htmlfilename
} elseif {[file isdirectory $htmlfilename]} {
 foreach e [glob [file join $htmlfilename *.htm*]] {
     puts "********** $e **********"
    ::Parser::start $e
 }
}
# end.
저작자표시 비영리 변경금지
댓글 , 엮인글
Korea Tcl/Tk Community
블로그 이미지 ihmin 님의 블로그
MENU
CATEGORY
VISITOR 오늘 / 전체

티스토리툴바