Tcl / Tk
Programmation cgi en tcl
Auteur :
Arnaud LAPREVOTE
Linbox Free&ALter Soft
152, rue de Grigy
57070 METZ
tel: 03 87 50 87 90 - 06 11 36 15 30
fax : 03 87 75 19 26
Email : arnaud.laprevote@linbox.com
1. Introduction
Il existe plusieurs ensemble de packages pour la programmation cgi en tcl. Le premier est html et ncgi qui sont intégrés dans la tcllib 1.0. Je ne les ai jamais utilisés, mais à n'en point douter ils sont fort intéressants. Le second est le package cgi.tcl de Don Libes (http://expect.nist.gov/cgi.tcl). J'ai toujours programmé avec et l'expérience prouve que c'est un excellent package avec une très grande cohérence (donc facile à apprendre). C'est de ce package de programmation cgi dont je vais vous parler.2. Programmation cgi ?
Le web fondamentalement est un ensemble de protocoles et de formats :- au plus bas, échange des informations via tcp/ip,
- juste au dessus le protocole http gère l'échange des informations entre le navigateur et le serveur web,
- tout en haut, le format des fichiers est html. Un navigateur est capable d'afficher un fichier html. Un serveur web est cependant capable d'échanger tout fichier (binaire, texte, graphique, vidéo, ...) avec le navigateur. A charge au navigateur d'afficher ce qu'on lui envoie.
Le cgi est une norme d'échange des informations entre le serveur et un programme. Globalement, ce qu'il définit est que :
- la sortie standard d'affichage du programme est directement envoyée du programme vers le serveur et du serveur vers le navigateur,
- les données envoyées du navigateur vers le programme lui sont fournies sous une forme connue et normalisée,
- les cookies sont un palliatif au fait que chaque requète est totalement déconnectée de la précédente. Il n'y a pas maintient de la connection entre le serveur et le client.
cgi.tcl est un ensemble de procédures qui vont permettre à un programme tcl de devenir un script cgi. cgi.tcl assure :
- la génération simple des tags html,
- l'importation et la préparation de l'exportation des variables et des fichiers,
- la gestion des erreurs dans les scripts cgi.
Vous trouverez tclhttpd, tcllib, cgi.tcl (seul), directement sur http://www.linbox.com/tclhttpd.tgz .
3. Et hop un exemple simple
#!/usr/bin/tclsh
package require cgi
cgi_eval {
cgi_html {
cgi_head {
cgi_title "Premier exemple en cgi.tcl"
}
cgi_body "bgcolor=#ffffff" {
cgi_center {
cgi_h1 "E.T. téléphone maison en cgi"
}
cgi_p "[cgi_bold "E.T."] est un extra-terrestre qui a bu un coup de trop."
cgi_p "Il sort de sa [cgi_font "size=+1" "soucoupe" \
], et alors, n'est plus dans son assiette."
cgi_p "Il [cgi_font color=#FF0000 "marche" \
], il marche, dans un monde hostile, affolé par un décor inconnu."
cgi_p "A la fin, il se retrouve doper comme un cycliste, à pédaler sur la lune."
cgi_p "Et puis, cela finit bien."
cgi_hr
cgi_center {
cgi_h1 "E.T. téléphone maison en cgi"
}
cgi_puts "[cgi_bold "E.T."] est un extra-terrestre qui a bu un coup de trop."
cgi_br
cgi_puts "Il sort de sa soucoupe, et alors, n'est plus dans son assiette."
cgi_br
cgi_puts "Il marche, il marche, dans un monde hostile, affolé par un décor inconnu."
cgi_br
cgi_puts "A la fin, il se retrouve doper comme un cycliste, à pédaler sur la lune."
cgi_br
cgi_puts "Et puis, cela finit bien."
cgi_br
cgi_hr
cgi_center {
cgi_h1 "E.T. téléphone maison en cgi"
}
cgi_bullet_list {
cgi_li "[cgi_bold "E.T."] est un extra-terrestre qui a bu un coup de trop."
cgi_bullet_list {
cgi_li "Il sort de sa soucoupe, et alors, n'est plus dans son assiette."
}
cgi_li "Il marche, il marche, dans un monde hostile, affolé par un décor inconnu."
cgi_li "A la fin, il se retrouve doper comme un cycliste, à pédaler sur la lune."
cgi_li "Et puis, cela finit bien."
}
cgi_hr
cgi_center {
cgi_h1 "E.T. téléphone maison en cgi"
}
cgi_table "bgcolor=#E0E0E0" "border=1" "width=100%" {
cgi_table_row {
cgi_table_data colspan=2 align=center {
cgi_puts \
"[cgi_bold "E.T."] est un extra-terrestre qui a bu un coup de trop."
}
}
cgi_table_row {
cgi_table_data colspan=2 align=center {
cgi_puts \
"Il sort de sa soucoupe, et alors, n'est plus dans son assiette."
}
}
cgi_table_row {
cgi_table_data colspan=2 align=right {
cgi_puts \
"Il marche, il marche, \
dans un monde hostile, affolé par un décor inconnu."
}
}
cgi_table_row {
cgi_table_data align=left {
cgi_puts \
"A la fin, il se retrouve doper comme un cycliste, à pédaler sur la lune."
}
cgi_td align=justify "Et puis, cela finit bien."
}
}
}
}
}
Nous allons placer ce script appeler test_cgi.tcl dans le sous répertoire cours que nous créons pour l'occasion du répertoire où se trouvent les cgi. Ce répertoire dépend de la manière dont apache a été installé. Ce peut être /home/httpd/cgi-bin (RedHat 6.2 Mandrake 7.2) => /home/httpd/cgi-bin/cours/test_cgi.tcl ou peut-être /var/httpd/cgi-bin ou encore /usr/lib/cgi-bin (debian).
Après avoir rendu ce programme lisible et exécutable par tout le monde, il suffit de demander depuis un navigateur :
http://localhost/cgi-bin/cours/test_cgi.cgi
Et sous vos yeux émerveillés vous devriez voir quelque chose comme cela :
4. html généré
Si l'on regarde l'html, l'on voit :<html> <head> <title>untitled</title> </head> <bodybgcolor="#ffffff" > <divalign=center><h1>E.T. téléphone maison en cgi</h1></div> <p><b>E.T.</b> est un extra-terrestre qui a bu un coup de trop.</p> <p>Il sort de sa <fontsize=+1>soucoupe</font>, et alors, n'est plus dans son assiette.</p> <p>Il <fontcolor="#FF0000">marche</font>, il marche, dans un monde hostile, affolée par un décor inconnu.</p> <p>A la fin, il se retrouve doper comme un cycliste, à pédaler sur la lune.</p> <p>Et puis, cela finit bien.</p> <hr> <divalign=center><h1>E.T. téléphone maison en cgi</h1></div> <b>E.T.</b> est un extra-terrestre qui a bu un coup de trop. <br>Il sort de sa soucoupe, et alors, n'est plus dans son assiette. <br>Il marche, il marche, dans un monde hostile, affolée par un décor inconnu. <br>A la fin, il se retrouve doper comme un cycliste, à pédaler sur la lune. <br>Et puis, cela finit bien. <br> <hr> <divalign=center><h1>E.T. téléphone maison en cgi</h1></div> <ul> <li><b>E.T.</b> est un extra-terrestre qui a bu un coup de trop. <ul><li>Il sort de sa soucoupe, et alors, n'est plus dans son assiette.</ul> <li>Il marche, il marche, dans un monde hostile, affolée par un décor inconnu. <li>A la fin, il se retrouve doper comme un cycliste, à pédaler sur la lune. <li>Et puis, cela finit bien. </ul> <hr> <divalign=center><h1>E.T. téléphone maison en cgi</h1></div> <tablebgcolor=#E0E0E0border=1width=100%> <tr> <tdcolspan=2align=center><b>E.T.</b> est un extra-terrestre qui a bu un coup de trop. </td> </tr> <tr> <tdcolspan=2align=center>Il sort de sa soucoupe, et alors, n'est plus dans son assiette. </td> </tr> <tr> <tdcolspan=2align=right>Il marche, il marche, dans un monde hostile, affolée par un décor inconnu. </td> </tr> <tr> <tdalign=left>A la fin, il se retrouve doper comme un cycliste, à pédaler sur la lune. </td> <tdalign=justify>Et puis, cela finit bien. </td> </tr> </table> </body> </html>
Et nous allons commenter cela en détail.
5. Commandes de base de génération
- cgi_eval : permet d'attraper les erreurs et de les afficher dans le navigateur lors du debogue. Les erreurs sont sinon mailées au webmaster.
- cgi_html : génération de <html></html>
- cgi_head : <head></head>
- cgi_title "Le titre" : <title>Le titre</title>
- cgi_center toto: <center>toto</center>
- commandes de génération de paragraphes
-
- cgi_p
- cgi_address
- cgi_blockquote
- cgi_h1 through h7
- cgi_bullet_list
- li
- cgi_br
- commandes de formattage de caractères
-
- cgi_bold
- cgi_italic
- cgi_underline
- cgi_font
- commandes de génération de caractères
-
- cgi_lt <
- cgi_gt >
- cgi_amp &
- cgi_quote "
- cgi_enspace en space
- cgi_emspace em space
- cgi_nbspace nonbreaking space
- cgi_isochar n ISO character #n
- tags renvoyant à d'autres objets
-
- liens -> cgi_url : cgi_url "Arnaud Laprévote" "mailto:arnaud.laprevote@freealter.com"
- images -> cgi_img : cgi_img rose.jpeg "Ma Rose"
- génération de tables
-
- cgi_table
- cgi_table_row
- cgi_table_data (cgi_td : pas d'évaluation)
6. Les formulaires
#!/usr/bin/tclsh
package require cgi
cgi_eval {
cgi_html {
cgi_head {
cgi_title "cgi 2"
}
cgi_body "bgcolor=#ffffff" {
cgi_center {
cgi_h1 "[cgi_title]"
}
cgi_form test_cgi3 {
cgi_table {
cgi_table_row {
cgi_td "Fichier"
cgi_table_data {
cgi_text "fichier=" size=20
}
}
cgi_table_row {
cgi_table_data colspan=2 {
cgi_textarea "contenu=" \
rows=10 cols=30 wrap=virtual
}
}
cgi_table_row {
cgi_table_data {
cgi_select selection size=10 {
cgi_option 1
cgi_option 2 selected
cgi_option 3
cgi_option 4
}
}
cgi_table_data {
cgi_puts "V1 :"
cgi_radio_button "version=1"
cgi_br
cgi_puts "V2 :"
cgi_radio_button "version=2" checked
cgi_br
cgi_puts "Bleu :"
cgi_checkbox "tList=a"
cgi_br
cgi_puts "Rouge :"
cgi_checkbox "tList=b"
}
}
cgi_table_row {
cgi_table_data {
cgi_submit_button "Action=OK"
}
cgi_export "hidden_data=Totally hidden"
cgi_table_data {
cgi_image_button \
"Image=http://localhost/NewsClipper/images/enveloppe.gif"
}
}
}
}
}
}
}
Donc :
- cgi_form
- cgi_text (toto=xxxxxx => name=toto value=xxxxx)
- cgi_textarea (toto=xxxxxx => name=toto value=xxxxx)
- cgi_radio_button
- cgi_checkbox (nomList=valeur)
- cgi_submit_button (nom=valeur)
- cgi_select toto { cgi_option truc }
- cgi_image_button (nom=url_image)
7. Récupérons maintenant
Globalement, il y a 2 méthodes. La méthode pépère, et la méthode non documentée et donc plus intéressante.
#!/usr/bin/tclsh
package require cgi
cgi_eval {
cgi_input "Action=test"
cgi_html {
cgi_head {
cgi_title "cgi 3 - valeurs importées"
}
cgi_body "bgcolor=#ffffff" {
cgi_center {
cgi_h1 "[cgi_title]"
}
set importList [cgi_import_list]
cgi_table {
foreach name $importList {
cgi_table_row {
cgi_import $name
cgi_td "$name"
cgi_td "[set $name]"
}
}
}
cgi_puts "Mais diaboliquement"
cgi_parray _cgi_uservar
}
}
}
Commencez par lancer ce code depuis le shell et examinez le résultat.
8. Importations et bananes
- cgi_input "name=libes&old=foo&new1=bar&new2=hello"
- cgi_import_list
- cgi_import nom_de_variable
- cgi_import_as nom variable_tcl
- commandes pour les cookies
- commandes pour les fichiers
9. Deboguons
Qui dit programmation, dit bogues. cgi.tcl a quelques sympathiques propositions.
#!/usr/bin/tclsh
package require cgi
cgi_debug -on
cgi_eval {
cgi_input "Action=test"
cgi_html {
cgi_head {
cgi_title "cgi 3 - valeurs importées"
}
cgi_body "bgcolor=#ffffff" {
cgi_center {
cgi_h1 "[cgi_title]"
}
cgi_debug {
cgi_p "Le deboguage est activé"
}
J'écris n'importe quoi cela
va planter
}
}
}
Ce qui nous donne :
10. Deboguons encore
- cgi_eval : coeur de la fonction d'attrapage des erreurs,
- cgi_debug (-on | -off | -temp | code à exécuter)
11. Quand au reste des commandes
Vous ferez comme tout le monde, vous lirez la documentation en entier (elle est courte).12. Trucs et astuces
- pour l'habillage, vous avez les fonctions app_body_start et app_body_end qui sont toujours appelées juste après l'ouverture du body et juste avant sa fermeture. Il est facile de localiser le code pour les menus dans cette section,
- pour l'importation des variables, il y a une méthode conseillée. Ergonomiquement, en programmation cgi, quand on renvoie des erreurs après la saisie de valeurs, il faut les renvoyer toutes d'un coup (sinon, il peut y avoir de nombreux allers et retours désagréables). D'où la méthode que nous utilisons systématiquement chez Free&ALter Soft :
#!/usr/bin/tclsh
package require cgi
cgi_debug -on
#
# Procedure used to validate a password.
# Here I do not need to do anything, then the password
# is always validated
# I just send back 1
#
proc ValidatePassword { password owner_list } {
return [list 1 ""]
}
#################### Import a variable
#
# Import a given variable shout in case of errors
# and add it to the error messages
# Always sendback a value, eventually empty.
# If they are errors the values must
# not be processed any longer.
# errors (which gives the nber of errors)
# errstr (which is the string of the errors)
# MUST EXIST in the calling environment
#
# If an argument -mandatory is given, it means
# that the variable is mandatory
# then an error message is generated if its length
# is 0 or if it could not be imported.
#
# If the value _("$name") exists in the array _
# then it is used in the error message.
#
# Other possible option than mandatory are :
# -number
# * if nothing is imported $default
# is used as a default value
# * if a value is imported, it is
# cleaned up to be only numbers else
# an error is issued
# -percent
# * as -number and any % sign is fully cancelled
# -year
# * a 2 or 4 digit number, if 2 => filled up to 4
# - month
# * should be in the month list
# -password {{name} {firstname}}
# * in this case the function ValidatePassword is called,
# it sends backs a list {1 "password"} or {0 "error message"}
# -default value
# * if no value are imported for the
# variable then the default value is used
# Calling example :
# ImportVariable Name -mandatory
# ImportVariable Coefficient -number -default 1.0
# ImportVariable PartialTime -percent -default 100
# ImportVariable Flag -flag
# Translation of error messages
set "_(Impossible to get )" "Impossible d obtenir"
set "_( - you did not call this script from the good place)" \
" - vous n'avez pas appelé ce script de la bonne manière"
set "_( must be filled in - please go back and fill it !)" \
" doit être rempli - merci de revenir en arrière et de les remplir"
set "_( must be a number \(1.0 or 1,5\))" \
" doit être un nombre (1.0 ou 1.5)"
set "_(Bad year specification)" \
"Mauvaise spécification d'année"
set "_(Not a valid month.)" \
"Mois non valide"
set "_(Please try again.)" \
"Merci d'essayer à nouveau"
proc ImportVariable { name args } {
global _
set result ""
set default ""
set mandatory 0
set month 0
set percent 0
set number 0
set flag 0
set year 0
set password 0
set default_state 0
set password_owner_list [list "" ""]
set state flag
foreach arg $args {
switch -- $state {
flag {
switch -glob -- $arg {
-ma* { set mandatory 1 }
-nu* { set number 1 }
-pe* { set number 1; set percent 1; }
-fl* { set flag 1 }
-ye* { set year 1 }
-mo* { set month 1 }
-de* { set state default; set default_state 1 }
-pa* { set state password; set password 1; }
}
}
default {
set default $arg
# come back to the flag examination
set state flag
}
password {
# password_owner is a list with name and firstname
set password_owner_list $arg
# come back to flag look
set state flag
}
}
}
if { [catch { cgi_import_as $name result}] } {
if { $mandatory } {
# There was a problem
uplevel { incr errors }
uplevel " append errstr \"$_(\"Impossible to get \")\" "
if { [info exists _("$name")] } {
set message $_("$name")
uplevel "append errstr \"$message\""
} else {
uplevel "append errstr $name"
}
uplevel "append errstr \"$_(\" - you did not call this script from the good place\")\"; append errstr \"<br>\"; "
}
if { $flag } {
# In this case, if no value was imported, it means that it is false
set result 0
}
if { $default_state } {
set result $default
}
if { $password } {
set result ""
}
} else {
# Now cleaning the input
set result [string trim $result]
if { $mandatory } {
# it is a mandatory input and is empty, an error is generated
if { [string length $result] < 1 } {
uplevel { incr errors }
if { [info exists _("$name")] } {
set message $_("$name")
} else {
set message $name
}
append message $_(" must be filled in - please go back and fill it !"); append message "<br>"
uplevel "append errstr \"$message\""
}
}
if { $percent } {
regsub -all "%" $result "" result
}
if { $number } {
# Is it empty ?
if { [string length $result] == 0 } {
set result $default
} else {
# it must be a number with either . or , as separators
# First, I substitute all , with a .
regsub -all "," $result "." result
# Next I verify that it is a number
if { [regexp {[^- .01-9]} $result match] > 0 } {
uplevel { incr errors }
if { [info exists _("$name")] } {
set message $_("$name")
uplevel "append errstr \"$message\""
} else {
uplevel "append errstr $name";
}
uplevel {
append errstr $_(" must be a number \(1.0 or 1,5\)")
append errstr "<br>"
}
}
}
}
if { $flag } {
# a value comes, either it is 1 or not. If it is not, it is 0.
if { $result != 1 } { set result 0}
}
if { $year } {
# Now cleaning the year
set result [string trim $result]
# and verifying that it is valid (4 digits only \
# - if 2 digits and < 99 then 2000 else 1999))
if { [regexp {[0-9]+} $result match] =< 0} {
if { $default_state } {
set result $default
} else {
uplevel {
incr errors
append errstr $_("Bad year specification")
append errstr "<br>"
}
}
} elseif { [string length $result] == 2 } {
# It is a 2 digit year then 00-99.
# If it is < 98 then it is 199?
# else it is 20??
if { $result < 98 } { set result "20$result" } else {
set $result "19$result"
}
}
# else it is a 4 digit year and I suppose that it is valid
}
if { $month } {
# just returns a number between 1 and 12
# and verifying that it belongs to the MonthList
if {[regexp {[^0-9]+} $result match] > 0 } {
uplevel {
incr errors
append errstr $_("Not a valid month.")
append errstr "<br>"
}
} elseif { !(( $result > 0 ) && ( $result < 13 )) } {
uplevel {
incr errors
append errstr $_("Not a valid month.")
append errstr "<br>"
}
}
}
}
# If no password was given then I use "" as a default value, which is perfectly possible
if { $password } {
# I have a value for the password and I am supposed to have a default name list
# I can now tryed to do the authentification
set accepted_list [ValidatePassword $result $password_owner_list]
set accepted [lindex $accepted_list 0]
if { !$accepted } {
uplevel {
incr errors
}
uplevel "append errstr \"[lindex $accepted_list 1]\""
uplevel {
append errstr "<br>"
append errstr $_("Please try again.")
append errstr "<br>"
}
}
}
return $result;
}
proc is_look_allowed { look } {
return 1
}
cgi_eval {
cgi_input "look=demo&owner=gerant&name=test"
set errors 0
set errstr ""
set look [ImportVariable look -mandatory]
set owner [ImportVariable owner -mandatory]
set name [ImportVariable name -mandatory]
if { ![is_look_allowed $look] } {
incr errors
set errstr "$errstr\n<p><b>Ce look n'existe pas.</b>"
}
if { $errors > 0 } {
cgi_title "Erreur dans do_copy.cgi"
cgi_html {
cgi_body {
puts "$errstr"
}
}
} else {
cgi_html {
cgi_head {
cgi_title "Pourquoi pas ?"
}
cgi_body "bgcolor=#ffffff" {
cgi_center {
cgi_h1 "[cgi_title]"
}
cgi_p "Look : $look"
cgi_p "Owner : $owner"
cgi_p "Name : $name"
}
}
}
}
- Ah oui, tiens, les template en tcl :
set template {<html><body bgcolor="${color}">
<center><h1>${name} est le meilleur</h1></center>
</body>
</html>
}
set color "#ffffff"
set name "Arnaud LAPREVOTE"
set result [eval subst [list $template]]
# With a procedure, it gives
proc templ_proc { data } {
puts [uplevel 1 subst [list $data]]
}
templ_proc $template
Bon, je ne l'ai pas trouvé tout seul, c'est Ludovic qui me l'a soufflé après l'avoir lu dans Advanced Tcl Programming de Brentt Welch.
13. Vous n'allez pas rigoler ...
Votre mission si vous l'acceptez, créer une petite application de carnet d'adresses en cgi.tcl . Vous stockerez le carnet d'adresse dans un fichier adresse.txt dans le répertoire tmp.Dans le programme tcl, vous représenterez l'ensemble des adresses comme étant une liste de listes. Chaque personne sera une liste : Numéro d'identification unique, Nom, Prénom, H/F, Addresse, Ville, Code Postal, Tel, Fax, Email, Portable.
Vous aurez 3 programmes cgi. Le premier vous permet d'afficher le formulaire d'entrée ou de modification des adresses, le second, entre ou modifie une adresse, le dernier permet d'avoir un tableau avec toutes les informations. Au bout de chaque ligne, un bouton permet de voir le détail et modifier une adresse.
